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