line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
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
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package Image::ExifTool::MIFF; |
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
4239
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
15
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
39
|
|
16
|
1
|
|
|
1
|
|
5
|
use Image::ExifTool qw(:DataAccess :Utils); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
1224
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$VERSION = '1.07'; |
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 |
104
|
|
|
|
|
|
|
sub ProcessMIFF($$) |
105
|
|
|
|
|
|
|
{ |
106
|
1
|
|
|
1
|
0
|
5
|
my ($et, $dirInfo) = @_; |
107
|
1
|
|
|
|
|
4
|
my $raf = $$dirInfo{RAF}; |
108
|
1
|
|
|
|
|
3
|
my $verbose = $$et{OPTIONS}{Verbose}; |
109
|
1
|
|
|
|
|
2
|
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
|
1
|
50
|
|
|
|
4
|
return 0 unless $raf->Read($hdr, 14) == 14; |
114
|
1
|
50
|
|
|
|
5
|
return 0 unless $hdr eq 'id=ImageMagick'; |
115
|
1
|
|
|
|
|
6
|
$et->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
|
1
|
|
|
|
|
9
|
local $/ = ":\x1a"; |
123
|
|
|
|
|
|
|
|
124
|
1
|
|
|
|
|
3
|
my $mode = ''; |
125
|
1
|
|
|
|
|
2
|
my @profiles; |
126
|
1
|
50
|
|
|
|
5
|
if ($raf->ReadLine($buff)) { |
127
|
1
|
|
|
|
|
4
|
chomp $buff; # remove end-of-line chars |
128
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::MIFF::Main'); |
129
|
1
|
|
|
|
|
22
|
my @entries = split ' ', $buff; |
130
|
1
|
|
|
|
|
5
|
unshift @entries, $hdr; # put the ID back in |
131
|
1
|
|
|
|
|
2
|
my ($tag, $val); |
132
|
1
|
|
|
|
|
4
|
foreach (@entries) { |
133
|
11
|
50
|
|
|
|
34
|
if ($mode eq 'com') { |
|
|
50
|
|
|
|
|
|
134
|
0
|
0
|
|
|
|
0
|
$mode = '' if /\}$/; |
135
|
0
|
|
|
|
|
0
|
next; |
136
|
|
|
|
|
|
|
} elsif (/^\{/) { |
137
|
0
|
|
|
|
|
0
|
$mode = 'com'; # read to the end of the comment |
138
|
0
|
|
|
|
|
0
|
next; |
139
|
|
|
|
|
|
|
} |
140
|
11
|
50
|
|
|
|
51
|
if ($mode eq 'val') { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
141
|
0
|
|
|
|
|
0
|
$val .= " $_"; # join back together with a space |
142
|
0
|
0
|
|
|
|
0
|
next unless /\}$/; |
143
|
0
|
|
|
|
|
0
|
$mode = ''; |
144
|
0
|
|
|
|
|
0
|
$val =~ s/(^\{|\}$)//g; # remove braces |
145
|
|
|
|
|
|
|
} elsif (/(.+)=(.+)/) { |
146
|
11
|
|
|
|
|
32
|
($tag, $val) = ($1, $2); |
147
|
11
|
50
|
|
|
|
25
|
if ($val =~ /^\{/) { |
148
|
0
|
|
|
|
|
0
|
$mode = 'val'; # read to the end of the value data |
149
|
0
|
|
|
|
|
0
|
next; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} elsif (/^:/) { |
152
|
|
|
|
|
|
|
# this could be the end of an old-style MIFF file |
153
|
0
|
|
|
|
|
0
|
last; |
154
|
|
|
|
|
|
|
} else { |
155
|
|
|
|
|
|
|
# something we don't recognize -- stop parsing here |
156
|
0
|
|
|
|
|
0
|
$et->Warn('Unrecognized MIFF data'); |
157
|
0
|
|
|
|
|
0
|
last; |
158
|
|
|
|
|
|
|
} |
159
|
11
|
|
|
|
|
28
|
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag); |
160
|
11
|
100
|
|
|
|
26
|
unless ($tagInfo) { |
161
|
1
|
|
|
|
|
3
|
$tagInfo = { Name => $tag }; |
162
|
1
|
|
|
|
|
6
|
AddTagToTable($tagTablePtr, $tag, $tagInfo); |
163
|
|
|
|
|
|
|
} |
164
|
11
|
50
|
|
|
|
22
|
$verbose and $et->VerboseInfo($tag, $tagInfo, |
165
|
|
|
|
|
|
|
Table => $tagTablePtr, |
166
|
|
|
|
|
|
|
DataPt => \$val, |
167
|
|
|
|
|
|
|
); |
168
|
|
|
|
|
|
|
# handle profile tags specially |
169
|
11
|
100
|
|
|
|
31
|
if ($tag =~ /^profile-(.*)/) { |
170
|
3
|
|
|
|
|
20
|
push @profiles, [$1, $val]; |
171
|
|
|
|
|
|
|
} else { |
172
|
8
|
|
|
|
|
19
|
$et->FoundTag($tagInfo, $val); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# process profile information |
178
|
1
|
|
|
|
|
8
|
foreach (@profiles) { |
179
|
3
|
|
|
|
|
6
|
my ($type, $len) = @{$_}; |
|
3
|
|
|
|
|
8
|
|
180
|
3
|
50
|
|
|
|
22
|
unless ($len =~ /^\d+$/) { |
181
|
0
|
|
|
|
|
0
|
$et->Warn("Invalid length for $type profile"); |
182
|
0
|
|
|
|
|
0
|
last; # don't try to read the rest |
183
|
|
|
|
|
|
|
} |
184
|
3
|
50
|
|
|
|
13
|
unless ($raf->Read($buff, $len) == $len) { |
185
|
0
|
|
|
|
|
0
|
$et->Warn("Error reading $type profile ($len bytes)"); |
186
|
0
|
|
|
|
|
0
|
next; |
187
|
|
|
|
|
|
|
} |
188
|
3
|
|
|
|
|
17
|
my $processed = 0; |
189
|
3
|
|
|
|
|
27
|
my %dirInfo = ( |
190
|
|
|
|
|
|
|
Parent => 'PNG', |
191
|
|
|
|
|
|
|
DataPt => \$buff, |
192
|
|
|
|
|
|
|
DataPos => $raf->Tell() - $len, |
193
|
|
|
|
|
|
|
DataLen => $len, |
194
|
|
|
|
|
|
|
DirStart => 0, |
195
|
|
|
|
|
|
|
DirLen => $len, |
196
|
|
|
|
|
|
|
); |
197
|
3
|
50
|
33
|
|
|
22
|
if ($type eq 'icc') { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
198
|
|
|
|
|
|
|
# ICC Profile information |
199
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main'); |
200
|
0
|
|
|
|
|
0
|
$processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr); |
201
|
|
|
|
|
|
|
} elsif ($type eq 'iptc') { |
202
|
1
|
50
|
|
|
|
7
|
if ($buff =~ /^8BIM/) { |
203
|
|
|
|
|
|
|
# Photoshop information |
204
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main'); |
205
|
1
|
|
|
|
|
8
|
$processed = $et->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
|
2
|
100
|
|
|
|
40
|
if ($buff =~ /^$Image::ExifTool::exifAPP1hdr/) { |
|
|
50
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# APP1 EXIF |
212
|
1
|
|
|
|
|
2
|
my $hdrLen = length($Image::ExifTool::exifAPP1hdr); |
213
|
1
|
|
|
|
|
3
|
$dirInfo{DirStart} += $hdrLen; |
214
|
1
|
|
|
|
|
3
|
$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
|
1
|
|
|
|
|
2
|
$dirInfo{Base} = 12; # this is the usual value |
218
|
1
|
|
|
|
|
5
|
$processed = $et->ProcessTIFF(\%dirInfo); |
219
|
|
|
|
|
|
|
} elsif ($buff =~ /^$Image::ExifTool::xmpAPP1hdr/) { |
220
|
|
|
|
|
|
|
# APP1 XMP |
221
|
1
|
|
|
|
|
4
|
my $hdrLen = length($Image::ExifTool::xmpAPP1hdr); |
222
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); |
223
|
1
|
|
|
|
|
3
|
$dirInfo{DirStart} += $hdrLen; |
224
|
1
|
|
|
|
|
3
|
$dirInfo{DirLen} -= $hdrLen; |
225
|
1
|
|
|
|
|
7
|
$processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr); |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
3
|
50
|
|
|
|
21
|
unless ($processed) { |
229
|
0
|
|
|
|
|
0
|
$et->Warn("Unknown MIFF $type profile data"); |
230
|
0
|
0
|
|
|
|
0
|
if ($verbose) { |
231
|
0
|
|
|
|
|
0
|
$et->VerboseDir($type, 0, $len); |
232
|
0
|
|
|
|
|
0
|
$et->VerboseDump(\$buff); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
} |
236
|
1
|
|
|
|
|
12
|
return 1; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
1; # end |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
__END__ |