File Coverage

blib/lib/Image/ExifTool/ITC.pm
Criterion Covered Total %
statement 60 65 92.3
branch 24 44 54.5
condition 4 12 33.3
subroutine 4 4 100.0
pod 0 1 0.0
total 92 126 73.0


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__