| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
2
|
|
|
|
|
|
|
# File: ITC.pm |
|
3
|
|
|
|
|
|
|
# |
|
4
|
|
|
|
|
|
|
# Description: Read iTunes Cover Flow meta information |
|
5
|
|
|
|
|
|
|
# |
|
6
|
|
|
|
|
|
|
# Revisions: 01/12/2008 - P. Harvey Created |
|
7
|
|
|
|
|
|
|
# |
|
8
|
|
|
|
|
|
|
# References: 1) http://www.waldoland.com/dev/Articles/ITCFileFormat.aspx |
|
9
|
|
|
|
|
|
|
# 2) http://www.falsecognate.org/2007/01/deciphering_the_itunes_itc_fil/ |
|
10
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
package Image::ExifTool::ITC; |
|
13
|
|
|
|
|
|
|
|
|
14
|
1
|
|
|
1
|
|
4340
|
use strict; |
|
|
1
|
|
|
|
|
5
|
|
|
|
1
|
|
|
|
|
32
|
|
|
15
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
39
|
|
|
16
|
1
|
|
|
1
|
|
6
|
use Image::ExifTool qw(:DataAccess :Utils); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
1253
|
|
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$VERSION = '1.02'; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub ProcessITC($$); |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# tags used in ITC files |
|
23
|
|
|
|
|
|
|
%Image::ExifTool::ITC::Main = ( |
|
24
|
|
|
|
|
|
|
NOTES => 'This information is found in iTunes Cover Flow data files.', |
|
25
|
|
|
|
|
|
|
itch => { SubDirectory => { TagTable => 'Image::ExifTool::ITC::Header' } }, |
|
26
|
|
|
|
|
|
|
item => { SubDirectory => { TagTable => 'Image::ExifTool::ITC::Item' } }, |
|
27
|
|
|
|
|
|
|
data => { |
|
28
|
|
|
|
|
|
|
Name => 'ImageData', |
|
29
|
|
|
|
|
|
|
Notes => 'embedded JPEG or PNG image, depending on ImageType', |
|
30
|
|
|
|
|
|
|
}, |
|
31
|
|
|
|
|
|
|
); |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# ITC header information |
|
34
|
|
|
|
|
|
|
%Image::ExifTool::ITC::Header = ( |
|
35
|
|
|
|
|
|
|
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, |
|
36
|
|
|
|
|
|
|
GROUPS => { 2 => 'Image' }, |
|
37
|
|
|
|
|
|
|
0x10 => { |
|
38
|
|
|
|
|
|
|
Name => 'DataType', |
|
39
|
|
|
|
|
|
|
Format => 'undef[4]', |
|
40
|
|
|
|
|
|
|
PrintConv => { artw => 'Artwork' }, |
|
41
|
|
|
|
|
|
|
}, |
|
42
|
|
|
|
|
|
|
); |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# ITC item information |
|
45
|
|
|
|
|
|
|
%Image::ExifTool::ITC::Item = ( |
|
46
|
|
|
|
|
|
|
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, |
|
47
|
|
|
|
|
|
|
GROUPS => { 2 => 'Image' }, |
|
48
|
|
|
|
|
|
|
FORMAT => 'int32u', |
|
49
|
|
|
|
|
|
|
FIRST_ENTRY => 0, |
|
50
|
|
|
|
|
|
|
0 => { |
|
51
|
|
|
|
|
|
|
Name => 'LibraryID', |
|
52
|
|
|
|
|
|
|
Format => 'undef[8]', |
|
53
|
|
|
|
|
|
|
ValueConv => 'uc unpack "H*", $val', |
|
54
|
|
|
|
|
|
|
}, |
|
55
|
|
|
|
|
|
|
2 => { |
|
56
|
|
|
|
|
|
|
Name => 'TrackID', |
|
57
|
|
|
|
|
|
|
Format => 'undef[8]', |
|
58
|
|
|
|
|
|
|
ValueConv => 'uc unpack "H*", $val', |
|
59
|
|
|
|
|
|
|
}, |
|
60
|
|
|
|
|
|
|
4 => { |
|
61
|
|
|
|
|
|
|
Name => 'DataLocation', |
|
62
|
|
|
|
|
|
|
Format => 'undef[4]', |
|
63
|
|
|
|
|
|
|
PrintConv => { |
|
64
|
|
|
|
|
|
|
down => 'Downloaded Separately', |
|
65
|
|
|
|
|
|
|
locl => 'Local Music File', |
|
66
|
|
|
|
|
|
|
}, |
|
67
|
|
|
|
|
|
|
}, |
|
68
|
|
|
|
|
|
|
5 => { |
|
69
|
|
|
|
|
|
|
Name => 'ImageType', |
|
70
|
|
|
|
|
|
|
Format => 'undef[4]', |
|
71
|
|
|
|
|
|
|
ValueConv => { # (not PrintConv because the unconverted JPEG value is nasty) |
|
72
|
|
|
|
|
|
|
'PNGf' => 'PNG', |
|
73
|
|
|
|
|
|
|
"\0\0\0\x0d" => 'JPEG', |
|
74
|
|
|
|
|
|
|
}, |
|
75
|
|
|
|
|
|
|
}, |
|
76
|
|
|
|
|
|
|
7 => 'ImageWidth', |
|
77
|
|
|
|
|
|
|
8 => 'ImageHeight', |
|
78
|
|
|
|
|
|
|
); |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
|
81
|
|
|
|
|
|
|
# Process an iTunes Cover Flow (ITC) file |
|
82
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) Directory information reference |
|
83
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid ITC file |
|
84
|
|
|
|
|
|
|
sub ProcessITC($$) |
|
85
|
|
|
|
|
|
|
{ |
|
86
|
1
|
|
|
1
|
0
|
4
|
my ($et, $dirInfo) = @_; |
|
87
|
1
|
|
|
|
|
4
|
my $raf = $$dirInfo{RAF}; |
|
88
|
1
|
|
|
|
|
2
|
my $rtnVal = 0; |
|
89
|
1
|
|
|
|
|
4
|
my ($buff, $err, $pos, $tagTablePtr, %dirInfo); |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# loop through all blocks in this image |
|
92
|
1
|
|
|
|
|
2
|
for (;;) { |
|
93
|
|
|
|
|
|
|
# read the block header |
|
94
|
3
|
|
|
|
|
23
|
my $n = $raf->Read($buff, 8); |
|
95
|
3
|
100
|
|
|
|
13
|
unless ($n == 8) { |
|
96
|
|
|
|
|
|
|
# no error if we reached the EOF normally |
|
97
|
1
|
50
|
|
|
|
4
|
undef $err unless $n; |
|
98
|
1
|
|
|
|
|
3
|
last; |
|
99
|
|
|
|
|
|
|
} |
|
100
|
2
|
|
|
|
|
20
|
my ($size, $tag) = unpack('Na4', $buff); |
|
101
|
2
|
100
|
|
|
|
6
|
if ($rtnVal) { |
|
102
|
1
|
50
|
33
|
|
|
7
|
last unless $size >= 8 and $size < 0x80000000; |
|
103
|
|
|
|
|
|
|
} else { |
|
104
|
|
|
|
|
|
|
# check to be sure this is a valid ITC image |
|
105
|
|
|
|
|
|
|
# (first block must be 'itch') |
|
106
|
1
|
50
|
|
|
|
5
|
last unless $tag eq 'itch'; |
|
107
|
1
|
50
|
33
|
|
|
8
|
last unless $size >= 0x1c and $size < 0x10000; |
|
108
|
1
|
|
|
|
|
8
|
$et->SetFileType(); |
|
109
|
1
|
|
|
|
|
14
|
SetByteOrder('MM'); |
|
110
|
1
|
|
|
|
|
2
|
$rtnVal = 1; # this is an ITC file |
|
111
|
1
|
|
|
|
|
3
|
$err = 1; # format error unless we read to EOF |
|
112
|
|
|
|
|
|
|
} |
|
113
|
2
|
100
|
|
|
|
9
|
if ($tag eq 'itch') { |
|
|
|
50
|
|
|
|
|
|
|
114
|
1
|
|
|
|
|
4
|
$pos = $raf->Tell(); |
|
115
|
1
|
|
|
|
|
3
|
$size -= 8; # size of remaining data in block |
|
116
|
1
|
50
|
|
|
|
4
|
$raf->Read($buff,$size) == $size or last; |
|
117
|
|
|
|
|
|
|
# extract header information |
|
118
|
1
|
|
|
|
|
20
|
%dirInfo = ( |
|
119
|
|
|
|
|
|
|
DirName => 'ITC Header', |
|
120
|
|
|
|
|
|
|
DataPt => \$buff, |
|
121
|
|
|
|
|
|
|
DataPos => $pos, |
|
122
|
|
|
|
|
|
|
); |
|
123
|
1
|
|
|
|
|
15
|
my $tagTablePtr = GetTagTable('Image::ExifTool::ITC::Header'); |
|
124
|
1
|
|
|
|
|
17
|
$et->ProcessDirectory(\%dirInfo, $tagTablePtr); |
|
125
|
|
|
|
|
|
|
} elsif ($tag eq 'item') { |
|
126
|
|
|
|
|
|
|
# don't want to read the entire item data (includes image) |
|
127
|
1
|
50
|
|
|
|
5
|
$size > 12 or last; |
|
128
|
1
|
50
|
|
|
|
5
|
$raf->Read($buff, 4) == 4 or last; |
|
129
|
1
|
|
|
|
|
5
|
my $len = unpack('N', $buff); |
|
130
|
1
|
50
|
33
|
|
|
10
|
$len >= 0xd0 and $len <= $size or last; |
|
131
|
1
|
|
|
|
|
2
|
$size -= $len; # size of data after item header |
|
132
|
1
|
|
|
|
|
2
|
$len -= 12; # length of remaining item header |
|
133
|
|
|
|
|
|
|
# read in 4-byte blocks until we find the null terminator |
|
134
|
|
|
|
|
|
|
# (this is just a guess about how to parse this variable-length part) |
|
135
|
1
|
|
|
|
|
4
|
while ($len >= 4) { |
|
136
|
4
|
50
|
|
|
|
19
|
$raf->Read($buff, 4) == 4 or last; |
|
137
|
4
|
|
|
|
|
6
|
$len -= 4; |
|
138
|
4
|
100
|
|
|
|
11
|
last if $buff eq "\0\0\0\0"; |
|
139
|
|
|
|
|
|
|
} |
|
140
|
1
|
50
|
|
|
|
15
|
last if $len < 4; |
|
141
|
1
|
|
|
|
|
6
|
$pos = $raf->Tell(); |
|
142
|
1
|
50
|
|
|
|
10
|
$raf->Read($buff, $len) == $len or last; |
|
143
|
1
|
50
|
33
|
|
|
11
|
unless ($len >= 0xb4 and substr($buff, 0xb0, 4) eq 'data') { |
|
144
|
0
|
|
|
|
|
0
|
$et->Warn('Parsing error. Please submit this ITC file for testing'); |
|
145
|
0
|
|
|
|
|
0
|
last; |
|
146
|
|
|
|
|
|
|
} |
|
147
|
|
|
|
|
|
|
%dirInfo = ( |
|
148
|
1
|
|
|
|
|
7
|
DirName => 'ITC Item', |
|
149
|
|
|
|
|
|
|
DataPt => \$buff, |
|
150
|
|
|
|
|
|
|
DataPos => $pos, |
|
151
|
|
|
|
|
|
|
); |
|
152
|
1
|
|
|
|
|
4
|
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Item'); |
|
153
|
1
|
|
|
|
|
5
|
$et->ProcessDirectory(\%dirInfo, $tagTablePtr); |
|
154
|
|
|
|
|
|
|
# extract embedded image |
|
155
|
1
|
|
|
|
|
3
|
$pos += $len; |
|
156
|
1
|
50
|
|
|
|
4
|
if ($size > 0) { |
|
|
|
0
|
|
|
|
|
|
|
157
|
1
|
|
|
|
|
4
|
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Main'); |
|
158
|
1
|
|
|
|
|
4
|
my $tagInfo = $et->GetTagInfo($tagTablePtr, 'data'); |
|
159
|
1
|
|
|
|
|
6
|
my $image = $et->ExtractBinary($pos, $size, $$tagInfo{Name}); |
|
160
|
1
|
|
|
|
|
6
|
$et->FoundTag($tagInfo, \$image); |
|
161
|
|
|
|
|
|
|
# skip the rest of the block if necessary |
|
162
|
1
|
50
|
|
|
|
15
|
$raf->Seek($pos+$size, 0) or last |
|
163
|
|
|
|
|
|
|
} elsif ($size < 0) { |
|
164
|
0
|
|
|
|
|
0
|
last; |
|
165
|
|
|
|
|
|
|
} |
|
166
|
|
|
|
|
|
|
} else { |
|
167
|
0
|
|
|
|
|
0
|
$et->VPrint(0, "Unknown $tag block ($size bytes)\n"); |
|
168
|
0
|
0
|
|
|
|
0
|
$raf->Seek($size-8, 1) or last; |
|
169
|
|
|
|
|
|
|
} |
|
170
|
|
|
|
|
|
|
} |
|
171
|
1
|
50
|
|
|
|
3
|
$err and $et->Warn('ITC file format error'); |
|
172
|
1
|
|
|
|
|
5
|
return $rtnVal; |
|
173
|
|
|
|
|
|
|
} |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
1; # end |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
__END__ |