- Timestamp:
- 2011-06-01T12:33:42+12:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
main/trunk/greenstone2/perllib/cpan/Image/ExifTool/GIF.pm
r16842 r24107 6 6 # Revisions: 10/18/2005 - P. Harvey Separated from ExifTool.pm 7 7 # 8 # References: http://www.w3.org/Graphics/GIF/spec-gif89a.txt 9 # 10 # Notes: GIF really doesn't have much meta information, except for 11 # comments which are allowed in GIF89a images 8 # References: 1) http://www.w3.org/Graphics/GIF/spec-gif89a.txt 9 # 2) http://www.adobe.com/devnet/xmp/ 10 # 3) http://graphcomp.com/info/specs/ani_gif.html 12 11 #------------------------------------------------------------------------------ 13 12 … … 16 15 use strict; 17 16 use vars qw($VERSION); 18 use Image::ExifTool qw(:DataAccess); 19 20 $VERSION = '1.04'; 17 use Image::ExifTool qw(:DataAccess :Utils); 18 19 $VERSION = '1.06'; 20 21 # road map of directory locations in GIF images 22 my %gifMap = ( 23 XMP => 'GIF', 24 ); 25 26 %Image::ExifTool::GIF::Main = ( 27 GROUPS => { 2 => 'Image' }, 28 VARS => { NO_ID => 1 }, 29 NOTES => q{ 30 This table lists information extracted from GIF images. See 31 L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt> for the official GIF89a 32 specification. 33 }, 34 GIFVersion => { }, 35 FrameCount => { Notes => 'number of animated images' }, 36 Text => { Notes => 'text displayed in image' }, 37 Comment => { 38 # for documentation only -- flag as writable for the docs, but 39 # it won't appear in the TagLookup because there is no WRITE_PROC 40 Writable => 1, 41 }, 42 Duration => { 43 Notes => 'duration of a single animation iteration', 44 PrintConv => 'sprintf("%.2f s",$val)', 45 }, 46 ScreenDescriptor => { 47 SubDirectory => { TagTable => 'Image::ExifTool::GIF::Screen' }, 48 }, 49 AnimationExtension => { 50 SubDirectory => { TagTable => 'Image::ExifTool::GIF::Animate' }, 51 }, 52 XMPExtension => { # (for documentation only) 53 SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' }, 54 }, 55 ); 56 57 # GIF locical screen descriptor 58 %Image::ExifTool::GIF::Screen = ( 59 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, 60 GROUPS => { 2 => 'Image' }, 61 NOTES => 'Information extracted from the GIF logical screen descriptor.', 62 0 => { 63 Name => 'ImageWidth', 64 Format => 'int16u', 65 }, 66 2 => { 67 Name => 'ImageHeight', 68 Format => 'int16u', 69 }, 70 4.1 => { 71 Name => 'HasColorMap', 72 Mask => 0x80, 73 PrintConv => { 0x00 => 'No', 0x80 => 'Yes' }, 74 }, 75 4.2 => { 76 Name => 'ColorResolutionDepth', 77 Mask => 0x70, 78 ValueConv => '($val >> 4) + 1', 79 }, 80 4.3 => { 81 Name => 'BitsPerPixel', 82 Mask => 0x07, 83 ValueConv => '$val + 1', 84 }, 85 5 => 'BackgroundColor', 86 ); 87 88 # GIF Netscape 2.0 animation extension 89 %Image::ExifTool::GIF::Animate = ( 90 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, 91 GROUPS => { 2 => 'Image' }, 92 NOTES => 'Information extracted from the "NETSCAPE2.0" animation extension.', 93 2 => { 94 Name => 'AnimationIterations', 95 Format => 'int16u', 96 PrintConv => '$val ? $val : "Infinite"', 97 }, 98 ); 21 99 22 100 #------------------------------------------------------------------------------ … … 28 106 { 29 107 my ($exifTool, $dirInfo) = @_; 30 my ($type, $a, $s, $ch, $length, $buff);31 my ($err, $newComment, $setComment);108 my $outfile = $$dirInfo{OutFile}; 109 my $raf = $$dirInfo{RAF}; 32 110 my $verbose = $exifTool->Options('Verbose'); 33 111 my $out = $exifTool->Options('TextOut'); 34 my $outfile = $$dirInfo{OutFile}; 35 my $raf = $$dirInfo{RAF}; 112 my ($a, $s, $ch, $length, $buff, $comment); 113 my ($err, $newComment, $setComment); 114 my ($addDirs, %doneDir); 115 my ($frameCount, $delayTime) = (0, 0); 116 117 # verify this is a valid GIF file 118 return 0 unless $raf->Read($buff, 6) == 6 119 and $buff =~ /^GIF(8[79]a)$/ 120 and $raf->Read($s, 7) == 7; 121 122 my $ver = $1; 36 123 my $rtnVal = 0; 37 38 # verify this is a valid GIF file 39 # (must do a RAF read until we know the file is ours) 40 return 0 unless $raf->Read($type, 6) == 6 41 and $type =~ /^GIF8[79]a$/ 42 and $raf->Read($s, 4) == 4; 43 44 $verbose and print $out "GIF file version $type\n"; 124 my $tagTablePtr = GetTagTable('Image::ExifTool::GIF::Main'); 125 SetByteOrder('II'); 126 45 127 if ($outfile) { 46 Write($outfile, $type, $s) or $err = 1; 47 if ($exifTool->{DEL_GROUP}->{File}) { 128 $exifTool->InitWriteDirs(\%gifMap, 'XMP'); # make XMP the preferred group for GIF 129 $addDirs = $exifTool->{ADD_DIRS}; 130 # determine if we are editing the File:Comment tag 131 my $delGroup = $exifTool->{DEL_GROUP}; 132 if ($$delGroup{File}) { 48 133 $setComment = 1; 49 if ($ exifTool->{DEL_GROUP}->{File} == 2) {134 if ($$delGroup{File} == 2) { 50 135 $newComment = $exifTool->GetNewValues('Comment'); 51 136 } 52 137 } else { 53 my $newValueHash; 54 $newComment = $exifTool->GetNewValues('Comment', \$newValueHash); 55 $setComment = 1 if $newValueHash; 56 } 138 my $nvHash; 139 $newComment = $exifTool->GetNewValues('Comment', \$nvHash); 140 $setComment = 1 if $nvHash; 141 } 142 # change to GIF 89a if adding comment or XMP 143 $buff = 'GIF89a' if $$addDirs{XMP} or defined $newComment; 144 Write($outfile, $buff, $s) or $err = 1; 145 } else { 146 $exifTool->SetFileType(); # set file type 147 $exifTool->HandleTag($tagTablePtr, 'GIFVersion', $ver); 148 $exifTool->HandleTag($tagTablePtr, 'ScreenDescriptor', $s); 57 149 } 58 $exifTool->SetFileType(); # set file type 59 my ($w, $h) = unpack("v"x2, $s); 60 $exifTool->FoundTag('ImageWidth', $w); 61 $exifTool->FoundTag('ImageHeight', $h); 62 if ($raf->Read($s, 3) == 3) { 63 Write($outfile, $s) or $err = 1 if $outfile; 64 if (ord($s) & 0x80) { # does this image contain a color table? 65 # calculate color table size 66 $length = 3 * (2 << (ord($s) & 0x07)); 67 $raf->Read($buff, $length) == $length or return 0; # skip color table 68 Write($outfile, $buff) or $err = 1 if $outfile; 69 } 70 # write the comment first if necessary 71 if ($outfile and defined $newComment) { 72 if ($type ne 'GIF87a') { 73 # write comment marker 74 Write($outfile, "\x21\xfe") or $err = 1; 75 my $len = length($newComment); 76 # write out the comment in 255-byte chunks, each 77 # chunk beginning with a length byte 78 my $n; 79 for ($n=0; $n<$len; $n+=255) { 80 my $size = $len - $n; 81 $size > 255 and $size = 255; 82 my $str = substr($newComment,$n,$size); 83 Write($outfile, pack('C',$size), $str) or $err = 1; 84 } 85 Write($outfile, "\0") or $err = 1; # empty chunk as terminator 86 undef $newComment; 87 ++$exifTool->{CHANGED}; # increment file changed flag 88 } else { 89 $exifTool->Warn("The GIF87a format doesn't support comments"); 90 } 91 } 92 my $comment; 93 for (;;) { 94 last unless $raf->Read($ch, 1); 95 if (ord($ch) == 0x2c) { 150 my $flags = Get8u(\$s, 4); 151 if ($flags & 0x80) { # does this image contain a color table? 152 # calculate color table size 153 $length = 3 * (2 << ($flags & 0x07)); 154 $raf->Read($buff, $length) == $length or return 0; # skip color table 155 Write($outfile, $buff) or $err = 1 if $outfile; 156 } 157 # write the comment first if necessary 158 if ($outfile and defined $newComment) { 159 # write comment marker 160 Write($outfile, "\x21\xfe") or $err = 1; 161 $verbose and print $out " + Comment = $newComment\n"; 162 my $len = length($newComment); 163 # write out the comment in 255-byte chunks, each 164 # chunk beginning with a length byte 165 my $n; 166 for ($n=0; $n<$len; $n+=255) { 167 my $size = $len - $n; 168 $size > 255 and $size = 255; 169 my $str = substr($newComment,$n,$size); 170 Write($outfile, pack('C',$size), $str) or $err = 1; 171 } 172 Write($outfile, "\0") or $err = 1; # empty chunk as terminator 173 undef $newComment; 174 ++$exifTool->{CHANGED}; # increment file changed flag 175 } 176 # 177 # loop through GIF blocks 178 # 179 Block: 180 for (;;) { 181 last unless $raf->Read($ch, 1); 182 if ($outfile and ord($ch) != 0x21) { 183 # add application extension containing XMP block if necessary 184 # (this will place XMP before the first non-extension block) 185 if (exists $$addDirs{XMP} and not defined $doneDir{XMP}) { 186 $doneDir{XMP} = 1; 187 # write new XMP data 188 my $xmpTable = GetTagTable('Image::ExifTool::XMP::Main'); 189 my %dirInfo = ( Parent => 'GIF' ); 190 $verbose and print $out "Creating XMP application extension block:\n"; 191 $buff = $exifTool->WriteDirectory(\%dirInfo, $xmpTable); 192 if (defined $buff and length $buff) { 193 my $lz = pack('C*',1,reverse(0..255),0); 194 Write($outfile, "\x21\xff\x0bXMP DataXMP", $buff, $lz) or $err = 1; 195 ++$doneDir{XMP}; # set to 2 to indicate we added XMP 196 } else { 197 $verbose and print $out " -> no XMP to add\n"; 198 } 199 } 200 } 201 if (ord($ch) == 0x2c) { 202 ++$frameCount; 203 Write($outfile, $ch) or $err = 1 if $outfile; 204 # image descriptor 205 last unless $raf->Read($buff, 8) == 8 and $raf->Read($ch, 1); 206 Write($outfile, $buff, $ch) or $err = 1 if $outfile; 207 if ($verbose) { 208 my ($left, $top, $w, $h) = unpack('v*', $buff); 209 print $out "Image: left=$left top=$top width=$w height=$h\n"; 210 } 211 if (ord($ch) & 0x80) { # does color table exist? 212 $length = 3 * (2 << (ord($ch) & 0x07)); 213 # skip the color table 214 last unless $raf->Read($buff, $length) == $length; 215 Write($outfile, $buff) or $err = 1 if $outfile; 216 } 217 # skip "LZW Minimum Code Size" byte 218 last unless $raf->Read($buff, 1); 219 Write($outfile,$buff) or $err = 1 if $outfile; 220 # skip image blocks 221 for (;;) { 222 last unless $raf->Read($ch, 1); 96 223 Write($outfile, $ch) or $err = 1 if $outfile; 97 # image descriptor 98 last unless $raf->Read($buff, 8) == 8; 99 last unless $raf->Read($ch, 1); 100 Write($outfile, $buff, $ch) or $err = 1 if $outfile; 101 if (ord($ch) & 0x80) { # does color table exist? 102 $length = 3 * (2 << (ord($ch) & 0x07)); 103 # skip the color table 104 last unless $raf->Read($buff, $length) == $length; 105 Write($outfile, $buff) or $err = 1 if $outfile; 106 } 107 # skip "LZW Minimum Code Size" byte 108 last unless $raf->Read($buff, 1); 224 last unless ord($ch); 225 last unless $raf->Read($buff, ord($ch)); 109 226 Write($outfile,$buff) or $err = 1 if $outfile; 110 # skip image blocks 111 for (;;) { 112 last unless $raf->Read($ch, 1); 113 Write($outfile, $ch) or $err = 1 if $outfile; 114 last unless ord($ch); 115 last unless $raf->Read($buff, ord($ch)); 116 Write($outfile,$buff) or $err = 1 if $outfile; 117 } 118 next; # continue with next field 119 } 227 } 228 next; # continue with next field 229 } 120 230 # last if ord($ch) == 0x3b; # normal end of GIF marker 121 unless (ord($ch) == 0x21) { 122 if ($outfile) { 123 Write($outfile, $ch) or $err = 1; 124 # copy the rest of the file 125 while ($raf->Read($buff, 65536)) { 126 Write($outfile, $buff) or $err = 1; 127 } 128 } 129 $rtnVal = 1; 130 last; 131 } 132 # get extension block type/size 133 last unless $raf->Read($s, 2) == 2; 134 # get marker and block size 135 ($a,$length) = unpack("C"x2, $s); 136 if ($a == 0xfe) { # is this a comment? 137 if ($setComment) { 138 ++$exifTool->{CHANGED}; # increment the changed flag 139 } else { 140 Write($outfile, $ch, $s) or $err = 1 if $outfile; 141 } 142 while ($length) { 143 last unless $raf->Read($buff, $length) == $length; 144 $verbose > 2 and Image::ExifTool::HexDump(\$buff, undef, Out => $out); 145 if (defined $comment) { 146 $comment .= $buff; # add to comment string 147 } else { 148 $comment = $buff; 149 } 150 last unless $raf->Read($ch, 1); # read next block header 151 unless ($setComment) { 152 Write($outfile, $buff, $ch) or $err = 1 if $outfile; 153 } 154 $length = ord($ch); # get next block size 155 } 156 last if $length; # was a read error if length isn't zero 157 unless ($outfile) { 158 $rtnVal = 1; 159 $exifTool->FoundTag('Comment', $comment) if $comment; 160 undef $comment; 161 # assume no more than one comment in FastScan mode 162 last if $exifTool->Options('FastScan'); 163 } 231 unless (ord($ch) == 0x21) { 232 if ($outfile) { 233 Write($outfile, $ch) or $err = 1; 234 # copy the rest of the file 235 while ($raf->Read($buff, 65536)) { 236 Write($outfile, $buff) or $err = 1; 237 } 238 } 239 $rtnVal = 1; 240 last; 241 } 242 # get extension block type/size 243 last unless $raf->Read($s, 2) == 2; 244 # get marker and block size 245 ($a,$length) = unpack("C"x2, $s); 246 247 if ($a == 0xfe) { # comment extension 248 249 if ($setComment) { 250 ++$exifTool->{CHANGED}; # increment the changed flag 164 251 } else { 165 252 Write($outfile, $ch, $s) or $err = 1 if $outfile; 166 # skip the block 167 while ($length) { 168 last unless $raf->Read($buff, $length) == $length; 169 Write($outfile, $buff) or $err = 1 if $outfile; 170 last unless $raf->Read($ch, 1); # read next block header 171 Write($outfile, $ch) or $err = 1 if $outfile; 172 $length = ord($ch); # get next block size 173 } 174 } 175 } 253 } 254 while ($length) { 255 last unless $raf->Read($buff, $length) == $length; 256 if ($verbose > 2 and not $outfile) { 257 Image::ExifTool::HexDump(\$buff, undef, Out => $out); 258 } 259 # add buffer to comment string 260 $comment = defined $comment ? $comment . $buff : $buff; 261 last unless $raf->Read($ch, 1); # read next block header 262 $length = ord($ch); # get next block size 263 264 # write or delete comment 265 next unless $outfile; 266 if ($setComment) { 267 $verbose and print $out " - Comment = $buff\n"; 268 } else { 269 Write($outfile, $buff, $ch) or $err = 1; 270 } 271 } 272 last if $length; # was a read error if length isn't zero 273 unless ($outfile) { 274 $rtnVal = 1; 275 $exifTool->FoundTag('Comment', $comment) if $comment; 276 undef $comment; 277 # assume no more than one comment in FastScan mode 278 last if $exifTool->Options('FastScan'); 279 } 280 next; 281 282 } elsif ($a == 0xff and $length == 0x0b) { # application extension 283 284 last unless $raf->Read($buff, $length) == $length; 285 if ($verbose) { 286 my @a = unpack('a8a3', $buff); 287 s/\0.*//s foreach @a; 288 print $out "Application Extension: @a\n"; 289 } 290 if ($buff eq 'XMP DataXMP') { # XMP data (ref 2) 291 my $hdr = "$ch$s$buff"; 292 # read XMP data 293 my $xmp = ''; 294 for (;;) { 295 $raf->Read($ch, 1) or last Block; # read next block header 296 $length = ord($ch) or last; # get next block size 297 $raf->Read($buff, $length) == $length or last Block; 298 $xmp .= $ch . $buff; 299 } 300 # get length of XMP without landing zone data 301 # (note that LZ data may not be exactly the same as what we use) 302 my $xmpLen; 303 if ($xmp =~ /<\?xpacket end=['"][wr]['"]\?>/g) { 304 $xmpLen = pos($xmp); 305 } else { 306 $xmpLen = length($xmp); 307 } 308 my %dirInfo = ( 309 DataPt => \$xmp, 310 DataLen => length $xmp, 311 DirLen => $xmpLen, 312 Parent => 'GIF', 313 ); 314 my $xmpTable = GetTagTable('Image::ExifTool::XMP::Main'); 315 if ($outfile) { 316 if ($doneDir{XMP} and $doneDir{XMP} > 1) { 317 $exifTool->Warn('Duplicate XMP block created'); 318 } 319 my $newXMP = $exifTool->WriteDirectory(\%dirInfo, $xmpTable); 320 if (not defined $newXMP) { 321 Write($outfile, $hdr, $xmp) or $err = 1; # write original XMP 322 $doneDir{XMP} = 1; 323 } elsif (length $newXMP) { 324 if ($newXMP =~ /\0/) { # (check just to be safe) 325 $exifTool->Error('XMP contained NULL character'); 326 } else { 327 # write new XMP and landing zone 328 my $lz = pack('C*',1,reverse(0..255),0); 329 Write($outfile, $hdr, $newXMP, $lz) or $err = 1; 330 } 331 $doneDir{XMP} = 1; 332 } # else we are deleting the XMP 333 } else { 334 $exifTool->ProcessDirectory(\%dirInfo, $xmpTable); 335 } 336 next; 337 } elsif ($buff eq 'NETSCAPE2.0') { # animated GIF extension (ref 3) 338 $raf->Read($buff, 5) == 5 or last; 339 # make sure this contains the expected data 340 if ($buff =~ /^\x03\x01(..)\0$/) { 341 $exifTool->HandleTag($tagTablePtr, 'AnimationExtension', $buff); 342 } 343 $raf->Seek(-$length-5, 1) or last; # seek back to start of block 344 } else { 345 $raf->Seek(-$length, 1) or last; 346 } 347 348 } elsif ($a == 0xf9 and $length == 4) { # graphic control extension 349 350 last unless $raf->Read($buff, $length) == $length; 351 # sum the indivual delay times 352 my $delay = Get16u(\$buff, 1); 353 $delayTime += $delay; 354 $verbose and printf $out "Graphic Control: delay=%.2f\n", $delay / 100; 355 $raf->Seek(-$length, 1) or last; 356 357 } elsif ($a == 0x01 and $length == 12) { # plain text extension 358 359 last unless $raf->Read($buff, $length) == $length; 360 Write($outfile, $ch, $s, $buff) or $err = 1 if $outfile; 361 if ($verbose) { 362 my ($left, $top, $w, $h) = unpack('v4', $buff); 363 print $out "Text: left=$left top=$top width=$w height=$h\n"; 364 } 365 my $text = ''; 366 for (;;) { 367 last unless $raf->Read($ch, 1); 368 $length = ord($ch) or last; 369 last unless $raf->Read($buff, $length) == $length; 370 Write($outfile, $ch, $buff) or $err = 1 if $outfile; # write block 371 $text .= $buff; 372 } 373 Write($outfile, "\0") or $err = 1 if $outfile; # write terminator block 374 $exifTool->HandleTag($tagTablePtr, 'Text', $text); 375 next; 376 } 377 Write($outfile, $ch, $s) or $err = 1 if $outfile; 378 # skip the block 379 while ($length) { 380 last unless $raf->Read($buff, $length) == $length; 381 Write($outfile, $buff) or $err = 1 if $outfile; 382 last unless $raf->Read($ch, 1); # read next block header 383 Write($outfile, $ch) or $err = 1 if $outfile; 384 $length = ord($ch); # get next block size 385 } 386 } 387 unless ($outfile) { 388 $exifTool->HandleTag($tagTablePtr, 'FrameCount', $frameCount) if $frameCount > 1; 389 $exifTool->HandleTag($tagTablePtr, 'Duration', $delayTime/100) if $delayTime; 390 # for historical reasons, the GIF Comment tag is in the Extra table 176 391 $exifTool->FoundTag('Comment', $comment) if $comment; 177 392 } 393 178 394 # set return value to -1 if we only had a write error 179 395 $rtnVal = -1 if $rtnVal and $err; … … 197 413 198 414 This module contains definitions required by Image::ExifTool to read and 199 write GIF meta information. GIF87a images contain no meta information, and 200 only the Comment tag is currently supported in GIF89a images. 415 write GIF meta information. 201 416 202 417 =head1 AUTHOR 203 418 204 Copyright 2003-20 07, Phil Harvey (phil at owl.phy.queensu.ca)419 Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca) 205 420 206 421 This library is free software; you can redistribute it and/or modify it … … 213 428 =item L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt> 214 429 430 =item L<http://www.adobe.com/devnet/xmp/> 431 432 =item L<http://graphcomp.com/info/specs/ani_gif.html> 433 215 434 =back 216 435
Note:
See TracChangeset
for help on using the changeset viewer.
