source: gsdl/trunk/perllib/cpan/Image/ExifTool/APE.pm@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav

File size: 8.0 KB
Line 
1#------------------------------------------------------------------------------
2# File: APE.pm
3#
4# Description: Read Monkey's Audio meta information
5#
6# Revisions: 11/13/2006 - P. Harvey Created
7#
8# References: 1) http://www.monkeysaudio.com/
9# 2) http://www.personal.uni-jena.de/~pfk/mpp/sv8/apetag.html
10#------------------------------------------------------------------------------
11
12package Image::ExifTool::APE;
13
14use strict;
15use vars qw($VERSION);
16use Image::ExifTool qw(:DataAccess :Utils);
17
18$VERSION = '1.01';
19
20# APE metadata blocks
21%Image::ExifTool::APE::Main = (
22 GROUPS => { 2 => 'Audio' },
23 NOTES => q{
24 Tags found in Monkey's Audio (APE) information. Only a few common tags are
25 listed below, but ExifTool will extract any tag found. ExifTool supports
26 APEv1 and APEv2 tags, as well as ID3 information in APE files.
27 },
28 Album => { },
29 Artist => { },
30 Genre => { },
31 Title => { },
32 Track => { },
33 Year => { },
34 'Tool Version' => { Name => 'ToolVersion' },
35 'Tool Name' => { Name => 'ToolName' },
36);
37
38# APE MAC header version 3.97 or earlier
39%Image::ExifTool::APE::OldHeader = (
40 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
41 GROUPS => { 1 => 'MAC', 2 => 'Audio' },
42 FORMAT => 'int16u',
43 NOTES => 'APE MAC audio header for version 3.97 or earlier.',
44 0 => {
45 Name => 'APEVersion',
46 ValueConv => '$val / 1000',
47 },
48 1 => 'CompressionLevel',
49 # 2 => 'FormatFlags',
50 3 => 'Channels',
51 4 => { Name => 'SampleRate', Format => 'int32u' },
52 # 6 => { Name => 'HeaderBytes', Format => 'int32u' }, # WAV header bytes
53 # 8 => { Name => 'TerminatingBytes', Format => 'int32u' },
54 10 => { Name => 'TotalFrames', Format => 'int32u' },
55 12 => { Name => 'FinalFrameBlocks', Format => 'int32u' },
56);
57
58# APE MAC header version 3.98 or later
59%Image::ExifTool::APE::NewHeader = (
60 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
61 GROUPS => { 1 => 'MAC', 2 => 'Audio' },
62 FORMAT => 'int16u',
63 NOTES => 'APE MAC audio header for version 3.98 or later.',
64 0 => 'CompressionLevel',
65 # 1 => 'FormatFlags',
66 2 => { Name => 'BlocksPerFrame', Format => 'int32u' },
67 4 => { Name => 'FinalFrameBlocks', Format => 'int32u' },
68 6 => { Name => 'TotalFrames', Format => 'int32u' },
69 8 => 'BitsPerSample',
70 9 => 'Channels',
71 10 => { Name => 'SampleRate', Format => 'int32u' },
72);
73
74#------------------------------------------------------------------------------
75# Make tag info hash for specified tag
76# Inputs: 0) tag name, 1) tag table ref
77# - must only call if tag doesn't exist
78sub MakeTag($$)
79{
80 my ($tag, $tagTablePtr) = @_;
81 my $name = ucfirst(lc($tag));
82 # remove invalid characters in tag name and capitalize following letters
83 $name =~ s/[^\w-]+(.?)/\U$1/sg;
84 $name =~ s/([a-z0-9])_([a-z])/$1\U$2/g;
85 Image::ExifTool::AddTagToTable($tagTablePtr, $tag, { Name => $name });
86}
87
88#------------------------------------------------------------------------------
89# Extract information from an APE file
90# Inputs: 0) ExifTool object reference, 1) dirInfo reference
91# - Just looks for APE trailer if FileType is already set
92# Returns: 1 on success, 0 if this wasn't a valid APE file
93sub ProcessAPE($$)
94{
95 my ($exifTool, $dirInfo) = @_;
96
97 # must first check for leading/trailing ID3 information
98 unless ($exifTool->{DONE_ID3}) {
99 require Image::ExifTool::ID3;
100 Image::ExifTool::ID3::ProcessID3($exifTool, $dirInfo) and return 1;
101 }
102 my $raf = $$dirInfo{RAF};
103 my $verbose = $exifTool->Options('Verbose');
104 my ($buff, $i, $header, $tagTablePtr, $dataPos);
105
106 # check APE signature and process audio information
107 # unless this is some other type of file
108 unless ($exifTool->{VALUE}->{FileType}) {
109 $raf->Read($buff, 32) == 32 or return 0;
110 $buff =~ /^(MAC |APETAGEX)/ or return 0;
111 $exifTool->SetFileType();
112 SetByteOrder('II');
113
114 if ($buff =~ /^APETAGEX/) {
115 # we already read the APE header
116 $header = 1;
117 } else {
118 # process the MAC header
119 my $vers = Get16u(\$buff, 4);
120 my $table;
121 if ($vers <= 3970) {
122 $buff = substr($buff, 4);
123 $table = GetTagTable('Image::ExifTool::APE::OldHeader');
124 } else {
125 my $dlen = Get32u(\$buff, 8);
126 my $hlen = Get32u(\$buff, 12);
127 unless ($dlen & 0x80000000 or $hlen & 0x80000000) {
128 if ($raf->Seek($dlen, 0) and $raf->Read($buff, $hlen) == $hlen) {
129 $table = GetTagTable('Image::ExifTool::APE::NewHeader');
130 }
131 }
132 }
133 $exifTool->ProcessDirectory( { DataPt => \$buff }, $table) if $table;
134 }
135 }
136 # look for APE trailer unless we already found an APE header
137 unless ($header) {
138 # look for the APE trailer footer...
139 my $footPos = -32;
140 # (...but before the ID3v1 trailer if it exists)
141 $footPos -= 128 if $exifTool->{DONE_ID3} == 2;
142 $raf->Seek($footPos, 2) or return 1;
143 $raf->Read($buff, 32) == 32 or return 1;
144 $buff =~ /^APETAGEX/ or return 1;
145 SetByteOrder('II');
146 }
147#
148# Read the APE data (we have just read the APE header or footer into $buff)
149#
150 my ($version, $size, $count, $flags) = unpack('x8V4', $buff);
151 $version /= 1000;
152 $size -= 32; # get size of data only
153 if (($size & 0x80000000) == 0 and
154 ($header or $raf->Seek(-$size-32, 1)) and
155 $raf->Read($buff, $size) == $size)
156 {
157 if ($verbose) {
158 $exifTool->VerboseDir("APEv$version", $count, $size);
159 $exifTool->VerboseDump(\$buff, DataPos => $raf->Tell() - $size);
160 }
161 $tagTablePtr = GetTagTable('Image::ExifTool::APE::Main');
162 $dataPos = $raf->Tell() - $size;
163 } else {
164 $count = -1;
165 }
166#
167# Process the APE tags
168#
169 my $pos = 0;
170 for ($i=0; $i<$count; ++$i) {
171 # read next APE tag
172 last if $pos + 8 > $size;
173 my $len = Get32u(\$buff, $pos);
174 my $flags = Get32u(\$buff, $pos + 4);
175 pos($buff) = $pos + 8;
176 last unless $buff =~ /\G(.*?)\0/sg;
177 my $tag = $1;
178 $pos = pos($buff);
179 last if $pos + $len > $size;
180 my $val = substr($buff, $pos, $len);
181 MakeTag($tag, $tagTablePtr) unless $$tagTablePtr{$tag};
182 # handle binary-value tags
183 if (($flags & 0x06) == 0x02) {
184 my $buf2 = $val;
185 $val = \$buf2;
186 # extract cover art description separately (hackitty hack)
187 if ($tag =~ /^Cover Art/) {
188 $buf2 =~ s/^([\x20-\x7f]*)\0//;
189 if ($1) {
190 my $t = "$tag Desc";
191 my $v = $1;
192 MakeTag($t, $tagTablePtr) unless $$tagTablePtr{$t};
193 $exifTool->HandleTag($tagTablePtr, $t, $v);
194 }
195 }
196 }
197 $exifTool->HandleTag($tagTablePtr, $tag, $val,
198 Index => $i,
199 DataPt => \$buff,
200 DataPos => $dataPos,
201 Start => $pos,
202 Size => $len,
203 );
204 $pos += $len;
205 }
206 $i == $count or $exifTool->Warn('Bad APE trailer');
207 return 1;
208}
209
2101; # end
211
212__END__
213
214=head1 NAME
215
216Image::ExifTool::APE - Read Monkey's Audio meta information
217
218=head1 SYNOPSIS
219
220This module is used by Image::ExifTool
221
222=head1 DESCRIPTION
223
224This module contains definitions required by Image::ExifTool to extract meta
225information from Monkey's Audio (APE) audio files.
226
227=head1 BUGS
228
229Currently doesn't parse MAC header unless it is at the start of the file.
230
231=head1 AUTHOR
232
233Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
234
235This library is free software; you can redistribute it and/or modify it
236under the same terms as Perl itself.
237
238=head1 REFERENCES
239
240=over 4
241
242=item L<http://www.monkeysaudio.com/>
243
244=item L<http://www.personal.uni-jena.de/~pfk/mpp/sv8/apetag.html>
245
246=back
247
248=head1 SEE ALSO
249
250L<Image::ExifTool::TagNames/APE Tags>,
251L<Image::ExifTool(3pm)|Image::ExifTool>
252
253=cut
254
Note: See TracBrowser for help on using the repository browser.