source: gs2-extensions/parallel-building/trunk/src/perllib/cpan/Image/ExifTool/MIFF.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: 9.2 KB
Line 
1#------------------------------------------------------------------------------
2# File: MIFF.pm
3#
4# Description: Read Magick Image File Format meta information
5#
6# Revisions: 06/10/2005 - P. Harvey Created
7#
8# References: 1) http://www.imagemagick.org/script/miff.php
9# 2) http://www.cs.uni.edu/Help/ImageMagick/www/miff.html
10#------------------------------------------------------------------------------
11
12package Image::ExifTool::MIFF;
13
14use strict;
15use vars qw($VERSION);
16use Image::ExifTool qw(:DataAccess :Utils);
17
18$VERSION = '1.05';
19
20# MIFF chunks
21%Image::ExifTool::MIFF::Main = (
22 GROUPS => { 2 => 'Image' },
23 NOTES => q{
24 The MIFF (Magick Image File Format) format allows aribrary tag names to be
25 used. Only the standard tag names are listed below, however ExifTool will
26 decode any tags found in the image.
27 },
28 'background-color' => 'BackgroundColor',
29 'blue-primary' => 'BluePrimary',
30 'border-color' => 'BorderColor',
31 'matt-color' => 'MattColor',
32 class => 'Class',
33 colors => 'Colors',
34 colorspace => 'Colorspace',
35 columns => 'ImageWidth',
36 compression => 'Compression',
37 delay => 'Delay',
38 depth => 'Depth',
39 dispose => 'Dispose',
40 gamma => 'Gamma',
41 'green-primary' => 'GreenPrimary',
42 id => 'ID',
43 iterations => 'Iterations',
44 label => 'Label',
45 matte => 'Matte',
46 montage => 'Montage',
47 packets => 'Packets',
48 page => 'Page',
49 # profile tags. Note the SubDirectory is not used by ProcessMIFF(),
50 # but is inserted for documentation purposes only
51 'profile-APP1' => [
52 # [this list is just for the sake of the documentation]
53 {
54 Name => 'APP1_Profile',
55 SubDirectory => {
56 TagTable => 'Image::ExifTool::Exif::Main',
57 },
58 },
59 {
60 Name => 'APP1_Profile',
61 SubDirectory => {
62 TagTable => 'Image::ExifTool::XMP::Main',
63 },
64 },
65 ],
66 'profile-exif' => { # haven't seen this, but it would make sense - PH
67 Name => 'EXIF_Profile',
68 SubDirectory => {
69 TagTable => 'Image::ExifTool::Exif::Main',
70 },
71 },
72 'profile-icc' => {
73 Name => 'ICC_Profile',
74 SubDirectory => {
75 TagTable => 'Image::ExifTool::ICC_Profile::Main',
76 },
77 },
78 'profile-iptc' => {
79 Name => 'IPTC_Profile',
80 SubDirectory => {
81 TagTable => 'Image::ExifTool::Photoshop::Main',
82 },
83 },
84 'profile-xmp' => { # haven't seen this, but it would make sense - PH
85 Name => 'XMP_Profile',
86 SubDirectory => {
87 TagTable => 'Image::ExifTool::XMP::Main',
88 },
89 },
90 'red-primary' => 'RedPrimary',
91 'rendering-intent' => 'RenderingIntent',
92 resolution => 'Resolution',
93 rows => 'ImageHeight',
94 scene => 'Scene',
95 signature => 'Signature',
96 units => 'Units',
97 'white-point' => 'WhitePoint',
98);
99
100#------------------------------------------------------------------------------
101# Extract meta information from a MIFF image
102# Inputs: 0) ExifTool object reference, 1) dirInfo reference
103# Returns: 1 on success, 0 if this wasn't a valid MIFF image
104sub ProcessMIFF($$)
105{
106 my ($exifTool, $dirInfo) = @_;
107 my $raf = $$dirInfo{RAF};
108 my $verbose = $exifTool->{OPTIONS}->{Verbose};
109 my ($hdr, $buff);
110
111 # validate the MIFF file (note: MIFF files _may_ begin with other
112 # characters, but this starting sequence is strongly suggested.)
113 return 0 unless $raf->Read($hdr, 14) == 14;
114 return 0 unless $hdr eq 'id=ImageMagick';
115 $exifTool->SetFileType(); # set the FileType tag
116
117 # set end-of-line character sequence to read to end of the TEXT
118 # section for new-type MIFF files (text ends with Colon+Ctrl-Z)
119 # Old MIFF files end with Colon+Linefeed, so this will likely
120 # slurp those entire files, which will be slower, but will work
121 # OK except that the profile information won't be decoded
122 local $/ = ":\x1a";
123
124 my $mode = '';
125 my @profiles;
126 if ($raf->ReadLine($buff)) {
127 chomp $buff; # remove end-of-line chars
128 my $tagTablePtr = GetTagTable('Image::ExifTool::MIFF::Main');
129 my @entries = split ' ', $buff;
130 unshift @entries, $hdr; # put the ID back in
131 my ($tag, $val);
132 foreach (@entries) {
133 if ($mode eq 'com') {
134 $mode = '' if /\}$/;
135 next;
136 } elsif (/^\{/) {
137 $mode = 'com'; # read to the end of the comment
138 next;
139 }
140 if ($mode eq 'val') {
141 $val .= " $_"; # join back together with a space
142 next unless /\}$/;
143 $mode = '';
144 $val =~ s/(^\{|\}$)//g; # remove braces
145 } elsif (/(.+)=(.+)/) {
146 ($tag, $val) = ($1, $2);
147 if ($val =~ /^\{/) {
148 $mode = 'val'; # read to the end of the value data
149 next;
150 }
151 } elsif (/^:/) {
152 # this could be the end of an old-style MIFF file
153 last;
154 } else {
155 # something we don't recognize -- stop parsing here
156 $exifTool->Warn('Unrecognized MIFF data');
157 last;
158 }
159 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
160 unless ($tagInfo) {
161 $tagInfo = { Name => $tag };
162 Image::ExifTool::AddTagToTable($tagTablePtr, $tag, $tagInfo);
163 }
164 $verbose and $exifTool->VerboseInfo($tag, $tagInfo,
165 Table => $tagTablePtr,
166 DataPt => \$val,
167 );
168 # handle profile tags specially
169 if ($tag =~ /^profile-(.*)/) {
170 push @profiles, [$1, $val];
171 } else {
172 $exifTool->FoundTag($tagInfo, $val);
173 }
174 }
175 }
176
177 # process profile information
178 foreach (@profiles) {
179 my ($type, $len) = @{$_};
180 unless ($len =~ /^\d+$/) {
181 $exifTool->Warn("Invalid length for $type profile");
182 last; # don't try to read the rest
183 }
184 unless ($raf->Read($buff, $len) == $len) {
185 $exifTool->Warn("Error reading $type profile ($len bytes)");
186 next;
187 }
188 my $processed = 0;
189 my %dirInfo = (
190 Parent => 'PNG',
191 DataPt => \$buff,
192 DataPos => $raf->Tell() - $len,
193 DataLen => $len,
194 DirStart => 0,
195 DirLen => $len,
196 );
197 if ($type eq 'icc') {
198 # ICC Profile information
199 my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
200 $processed = $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
201 } elsif ($type eq 'iptc') {
202 if ($buff =~ /^8BIM/) {
203 # Photoshop information
204 my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
205 $processed = $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
206 }
207 # I haven't seen 'exif' or 'xmp' profile types yet, but I have seen them
208 # in newer PNG files so presumably they are possible here as well - PH
209 } elsif ($type eq 'APP1' or $type eq 'exif' or $type eq 'xmp') {
210 if ($buff =~ /^$Image::ExifTool::exifAPP1hdr/) {
211 # APP1 EXIF
212 my $hdrLen = length($Image::ExifTool::exifAPP1hdr);
213 $dirInfo{DirStart} += $hdrLen;
214 $dirInfo{DirLen} -= $hdrLen;
215 # use the usual position for EXIF data: 12 bytes from start of file
216 # (this may be wrong, but I can't see where the PNG stores this information)
217 $dirInfo{Base} = 12; # this is the usual value
218 $processed = $exifTool->ProcessTIFF(\%dirInfo);
219 } elsif ($buff =~ /^$Image::ExifTool::xmpAPP1hdr/) {
220 # APP1 XMP
221 my $hdrLen = length($Image::ExifTool::xmpAPP1hdr);
222 my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
223 $dirInfo{DirStart} += $hdrLen;
224 $dirInfo{DirLen} -= $hdrLen;
225 $processed = $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
226 }
227 }
228 unless ($processed) {
229 $exifTool->Warn("Unknown MIFF $type profile data");
230 if ($verbose) {
231 $exifTool->VerboseDir($type, 0, $len);
232 $exifTool->VerboseDump(\$buff);
233 }
234 }
235 }
236 return 1;
237}
238
2391; # end
240
241__END__
242
243=head1 NAME
244
245Image::ExifTool::MIFF - Read Magick Image File Format meta information
246
247=head1 SYNOPSIS
248
249This module is used by Image::ExifTool
250
251=head1 DESCRIPTION
252
253This module contains routines required by Image::ExifTool to read MIFF
254(Magick Image File Format) images.
255
256=head1 AUTHOR
257
258Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
259
260This library is free software; you can redistribute it and/or modify it
261under the same terms as Perl itself.
262
263=head1 REFERENCES
264
265=over 4
266
267=item L<http://www.imagemagick.org/script/miff.php>
268
269=item L<http://www.cs.uni.edu/Help/ImageMagick/www/miff.html>
270
271=back
272
273=head1 SEE ALSO
274
275L<Image::ExifTool::TagNames/MIFF Tags>,
276L<Image::ExifTool(3pm)|Image::ExifTool>
277
278=cut
279
Note: See TracBrowser for help on using the repository browser.