source: gs2-extensions/parallel-building/trunk/src/perllib/cpan/Image/ExifTool/GIF.pm@ 24626

Last change on this file since 24626 was 24626, checked in by jmt12, 13 years ago

An (almost) complete copy of the perllib directory from a (circa SEP2011) head checkout from Greenstone 2 trunk - in order to try and make merging in this extension a little easier later on (as there have been some major changes to buildcol.pl commited in the main trunk but not in the x64 branch)
File size: 16.2 KB
Line 
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#
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
11#------------------------------------------------------------------------------
12
13package Image::ExifTool::GIF;
14
15use strict;
16use vars qw($VERSION);
17use Image::ExifTool qw(:DataAccess :Utils);
18
19$VERSION = '1.06';
20
21# road map of directory locations in GIF images
22my %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);
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
105sub ProcessGIF($$)
106{
107 my ($exifTool, $dirInfo) = @_;
108 my $outfile = $$dirInfo{OutFile};
109 my $raf = $$dirInfo{RAF};
110 my $verbose = $exifTool->Options('Verbose');
111 my $out = $exifTool->Options('TextOut');
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;
123 my $rtnVal = 0;
124 my $tagTablePtr = GetTagTable('Image::ExifTool::GIF::Main');
125 SetByteOrder('II');
126
127 if ($outfile) {
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}) {
133 $setComment = 1;
134 if ($$delGroup{File} == 2) {
135 $newComment = $exifTool->GetNewValues('Comment');
136 }
137 } else {
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);
149 }
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#
179Block:
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);
223 Write($outfile, $ch) or $err = 1 if $outfile;
224 last unless ord($ch);
225 last unless $raf->Read($buff, ord($ch));
226 Write($outfile,$buff) or $err = 1 if $outfile;
227 }
228 next; # continue with next field
229 }
230# last if ord($ch) == 0x3b; # normal end of GIF marker
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
251 } else {
252 Write($outfile, $ch, $s) or $err = 1 if $outfile;
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
391 $exifTool->FoundTag('Comment', $comment) if $comment;
392 }
393
394 # set return value to -1 if we only had a write error
395 $rtnVal = -1 if $rtnVal and $err;
396 return $rtnVal;
397}
398
399
4001; #end
401
402__END__
403
404=head1 NAME
405
406Image::ExifTool::GIF - Read and write GIF meta information
407
408=head1 SYNOPSIS
409
410This module is loaded automatically by Image::ExifTool when required.
411
412=head1 DESCRIPTION
413
414This module contains definitions required by Image::ExifTool to read and
415write GIF meta information.
416
417=head1 AUTHOR
418
419Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
420
421This library is free software; you can redistribute it and/or modify it
422under the same terms as Perl itself.
423
424=head1 REFERENCES
425
426=over 4
427
428=item L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt>
429
430=item L<http://www.adobe.com/devnet/xmp/>
431
432=item L<http://graphcomp.com/info/specs/ani_gif.html>
433
434=back
435
436=head1 SEE ALSO
437
438L<Image::ExifTool(3pm)|Image::ExifTool>
439
440=cut
Note: See TracBrowser for help on using the repository browser.