| 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: 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
|
|---|
| 12 | #------------------------------------------------------------------------------
|
|---|
| 13 |
|
|---|
| 14 | package Image::ExifTool::GIF;
|
|---|
| 15 |
|
|---|
| 16 | use strict;
|
|---|
| 17 | use vars qw($VERSION);
|
|---|
| 18 | use Image::ExifTool qw(:DataAccess);
|
|---|
| 19 |
|
|---|
| 20 | $VERSION = '1.04';
|
|---|
| 21 |
|
|---|
| 22 | #------------------------------------------------------------------------------
|
|---|
| 23 | # Process meta information in GIF image
|
|---|
| 24 | # Inputs: 0) ExifTool object reference, 1) Directory information ref
|
|---|
| 25 | # Returns: 1 on success, 0 if this wasn't a valid GIF file, or -1 if
|
|---|
| 26 | # an output file was specified and a write error occurred
|
|---|
| 27 | sub ProcessGIF($$)
|
|---|
| 28 | {
|
|---|
| 29 | my ($exifTool, $dirInfo) = @_;
|
|---|
| 30 | my ($type, $a, $s, $ch, $length, $buff);
|
|---|
| 31 | my ($err, $newComment, $setComment);
|
|---|
| 32 | my $verbose = $exifTool->Options('Verbose');
|
|---|
| 33 | my $out = $exifTool->Options('TextOut');
|
|---|
| 34 | my $outfile = $$dirInfo{OutFile};
|
|---|
| 35 | my $raf = $$dirInfo{RAF};
|
|---|
| 36 | 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";
|
|---|
| 45 | if ($outfile) {
|
|---|
| 46 | Write($outfile, $type, $s) or $err = 1;
|
|---|
| 47 | if ($exifTool->{DEL_GROUP}->{File}) {
|
|---|
| 48 | $setComment = 1;
|
|---|
| 49 | if ($exifTool->{DEL_GROUP}->{File} == 2) {
|
|---|
| 50 | $newComment = $exifTool->GetNewValues('Comment');
|
|---|
| 51 | }
|
|---|
| 52 | } else {
|
|---|
| 53 | my $newValueHash;
|
|---|
| 54 | $newComment = $exifTool->GetNewValues('Comment', \$newValueHash);
|
|---|
| 55 | $setComment = 1 if $newValueHash;
|
|---|
| 56 | }
|
|---|
| 57 | }
|
|---|
| 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) {
|
|---|
| 96 | 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);
|
|---|
| 109 | 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 | }
|
|---|
| 120 | # 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 | }
|
|---|
| 164 | } else {
|
|---|
| 165 | 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 | }
|
|---|
| 176 | $exifTool->FoundTag('Comment', $comment) if $comment;
|
|---|
| 177 | }
|
|---|
| 178 | # set return value to -1 if we only had a write error
|
|---|
| 179 | $rtnVal = -1 if $rtnVal and $err;
|
|---|
| 180 | return $rtnVal;
|
|---|
| 181 | }
|
|---|
| 182 |
|
|---|
| 183 |
|
|---|
| 184 | 1; #end
|
|---|
| 185 |
|
|---|
| 186 | __END__
|
|---|
| 187 |
|
|---|
| 188 | =head1 NAME
|
|---|
| 189 |
|
|---|
| 190 | Image::ExifTool::GIF - Read and write GIF meta information
|
|---|
| 191 |
|
|---|
| 192 | =head1 SYNOPSIS
|
|---|
| 193 |
|
|---|
| 194 | This module is loaded automatically by Image::ExifTool when required.
|
|---|
| 195 |
|
|---|
| 196 | =head1 DESCRIPTION
|
|---|
| 197 |
|
|---|
| 198 | 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.
|
|---|
| 201 |
|
|---|
| 202 | =head1 AUTHOR
|
|---|
| 203 |
|
|---|
| 204 | Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
|
|---|
| 205 |
|
|---|
| 206 | This library is free software; you can redistribute it and/or modify it
|
|---|
| 207 | under the same terms as Perl itself.
|
|---|
| 208 |
|
|---|
| 209 | =head1 REFERENCES
|
|---|
| 210 |
|
|---|
| 211 | =over 4
|
|---|
| 212 |
|
|---|
| 213 | =item L<http://www.w3.org/Graphics/GIF/spec-gif89a.txt>
|
|---|
| 214 |
|
|---|
| 215 | =back
|
|---|
| 216 |
|
|---|
| 217 | =head1 SEE ALSO
|
|---|
| 218 |
|
|---|
| 219 | L<Image::ExifTool(3pm)|Image::ExifTool>
|
|---|
| 220 |
|
|---|
| 221 | =cut
|
|---|
