APP12.pm 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322
  1. #------------------------------------------------------------------------------
  2. # File: APP12.pm
  3. #
  4. # Description: Read APP12 meta information
  5. #
  6. # Revisions: 10/18/2005 - P. Harvey Created
  7. #
  8. # References: 1) Heinrich Giesen private communication
  9. #------------------------------------------------------------------------------
  10. package Image::ExifTool::APP12;
  11. use strict;
  12. use vars qw($VERSION);
  13. use Image::ExifTool qw(:DataAccess :Utils);
  14. $VERSION = '1.13';
  15. sub ProcessAPP12($$$);
  16. sub ProcessDucky($$$);
  17. sub WriteDucky($$$);
  18. # APP12 tags (ref PH)
  19. %Image::ExifTool::APP12::PictureInfo = (
  20. PROCESS_PROC => \&ProcessAPP12,
  21. GROUPS => { 0 => 'APP12', 1 => 'PictureInfo', 2 => 'Image' },
  22. PRIORITY => 0,
  23. NOTES => q{
  24. The JPEG APP12 "Picture Info" segment was used by some older cameras, and
  25. contains ASCII-based meta information. Below are some tags which have been
  26. observed Agfa and Polaroid images, however ExifTool will extract information
  27. from any tags found in this segment.
  28. },
  29. FNumber => {
  30. ValueConv => '$val=~s/^[A-Za-z ]*//;$val', # Agfa leads with an 'F'
  31. PrintConv => 'sprintf("%.1f",$val)',
  32. },
  33. Aperture => {
  34. PrintConv => 'sprintf("%.1f",$val)',
  35. },
  36. TimeDate => {
  37. Name => 'DateTimeOriginal',
  38. Description => 'Date/Time Original',
  39. Groups => { 2 => 'Time' },
  40. ValueConv => '$val=~/^\d+$/ ? ConvertUnixTime($val) : $val',
  41. PrintConv => '$self->ConvertDateTime($val)',
  42. },
  43. Shutter => {
  44. Name => 'ExposureTime',
  45. ValueConv => '$val * 1e-6',
  46. PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
  47. },
  48. shtr => {
  49. Name => 'ExposureTime',
  50. ValueConv => '$val * 1e-6',
  51. PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
  52. },
  53. 'Serial#' => {
  54. Name => 'SerialNumber',
  55. Groups => { 2 => 'Camera' },
  56. },
  57. Flash => { PrintConv => { 0 => 'Off', 1 => 'On' } },
  58. Macro => { PrintConv => { 0 => 'Off', 1 => 'On' } },
  59. StrobeTime => { },
  60. Ytarget => { Name => 'YTarget' },
  61. ylevel => { Name => 'YLevel' },
  62. FocusPos => { },
  63. FocusMode => { },
  64. Quality => { },
  65. ExpBias => 'ExposureCompensation',
  66. FWare => 'FirmwareVersion',
  67. StrobeTime => { },
  68. Resolution => { },
  69. Protect => { },
  70. ConTake => { },
  71. ImageSize => { PrintConv => '$val=~tr/-/x/;$val' },
  72. ColorMode => { },
  73. Zoom => { },
  74. ZoomPos => { },
  75. LightS => { },
  76. Type => {
  77. Name => 'CameraType',
  78. Groups => { 2 => 'Camera' },
  79. DataMember => 'CameraType',
  80. RawConv => '$self->{CameraType} = $val',
  81. },
  82. Version => { Groups => { 2 => 'Camera' } },
  83. ID => { Groups => { 2 => 'Camera' } },
  84. );
  85. # APP12 segment written in Photoshop "Save For Web" images
  86. # (from tests with Photoshop 7 files - PH/1)
  87. %Image::ExifTool::APP12::Ducky = (
  88. PROCESS_PROC => \&ProcessDucky,
  89. WRITE_PROC => \&WriteDucky,
  90. GROUPS => { 0 => 'Ducky', 1 => 'Ducky', 2 => 'Image' },
  91. WRITABLE => 'string',
  92. NOTES => q{
  93. Photoshop uses the JPEG APP12 "Ducky" segment to store some information in
  94. "Save for Web" images.
  95. },
  96. 1 => { #PH
  97. Name => 'Quality',
  98. Priority => 0,
  99. Avoid => 1,
  100. Writable => 'int32u',
  101. ValueConv => 'unpack("N",$val)', # 4-byte integer
  102. ValueConvInv => 'pack("N",$val)',
  103. PrintConv => '"$val%"',
  104. PrintConvInv => '$val=~/(\d+)/ ? $1 : undef',
  105. },
  106. 2 => { #1
  107. Name => 'Comment',
  108. Priority => 0,
  109. Avoid => 1,
  110. # (ignore 4-byte character count at start of value)
  111. ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
  112. ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
  113. },
  114. 3 => { #PH
  115. Name => 'Copyright',
  116. Priority => 0,
  117. Avoid => 1,
  118. Groups => { 2 => 'Author' },
  119. # (ignore 4-byte character count at start of value)
  120. ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
  121. ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
  122. },
  123. );
  124. #------------------------------------------------------------------------------
  125. # Write APP12 Ducky segment
  126. # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
  127. # Returns: New directory data or undefined on error
  128. sub WriteDucky($$$)
  129. {
  130. my ($et, $dirInfo, $tagTablePtr) = @_;
  131. $et or return 1; # allow dummy access to autoload this package
  132. my $dataPt = $$dirInfo{DataPt};
  133. my $pos = $$dirInfo{DirStart};
  134. my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
  135. my @addTags = sort { $a <=> $b } keys(%$newTags);
  136. my ($dirEnd, %doneTags);
  137. if ($dataPt) {
  138. $dirEnd = $pos + $$dirInfo{DirLen};
  139. } else {
  140. my $tmp = '';
  141. $dataPt = \$tmp;
  142. $pos = $dirEnd = 0;
  143. }
  144. my $newData = '';
  145. SetByteOrder('MM');
  146. # process all data blocks in Ducky segment
  147. for (;;) {
  148. my ($tag, $len, $val);
  149. if ($pos + 4 <= $dirEnd) {
  150. $tag = Get16u($dataPt, $pos);
  151. $len = Get16u($dataPt, $pos + 2);
  152. $pos += 4;
  153. if ($pos + $len > $dirEnd) {
  154. $et->Warn('Invalid Ducky block length');
  155. return undef;
  156. }
  157. $val = substr($$dataPt, $pos, $len);
  158. $pos += $len;
  159. } else {
  160. last unless @addTags;
  161. $tag = pop @addTags;
  162. next if $doneTags{$tag};
  163. }
  164. $doneTags{$tag} = 1;
  165. my $tagInfo = $$newTags{$tag};
  166. if ($tagInfo) {
  167. my $nvHash = $et->GetNewValueHash($tagInfo);
  168. my $isNew;
  169. if (defined $val) {
  170. if ($et->IsOverwriting($nvHash, $val)) {
  171. $et->VerboseValue("- Ducky:$$tagInfo{Name}", $val);
  172. $isNew = 1;
  173. }
  174. } else {
  175. next unless $$nvHash{IsCreating};
  176. $isNew = 1;
  177. }
  178. if ($isNew) {
  179. $val = $et->GetNewValue($nvHash);
  180. ++$$et{CHANGED};
  181. next unless defined $val; # next if tag is being deleted
  182. $et->VerboseValue("+ Ducky:$$tagInfo{Name}", $val);
  183. }
  184. }
  185. $newData .= pack('nn', $tag, length $val) . $val;
  186. }
  187. $newData .= "\0\0" if length $newData;
  188. return $newData;
  189. }
  190. #------------------------------------------------------------------------------
  191. # Process APP12 Ducky segment (ref PH)
  192. # Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
  193. # Returns: 1 on success, 0 if this wasn't a recognized Ducky segment
  194. # Notes: This segment has the following format:
  195. # 1) 5 bytes: "Ducky"
  196. # 2) multiple data blocks (all integers are big endian):
  197. # a) 2 bytes: block type (0=end, 1=Quality, 2=Comment, 3=Copyright)
  198. # b) 2 bytes: block length (N)
  199. # c) N bytes: block data
  200. sub ProcessDucky($$$)
  201. {
  202. my ($et, $dirInfo, $tagTablePtr) = @_;
  203. my $dataPt = $$dirInfo{DataPt};
  204. my $pos = $$dirInfo{DirStart};
  205. my $dirEnd = $pos + $$dirInfo{DirLen};
  206. SetByteOrder('MM');
  207. # process all data blocks in Ducky segment
  208. for (;;) {
  209. last if $pos + 4 > $dirEnd;
  210. my $tag = Get16u($dataPt, $pos);
  211. my $len = Get16u($dataPt, $pos + 2);
  212. $pos += 4;
  213. if ($pos + $len > $dirEnd) {
  214. $et->Warn('Invalid Ducky block length');
  215. last;
  216. }
  217. my $val = substr($$dataPt, $pos, $len);
  218. $et->HandleTag($tagTablePtr, $tag, $val,
  219. DataPt => $dataPt,
  220. DataPos => $$dirInfo{DataPos},
  221. Start => $pos,
  222. Size => $len,
  223. );
  224. $pos += $len;
  225. }
  226. return 1;
  227. }
  228. #------------------------------------------------------------------------------
  229. # Process APP12 Picture Info segment (ref PH)
  230. # Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
  231. # Returns: 1 on success, 0 if this wasn't a recognized APP12
  232. sub ProcessAPP12($$$)
  233. {
  234. my ($et, $dirInfo, $tagTablePtr) = @_;
  235. my $dataPt = $$dirInfo{DataPt};
  236. my $dirStart = $$dirInfo{DirStart} || 0;
  237. my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
  238. if ($dirLen != $dirStart + length($$dataPt)) {
  239. my $buff = substr($$dataPt, $dirStart, $dirLen);
  240. $dataPt = \$buff;
  241. } else {
  242. pos($$dataPt) = $$dirInfo{DirStart};
  243. }
  244. my $verbose = $et->Options('Verbose');
  245. my $success = 0;
  246. my $section = '';
  247. pos($$dataPt) = 0;
  248. # this regular expression is a bit complex, but basically we are looking for
  249. # section headers (eg. "[Camera Info]") and tag/value pairs (eg. "tag=value",
  250. # where "value" may contain white space), separated by spaces or CR/LF.
  251. # (APP12 uses CR/LF, but Olympus TextualInfo is similar and uses spaces)
  252. while ($$dataPt =~ /(\[.*?\]|[\w#-]+=[\x20-\x7e]+?(?=\s*([\n\r\0]|[\w#-]+=|\[|$)))/g) {
  253. my $token = $1;
  254. # was this a section name?
  255. if ($token =~ /^\[(.*)\]/) {
  256. $et->VerboseDir($1) if $verbose;
  257. $section = ($token =~ /\[(\S+) ?Info\]/i) ? $1 : '';
  258. $success = 1;
  259. next;
  260. }
  261. $et->VerboseDir($$dirInfo{DirName}) if $verbose and not $success;
  262. $success = 1;
  263. my ($tag, $val) = ($token =~ /(\S+)=(.+)/);
  264. my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
  265. $verbose and $et->VerboseInfo($tag, $tagInfo, Value => $val);
  266. unless ($tagInfo) {
  267. # add new tag to table
  268. $tagInfo = { Name => ucfirst $tag };
  269. # put in Camera group if information in "Camera" section
  270. $$tagInfo{Groups} = { 2 => 'Camera' } if $section =~ /camera/i;
  271. AddTagToTable($tagTablePtr, $tag, $tagInfo);
  272. }
  273. $et->FoundTag($tagInfo, $val);
  274. }
  275. return $success;
  276. }
  277. 1; #end
  278. __END__
  279. =head1 NAME
  280. Image::ExifTool::APP12 - Read APP12 meta information
  281. =head1 SYNOPSIS
  282. This module is loaded automatically by Image::ExifTool when required.
  283. =head1 DESCRIPTION
  284. This module contains definitions required by Image::ExifTool to interpret
  285. APP12 meta information.
  286. =head1 AUTHOR
  287. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  288. This library is free software; you can redistribute it and/or modify it
  289. under the same terms as Perl itself.
  290. =head1 ACKNOWLEDGEMENTS
  291. Thanks to Heinrich Giesen for his help decoding APP12 "Ducky" information.
  292. =head1 SEE ALSO
  293. L<Image::ExifTool::TagNames/APP12 Tags>,
  294. L<Image::ExifTool(3pm)|Image::ExifTool>
  295. =cut