GIF.pm 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542
  1. #------------------------------------------------------------------------------
  2. # File: GIF.pm
  3. #
  4. # Description: Read and write GIF meta information
  5. #
  6. # Revisions: 10/18/2005 - P. Harvey Separated from ExifTool.pm
  7. # 05/23/2008 - P. Harvey Added ability to read/write XMP
  8. # 10/28/2011 - P. Harvey Added ability to read/write ICC_Profile
  9. #
  10. # References: 1) http://www.w3.org/Graphics/GIF/spec-gif89a.txt
  11. # 2) http://www.adobe.com/devnet/xmp/
  12. # 3) http://graphcomp.com/info/specs/ani_gif.html
  13. # 4) http://www.color.org/icc_specs2.html
  14. #------------------------------------------------------------------------------
  15. package Image::ExifTool::GIF;
  16. use strict;
  17. use vars qw($VERSION);
  18. use Image::ExifTool qw(:DataAccess :Utils);
  19. $VERSION = '1.12';
  20. # road map of directory locations in GIF images
  21. my %gifMap = (
  22. XMP => 'GIF',
  23. ICC_Profile => 'GIF',
  24. );
  25. %Image::ExifTool::GIF::Main = (
  26. GROUPS => { 2 => 'Image' },
  27. VARS => { NO_ID => 1 },
  28. NOTES => q{
  29. This table lists information extracted from GIF images. See
  30. L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt> for the official GIF89a
  31. specification.
  32. },
  33. GIFVersion => { },
  34. FrameCount => { Notes => 'number of animated images' },
  35. Text => { Notes => 'text displayed in image' },
  36. Comment => {
  37. # for documentation only -- flag as writable for the docs, but
  38. # it won't appear in the TagLookup because there is no WRITE_PROC
  39. Writable => 1,
  40. },
  41. Duration => {
  42. Notes => 'duration of a single animation iteration',
  43. PrintConv => 'sprintf("%.2f s",$val)',
  44. },
  45. ScreenDescriptor => {
  46. SubDirectory => { TagTable => 'Image::ExifTool::GIF::Screen' },
  47. },
  48. # GIF89a application extensions:
  49. ExtensionAnimation => {
  50. SubDirectory => { TagTable => 'Image::ExifTool::GIF::Animate' },
  51. },
  52. ExtensionXMP => { # (for documentation only)
  53. SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
  54. },
  55. ExtensionICC => { # (for documentation only)
  56. SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' },
  57. },
  58. );
  59. # GIF locical screen descriptor
  60. %Image::ExifTool::GIF::Screen = (
  61. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  62. GROUPS => { 2 => 'Image' },
  63. NOTES => 'Information extracted from the GIF logical screen descriptor.',
  64. 0 => {
  65. Name => 'ImageWidth',
  66. Format => 'int16u',
  67. },
  68. 2 => {
  69. Name => 'ImageHeight',
  70. Format => 'int16u',
  71. },
  72. 4.1 => {
  73. Name => 'HasColorMap',
  74. Mask => 0x80,
  75. PrintConv => { 0x00 => 'No', 0x80 => 'Yes' },
  76. },
  77. 4.2 => {
  78. Name => 'ColorResolutionDepth',
  79. Mask => 0x70,
  80. ValueConv => '($val >> 4) + 1',
  81. },
  82. 4.3 => {
  83. Name => 'BitsPerPixel',
  84. Mask => 0x07,
  85. ValueConv => '$val + 1',
  86. },
  87. 5 => 'BackgroundColor',
  88. );
  89. # GIF Netscape 2.0 animation extension
  90. %Image::ExifTool::GIF::Animate = (
  91. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  92. GROUPS => { 2 => 'Image' },
  93. NOTES => 'Information extracted from the "NETSCAPE2.0" animation extension.',
  94. 2 => {
  95. Name => 'AnimationIterations',
  96. Format => 'int16u',
  97. PrintConv => '$val ? $val : "Infinite"',
  98. },
  99. );
  100. #------------------------------------------------------------------------------
  101. # Process meta information in GIF image
  102. # Inputs: 0) ExifTool object reference, 1) Directory information ref
  103. # Returns: 1 on success, 0 if this wasn't a valid GIF file, or -1 if
  104. # an output file was specified and a write error occurred
  105. sub ProcessGIF($$)
  106. {
  107. my ($et, $dirInfo) = @_;
  108. my $outfile = $$dirInfo{OutFile};
  109. my $raf = $$dirInfo{RAF};
  110. my $verbose = $et->Options('Verbose');
  111. my $out = $et->Options('TextOut');
  112. my ($a, $s, $ch, $length, $buff);
  113. my ($err, $newComment, $setComment, $nvComment);
  114. my ($addDirs, %doneDir);
  115. my ($frameCount, $delayTime) = (0, 0);
  116. # verify this is a valid GIF file
  117. return 0 unless $raf->Read($buff, 6) == 6
  118. and $buff =~ /^GIF(8[79]a)$/
  119. and $raf->Read($s, 7) == 7;
  120. my $ver = $1;
  121. my $rtnVal = 0;
  122. my $tagTablePtr = GetTagTable('Image::ExifTool::GIF::Main');
  123. SetByteOrder('II');
  124. if ($outfile) {
  125. $et->InitWriteDirs(\%gifMap, 'XMP'); # make XMP the preferred group for GIF
  126. $addDirs = $$et{ADD_DIRS};
  127. # determine if we are editing the File:Comment tag
  128. my $delGroup = $$et{DEL_GROUP};
  129. $newComment = $et->GetNewValue('Comment', \$nvComment);
  130. $setComment = 1 if $nvComment or $$delGroup{File};
  131. # change to GIF 89a if adding comment, XMP or ICC_Profile
  132. $buff = 'GIF89a' if $$addDirs{XMP} or $$addDirs{ICC_Profile} or defined $newComment;
  133. Write($outfile, $buff, $s) or $err = 1;
  134. } else {
  135. $et->SetFileType(); # set file type
  136. $et->HandleTag($tagTablePtr, 'GIFVersion', $ver);
  137. $et->HandleTag($tagTablePtr, 'ScreenDescriptor', $s);
  138. }
  139. my $flags = Get8u(\$s, 4);
  140. if ($flags & 0x80) { # does this image contain a color table?
  141. # calculate color table size
  142. $length = 3 * (2 << ($flags & 0x07));
  143. $raf->Read($buff, $length) == $length or return 0; # skip color table
  144. Write($outfile, $buff) or $err = 1 if $outfile;
  145. }
  146. #
  147. # loop through GIF blocks
  148. #
  149. Block:
  150. for (;;) {
  151. last unless $raf->Read($ch, 1);
  152. # write out any new metadata now if this isn't an extension block
  153. if ($outfile and ord($ch) != 0x21) {
  154. # write the comment first if necessary
  155. if (defined $newComment and $$nvComment{IsCreating}) {
  156. # write comment marker
  157. Write($outfile, "\x21\xfe") or $err = 1;
  158. $verbose and print $out " + Comment = $newComment\n";
  159. my $len = length($newComment);
  160. # write out the comment in 255-byte chunks, each
  161. # chunk beginning with a length byte
  162. my $n;
  163. for ($n=0; $n<$len; $n+=255) {
  164. my $size = $len - $n;
  165. $size > 255 and $size = 255;
  166. my $str = substr($newComment,$n,$size);
  167. Write($outfile, pack('C',$size), $str) or $err = 1;
  168. }
  169. Write($outfile, "\0") or $err = 1; # empty chunk as terminator
  170. undef $newComment;
  171. undef $nvComment; # delete any other extraneous comments
  172. ++$$et{CHANGED}; # increment file changed flag
  173. }
  174. # add application extension containing XMP block if necessary
  175. # (this will place XMP before the first non-extension block)
  176. if (exists $$addDirs{XMP} and not defined $doneDir{XMP}) {
  177. $doneDir{XMP} = 1;
  178. # write new XMP data
  179. my $xmpTable = GetTagTable('Image::ExifTool::XMP::Main');
  180. my %dirInfo = ( Parent => 'GIF' );
  181. $verbose and print $out "Creating XMP application extension block:\n";
  182. $buff = $et->WriteDirectory(\%dirInfo, $xmpTable);
  183. if (defined $buff and length $buff) {
  184. my $lz = pack('C*',1,reverse(0..255),0);
  185. Write($outfile, "\x21\xff\x0bXMP DataXMP", $buff, $lz) or $err = 1;
  186. ++$doneDir{XMP}; # set to 2 to indicate we added XMP
  187. } else {
  188. $verbose and print $out " -> no XMP to add\n";
  189. }
  190. }
  191. # add application extension containing ICC_Profile if necessary
  192. if (exists $$addDirs{ICC_Profile} and not defined $doneDir{ICC_Profile}) {
  193. $doneDir{ICC_Profile} = 1;
  194. # write new ICC_Profile
  195. my $iccTable = GetTagTable('Image::ExifTool::ICC_Profile::Main');
  196. my %dirInfo = ( Parent => 'GIF' );
  197. $verbose and print $out "Creating ICC_Profile application extension block:\n";
  198. $buff = $et->WriteDirectory(\%dirInfo, $iccTable);
  199. if (defined $buff and length $buff) {
  200. my $pos = 0;
  201. Write($outfile, "\x21\xff\x0bICCRGBG1012") or $err = 1;
  202. my $len = length $buff;
  203. while ($pos < $len) {
  204. my $n = $len - $pos;
  205. $n = 255 if $n > 255;
  206. Write($outfile, chr($n), substr($buff, $pos, $n)) or $err = 1;
  207. $pos += $n;
  208. }
  209. Write($outfile, "\0") or $err = 1; # write null terminator
  210. ++$doneDir{ICC_Profile}; # set to 2 to indicate we added a new profile
  211. } else {
  212. $verbose and print $out " -> no ICC_Profile to add\n";
  213. }
  214. }
  215. }
  216. if (ord($ch) == 0x2c) {
  217. ++$frameCount;
  218. Write($outfile, $ch) or $err = 1 if $outfile;
  219. # image descriptor
  220. last unless $raf->Read($buff, 8) == 8 and $raf->Read($ch, 1);
  221. Write($outfile, $buff, $ch) or $err = 1 if $outfile;
  222. if ($verbose) {
  223. my ($left, $top, $w, $h) = unpack('v*', $buff);
  224. print $out "Image: left=$left top=$top width=$w height=$h\n";
  225. }
  226. if (ord($ch) & 0x80) { # does color table exist?
  227. $length = 3 * (2 << (ord($ch) & 0x07));
  228. # skip the color table
  229. last unless $raf->Read($buff, $length) == $length;
  230. Write($outfile, $buff) or $err = 1 if $outfile;
  231. }
  232. # skip "LZW Minimum Code Size" byte
  233. last unless $raf->Read($buff, 1);
  234. Write($outfile,$buff) or $err = 1 if $outfile;
  235. # skip image blocks
  236. for (;;) {
  237. last unless $raf->Read($ch, 1);
  238. Write($outfile, $ch) or $err = 1 if $outfile;
  239. last unless ord($ch);
  240. last unless $raf->Read($buff, ord($ch));
  241. Write($outfile,$buff) or $err = 1 if $outfile;
  242. }
  243. next; # continue with next field
  244. }
  245. # last if ord($ch) == 0x3b; # normal end of GIF marker
  246. unless (ord($ch) == 0x21) {
  247. if ($outfile) {
  248. Write($outfile, $ch) or $err = 1;
  249. # copy the rest of the file
  250. while ($raf->Read($buff, 65536)) {
  251. Write($outfile, $buff) or $err = 1;
  252. }
  253. }
  254. $rtnVal = 1;
  255. last;
  256. }
  257. # get extension block type/size
  258. last unless $raf->Read($s, 2) == 2;
  259. # get marker and block size
  260. ($a,$length) = unpack("C"x2, $s);
  261. if ($a == 0xfe) { # comment extension
  262. my $comment = '';
  263. while ($length) {
  264. last unless $raf->Read($buff, $length) == $length;
  265. if ($verbose > 2 and not $outfile) {
  266. HexDump(\$buff, undef, Out => $out);
  267. }
  268. # add buffer to comment string
  269. $comment .= $buff;
  270. last unless $raf->Read($ch, 1); # read next block header
  271. $length = ord($ch); # get next block size
  272. }
  273. last if $length; # was a read error if length isn't zero
  274. if ($outfile) {
  275. my $isOverwriting;
  276. if ($setComment) {
  277. if ($nvComment) {
  278. $isOverwriting = $et->IsOverwriting($nvComment,$comment);
  279. # get new comment again (may have been shifted)
  280. $newComment = $et->GetNewValue($nvComment) if defined $newComment;
  281. } else {
  282. # group delete, or deleting additional comments after writing one
  283. $isOverwriting = 1;
  284. }
  285. }
  286. if ($isOverwriting) {
  287. ++$$et{CHANGED}; # increment file changed flag
  288. $et->VerboseValue('- Comment', $comment);
  289. $comment = $newComment;
  290. $et->VerboseValue('+ Comment', $comment) if defined $comment;
  291. undef $nvComment; # just delete remaining comments
  292. } else {
  293. undef $setComment; # leave remaining comments alone
  294. }
  295. if (defined $comment) {
  296. # write comment marker
  297. Write($outfile, "\x21\xfe") or $err = 1;
  298. my $len = length($comment);
  299. # write out the comment in 255-byte chunks, each
  300. # chunk beginning with a length byte
  301. my $n;
  302. for ($n=0; $n<$len; $n+=255) {
  303. my $size = $len - $n;
  304. $size > 255 and $size = 255;
  305. my $str = substr($comment,$n,$size);
  306. Write($outfile, pack('C',$size), $str) or $err = 1;
  307. }
  308. Write($outfile, "\0") or $err = 1; # empty chunk as terminator
  309. }
  310. undef $newComment; # don't write the new comment again
  311. } else {
  312. $rtnVal = 1;
  313. $et->FoundTag('Comment', $comment) if $comment;
  314. undef $comment;
  315. # assume no more than one comment in FastScan mode
  316. last if $et->Options('FastScan');
  317. }
  318. next;
  319. } elsif ($a == 0xff and $length == 0x0b) { # application extension
  320. last unless $raf->Read($buff, $length) == $length;
  321. if ($verbose) {
  322. my @a = unpack('a8a3', $buff);
  323. s/\0.*//s foreach @a;
  324. print $out "Application Extension: @a\n";
  325. }
  326. if ($buff eq 'XMP DataXMP') { # XMP data (ref 2)
  327. my $hdr = "$ch$s$buff";
  328. # read XMP data
  329. my $xmp = '';
  330. for (;;) {
  331. $raf->Read($ch, 1) or last Block; # read next block header
  332. $length = ord($ch) or last; # get next block size
  333. $raf->Read($buff, $length) == $length or last Block;
  334. $xmp .= $ch . $buff;
  335. }
  336. # get length of XMP without landing zone data
  337. # (note that LZ data may not be exactly the same as what we use)
  338. my $xmpLen;
  339. if ($xmp =~ /<\?xpacket end=['"][wr]['"]\?>/g) {
  340. $xmpLen = pos($xmp);
  341. } else {
  342. $xmpLen = length($xmp);
  343. }
  344. my %dirInfo = (
  345. DataPt => \$xmp,
  346. DataLen => length $xmp,
  347. DirLen => $xmpLen,
  348. Parent => 'GIF',
  349. );
  350. my $xmpTable = GetTagTable('Image::ExifTool::XMP::Main');
  351. if ($outfile) {
  352. if ($doneDir{XMP} and $doneDir{XMP} > 1) {
  353. $et->Warn('Duplicate XMP block created');
  354. }
  355. $buff = $et->WriteDirectory(\%dirInfo, $xmpTable);
  356. if (not defined $buff) {
  357. # rewrite original XMP with landing zone (adding back null terminator)
  358. Write($outfile, $hdr, $xmp, "\0") or $err = 1;
  359. $doneDir{XMP} = 1;
  360. } elsif (length $buff) {
  361. if ($buff =~ /\0/) { # (check just to be safe)
  362. $et->Error('XMP contained NULL character');
  363. } else {
  364. # write new XMP and landing zone
  365. my $lz = pack('C*',1,reverse(0..255),0);
  366. Write($outfile, $hdr, $buff, $lz) or $err = 1;
  367. }
  368. $doneDir{XMP} = 1;
  369. } # else we are deleting the XMP
  370. } else {
  371. $et->ProcessDirectory(\%dirInfo, $xmpTable);
  372. }
  373. next;
  374. } elsif ($buff eq 'ICCRGBG1012') { # ICC_Profile extension (ref 4)
  375. my $hdr = "$ch$s$buff";
  376. # read ICC profile data
  377. my $icc_profile = '';
  378. for (;;) {
  379. $raf->Read($ch, 1) or last Block; # read next block header
  380. $length = ord($ch) or last; # get next block size
  381. $raf->Read($buff, $length) == $length or last Block;
  382. $icc_profile .= $buff;
  383. }
  384. my %dirInfo = (
  385. DataPt => \$icc_profile,
  386. DataLen => length $icc_profile,
  387. DirLen => length $icc_profile,
  388. Parent => 'GIF',
  389. );
  390. my $iccTable = GetTagTable('Image::ExifTool::ICC_Profile::Main');
  391. if ($outfile) {
  392. if ($doneDir{ICC_Profile} and $doneDir{ICC_Profile} > 1) {
  393. $et->Warn('Duplicate ICC_Profile block created');
  394. }
  395. $buff = $et->WriteDirectory(\%dirInfo, $iccTable);
  396. # rewrite original ICC_Profile if nothing changed
  397. $buff = $icc_profile unless defined $buff;
  398. if (length $buff) {
  399. # write ICC profile sub-blocks
  400. my $pos = 0;
  401. Write($outfile, $hdr) or $err = 1;
  402. my $len = length $buff;
  403. while ($pos < $len) {
  404. my $n = $len - $pos;
  405. $n = 255 if $n > 255;
  406. Write($outfile, chr($n), substr($buff, $pos, $n)) or $err = 1;
  407. $pos += $n;
  408. }
  409. Write($outfile, "\0") or $err = 1; # write null terminator
  410. $doneDir{ICC_Profile} = 1;
  411. } # else we are deleting the ICC profile
  412. } else {
  413. $et->ProcessDirectory(\%dirInfo, $iccTable);
  414. }
  415. next;
  416. } elsif ($buff eq 'NETSCAPE2.0') { # animated GIF extension (ref 3)
  417. $raf->Read($buff, 5) == 5 or last;
  418. # make sure this contains the expected data
  419. if ($buff =~ /^\x03\x01(..)\0$/s) {
  420. $et->HandleTag($tagTablePtr, 'ExtensionAnimation', $buff);
  421. }
  422. $raf->Seek(-$length-5, 1) or last; # seek back to start of block
  423. } else {
  424. # rewind to start of application extension to copy the unknown block
  425. $raf->Seek(-$length, 1) or last;
  426. }
  427. } elsif ($a == 0xf9 and $length == 4) { # graphic control extension
  428. last unless $raf->Read($buff, $length) == $length;
  429. # sum the indivual delay times
  430. my $delay = Get16u(\$buff, 1);
  431. $delayTime += $delay;
  432. $verbose and printf $out "Graphic Control: delay=%.2f\n", $delay / 100;
  433. $raf->Seek(-$length, 1) or last;
  434. } elsif ($a == 0x01 and $length == 12) { # plain text extension
  435. last unless $raf->Read($buff, $length) == $length;
  436. Write($outfile, $ch, $s, $buff) or $err = 1 if $outfile;
  437. if ($verbose) {
  438. my ($left, $top, $w, $h) = unpack('v4', $buff);
  439. print $out "Text: left=$left top=$top width=$w height=$h\n";
  440. }
  441. my $text = '';
  442. for (;;) {
  443. last unless $raf->Read($ch, 1);
  444. $length = ord($ch) or last;
  445. last unless $raf->Read($buff, $length) == $length;
  446. Write($outfile, $ch, $buff) or $err = 1 if $outfile; # write block
  447. $text .= $buff;
  448. }
  449. Write($outfile, "\0") or $err = 1 if $outfile; # write terminator block
  450. $et->HandleTag($tagTablePtr, 'Text', $text);
  451. next;
  452. }
  453. Write($outfile, $ch, $s) or $err = 1 if $outfile;
  454. # skip the block
  455. while ($length) {
  456. last unless $raf->Read($buff, $length) == $length;
  457. Write($outfile, $buff) or $err = 1 if $outfile;
  458. last unless $raf->Read($ch, 1); # read next block header
  459. Write($outfile, $ch) or $err = 1 if $outfile;
  460. $length = ord($ch); # get next block size
  461. }
  462. }
  463. unless ($outfile) {
  464. $et->HandleTag($tagTablePtr, 'FrameCount', $frameCount) if $frameCount > 1;
  465. $et->HandleTag($tagTablePtr, 'Duration', $delayTime/100) if $delayTime;
  466. }
  467. # set return value to -1 if we only had a write error
  468. $rtnVal = -1 if $rtnVal and $err;
  469. return $rtnVal;
  470. }
  471. 1; #end
  472. __END__
  473. =head1 NAME
  474. Image::ExifTool::GIF - Read and write GIF meta information
  475. =head1 SYNOPSIS
  476. This module is loaded automatically by Image::ExifTool when required.
  477. =head1 DESCRIPTION
  478. This module contains definitions required by Image::ExifTool to read and
  479. write GIF meta information.
  480. =head1 AUTHOR
  481. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  482. This library is free software; you can redistribute it and/or modify it
  483. under the same terms as Perl itself.
  484. =head1 REFERENCES
  485. =over 4
  486. =item L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt>
  487. =item L<http://www.adobe.com/devnet/xmp/>
  488. =item L<http://graphcomp.com/info/specs/ani_gif.html>
  489. =item L<http://www.color.org/icc_specs2.html>
  490. =back
  491. =head1 SEE ALSO
  492. L<Image::ExifTool(3pm)|Image::ExifTool>
  493. =cut