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
|
|
4272
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
41
|
|
15
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
51
|
|
16
|
1
|
|
|
1
|
|
5
|
use Image::ExifTool qw(:DataAccess :Utils); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
908
|
|
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
|
3
|
my ($et, $dirInfo) = @_; |
87
|
1
|
|
|
|
|
3
|
my $raf = $$dirInfo{RAF}; |
88
|
1
|
|
|
|
|
2
|
my $rtnVal = 0; |
89
|
1
|
|
|
|
|
2
|
my ($buff, $err, $pos, $tagTablePtr, %dirInfo); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# loop through all blocks in this image |
92
|
1
|
|
|
|
|
3
|
for (;;) { |
93
|
|
|
|
|
|
|
# read the block header |
94
|
3
|
|
|
|
|
11
|
my $n = $raf->Read($buff, 8); |
95
|
3
|
100
|
|
|
|
9
|
unless ($n == 8) { |
96
|
|
|
|
|
|
|
# no error if we reached the EOF normally |
97
|
1
|
50
|
|
|
|
6
|
undef $err unless $n; |
98
|
1
|
|
|
|
|
3
|
last; |
99
|
|
|
|
|
|
|
} |
100
|
2
|
|
|
|
|
19
|
my ($size, $tag) = unpack('Na4', $buff); |
101
|
2
|
100
|
|
|
|
7
|
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
|
|
|
|
3
|
last unless $tag eq 'itch'; |
107
|
1
|
50
|
33
|
|
|
8
|
last unless $size >= 0x1c and $size < 0x10000; |
108
|
1
|
|
|
|
|
6
|
$et->SetFileType(); |
109
|
1
|
|
|
|
|
5
|
SetByteOrder('MM'); |
110
|
1
|
|
|
|
|
2
|
$rtnVal = 1; # this is an ITC file |
111
|
1
|
|
|
|
|
2
|
$err = 1; # format error unless we read to EOF |
112
|
|
|
|
|
|
|
} |
113
|
2
|
100
|
|
|
|
6
|
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
|
|
|
|
3
|
$raf->Read($buff,$size) == $size or last; |
117
|
|
|
|
|
|
|
# extract header information |
118
|
1
|
|
|
|
|
7
|
%dirInfo = ( |
119
|
|
|
|
|
|
|
DirName => 'ITC Header', |
120
|
|
|
|
|
|
|
DataPt => \$buff, |
121
|
|
|
|
|
|
|
DataPos => $pos, |
122
|
|
|
|
|
|
|
); |
123
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::ITC::Header'); |
124
|
1
|
|
|
|
|
5
|
$et->ProcessDirectory(\%dirInfo, $tagTablePtr); |
125
|
|
|
|
|
|
|
} elsif ($tag eq 'item') { |
126
|
|
|
|
|
|
|
# don't want to read the entire item data (includes image) |
127
|
1
|
50
|
|
|
|
4
|
$size > 12 or last; |
128
|
1
|
50
|
|
|
|
3
|
$raf->Read($buff, 4) == 4 or last; |
129
|
1
|
|
|
|
|
2
|
my $len = unpack('N', $buff); |
130
|
1
|
50
|
33
|
|
|
7
|
$len >= 0xd0 and $len <= $size or last; |
131
|
1
|
|
|
|
|
11
|
$size -= $len; # size of data after item header |
132
|
1
|
|
|
|
|
3
|
$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
|
|
|
|
|
5
|
while ($len >= 4) { |
136
|
4
|
50
|
|
|
|
8
|
$raf->Read($buff, 4) == 4 or last; |
137
|
4
|
|
|
|
|
6
|
$len -= 4; |
138
|
4
|
100
|
|
|
|
10
|
last if $buff eq "\0\0\0\0"; |
139
|
|
|
|
|
|
|
} |
140
|
1
|
50
|
|
|
|
4
|
last if $len < 4; |
141
|
1
|
|
|
|
|
8
|
$pos = $raf->Tell(); |
142
|
1
|
50
|
|
|
|
4
|
$raf->Read($buff, $len) == $len or last; |
143
|
1
|
50
|
33
|
|
|
9
|
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
|
|
|
|
|
5
|
DirName => 'ITC Item', |
149
|
|
|
|
|
|
|
DataPt => \$buff, |
150
|
|
|
|
|
|
|
DataPos => $pos, |
151
|
|
|
|
|
|
|
); |
152
|
1
|
|
|
|
|
5
|
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Item'); |
153
|
1
|
|
|
|
|
5
|
$et->ProcessDirectory(\%dirInfo, $tagTablePtr); |
154
|
|
|
|
|
|
|
# extract embedded image |
155
|
1
|
|
|
|
|
2
|
$pos += $len; |
156
|
1
|
50
|
|
|
|
5
|
if ($size > 0) { |
|
|
0
|
|
|
|
|
|
157
|
1
|
|
|
|
|
3
|
$tagTablePtr = GetTagTable('Image::ExifTool::ITC::Main'); |
158
|
1
|
|
|
|
|
5
|
my $tagInfo = $et->GetTagInfo($tagTablePtr, 'data'); |
159
|
1
|
|
|
|
|
6
|
my $image = $et->ExtractBinary($pos, $size, $$tagInfo{Name}); |
160
|
1
|
|
|
|
|
5
|
$et->FoundTag($tagInfo, \$image); |
161
|
|
|
|
|
|
|
# skip the rest of the block if necessary |
162
|
1
|
50
|
|
|
|
36
|
$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__ |