| line | stmt | bran | cond | sub | pod | time | code | 
| 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 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | package Image::ExifTool::APE; | 
| 13 |  |  |  |  |  |  |  | 
| 14 | 2 |  |  | 2 |  | 4385 | use strict; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 80 |  | 
| 15 | 2 |  |  | 2 |  | 12 | use vars qw($VERSION); | 
|  | 2 |  |  |  |  | 5 |  | 
|  | 2 |  |  |  |  | 100 |  | 
| 16 | 2 |  |  | 2 |  | 12 | use Image::ExifTool qw(:DataAccess :Utils); | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 3053 |  | 
| 17 |  |  |  |  |  |  |  | 
| 18 |  |  |  |  |  |  | $VERSION = '1.06'; | 
| 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, and will also | 
| 27 |  |  |  |  |  |  | read APE metadata from MP3 and MPC files. | 
| 28 |  |  |  |  |  |  | }, | 
| 29 |  |  |  |  |  |  | Album   => { }, | 
| 30 |  |  |  |  |  |  | Artist  => { }, | 
| 31 |  |  |  |  |  |  | Genre   => { }, | 
| 32 |  |  |  |  |  |  | Title   => { }, | 
| 33 |  |  |  |  |  |  | Track   => { }, | 
| 34 |  |  |  |  |  |  | Year    => { }, | 
| 35 |  |  |  |  |  |  | DURATION => { | 
| 36 |  |  |  |  |  |  | Name => 'Duration', | 
| 37 |  |  |  |  |  |  | ValueConv => '$val += 4294967296 if $val < 0 and $val >= -2147483648; $val * 1e-7', | 
| 38 |  |  |  |  |  |  | PrintConv => 'ConvertDuration($val)', | 
| 39 |  |  |  |  |  |  | }, | 
| 40 |  |  |  |  |  |  | 'Tool Version' => { Name => 'ToolVersion' }, | 
| 41 |  |  |  |  |  |  | 'Tool Name'    => { Name => 'ToolName' }, | 
| 42 |  |  |  |  |  |  | ); | 
| 43 |  |  |  |  |  |  |  | 
| 44 |  |  |  |  |  |  | # APE MAC header version 3.97 or earlier | 
| 45 |  |  |  |  |  |  | %Image::ExifTool::APE::OldHeader = ( | 
| 46 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 47 |  |  |  |  |  |  | GROUPS => { 1 => 'MAC', 2 => 'Audio' }, | 
| 48 |  |  |  |  |  |  | FORMAT => 'int16u', | 
| 49 |  |  |  |  |  |  | NOTES => 'APE MAC audio header for version 3.97 or earlier.', | 
| 50 |  |  |  |  |  |  | 0 => { | 
| 51 |  |  |  |  |  |  | Name => 'APEVersion', | 
| 52 |  |  |  |  |  |  | ValueConv => '$val / 1000', | 
| 53 |  |  |  |  |  |  | }, | 
| 54 |  |  |  |  |  |  | 1 => 'CompressionLevel', | 
| 55 |  |  |  |  |  |  | # 2 => 'FormatFlags', | 
| 56 |  |  |  |  |  |  | 3 => 'Channels', | 
| 57 |  |  |  |  |  |  | 4 => { Name => 'SampleRate', Format => 'int32u' }, | 
| 58 |  |  |  |  |  |  | # 6 => { Name => 'HeaderBytes', Format => 'int32u' }, # WAV header bytes | 
| 59 |  |  |  |  |  |  | # 8 => { Name => 'TerminatingBytes', Format => 'int32u' }, | 
| 60 |  |  |  |  |  |  | 10 => { Name => 'TotalFrames', Format => 'int32u' }, | 
| 61 |  |  |  |  |  |  | 12 => { Name => 'FinalFrameBlocks', Format => 'int32u' }, | 
| 62 |  |  |  |  |  |  | ); | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | # APE MAC header version 3.98 or later | 
| 65 |  |  |  |  |  |  | %Image::ExifTool::APE::NewHeader = ( | 
| 66 |  |  |  |  |  |  | PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, | 
| 67 |  |  |  |  |  |  | GROUPS => { 1 => 'MAC', 2 => 'Audio' }, | 
| 68 |  |  |  |  |  |  | FORMAT => 'int16u', | 
| 69 |  |  |  |  |  |  | NOTES => 'APE MAC audio header for version 3.98 or later.', | 
| 70 |  |  |  |  |  |  | 0 => 'CompressionLevel', | 
| 71 |  |  |  |  |  |  | # 1 => 'FormatFlags', | 
| 72 |  |  |  |  |  |  | 2 => { Name => 'BlocksPerFrame',   Format => 'int32u' }, | 
| 73 |  |  |  |  |  |  | 4 => { Name => 'FinalFrameBlocks', Format => 'int32u' }, | 
| 74 |  |  |  |  |  |  | 6 => { Name => 'TotalFrames',      Format => 'int32u' }, | 
| 75 |  |  |  |  |  |  | 8 => 'BitsPerSample', | 
| 76 |  |  |  |  |  |  | 9 => 'Channels', | 
| 77 |  |  |  |  |  |  | 10 => { Name => 'SampleRate',      Format => 'int32u' }, | 
| 78 |  |  |  |  |  |  | ); | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | # APE Composite tags | 
| 81 |  |  |  |  |  |  | %Image::ExifTool::APE::Composite = ( | 
| 82 |  |  |  |  |  |  | GROUPS => { 2 => 'Audio' }, | 
| 83 |  |  |  |  |  |  | Duration => { | 
| 84 |  |  |  |  |  |  | Require => { | 
| 85 |  |  |  |  |  |  | 0 => 'APE:SampleRate', | 
| 86 |  |  |  |  |  |  | 1 => 'APE:TotalFrames', | 
| 87 |  |  |  |  |  |  | 2 => 'APE:BlocksPerFrame', | 
| 88 |  |  |  |  |  |  | 3 => 'APE:FinalFrameBlocks', | 
| 89 |  |  |  |  |  |  | }, | 
| 90 |  |  |  |  |  |  | RawConv => '($val[0] && $val[1]) ? (($val[1] - 1) * $val[2] + $val[3]) / $val[0]: undef', | 
| 91 |  |  |  |  |  |  | PrintConv => 'ConvertDuration($val)', | 
| 92 |  |  |  |  |  |  | }, | 
| 93 |  |  |  |  |  |  | ); | 
| 94 |  |  |  |  |  |  |  | 
| 95 |  |  |  |  |  |  | # add our composite tags | 
| 96 |  |  |  |  |  |  | Image::ExifTool::AddCompositeTags('Image::ExifTool::APE'); | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 99 |  |  |  |  |  |  | # Make tag info hash for specified tag | 
| 100 |  |  |  |  |  |  | # Inputs: 0) tag name, 1) tag table ref | 
| 101 |  |  |  |  |  |  | # - must only call if tag doesn't exist | 
| 102 |  |  |  |  |  |  | sub MakeTag($$) | 
| 103 |  |  |  |  |  |  | { | 
| 104 | 3 |  |  | 3 | 0 | 7 | my ($tag, $tagTablePtr) = @_; | 
| 105 | 3 |  |  |  |  | 7 | my $name = ucfirst(lc($tag)); | 
| 106 |  |  |  |  |  |  | # remove invalid characters in tag name and capitalize following letters | 
| 107 | 3 |  |  |  |  | 28 | $name =~ s/[^\w-]+(.?)/\U$1/sg; | 
| 108 | 3 |  |  |  |  | 8 | $name =~ s/([a-z0-9])_([a-z])/$1\U$2/g; | 
| 109 | 3 |  |  |  |  | 7 | my %tagInfo = ( Name => $name ); | 
| 110 | 3 | 100 | 100 |  |  | 21 | $tagInfo{Groups} = { 2 => 'Preview' } if $tag =~ /^Cover Art/ and $tag !~ /Desc$/; | 
| 111 | 3 |  |  |  |  | 11 | AddTagToTable($tagTablePtr, $tag, \%tagInfo); | 
| 112 |  |  |  |  |  |  | } | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | #------------------------------------------------------------------------------ | 
| 115 |  |  |  |  |  |  | # Extract information from an APE file | 
| 116 |  |  |  |  |  |  | # Inputs: 0) ExifTool object reference, 1) dirInfo reference | 
| 117 |  |  |  |  |  |  | # - Just looks for APE trailer if FileType is already set | 
| 118 |  |  |  |  |  |  | # Returns: 1 on success, 0 if this wasn't a valid APE file | 
| 119 |  |  |  |  |  |  | sub ProcessAPE($$) | 
| 120 |  |  |  |  |  |  | { | 
| 121 | 3 |  |  | 3 | 0 | 9 | my ($et, $dirInfo) = @_; | 
| 122 |  |  |  |  |  |  |  | 
| 123 |  |  |  |  |  |  | # must first check for leading/trailing ID3 information | 
| 124 | 3 | 100 |  |  |  | 11 | unless ($$et{DoneID3}) { | 
| 125 | 1 |  |  |  |  | 767 | require Image::ExifTool::ID3; | 
| 126 | 1 | 50 |  |  |  | 6 | Image::ExifTool::ID3::ProcessID3($et, $dirInfo) and return 1; | 
| 127 |  |  |  |  |  |  | } | 
| 128 | 3 |  |  |  |  | 8 | my $raf = $$dirInfo{RAF}; | 
| 129 | 3 |  |  |  |  | 12 | my $verbose = $et->Options('Verbose'); | 
| 130 | 3 |  |  |  |  | 8 | my ($buff, $i, $header, $tagTablePtr, $dataPos, $oldIndent); | 
| 131 |  |  |  |  |  |  |  | 
| 132 | 3 |  |  |  |  | 7 | $$et{DoneAPE} = 1; | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | # check APE signature and process audio information | 
| 135 |  |  |  |  |  |  | # unless this is some other type of file | 
| 136 | 3 | 100 |  |  |  | 12 | unless ($$et{VALUE}{FileType}) { | 
| 137 | 1 | 50 |  |  |  | 4 | $raf->Read($buff, 32) == 32 or return 0; | 
| 138 | 1 | 50 |  |  |  | 9 | $buff =~ /^(MAC |APETAGEX)/ or return 0; | 
| 139 | 1 |  |  |  |  | 7 | $et->SetFileType(); | 
| 140 | 1 |  |  |  |  | 5 | SetByteOrder('II'); | 
| 141 |  |  |  |  |  |  |  | 
| 142 | 1 | 50 |  |  |  | 5 | if ($buff =~ /^APETAGEX/) { | 
| 143 |  |  |  |  |  |  | # we already read the APE header | 
| 144 | 0 |  |  |  |  | 0 | $header = 1; | 
| 145 |  |  |  |  |  |  | } else { | 
| 146 |  |  |  |  |  |  | # process the MAC header | 
| 147 | 1 |  |  |  |  | 6 | my $vers = Get16u(\$buff, 4); | 
| 148 | 1 |  |  |  |  | 3 | my $table; | 
| 149 | 1 | 50 |  |  |  | 5 | if ($vers <= 3970) { | 
| 150 | 0 |  |  |  |  | 0 | $buff = substr($buff, 4); | 
| 151 | 0 |  |  |  |  | 0 | $table = GetTagTable('Image::ExifTool::APE::OldHeader'); | 
| 152 |  |  |  |  |  |  | } else { | 
| 153 | 1 |  |  |  |  | 6 | my $dlen = Get32u(\$buff, 8); | 
| 154 | 1 |  |  |  |  | 5 | my $hlen = Get32u(\$buff, 12); | 
| 155 | 1 | 50 | 33 |  |  | 909 | unless ($dlen & 0x80000000 or $hlen & 0x80000000) { | 
| 156 | 1 | 50 | 33 |  |  | 6 | if ($raf->Seek($dlen, 0) and $raf->Read($buff, $hlen) == $hlen) { | 
| 157 | 1 |  |  |  |  | 13 | $table = GetTagTable('Image::ExifTool::APE::NewHeader'); | 
| 158 |  |  |  |  |  |  | } | 
| 159 |  |  |  |  |  |  | } | 
| 160 |  |  |  |  |  |  | } | 
| 161 | 1 | 50 |  |  |  | 8 | $et->ProcessDirectory( { DataPt => \$buff }, $table) if $table; | 
| 162 |  |  |  |  |  |  | } | 
| 163 |  |  |  |  |  |  | } | 
| 164 |  |  |  |  |  |  | # look for APE trailer unless we already found an APE header | 
| 165 | 3 | 50 |  |  |  | 10 | unless ($header) { | 
| 166 |  |  |  |  |  |  | # look for the APE trailer footer... | 
| 167 | 3 |  |  |  |  | 5 | my $footPos = -32; | 
| 168 |  |  |  |  |  |  | # (...but before the ID3v1 trailer if it exists) | 
| 169 | 3 | 100 |  |  |  | 10 | $footPos -= $$et{DoneID3} if $$et{DoneID3} > 1; | 
| 170 | 3 | 50 |  |  |  | 65 | $raf->Seek($footPos, 2)     or return 1; | 
| 171 | 3 | 50 |  |  |  | 13 | $raf->Read($buff, 32) == 32 or return 1; | 
| 172 | 3 | 100 |  |  |  | 19 | $buff =~ /^APETAGEX/        or return 1; | 
| 173 | 2 |  |  |  |  | 8 | SetByteOrder('II'); | 
| 174 |  |  |  |  |  |  | } | 
| 175 |  |  |  |  |  |  | # | 
| 176 |  |  |  |  |  |  | # Read the APE data (we have just read the APE header or footer into $buff) | 
| 177 |  |  |  |  |  |  | # | 
| 178 | 2 |  |  |  |  | 8 | my ($version, $size, $count, $flags) = unpack('x8V4', $buff); | 
| 179 | 2 |  |  |  |  | 7 | $version /= 1000; | 
| 180 | 2 |  |  |  |  | 13 | $size -= 32;    # get size of data only | 
| 181 | 2 | 50 | 33 |  |  | 16 | if (($size & 0x80000000) == 0 and | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
| 182 |  |  |  |  |  |  | ($header or $raf->Seek(-$size-32, 1)) and | 
| 183 |  |  |  |  |  |  | $raf->Read($buff, $size) == $size) | 
| 184 |  |  |  |  |  |  | { | 
| 185 | 2 | 50 |  |  |  | 9 | if ($verbose) { | 
| 186 | 0 |  |  |  |  | 0 | $oldIndent = $$et{INDENT}; | 
| 187 | 0 |  |  |  |  | 0 | $$et{INDENT} .= '| '; | 
| 188 | 0 |  |  |  |  | 0 | $et->VerboseDir("APEv$version", $count, $size); | 
| 189 | 0 |  |  |  |  | 0 | $et->VerboseDump(\$buff, DataPos => $raf->Tell() - $size); | 
| 190 |  |  |  |  |  |  | } | 
| 191 | 2 |  |  |  |  | 7 | $tagTablePtr = GetTagTable('Image::ExifTool::APE::Main'); | 
| 192 | 2 |  |  |  |  | 8 | $dataPos = $raf->Tell() - $size; | 
| 193 |  |  |  |  |  |  | } else { | 
| 194 | 0 |  |  |  |  | 0 | $count = -1; | 
| 195 |  |  |  |  |  |  | } | 
| 196 |  |  |  |  |  |  | # | 
| 197 |  |  |  |  |  |  | # Process the APE tags | 
| 198 |  |  |  |  |  |  | # | 
| 199 | 2 |  |  |  |  | 6 | my $pos = 0; | 
| 200 | 2 |  |  |  |  | 9 | for ($i=0; $i<$count; ++$i) { | 
| 201 |  |  |  |  |  |  | # read next APE tag | 
| 202 | 20 | 50 |  |  |  | 42 | last if $pos + 8 > $size; | 
| 203 | 20 |  |  |  |  | 49 | my $len = Get32u(\$buff, $pos); | 
| 204 | 20 |  |  |  |  | 47 | my $flags = Get32u(\$buff, $pos + 4); | 
| 205 | 20 |  |  |  |  | 61 | pos($buff) = $pos + 8; | 
| 206 | 20 | 50 |  |  |  | 102 | last unless $buff =~ /\G(.*?)\0/sg; | 
| 207 | 20 |  |  |  |  | 46 | my $tag = $1; | 
| 208 |  |  |  |  |  |  | # avoid conflicts with our special table entries | 
| 209 | 20 | 50 |  |  |  | 45 | $tag .= '.' if $Image::ExifTool::specialTags{$tag}; | 
| 210 | 20 |  |  |  |  | 31 | $pos = pos($buff); | 
| 211 | 20 | 50 |  |  |  | 39 | last if $pos + $len > $size; | 
| 212 | 20 |  |  |  |  | 47 | my $val = substr($buff, $pos, $len); | 
| 213 | 20 | 100 |  |  |  | 199 | MakeTag($tag, $tagTablePtr) unless $$tagTablePtr{$tag}; | 
| 214 |  |  |  |  |  |  | # handle binary-value tags | 
| 215 | 20 | 100 |  |  |  | 47 | if (($flags & 0x06) == 0x02) { | 
| 216 | 2 |  |  |  |  | 5 | my $buf2 = $val; | 
| 217 | 2 |  |  |  |  | 4 | $val = \$buf2; | 
| 218 |  |  |  |  |  |  | # extract cover art description separately (hackitty hack) | 
| 219 | 2 | 50 |  |  |  | 9 | if ($tag =~ /^Cover Art/) { | 
| 220 | 2 |  |  |  |  | 13 | $buf2 =~ s/^([\x20-\x7f]*)\0//; | 
| 221 | 2 | 50 |  |  |  | 8 | if ($1) { | 
| 222 | 2 |  |  |  |  | 8 | my $t = "$tag Desc"; | 
| 223 | 2 |  |  |  |  | 5 | my $v = $1; | 
| 224 | 2 | 100 |  |  |  | 9 | MakeTag($t, $tagTablePtr) unless $$tagTablePtr{$t}; | 
| 225 | 2 |  |  |  |  | 6 | $et->HandleTag($tagTablePtr, $t, $v); | 
| 226 |  |  |  |  |  |  | } | 
| 227 |  |  |  |  |  |  | } | 
| 228 |  |  |  |  |  |  | } | 
| 229 | 20 |  |  |  |  | 69 | $et->HandleTag($tagTablePtr, $tag, $val, | 
| 230 |  |  |  |  |  |  | Index => $i, | 
| 231 |  |  |  |  |  |  | DataPt => \$buff, | 
| 232 |  |  |  |  |  |  | DataPos => $dataPos, | 
| 233 |  |  |  |  |  |  | Start => $pos, | 
| 234 |  |  |  |  |  |  | Size => $len, | 
| 235 |  |  |  |  |  |  | ); | 
| 236 | 20 |  |  |  |  | 55 | $pos += $len; | 
| 237 |  |  |  |  |  |  | } | 
| 238 | 2 | 50 |  |  |  | 6 | $i == $count or $et->Warn('Bad APE trailer'); | 
| 239 | 2 | 50 |  |  |  | 4 | $$et{INDENT} = $oldIndent if defined $oldIndent; | 
| 240 | 2 |  |  |  |  | 7 | return 1; | 
| 241 |  |  |  |  |  |  | } | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | 1;  # end | 
| 244 |  |  |  |  |  |  |  | 
| 245 |  |  |  |  |  |  | __END__ |