source: gs2-extensions/parallel-building/trunk/src/perllib/cpan/Image/ExifTool/ITC.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)

  • Property svn:executable set to *
File size: 6.6 KB
Line 
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
12package Image::ExifTool::ITC;
13
14use strict;
15use vars qw($VERSION);
16use Image::ExifTool qw(:DataAccess :Utils);
17
18$VERSION = '1.00';
19
20sub 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 PrintConv => {
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
84sub ProcessITC($$)
85{
86 my ($exifTool, $dirInfo) = @_;
87 my $raf = $$dirInfo{RAF};
88 my $rtnVal = 0;
89 my ($buff, $err, $pos, $tagTablePtr, %dirInfo);
90
91 # loop through all blocks in this image
92 for (;;) {
93 # read the block header
94 my $n = $raf->Read($buff, 8);
95 unless ($n == 8) {
96 # no error if we reached the EOF normally
97 undef $err unless $n;
98 last;
99 }
100 my ($size, $tag) = unpack('Na4', $buff);
101 if ($rtnVal) {
102 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 last unless $tag eq 'itch';
107 last unless $size >= 0x1c and $size < 0x10000;
108 $exifTool->SetFileType();
109 SetByteOrder('MM');
110 $rtnVal = 1; # this is an ITC file
111 $err = 1; # format error unless we read to EOF
112 }
113 if ($tag eq 'itch') {
114 $pos = $raf->Tell();
115 $size -= 8; # size of remaining data in block
116 $raf->Read($buff,$size) == $size or last;
117 # extract header information
118 %dirInfo = (
119 DirName => 'ITC Header',
120 DataPt => \$buff,
121 DataPos => $pos,
122 );
123 my $tagTablePtr = GetTagTable('Image::ExifTool::ITC::Header');
124 $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
125 } elsif ($tag eq 'item') {
126 # don't want to read the entire item data (includes image)
127 $size > 12 or last;
128 $raf->Read($buff, 4) == 4 or last;
129 my $len = unpack('N', $buff);
130 $len >= 0xd0 and $len <= $size or last;
131 $size -= $len; # size of data after item header
132 $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 while ($len >= 4) {
136 $raf->Read($buff, 4) == 4 or last;
137 $len -= 4;
138 last if $buff eq "\0\0\0\0";
139 }
140 last if $len < 4;
141 $pos = $raf->Tell();
142 $raf->Read($buff, $len) == $len or last;
143 unless ($len >= 0xb4 and substr($buff, 0xb0, 4) eq 'data') {
144 $exifTool->Warn('Parsing error. Please submit this ITC file for testing');
145 last;
146 }
147 %dirInfo = (
148 DirName => 'ITC Item',
149 DataPt => \$buff,
150 DataPos => $pos,
151 );
152 $tagTablePtr = GetTagTable('Image::ExifTool::ITC::Item');
153 $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
154 # extract embedded image
155 $pos += $len;
156 if ($size > 0) {
157 $tagTablePtr = GetTagTable('Image::ExifTool::ITC::Main');
158 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, 'data');
159 my $image = $exifTool->ExtractBinary($pos, $size, $$tagInfo{Name});
160 $exifTool->FoundTag($tagInfo, \$image);
161 # skip the rest of the block if necessary
162 $raf->Seek($pos+$size, 0) or last
163 } elsif ($size < 0) {
164 last;
165 }
166 } else {
167 $exifTool->VPrint(0, "Unknown $tag block ($size bytes)\n");
168 $raf->Seek($size-8, 1) or last;
169 }
170 }
171 $err and $exifTool->Warn('ITC file format error');
172 return $rtnVal;
173}
174
1751; # end
176
177__END__
178
179=head1 NAME
180
181Image::ExifTool::ITC - Read iTunes Cover Flow meta information
182
183=head1 SYNOPSIS
184
185This module is used by Image::ExifTool
186
187=head1 DESCRIPTION
188
189This module contains the routines required by Image::ExifTool to read meta
190information (including artwork images) from iTunes Cover Flow files.
191
192=head1 AUTHOR
193
194Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
195
196This library is free software; you can redistribute it and/or modify it
197under the same terms as Perl itself.
198
199=head1 REFERENCES
200
201=over 4
202
203=item L<http://www.waldoland.com/dev/Articles/ITCFileFormat.aspx>
204
205=item L<http://www.falsecognate.org/2007/01/deciphering_the_itunes_itc_fil/>
206
207=back
208
209=head1 SEE ALSO
210
211L<Image::ExifTool::TagNames/ITC Tags>,
212L<Image::ExifTool(3pm)|Image::ExifTool>
213
214=cut
215
Note: See TracBrowser for help on using the repository browser.