diff options
author | Hardeep Sidhu <dyp@pobox.com> | 2006-06-28 15:44:51 +0000 |
---|---|---|
committer | Hardeep Sidhu <dyp@pobox.com> | 2006-06-28 15:44:51 +0000 |
commit | 4e88de837e0cd0217c50da305e59cce2342ee1ec (patch) | |
tree | 3795e79ed70691887f0d89dafcb6e979aa877bda | |
parent | 71cf604d8d317b7c2b167aac37493795046431cd (diff) | |
download | rockbox-4e88de837e0cd0217c50da305e59cce2342ee1ec.tar.gz rockbox-4e88de837e0cd0217c50da305e59cce2342ee1ec.zip |
Re-adding songdb.pl with support for tagcache. Works with mp3 and has partial support for ogg.
git-svn-id: svn://svn.rockbox.org/rockbox/trunk@10150 a1c6a512-1295-4272-9138-f99709370657
-rwxr-xr-x | tools/mp3info.pm | 2184 | ||||
-rwxr-xr-x | tools/songdb.pl | 448 | ||||
-rw-r--r-- | tools/vorbiscomm.pm | 732 |
3 files changed, 3364 insertions, 0 deletions
diff --git a/tools/mp3info.pm b/tools/mp3info.pm new file mode 100755 index 0000000000..d900777266 --- /dev/null +++ b/tools/mp3info.pm | |||
@@ -0,0 +1,2184 @@ | |||
1 | package mp3info; | ||
2 | |||
3 | require 5.006; | ||
4 | |||
5 | use overload; | ||
6 | use strict; | ||
7 | use Carp; | ||
8 | |||
9 | use vars qw( | ||
10 | @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $REVISION | ||
11 | @mp3_genres %mp3_genres @winamp_genres %winamp_genres $try_harder | ||
12 | @t_bitrate @t_sampling_freq @frequency_tbl %v1_tag_fields | ||
13 | @v1_tag_names %v2_tag_names %v2_to_v1_names $AUTOLOAD | ||
14 | @mp3_info_fields %rva2_channel_types | ||
15 | ); | ||
16 | |||
17 | @ISA = 'Exporter'; | ||
18 | @EXPORT = qw( | ||
19 | set_mp3tag get_mp3tag get_mp3info remove_mp3tag | ||
20 | use_winamp_genres, use_mp3_utf8 | ||
21 | ); | ||
22 | @EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8); | ||
23 | %EXPORT_TAGS = ( | ||
24 | genres => [qw(@mp3_genres %mp3_genres)], | ||
25 | utf8 => [qw(use_mp3_utf8)], | ||
26 | all => [@EXPORT, @EXPORT_OK] | ||
27 | ); | ||
28 | |||
29 | # $Id$ | ||
30 | ($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/; | ||
31 | $VERSION = '1.20'; | ||
32 | |||
33 | =pod | ||
34 | |||
35 | =head1 NAME | ||
36 | |||
37 | MP3::Info - Manipulate / fetch info from MP3 audio files | ||
38 | |||
39 | =head1 SYNOPSIS | ||
40 | |||
41 | #!perl -w | ||
42 | use MP3::Info; | ||
43 | my $file = 'Pearls_Before_Swine.mp3'; | ||
44 | set_mp3tag($file, 'Pearls Before Swine', q"77's", | ||
45 | 'Sticks and Stones', '1990', | ||
46 | q"(c) 1990 77's LTD.", 'rock & roll'); | ||
47 | |||
48 | my $tag = get_mp3tag($file) or die "No TAG info"; | ||
49 | $tag->{GENRE} = 'rock'; | ||
50 | set_mp3tag($file, $tag); | ||
51 | |||
52 | my $info = get_mp3info($file); | ||
53 | printf "$file length is %d:%d\n", $info->{MM}, $info->{SS}; | ||
54 | |||
55 | =cut | ||
56 | |||
57 | { | ||
58 | my $c = -1; | ||
59 | # set all lower-case and regular-cased versions of genres as keys | ||
60 | # with index as value of each key | ||
61 | %mp3_genres = map {($_, ++$c, lc, $c)} @mp3_genres; | ||
62 | |||
63 | # do it again for winamp genres | ||
64 | $c = -1; | ||
65 | %winamp_genres = map {($_, ++$c, lc, $c)} @winamp_genres; | ||
66 | } | ||
67 | |||
68 | =pod | ||
69 | |||
70 | my $mp3 = new MP3::Info $file; | ||
71 | $mp3->title('Perls Before Swine'); | ||
72 | printf "$file length is %s, title is %s\n", | ||
73 | $mp3->time, $mp3->title; | ||
74 | |||
75 | |||
76 | =head1 DESCRIPTION | ||
77 | |||
78 | =over 4 | ||
79 | |||
80 | =item $mp3 = MP3::Info-E<gt>new(FILE) | ||
81 | |||
82 | OOP interface to the rest of the module. The same keys | ||
83 | available via get_mp3info and get_mp3tag are available | ||
84 | via the returned object (using upper case or lower case; | ||
85 | but note that all-caps "VERSION" will return the module | ||
86 | version, not the MP3 version). | ||
87 | |||
88 | Passing a value to one of the methods will set the value | ||
89 | for that tag in the MP3 file, if applicable. | ||
90 | |||
91 | =cut | ||
92 | |||
93 | sub new { | ||
94 | my($pack, $file) = @_; | ||
95 | |||
96 | my $info = get_mp3info($file) or return undef; | ||
97 | my $tags = get_mp3tag($file) || { map { ($_ => undef) } @v1_tag_names }; | ||
98 | my %self = ( | ||
99 | FILE => $file, | ||
100 | TRY_HARDER => 0 | ||
101 | ); | ||
102 | |||
103 | @self{@mp3_info_fields, @v1_tag_names, 'file'} = ( | ||
104 | @{$info}{@mp3_info_fields}, | ||
105 | @{$tags}{@v1_tag_names}, | ||
106 | $file | ||
107 | ); | ||
108 | |||
109 | return bless \%self, $pack; | ||
110 | } | ||
111 | |||
112 | sub can { | ||
113 | my $self = shift; | ||
114 | return $self->SUPER::can(@_) unless ref $self; | ||
115 | my $name = uc shift; | ||
116 | return sub { $self->$name(@_) } if exists $self->{$name}; | ||
117 | return undef; | ||
118 | } | ||
119 | |||
120 | sub AUTOLOAD { | ||
121 | my($self) = @_; | ||
122 | (my $name = uc $AUTOLOAD) =~ s/^.*://; | ||
123 | |||
124 | if (exists $self->{$name}) { | ||
125 | my $sub = exists $v1_tag_fields{$name} | ||
126 | ? sub { | ||
127 | if (defined $_[1]) { | ||
128 | $_[0]->{$name} = $_[1]; | ||
129 | set_mp3tag($_[0]->{FILE}, $_[0]); | ||
130 | } | ||
131 | return $_[0]->{$name}; | ||
132 | } | ||
133 | : sub { | ||
134 | return $_[0]->{$name} | ||
135 | }; | ||
136 | |||
137 | no strict 'refs'; | ||
138 | *{$AUTOLOAD} = $sub; | ||
139 | goto &$AUTOLOAD; | ||
140 | |||
141 | } else { | ||
142 | carp(sprintf "No method '$name' available in package %s.", | ||
143 | __PACKAGE__); | ||
144 | } | ||
145 | } | ||
146 | |||
147 | sub DESTROY { | ||
148 | |||
149 | } | ||
150 | |||
151 | |||
152 | =item use_mp3_utf8([STATUS]) | ||
153 | |||
154 | Tells MP3::Info to (or not) return TAG info in UTF-8. | ||
155 | TRUE is 1, FALSE is 0. Default is TRUE, if available. | ||
156 | |||
157 | Will only be able to turn it on if Encode is available. ID3v2 | ||
158 | tags will be converted to UTF-8 according to the encoding specified | ||
159 | in each tag; ID3v1 tags will be assumed Latin-1 and converted | ||
160 | to UTF-8. | ||
161 | |||
162 | Function returns status (TRUE/FALSE). If no argument is supplied, | ||
163 | or an unaccepted argument is supplied, function merely returns status. | ||
164 | |||
165 | This function is not exported by default, but may be exported | ||
166 | with the C<:utf8> or C<:all> export tag. | ||
167 | |||
168 | =cut | ||
169 | |||
170 | my $unicode_module = eval { require Encode; require Encode::Guess }; | ||
171 | my $UNICODE = use_mp3_utf8($unicode_module ? 1 : 0); | ||
172 | |||
173 | sub use_mp3_utf8 { | ||
174 | my($val) = @_; | ||
175 | if ($val == 1) { | ||
176 | if ($unicode_module) { | ||
177 | $UNICODE = 1; | ||
178 | $Encode::Guess::NoUTFAutoGuess = 1; | ||
179 | } | ||
180 | } elsif ($val == 0) { | ||
181 | $UNICODE = 0; | ||
182 | } | ||
183 | return $UNICODE; | ||
184 | } | ||
185 | |||
186 | =pod | ||
187 | |||
188 | =item use_winamp_genres() | ||
189 | |||
190 | Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres> | ||
191 | (adds 68 additional genres to the default list of 80). | ||
192 | This is a separate function because these are non-standard | ||
193 | genres, but they are included because they are widely used. | ||
194 | |||
195 | You can import the data structures with one of: | ||
196 | |||
197 | use MP3::Info qw(:genres); | ||
198 | use MP3::Info qw(:DEFAULT :genres); | ||
199 | use MP3::Info qw(:all); | ||
200 | |||
201 | =cut | ||
202 | |||
203 | sub use_winamp_genres { | ||
204 | %mp3_genres = %winamp_genres; | ||
205 | @mp3_genres = @winamp_genres; | ||
206 | return 1; | ||
207 | } | ||
208 | |||
209 | =pod | ||
210 | |||
211 | =item remove_mp3tag (FILE [, VERSION, BUFFER]) | ||
212 | |||
213 | Can remove ID3v1 or ID3v2 tags. VERSION should be C<1> for ID3v1 | ||
214 | (the default), C<2> for ID3v2, and C<ALL> for both. | ||
215 | |||
216 | For ID3v1, removes last 128 bytes from file if those last 128 bytes begin | ||
217 | with the text 'TAG'. File will be 128 bytes shorter. | ||
218 | |||
219 | For ID3v2, removes ID3v2 tag. Because an ID3v2 tag is at the | ||
220 | beginning of the file, we rewrite the file after removing the tag data. | ||
221 | The buffer for rewriting the file is 4MB. BUFFER (in bytes) ca | ||
222 | change the buffer size. | ||
223 | |||
224 | Returns the number of bytes removed, or -1 if no tag removed, | ||
225 | or undef if there is an error. | ||
226 | |||
227 | =cut | ||
228 | |||
229 | sub remove_mp3tag { | ||
230 | my($file, $version, $buf) = @_; | ||
231 | my($fh, $return); | ||
232 | |||
233 | $buf ||= 4096*1024; # the bigger the faster | ||
234 | $version ||= 1; | ||
235 | |||
236 | if (not (defined $file && $file ne '')) { | ||
237 | $@ = "No file specified"; | ||
238 | return undef; | ||
239 | } | ||
240 | |||
241 | if (not -s $file) { | ||
242 | $@ = "File is empty"; | ||
243 | return undef; | ||
244 | } | ||
245 | |||
246 | if (ref $file) { # filehandle passed | ||
247 | $fh = $file; | ||
248 | } else { | ||
249 | if (not open $fh, '+<', $file) { | ||
250 | $@ = "Can't open $file: $!"; | ||
251 | return undef; | ||
252 | } | ||
253 | } | ||
254 | |||
255 | binmode $fh; | ||
256 | |||
257 | if ($version eq 1 || $version eq 'ALL') { | ||
258 | seek $fh, -128, 2; | ||
259 | my $tell = tell $fh; | ||
260 | if (<$fh> =~ /^TAG/) { | ||
261 | truncate $fh, $tell or carp "Can't truncate '$file': $!"; | ||
262 | $return += 128; | ||
263 | } | ||
264 | } | ||
265 | |||
266 | if ($version eq 2 || $version eq 'ALL') { | ||
267 | my $v2h = _get_v2head($fh); | ||
268 | if ($v2h) { | ||
269 | local $\; | ||
270 | seek $fh, 0, 2; | ||
271 | my $eof = tell $fh; | ||
272 | my $off = $v2h->{tag_size}; | ||
273 | |||
274 | while ($off < $eof) { | ||
275 | seek $fh, $off, 0; | ||
276 | read $fh, my($bytes), $buf; | ||
277 | seek $fh, $off - $v2h->{tag_size}, 0; | ||
278 | print $fh $bytes; | ||
279 | $off += $buf; | ||
280 | } | ||
281 | |||
282 | truncate $fh, $eof - $v2h->{tag_size} | ||
283 | or carp "Can't truncate '$file': $!"; | ||
284 | $return += $v2h->{tag_size}; | ||
285 | } | ||
286 | } | ||
287 | |||
288 | _close($file, $fh); | ||
289 | |||
290 | return $return || -1; | ||
291 | } | ||
292 | |||
293 | |||
294 | =pod | ||
295 | |||
296 | =item set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM]) | ||
297 | |||
298 | =item set_mp3tag (FILE, $HASHREF) | ||
299 | |||
300 | Adds/changes tag information in an MP3 audio file. Will clobber | ||
301 | any existing information in file. | ||
302 | |||
303 | Fields are TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE. All fields have | ||
304 | a 30-byte limit, except for YEAR, which has a four-byte limit, and GENRE, | ||
305 | which is one byte in the file. The GENRE passed in the function is a | ||
306 | case-insensitive text string representing a genre found in C<@mp3_genres>. | ||
307 | |||
308 | Will accept either a list of values, or a hashref of the type | ||
309 | returned by C<get_mp3tag>. | ||
310 | |||
311 | If TRACKNUM is present (for ID3v1.1), then the COMMENT field can only be | ||
312 | 28 bytes. | ||
313 | |||
314 | ID3v2 support may come eventually. Note that if you set a tag on a file | ||
315 | with ID3v2, the set tag will be for ID3v1[.1] only, and if you call | ||
316 | C<get_mp3tag> on the file, it will show you the (unchanged) ID3v2 tags, | ||
317 | unless you specify ID3v1. | ||
318 | |||
319 | =cut | ||
320 | |||
321 | sub set_mp3tag { | ||
322 | my($file, $title, $artist, $album, $year, $comment, $genre, $tracknum) = @_; | ||
323 | my(%info, $oldfh, $ref, $fh); | ||
324 | local %v1_tag_fields = %v1_tag_fields; | ||
325 | |||
326 | # set each to '' if undef | ||
327 | for ($title, $artist, $album, $year, $comment, $tracknum, $genre, | ||
328 | (@info{@v1_tag_names})) | ||
329 | {$_ = defined() ? $_ : ''} | ||
330 | |||
331 | ($ref) = (overload::StrVal($title) =~ /^(?:.*\=)?([^=]*)\((?:[^\(]*)\)$/) | ||
332 | if ref $title; | ||
333 | # populate data to hashref if hashref is not passed | ||
334 | if (!$ref) { | ||
335 | (@info{@v1_tag_names}) = | ||
336 | ($title, $artist, $album, $year, $comment, $tracknum, $genre); | ||
337 | |||
338 | # put data from hashref into hashref if hashref is passed | ||
339 | } elsif ($ref eq 'HASH') { | ||
340 | %info = %$title; | ||
341 | |||
342 | # return otherwise | ||
343 | } else { | ||
344 | carp(<<'EOT'); | ||
345 | Usage: set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM]) | ||
346 | set_mp3tag (FILE, $HASHREF) | ||
347 | EOT | ||
348 | return undef; | ||
349 | } | ||
350 | |||
351 | if (not (defined $file && $file ne '')) { | ||
352 | $@ = "No file specified"; | ||
353 | return undef; | ||
354 | } | ||
355 | |||
356 | if (not -s $file) { | ||
357 | $@ = "File is empty"; | ||
358 | return undef; | ||
359 | } | ||
360 | |||
361 | # comment field length 28 if ID3v1.1 | ||
362 | $v1_tag_fields{COMMENT} = 28 if $info{TRACKNUM}; | ||
363 | |||
364 | |||
365 | # only if -w is on | ||
366 | if ($^W) { | ||
367 | # warn if fields too long | ||
368 | foreach my $field (keys %v1_tag_fields) { | ||
369 | $info{$field} = '' unless defined $info{$field}; | ||
370 | if (length($info{$field}) > $v1_tag_fields{$field}) { | ||
371 | carp "Data too long for field $field: truncated to " . | ||
372 | "$v1_tag_fields{$field}"; | ||
373 | } | ||
374 | } | ||
375 | |||
376 | if ($info{GENRE}) { | ||
377 | carp "Genre `$info{GENRE}' does not exist\n" | ||
378 | unless exists $mp3_genres{$info{GENRE}}; | ||
379 | } | ||
380 | } | ||
381 | |||
382 | if ($info{TRACKNUM}) { | ||
383 | $info{TRACKNUM} =~ s/^(\d+)\/(\d+)$/$1/; | ||
384 | unless ($info{TRACKNUM} =~ /^\d+$/ && | ||
385 | $info{TRACKNUM} > 0 && $info{TRACKNUM} < 256) { | ||
386 | carp "Tracknum `$info{TRACKNUM}' must be an integer " . | ||
387 | "from 1 and 255\n" if $^W; | ||
388 | $info{TRACKNUM} = ''; | ||
389 | } | ||
390 | } | ||
391 | |||
392 | if (ref $file) { # filehandle passed | ||
393 | $fh = $file; | ||
394 | } else { | ||
395 | if (not open $fh, '+<', $file) { | ||
396 | $@ = "Can't open $file: $!"; | ||
397 | return undef; | ||
398 | } | ||
399 | } | ||
400 | |||
401 | binmode $fh; | ||
402 | $oldfh = select $fh; | ||
403 | seek $fh, -128, 2; | ||
404 | # go to end of file if no tag, beginning of file if tag | ||
405 | seek $fh, (<$fh> =~ /^TAG/ ? -128 : 0), 2; | ||
406 | |||
407 | # get genre value | ||
408 | $info{GENRE} = $info{GENRE} && exists $mp3_genres{$info{GENRE}} ? | ||
409 | $mp3_genres{$info{GENRE}} : 255; # some default genre | ||
410 | |||
411 | local $\; | ||
412 | # print TAG to file | ||
413 | if ($info{TRACKNUM}) { | ||
414 | print pack 'a3a30a30a30a4a28xCC', 'TAG', @info{@v1_tag_names}; | ||
415 | } else { | ||
416 | print pack 'a3a30a30a30a4a30C', 'TAG', @info{@v1_tag_names[0..4, 6]}; | ||
417 | } | ||
418 | |||
419 | select $oldfh; | ||
420 | |||
421 | _close($file, $fh); | ||
422 | |||
423 | return 1; | ||
424 | } | ||
425 | |||
426 | =pod | ||
427 | |||
428 | =item get_mp3tag (FILE [, VERSION, RAW_V2]) | ||
429 | |||
430 | Returns hash reference containing tag information in MP3 file. The keys | ||
431 | returned are the same as those supplied for C<set_mp3tag>, except in the | ||
432 | case of RAW_V2 being set. | ||
433 | |||
434 | If VERSION is C<1>, the information is taken from the ID3v1 tag (if present). | ||
435 | If VERSION is C<2>, the information is taken from the ID3v2 tag (if present). | ||
436 | If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and | ||
437 | then, if present, the ID3v2 tag information will override any existing ID3v1 | ||
438 | tag info. | ||
439 | |||
440 | If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation | ||
441 | of text encoding. The key name is the same as the frame ID (ID to name mappings | ||
442 | are in the global %v2_tag_names). | ||
443 | |||
444 | If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if | ||
445 | necessary, etc. It also takes multiple values for a given key (such as comments) | ||
446 | and puts them in an arrayref. | ||
447 | |||
448 | If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will | ||
449 | not be read. | ||
450 | |||
451 | Strings returned will be in Latin-1, unless UTF-8 is specified (L<use_mp3_utf8>), | ||
452 | (unless RAW_V2 is C<1>). | ||
453 | |||
454 | Also returns a TAGVERSION key, containing the ID3 version used for the returned | ||
455 | data (if TAGVERSION argument is C<0>, may contain two versions). | ||
456 | |||
457 | =cut | ||
458 | |||
459 | sub get_mp3tag { | ||
460 | my ($file, $ver, $raw_v2, $find_ape) = @_; | ||
461 | my ($tag, $v2h, $fh); | ||
462 | |||
463 | my $v1 = {}; | ||
464 | my $v2 = {}; | ||
465 | my $ape = {}; | ||
466 | my %info = (); | ||
467 | my @array = (); | ||
468 | |||
469 | $raw_v2 ||= 0; | ||
470 | $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0; | ||
471 | |||
472 | if (not (defined $file && $file ne '')) { | ||
473 | $@ = "No file specified"; | ||
474 | return undef; | ||
475 | } | ||
476 | |||
477 | my $filesize = -s $file; | ||
478 | |||
479 | if (!$filesize) { | ||
480 | $@ = "File is empty"; | ||
481 | return undef; | ||
482 | } | ||
483 | |||
484 | if (ref $file) { # filehandle passed | ||
485 | $fh = $file; | ||
486 | } else { | ||
487 | if (not open $fh, '<', $file) { | ||
488 | $@ = "Can't open $file: $!"; | ||
489 | return undef; | ||
490 | } | ||
491 | } | ||
492 | |||
493 | binmode $fh; | ||
494 | |||
495 | # Try and find an APE Tag - this is where FooBar2k & others | ||
496 | # store ReplayGain information | ||
497 | if ($find_ape) { | ||
498 | |||
499 | $ape = _parse_ape_tag($fh, $filesize, \%info); | ||
500 | } | ||
501 | |||
502 | if ($ver < 2) { | ||
503 | |||
504 | $v1 = _get_v1tag($fh, \%info); | ||
505 | |||
506 | if ($ver == 1 && !$v1) { | ||
507 | _close($file, $fh); | ||
508 | $@ = "No ID3v1 tag found"; | ||
509 | return undef; | ||
510 | } | ||
511 | } | ||
512 | |||
513 | if ($ver == 2 || $ver == 0) { | ||
514 | ($v2, $v2h) = _get_v2tag($fh); | ||
515 | } | ||
516 | |||
517 | if (!$v1 && !$v2 && !$ape) { | ||
518 | _close($file, $fh); | ||
519 | $@ = "No ID3 tag found"; | ||
520 | return undef; | ||
521 | } | ||
522 | |||
523 | if (($ver == 0 || $ver == 2) && $v2) { | ||
524 | |||
525 | if ($raw_v2 == 1 && $ver == 2) { | ||
526 | |||
527 | %info = %$v2; | ||
528 | |||
529 | $info{'TAGVERSION'} = $v2h->{'version'}; | ||
530 | |||
531 | } else { | ||
532 | |||
533 | _parse_v2tag($raw_v2, $v2, \%info); | ||
534 | |||
535 | if ($ver == 0 && $info{'TAGVERSION'}) { | ||
536 | $info{'TAGVERSION'} .= ' / ' . $v2h->{'version'}; | ||
537 | } else { | ||
538 | $info{'TAGVERSION'} = $v2h->{'version'}; | ||
539 | } | ||
540 | } | ||
541 | } | ||
542 | |||
543 | unless ($raw_v2 && $ver == 2) { | ||
544 | foreach my $key (keys %info) { | ||
545 | if (defined $info{$key}) { | ||
546 | $info{$key} =~ s/\000+.*//g; | ||
547 | $info{$key} =~ s/\s+$//; | ||
548 | } | ||
549 | } | ||
550 | |||
551 | for (@v1_tag_names) { | ||
552 | $info{$_} = '' unless defined $info{$_}; | ||
553 | } | ||
554 | } | ||
555 | |||
556 | if (keys %info && exists $info{'GENRE'} && ! defined $info{'GENRE'}) { | ||
557 | $info{'GENRE'} = ''; | ||
558 | } | ||
559 | |||
560 | _close($file, $fh); | ||
561 | |||
562 | return keys %info ? {%info} : undef; | ||
563 | } | ||
564 | |||
565 | sub _get_v1tag { | ||
566 | my ($fh, $info) = @_; | ||
567 | |||
568 | seek $fh, -128, 2; | ||
569 | read($fh, my $tag, 128); | ||
570 | |||
571 | if (!defined($tag) || $tag !~ /^TAG/) { | ||
572 | |||
573 | return 0; | ||
574 | } | ||
575 | |||
576 | if (substr($tag, -3, 2) =~ /\000[^\000]/) { | ||
577 | |||
578 | (undef, @{$info}{@v1_tag_names}) = | ||
579 | (unpack('a3a30a30a30a4a28', $tag), | ||
580 | ord(substr($tag, -2, 1)), | ||
581 | $mp3_genres[ord(substr $tag, -1)]); | ||
582 | |||
583 | $info->{'TAGVERSION'} = 'ID3v1.1'; | ||
584 | |||
585 | } else { | ||
586 | |||
587 | (undef, @{$info}{@v1_tag_names[0..4, 6]}) = | ||
588 | (unpack('a3a30a30a30a4a30', $tag), | ||
589 | $mp3_genres[ord(substr $tag, -1)]); | ||
590 | |||
591 | $info->{'TAGVERSION'} = 'ID3v1'; | ||
592 | } | ||
593 | |||
594 | if ($UNICODE) { | ||
595 | |||
596 | # Save off the old suspects list, since we add | ||
597 | # iso-8859-1 below, but don't want that there | ||
598 | # for possible ID3 v2.x parsing below. | ||
599 | my $oldSuspects = $Encode::Encoding{'Guess'}->{'Suspects'}; | ||
600 | |||
601 | for my $key (keys %{$info}) { | ||
602 | |||
603 | next unless $info->{$key}; | ||
604 | |||
605 | # Try and guess the encoding. | ||
606 | my $value = $info->{$key}; | ||
607 | my $icode = Encode::Guess->guess($value); | ||
608 | |||
609 | unless (ref($icode)) { | ||
610 | |||
611 | # Often Latin1 bytes are | ||
612 | # stuffed into a 1.1 tag. | ||
613 | Encode::Guess->add_suspects('iso-8859-1'); | ||
614 | |||
615 | while (length($value)) { | ||
616 | |||
617 | $icode = Encode::Guess->guess($value); | ||
618 | |||
619 | last if ref($icode); | ||
620 | |||
621 | # Remove garbage and retry | ||
622 | # (string is truncated in the | ||
623 | # middle of a multibyte char?) | ||
624 | $value =~ s/(.)$//; | ||
625 | } | ||
626 | } | ||
627 | |||
628 | $info->{$key} = Encode::decode(ref($icode) ? $icode->name : 'iso-8859-1', $info->{$key}); | ||
629 | } | ||
630 | |||
631 | Encode::Guess->set_suspects(keys %{$oldSuspects}); | ||
632 | } | ||
633 | |||
634 | return 1; | ||
635 | } | ||
636 | |||
637 | sub _parse_v2tag { | ||
638 | my ($raw_v2, $v2, $info) = @_; | ||
639 | |||
640 | # Make sure any existing TXXX flags are an array. | ||
641 | # As we might need to append comments to it below. | ||
642 | if ($v2->{'TXXX'} && ref($v2->{'TXXX'}) ne 'ARRAY') { | ||
643 | |||
644 | $v2->{'TXXX'} = [ $v2->{'TXXX'} ]; | ||
645 | } | ||
646 | |||
647 | # J.River Media Center sticks RG tags in comments. | ||
648 | # Ugh. Make them look like TXXX tags, which is really what they are. | ||
649 | if (ref($v2->{'COMM'}) eq 'ARRAY' && grep { /Media Jukebox/ } @{$v2->{'COMM'}}) { | ||
650 | |||
651 | for my $comment (@{$v2->{'COMM'}}) { | ||
652 | |||
653 | if ($comment =~ /Media Jukebox/) { | ||
654 | |||
655 | # we only want one null to lead. | ||
656 | $comment =~ s/^\000+//g; | ||
657 | |||
658 | push @{$v2->{'TXXX'}}, "\000$comment"; | ||
659 | } | ||
660 | } | ||
661 | } | ||
662 | |||
663 | my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names; | ||
664 | |||
665 | for my $id (keys %$hash) { | ||
666 | |||
667 | next if !exists $v2->{$id}; | ||
668 | |||
669 | if ($id =~ /^UFID?$/) { | ||
670 | |||
671 | my @ufid_list = split(/\0/, $v2->{$id}); | ||
672 | |||
673 | $info->{$hash->{$id}} = $ufid_list[1] if ($#ufid_list > 0); | ||
674 | |||
675 | } elsif ($id =~ /^RVA[D2]?$/) { | ||
676 | |||
677 | # Expand these binary fields. See the ID3 spec for Relative Volume Adjustment. | ||
678 | if ($id eq 'RVA2') { | ||
679 | |||
680 | # ID is a text string | ||
681 | ($info->{$hash->{$id}}->{'ID'}, my $rvad) = split /\0/, $v2->{$id}; | ||
682 | |||
683 | my $channel = $rva2_channel_types{ ord(substr($rvad, 0, 1, '')) }; | ||
684 | |||
685 | $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_GAIN'} = | ||
686 | sprintf('%f', _grab_int_16(\$rvad) / 512); | ||
687 | |||
688 | my $peakBytes = ord(substr($rvad, 0, 1, '')); | ||
689 | |||
690 | if (int($peakBytes / 8)) { | ||
691 | |||
692 | $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_PEAK'} = | ||
693 | sprintf('%f', _grab_int_16(\$rvad) / 512); | ||
694 | } | ||
695 | |||
696 | } elsif ($id eq 'RVAD' || $id eq 'RVA') { | ||
697 | |||
698 | my $rvad = $v2->{$id}; | ||
699 | my $flags = ord(substr($rvad, 0, 1, '')); | ||
700 | my $desc = ord(substr($rvad, 0, 1, '')); | ||
701 | |||
702 | # iTunes appears to be the only program that actually writes | ||
703 | # out a RVA/RVAD tag. Everyone else punts. | ||
704 | for my $type (qw(REPLAYGAIN_TRACK_GAIN REPLAYGAIN_TRACK_PEAK)) { | ||
705 | |||
706 | for my $channel (qw(RIGHT LEFT)) { | ||
707 | |||
708 | my $val = _grab_uint_16(\$rvad) / 256; | ||
709 | |||
710 | # iTunes uses a range of -255 to 255 | ||
711 | # to be -100% (silent) to 100% (+6dB) | ||
712 | if ($val == -255) { | ||
713 | $val = -96.0; | ||
714 | } else { | ||
715 | $val = 20.0 * log(($val+255)/255)/log(10); | ||
716 | } | ||
717 | |||
718 | $info->{$hash->{$id}}->{$channel}->{$type} = $flags & 0x01 ? $val : -$val; | ||
719 | } | ||
720 | } | ||
721 | } | ||
722 | |||
723 | } elsif ($id =~ /^A?PIC$/) { | ||
724 | |||
725 | my $pic = $v2->{$id}; | ||
726 | |||
727 | # if there is more than one picture, just grab the first one. | ||
728 | if (ref($pic) eq 'ARRAY') { | ||
729 | $pic = (@$pic)[0]; | ||
730 | } | ||
731 | |||
732 | use bytes; | ||
733 | |||
734 | my $valid_pic = 0; | ||
735 | my $pic_len = 0; | ||
736 | my $pic_format = ''; | ||
737 | |||
738 | # look for ID3 v2.2 picture | ||
739 | if ($pic && $id eq 'PIC') { | ||
740 | |||
741 | # look for ID3 v2.2 picture | ||
742 | my ($encoding, $format, $picture_type, $description) = unpack 'Ca3CZ*', $pic; | ||
743 | $pic_len = length($description) + 1 + 5; | ||
744 | |||
745 | # skip extra terminating null if unicode | ||
746 | if ($encoding) { $pic_len++; } | ||
747 | |||
748 | if ($pic_len < length($pic)) { | ||
749 | $valid_pic = 1; | ||
750 | $pic_format = $format; | ||
751 | } | ||
752 | |||
753 | } elsif ($pic && $id eq 'APIC') { | ||
754 | |||
755 | # look for ID3 v2.3 picture | ||
756 | my ($encoding, $format) = unpack 'C Z*', $pic; | ||
757 | |||
758 | $pic_len = length($format) + 2; | ||
759 | |||
760 | if ($pic_len < length($pic)) { | ||
761 | |||
762 | my ($picture_type, $description) = unpack "x$pic_len C Z*", $pic; | ||
763 | |||
764 | $pic_len += 1 + length($description) + 1; | ||
765 | |||
766 | # skip extra terminating null if unicode | ||
767 | if ($encoding) { $pic_len++; } | ||
768 | |||
769 | $valid_pic = 1; | ||
770 | $pic_format = $format; | ||
771 | } | ||
772 | } | ||
773 | |||
774 | # Proceed if we have a valid picture. | ||
775 | if ($valid_pic && $pic_format) { | ||
776 | |||
777 | my ($data) = unpack("x$pic_len A*", $pic); | ||
778 | |||
779 | if (length($data) && $pic_format) { | ||
780 | |||
781 | $info->{$hash->{$id}} = { | ||
782 | 'DATA' => $data, | ||
783 | 'FORMAT' => $pic_format, | ||
784 | } | ||
785 | } | ||
786 | } | ||
787 | |||
788 | } else { | ||
789 | my $data1 = $v2->{$id}; | ||
790 | |||
791 | # this is tricky ... if this is an arrayref, | ||
792 | # we want to only return one, so we pick the | ||
793 | # first one. but if it is a comment, we pick | ||
794 | # the first one where the first charcter after | ||
795 | # the language is NULL and not an additional | ||
796 | # sub-comment, because that is most likely to be | ||
797 | # the user-supplied comment | ||
798 | if (ref $data1 && !$raw_v2) { | ||
799 | if ($id =~ /^COMM?$/) { | ||
800 | my($newdata) = grep /^(....\000)/, @{$data1}; | ||
801 | $data1 = $newdata || $data1->[0]; | ||
802 | } elsif ($id !~ /^(?:TXXX?|PRIV)$/) { | ||
803 | # We can get multiple User Defined Text frames in a mp3 file | ||
804 | $data1 = $data1->[0]; | ||
805 | } | ||
806 | } | ||
807 | |||
808 | $data1 = [ $data1 ] if ! ref $data1; | ||
809 | |||
810 | for my $data (@$data1) { | ||
811 | # TODO : this should only be done for certain frames; | ||
812 | # using RAW still gives you access, but we should be smarter | ||
813 | # about how individual frame types are handled. it's not | ||
814 | # like the list is infinitely long. | ||
815 | $data =~ s/^(.)//; # strip first char (text encoding) | ||
816 | my $encoding = $1; | ||
817 | my $desc; | ||
818 | |||
819 | # Comments & Unsyncronized Lyrics have the same format. | ||
820 | if ($id =~ /^(COM[M ]?|USLT)$/) { # space for iTunes brokenness | ||
821 | |||
822 | $data =~ s/^(?:...)//; # strip language | ||
823 | } | ||
824 | |||
825 | if ($UNICODE) { | ||
826 | |||
827 | if ($encoding eq "\001" || $encoding eq "\002") { # UTF-16, UTF-16BE | ||
828 | # text fields can be null-separated lists; | ||
829 | # UTF-16 therefore needs special care | ||
830 | # | ||
831 | # foobar2000 encodes tags in UTF-16LE | ||
832 | # (which is apparently illegal) | ||
833 | # Encode dies on a bad BOM, so it is | ||
834 | # probably wise to wrap it in an eval | ||
835 | # anyway | ||
836 | $data = eval { Encode::decode('utf16', $data) } || Encode::decode('utf16le', $data); | ||
837 | |||
838 | } elsif ($encoding eq "\003") { # UTF-8 | ||
839 | |||
840 | # make sure string is UTF8, and set flag appropriately | ||
841 | $data = Encode::decode('utf8', $data); | ||
842 | |||
843 | } elsif ($encoding eq "\000") { | ||
844 | |||
845 | # Only guess if it's not ascii. | ||
846 | if ($data && $data !~ /^[\x00-\x7F]+$/) { | ||
847 | |||
848 | # Try and guess the encoding, otherwise just use latin1 | ||
849 | my $dec = Encode::Guess->guess($data); | ||
850 | |||
851 | if (ref $dec) { | ||
852 | $data = $dec->decode($data); | ||
853 | } else { | ||
854 | # Best try | ||
855 | $data = Encode::decode('iso-8859-1', $data); | ||
856 | } | ||
857 | } | ||
858 | } | ||
859 | |||
860 | } else { | ||
861 | |||
862 | # If the string starts with an | ||
863 | # UTF-16 little endian BOM, use a hack to | ||
864 | # convert to ASCII per best-effort | ||
865 | my $pat; | ||
866 | if ($data =~ s/^\xFF\xFE//) { | ||
867 | $pat = 'v'; | ||
868 | } elsif ($data =~ s/^\xFE\xFF//) { | ||
869 | $pat = 'n'; | ||
870 | } | ||
871 | |||
872 | if ($pat) { | ||
873 | $data = pack 'C*', map { | ||
874 | (chr =~ /[[:ascii:]]/ && chr =~ /[[:print:]]/) | ||
875 | ? $_ | ||
876 | : ord('?') | ||
877 | } unpack "$pat*", $data; | ||
878 | } | ||
879 | } | ||
880 | |||
881 | # We do this after decoding so we could be certain we're dealing | ||
882 | # with 8-bit text. | ||
883 | if ($id =~ /^(COM[M ]?|USLT)$/) { # space for iTunes brokenness | ||
884 | |||
885 | $data =~ s/^(.*?)\000//; # strip up to first NULL(s), | ||
886 | # for sub-comments (TODO: | ||
887 | # handle all comment data) | ||
888 | $desc = $1; | ||
889 | |||
890 | } elsif ($id =~ /^TCON?$/) { | ||
891 | |||
892 | my ($index, $name); | ||
893 | |||
894 | # Turn multiple nulls into a single. | ||
895 | $data =~ s/\000+/\000/g; | ||
896 | |||
897 | # Handle the ID3v2.x spec - | ||
898 | # | ||
899 | # just an index number, possibly | ||
900 | # paren enclosed - referer to the v1 genres. | ||
901 | if ($data =~ /^ \(? (\d+) \)?\000?$/sx) { | ||
902 | |||
903 | $index = $1; | ||
904 | |||
905 | # Paren enclosed index with refinement. | ||
906 | # (4)Eurodisco | ||
907 | } elsif ($data =~ /^ \( (\d+) \)\000? ([^\(].+)$/x) { | ||
908 | |||
909 | ($index, $name) = ($1, $2); | ||
910 | |||
911 | # List of indexes: (37)(38) | ||
912 | } elsif ($data =~ /^ \( (\d+) \)\000?/x) { | ||
913 | |||
914 | my @genres = (); | ||
915 | |||
916 | while ($data =~ s/^ \( (\d+) \)\000?//x) { | ||
917 | |||
918 | push @genres, $mp3_genres[$1]; | ||
919 | } | ||
920 | |||
921 | $data = \@genres; | ||
922 | } | ||
923 | |||
924 | # Text based genres will fall through. | ||
925 | if ($name && $name ne "\000") { | ||
926 | $data = $name; | ||
927 | } elsif (defined $index) { | ||
928 | $data = $mp3_genres[$index]; | ||
929 | } | ||
930 | } | ||
931 | |||
932 | if ($raw_v2 == 2 && $desc) { | ||
933 | $data = { $desc => $data }; | ||
934 | } | ||
935 | |||
936 | if ($raw_v2 == 2 && exists $info->{$hash->{$id}}) { | ||
937 | |||
938 | if (ref $info->{$hash->{$id}} eq 'ARRAY') { | ||
939 | push @{$info->{$hash->{$id}}}, $data; | ||
940 | } else { | ||
941 | $info->{$hash->{$id}} = [ $info->{$hash->{$id}}, $data ]; | ||
942 | } | ||
943 | |||
944 | } else { | ||
945 | |||
946 | # User defined frame | ||
947 | if ($id eq 'TXXX') { | ||
948 | |||
949 | my ($key, $val) = split(/\0/, $data); | ||
950 | $info->{uc($key)} = $val; | ||
951 | |||
952 | } elsif ($id eq 'PRIV') { | ||
953 | |||
954 | my ($key, $val) = split(/\0/, $data); | ||
955 | $info->{uc($key)} = unpack('v', $val); | ||
956 | |||
957 | } else { | ||
958 | |||
959 | $info->{$hash->{$id}} = $data; | ||
960 | } | ||
961 | } | ||
962 | } | ||
963 | } | ||
964 | } | ||
965 | } | ||
966 | |||
967 | sub _get_v2tag { | ||
968 | my($fh) = @_; | ||
969 | my($off, $end, $myseek, $v2, $v2h, $hlen, $num, $wholetag); | ||
970 | |||
971 | $v2 = {}; | ||
972 | $v2h = _get_v2head($fh) or return; | ||
973 | |||
974 | if ($v2h->{major_version} < 2) { | ||
975 | carp "This is $v2h->{version}; " . | ||
976 | "ID3v2 versions older than ID3v2.2.0 not supported\n" | ||
977 | if $^W; | ||
978 | return; | ||
979 | } | ||
980 | |||
981 | # use syncsafe bytes if using version 2.4 | ||
982 | # my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256; | ||
983 | |||
984 | # alas, that's what the spec says, but iTunes and others don't syncsafe | ||
985 | # the length, which breaks MP3 files with v2.4 tags longer than 128 bytes, | ||
986 | # like every image file. | ||
987 | my $bytesize = 256; | ||
988 | |||
989 | if ($v2h->{major_version} == 2) { | ||
990 | $hlen = 6; | ||
991 | $num = 3; | ||
992 | } else { | ||
993 | $hlen = 10; | ||
994 | $num = 4; | ||
995 | } | ||
996 | |||
997 | $off = $v2h->{ext_header_size} + 10; | ||
998 | $end = $v2h->{tag_size} + 10; # should we read in the footer too? | ||
999 | |||
1000 | seek $fh, $v2h->{offset}, 0; | ||
1001 | read $fh, $wholetag, $end; | ||
1002 | |||
1003 | $wholetag =~ s/\xFF\x00/\xFF/gs if $v2h->{unsync}; | ||
1004 | |||
1005 | $myseek = sub { | ||
1006 | my $bytes = substr($wholetag, $off, $hlen); | ||
1007 | return unless $bytes =~ /^([A-Z0-9]{$num})/ | ||
1008 | || ($num == 4 && $bytes =~ /^(COM )/); # stupid iTunes | ||
1009 | my($id, $size) = ($1, $hlen); | ||
1010 | my @bytes = reverse unpack "C$num", substr($bytes, $num, $num); | ||
1011 | |||
1012 | for my $i (0 .. ($num - 1)) { | ||
1013 | $size += $bytes[$i] * $bytesize ** $i; | ||
1014 | } | ||
1015 | |||
1016 | my $flags = {}; | ||
1017 | if ($v2h->{major_version} > 3) { | ||
1018 | my @bits = split //, unpack 'B16', substr($bytes, 8, 2); | ||
1019 | $flags->{frame_unsync} = $bits[14]; | ||
1020 | $flags->{data_len_indicator} = $bits[15]; | ||
1021 | } | ||
1022 | |||
1023 | return($id, $size, $flags); | ||
1024 | }; | ||
1025 | |||
1026 | while ($off < $end) { | ||
1027 | my($id, $size, $flags) = &$myseek or last; | ||
1028 | |||
1029 | my $bytes = substr($wholetag, $off+$hlen, $size-$hlen); | ||
1030 | |||
1031 | my $data_len; | ||
1032 | if ($flags->{data_len_indicator}) { | ||
1033 | $data_len = 0; | ||
1034 | my @data_len_bytes = reverse unpack 'C4', substr($bytes, 0, 4); | ||
1035 | $bytes = substr($bytes, 4); | ||
1036 | for my $i (0..3) { | ||
1037 | $data_len += $data_len_bytes[$i] * 128 ** $i; | ||
1038 | } | ||
1039 | } | ||
1040 | |||
1041 | # perform frame-level unsync if needed (skip if already done for whole tag) | ||
1042 | $bytes =~ s/\xFF\x00/\xFF/gs if $flags->{frame_unsync} && !$v2h->{unsync}; | ||
1043 | |||
1044 | # if we know the data length, sanity check it now. | ||
1045 | if ($flags->{data_len_indicator} && defined $data_len) { | ||
1046 | carp "Size mismatch on $id\n" unless $data_len == length($bytes); | ||
1047 | } | ||
1048 | |||
1049 | if (exists $v2->{$id}) { | ||
1050 | if (ref $v2->{$id} eq 'ARRAY') { | ||
1051 | push @{$v2->{$id}}, $bytes; | ||
1052 | } else { | ||
1053 | $v2->{$id} = [$v2->{$id}, $bytes]; | ||
1054 | } | ||
1055 | } else { | ||
1056 | $v2->{$id} = $bytes; | ||
1057 | } | ||
1058 | $off += $size; | ||
1059 | } | ||
1060 | |||
1061 | return($v2, $v2h); | ||
1062 | } | ||
1063 | |||
1064 | |||
1065 | =pod | ||
1066 | |||
1067 | =item get_mp3info (FILE) | ||
1068 | |||
1069 | Returns hash reference containing file information for MP3 file. | ||
1070 | This data cannot be changed. Returned data: | ||
1071 | |||
1072 | VERSION MPEG audio version (1, 2, 2.5) | ||
1073 | LAYER MPEG layer description (1, 2, 3) | ||
1074 | STEREO boolean for audio is in stereo | ||
1075 | |||
1076 | VBR boolean for variable bitrate | ||
1077 | BITRATE bitrate in kbps (average for VBR files) | ||
1078 | FREQUENCY frequency in kHz | ||
1079 | SIZE bytes in audio stream | ||
1080 | OFFSET bytes offset that stream begins | ||
1081 | |||
1082 | SECS total seconds | ||
1083 | MM minutes | ||
1084 | SS leftover seconds | ||
1085 | MS leftover milliseconds | ||
1086 | TIME time in MM:SS | ||
1087 | |||
1088 | COPYRIGHT boolean for audio is copyrighted | ||
1089 | PADDING boolean for MP3 frames are padded | ||
1090 | MODE channel mode (0 = stereo, 1 = joint stereo, | ||
1091 | 2 = dual channel, 3 = single channel) | ||
1092 | FRAMES approximate number of frames | ||
1093 | FRAME_LENGTH approximate length of a frame | ||
1094 | VBR_SCALE VBR scale from VBR header | ||
1095 | |||
1096 | On error, returns nothing and sets C<$@>. | ||
1097 | |||
1098 | =cut | ||
1099 | |||
1100 | sub get_mp3info { | ||
1101 | my($file) = @_; | ||
1102 | my($off, $byte, $eof, $h, $tot, $fh); | ||
1103 | |||
1104 | if (not (defined $file && $file ne '')) { | ||
1105 | $@ = "No file specified"; | ||
1106 | return undef; | ||
1107 | } | ||
1108 | |||
1109 | if (not -s $file) { | ||
1110 | $@ = "File is empty"; | ||
1111 | return undef; | ||
1112 | } | ||
1113 | |||
1114 | if (ref $file) { # filehandle passed | ||
1115 | $fh = $file; | ||
1116 | } else { | ||
1117 | if (not open $fh, '<', $file) { | ||
1118 | $@ = "Can't open $file: $!"; | ||
1119 | return undef; | ||
1120 | } | ||
1121 | } | ||
1122 | |||
1123 | $off = 0; | ||
1124 | $tot = 8192; | ||
1125 | |||
1126 | # Let the caller change how far we seek in looking for a header. | ||
1127 | if ($try_harder) { | ||
1128 | $tot *= $try_harder; | ||
1129 | } | ||
1130 | |||
1131 | binmode $fh; | ||
1132 | seek $fh, $off, 0; | ||
1133 | read $fh, $byte, 4; | ||
1134 | |||
1135 | if ($off == 0) { | ||
1136 | if (my $v2h = _get_v2head($fh)) { | ||
1137 | $tot += $off += $v2h->{tag_size}; | ||
1138 | seek $fh, $off, 0; | ||
1139 | read $fh, $byte, 4; | ||
1140 | } | ||
1141 | } | ||
1142 | |||
1143 | $h = _get_head($byte); | ||
1144 | my $is_mp3 = _is_mp3($h); | ||
1145 | |||
1146 | # the head wasn't where we were expecting it.. dig deeper. | ||
1147 | unless ($is_mp3) { | ||
1148 | |||
1149 | # do only one read - it's _much_ faster | ||
1150 | $off++; | ||
1151 | seek $fh, $off, 0; | ||
1152 | read $fh, $byte, $tot; | ||
1153 | |||
1154 | my $i; | ||
1155 | |||
1156 | # now walk the bytes looking for the head | ||
1157 | for ($i = 0; $i < $tot; $i++) { | ||
1158 | |||
1159 | last if ($tot - $i) < 4; | ||
1160 | |||
1161 | my $head = substr($byte, $i, 4) || last; | ||
1162 | |||
1163 | next if (ord($head) != 0xff); | ||
1164 | |||
1165 | $h = _get_head($head); | ||
1166 | $is_mp3 = _is_mp3($h); | ||
1167 | last if $is_mp3; | ||
1168 | } | ||
1169 | |||
1170 | # adjust where we are for _get_vbr() | ||
1171 | $off += $i; | ||
1172 | |||
1173 | if ($off > $tot && !$try_harder) { | ||
1174 | _close($file, $fh); | ||
1175 | $@ = "Couldn't find MP3 header (perhaps set " . | ||
1176 | '$MP3::Info::try_harder and retry)'; | ||
1177 | return undef; | ||
1178 | } | ||
1179 | } | ||
1180 | |||
1181 | my $vbr = _get_vbr($fh, $h, \$off); | ||
1182 | |||
1183 | seek $fh, 0, 2; | ||
1184 | $eof = tell $fh; | ||
1185 | seek $fh, -128, 2; | ||
1186 | $eof -= 128 if <$fh> =~ /^TAG/ ? 1 : 0; | ||
1187 | |||
1188 | _close($file, $fh); | ||
1189 | |||
1190 | $h->{size} = $eof - $off; | ||
1191 | $h->{offset} = $off; | ||
1192 | |||
1193 | return _get_info($h, $vbr); | ||
1194 | } | ||
1195 | |||
1196 | sub _get_info { | ||
1197 | my($h, $vbr) = @_; | ||
1198 | my $i; | ||
1199 | |||
1200 | # No bitrate or sample rate? Something's wrong. | ||
1201 | unless ($h->{bitrate} && $h->{fs}) { | ||
1202 | return {}; | ||
1203 | } | ||
1204 | |||
1205 | $i->{VERSION} = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 : | ||
1206 | $h->{IDR} == 0 ? 2.5 : 0; | ||
1207 | $i->{LAYER} = 4 - $h->{layer}; | ||
1208 | $i->{VBR} = defined $vbr ? 1 : 0; | ||
1209 | |||
1210 | $i->{COPYRIGHT} = $h->{copyright} ? 1 : 0; | ||
1211 | $i->{PADDING} = $h->{padding_bit} ? 1 : 0; | ||
1212 | $i->{STEREO} = $h->{mode} == 3 ? 0 : 1; | ||
1213 | $i->{MODE} = $h->{mode}; | ||
1214 | |||
1215 | $i->{SIZE} = $vbr && $vbr->{bytes} ? $vbr->{bytes} : $h->{size}; | ||
1216 | $i->{OFFSET} = $h->{offset}; | ||
1217 | |||
1218 | my $mfs = $h->{fs} / ($h->{ID} ? 144000 : 72000); | ||
1219 | $i->{FRAMES} = int($vbr && $vbr->{frames} | ||
1220 | ? $vbr->{frames} | ||
1221 | : $i->{SIZE} / ($h->{bitrate} / $mfs) | ||
1222 | ); | ||
1223 | |||
1224 | if ($vbr) { | ||
1225 | $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale}; | ||
1226 | $h->{bitrate} = $i->{SIZE} / $i->{FRAMES} * $mfs; | ||
1227 | if (not $h->{bitrate}) { | ||
1228 | $@ = "Couldn't determine VBR bitrate"; | ||
1229 | return undef; | ||
1230 | } | ||
1231 | } | ||
1232 | |||
1233 | $h->{'length'} = ($i->{SIZE} * 8) / $h->{bitrate} / 10; | ||
1234 | $i->{SECS} = $h->{'length'} / 100; | ||
1235 | $i->{MM} = int $i->{SECS} / 60; | ||
1236 | $i->{SS} = int $i->{SECS} % 60; | ||
1237 | $i->{MS} = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000); | ||
1238 | # $i->{LF} = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS}); | ||
1239 | # int($i->{MS} / 100 * 75); # is this right? | ||
1240 | $i->{TIME} = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'}; | ||
1241 | |||
1242 | $i->{BITRATE} = int $h->{bitrate}; | ||
1243 | # should we just return if ! FRAMES? | ||
1244 | $i->{FRAME_LENGTH} = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES}; | ||
1245 | $i->{FREQUENCY} = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}]; | ||
1246 | |||
1247 | return $i; | ||
1248 | } | ||
1249 | |||
1250 | sub _get_head { | ||
1251 | my($byte) = @_; | ||
1252 | my($bytes, $h); | ||
1253 | |||
1254 | $bytes = _unpack_head($byte); | ||
1255 | @$h{qw(IDR ID layer protection_bit | ||
1256 | bitrate_index sampling_freq padding_bit private_bit | ||
1257 | mode mode_extension copyright original | ||
1258 | emphasis version_index bytes)} = ( | ||
1259 | ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1, | ||
1260 | ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1, | ||
1261 | ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1, | ||
1262 | $bytes&3, ($bytes>>19)&3, $bytes | ||
1263 | ); | ||
1264 | |||
1265 | $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}]; | ||
1266 | $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}]; | ||
1267 | |||
1268 | return $h; | ||
1269 | } | ||
1270 | |||
1271 | sub _is_mp3 { | ||
1272 | my $h = $_[0] or return undef; | ||
1273 | return ! ( # all below must be false | ||
1274 | $h->{bitrate_index} == 0 | ||
1275 | || | ||
1276 | $h->{version_index} == 1 | ||
1277 | || | ||
1278 | ($h->{bytes} & 0xFFE00000) != 0xFFE00000 | ||
1279 | || | ||
1280 | !$h->{fs} | ||
1281 | || | ||
1282 | !$h->{bitrate} | ||
1283 | || | ||
1284 | $h->{bitrate_index} == 15 | ||
1285 | || | ||
1286 | !$h->{layer} | ||
1287 | || | ||
1288 | $h->{sampling_freq} == 3 | ||
1289 | || | ||
1290 | $h->{emphasis} == 2 | ||
1291 | || | ||
1292 | !$h->{bitrate_index} | ||
1293 | || | ||
1294 | ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000 | ||
1295 | || | ||
1296 | ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1) | ||
1297 | # mode extension should only be applicable when mode = 1 | ||
1298 | # however, failing just becuase mode extension is used when unneeded is a bit strict | ||
1299 | # || | ||
1300 | #($h->{mode_extension} != 0 && $h->{mode} != 1) | ||
1301 | ); | ||
1302 | } | ||
1303 | |||
1304 | sub _vbr_seek { | ||
1305 | my $fh = shift; | ||
1306 | my $off = shift; | ||
1307 | my $bytes = shift; | ||
1308 | my $n = shift || 4; | ||
1309 | |||
1310 | seek $fh, $$off, 0; | ||
1311 | read $fh, $$bytes, $n; | ||
1312 | |||
1313 | $$off += $n; | ||
1314 | } | ||
1315 | |||
1316 | sub _get_vbr { | ||
1317 | my($fh, $h, $roff) = @_; | ||
1318 | my($off, $bytes, @bytes, %vbr); | ||
1319 | |||
1320 | $off = $$roff; | ||
1321 | |||
1322 | $off += 4; | ||
1323 | |||
1324 | if ($h->{ID}) { # MPEG1 | ||
1325 | $off += $h->{mode} == 3 ? 17 : 32; | ||
1326 | } else { # MPEG2 | ||
1327 | $off += $h->{mode} == 3 ? 9 : 17; | ||
1328 | } | ||
1329 | |||
1330 | _vbr_seek($fh, \$off, \$bytes); | ||
1331 | return unless $bytes eq 'Xing'; | ||
1332 | |||
1333 | _vbr_seek($fh, \$off, \$bytes); | ||
1334 | $vbr{flags} = _unpack_head($bytes); | ||
1335 | |||
1336 | if ($vbr{flags} & 1) { | ||
1337 | _vbr_seek($fh, \$off, \$bytes); | ||
1338 | $vbr{frames} = _unpack_head($bytes); | ||
1339 | } | ||
1340 | |||
1341 | if ($vbr{flags} & 2) { | ||
1342 | _vbr_seek($fh, \$off, \$bytes); | ||
1343 | $vbr{bytes} = _unpack_head($bytes); | ||
1344 | } | ||
1345 | |||
1346 | if ($vbr{flags} & 4) { | ||
1347 | _vbr_seek($fh, \$off, \$bytes, 100); | ||
1348 | # Not used right now ... | ||
1349 | # $vbr{toc} = _unpack_head($bytes); | ||
1350 | } | ||
1351 | |||
1352 | if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst) | ||
1353 | _vbr_seek($fh, \$off, \$bytes); | ||
1354 | $vbr{scale} = _unpack_head($bytes); | ||
1355 | } else { | ||
1356 | $vbr{scale} = -1; | ||
1357 | } | ||
1358 | |||
1359 | $$roff = $off; | ||
1360 | return \%vbr; | ||
1361 | } | ||
1362 | |||
1363 | sub _get_v2head { | ||
1364 | my $fh = $_[0] or return; | ||
1365 | my($v2h, $bytes, @bytes); | ||
1366 | $v2h->{offset} = 0; | ||
1367 | |||
1368 | # check first three bytes for 'ID3' | ||
1369 | seek $fh, 0, 0; | ||
1370 | read $fh, $bytes, 3; | ||
1371 | |||
1372 | # TODO: add support for tags at the end of the file | ||
1373 | if ($bytes eq 'RIF' || $bytes eq 'FOR') { | ||
1374 | _find_id3_chunk($fh, $bytes) or return; | ||
1375 | $v2h->{offset} = tell $fh; | ||
1376 | read $fh, $bytes, 3; | ||
1377 | } | ||
1378 | |||
1379 | return unless $bytes eq 'ID3'; | ||
1380 | |||
1381 | # get version | ||
1382 | read $fh, $bytes, 2; | ||
1383 | $v2h->{version} = sprintf "ID3v2.%d.%d", | ||
1384 | @$v2h{qw[major_version minor_version]} = | ||
1385 | unpack 'c2', $bytes; | ||
1386 | |||
1387 | # get flags | ||
1388 | read $fh, $bytes, 1; | ||
1389 | my @bits = split //, unpack 'b8', $bytes; | ||
1390 | if ($v2h->{major_version} == 2) { | ||
1391 | $v2h->{unsync} = $bits[7]; | ||
1392 | $v2h->{compression} = $bits[8]; | ||
1393 | $v2h->{ext_header} = 0; | ||
1394 | $v2h->{experimental} = 0; | ||
1395 | } else { | ||
1396 | $v2h->{unsync} = $bits[7]; | ||
1397 | $v2h->{ext_header} = $bits[6]; | ||
1398 | $v2h->{experimental} = $bits[5]; | ||
1399 | $v2h->{footer} = $bits[4] if $v2h->{major_version} == 4; | ||
1400 | } | ||
1401 | |||
1402 | # get ID3v2 tag length from bytes 7-10 | ||
1403 | $v2h->{tag_size} = 10; # include ID3v2 header size | ||
1404 | $v2h->{tag_size} += 10 if $v2h->{footer}; | ||
1405 | read $fh, $bytes, 4; | ||
1406 | @bytes = reverse unpack 'C4', $bytes; | ||
1407 | foreach my $i (0 .. 3) { | ||
1408 | # whoaaaaaa nellllllyyyyyy! | ||
1409 | $v2h->{tag_size} += $bytes[$i] * 128 ** $i; | ||
1410 | } | ||
1411 | |||
1412 | # get extended header size | ||
1413 | $v2h->{ext_header_size} = 0; | ||
1414 | if ($v2h->{ext_header}) { | ||
1415 | read $fh, $bytes, 4; | ||
1416 | @bytes = reverse unpack 'C4', $bytes; | ||
1417 | |||
1418 | # use syncsafe bytes if using version 2.4 | ||
1419 | my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256; | ||
1420 | for my $i (0..3) { | ||
1421 | $v2h->{ext_header_size} += $bytes[$i] * $bytesize ** $i; | ||
1422 | } | ||
1423 | } | ||
1424 | |||
1425 | return $v2h; | ||
1426 | } | ||
1427 | |||
1428 | sub _find_id3_chunk { | ||
1429 | my($fh, $filetype) = @_; | ||
1430 | my($bytes, $size, $tag, $pat, $mat); | ||
1431 | |||
1432 | read $fh, $bytes, 1; | ||
1433 | if ($filetype eq 'RIF') { # WAV | ||
1434 | return 0 if $bytes ne 'F'; | ||
1435 | $pat = 'a4V'; | ||
1436 | $mat = 'id3 '; | ||
1437 | } elsif ($filetype eq 'FOR') { # AIFF | ||
1438 | return 0 if $bytes ne 'M'; | ||
1439 | $pat = 'a4N'; | ||
1440 | $mat = 'ID3 '; | ||
1441 | } | ||
1442 | seek $fh, 12, 0; # skip to the first chunk | ||
1443 | |||
1444 | while ((read $fh, $bytes, 8) == 8) { | ||
1445 | ($tag, $size) = unpack $pat, $bytes; | ||
1446 | return 1 if $tag eq $mat; | ||
1447 | seek $fh, $size, 1; | ||
1448 | } | ||
1449 | |||
1450 | return 0; | ||
1451 | } | ||
1452 | |||
1453 | sub _unpack_head { | ||
1454 | unpack('l', pack('L', unpack('N', $_[0]))); | ||
1455 | } | ||
1456 | |||
1457 | sub _grab_int_16 { | ||
1458 | my $data = shift; | ||
1459 | my $value = unpack('s',substr($$data,0,2)); | ||
1460 | $$data = substr($$data,2); | ||
1461 | return $value; | ||
1462 | } | ||
1463 | |||
1464 | sub _grab_uint_16 { | ||
1465 | my $data = shift; | ||
1466 | my $value = unpack('S',substr($$data,0,2)); | ||
1467 | $$data = substr($$data,2); | ||
1468 | return $value; | ||
1469 | } | ||
1470 | |||
1471 | sub _grab_int_32 { | ||
1472 | my $data = shift; | ||
1473 | my $value = unpack('V',substr($$data,0,4)); | ||
1474 | $$data = substr($$data,4); | ||
1475 | return $value; | ||
1476 | } | ||
1477 | |||
1478 | sub _parse_ape_tag { | ||
1479 | my ($fh, $filesize, $info) = @_; | ||
1480 | |||
1481 | my $ape_tag_id = 'APETAGEX'; | ||
1482 | |||
1483 | seek $fh, -256, 2; | ||
1484 | read($fh, my $tag, 256); | ||
1485 | my $pre_tag = substr($tag, 0, 128, ''); | ||
1486 | |||
1487 | # Try and bail early if there's no ape tag. | ||
1488 | if (substr($pre_tag, 96, 8) ne $ape_tag_id && substr($tag, 96, 8) ne $ape_tag_id) { | ||
1489 | |||
1490 | seek($fh, 0, 0); | ||
1491 | return 0; | ||
1492 | } | ||
1493 | |||
1494 | my $id3v1_tag_size = 128; | ||
1495 | my $ape_tag_header_size = 32; | ||
1496 | my $lyrics3_tag_size = 10; | ||
1497 | my $tag_offset_start = 0; | ||
1498 | my $tag_offset_end = 0; | ||
1499 | |||
1500 | seek($fh, (0 - $id3v1_tag_size - $ape_tag_header_size - $lyrics3_tag_size), 2); | ||
1501 | |||
1502 | read($fh, my $ape_footer_id3v1, $id3v1_tag_size + $ape_tag_header_size + $lyrics3_tag_size); | ||
1503 | |||
1504 | if (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $id3v1_tag_size - $ape_tag_header_size), 8) eq $ape_tag_id) { | ||
1505 | |||
1506 | $tag_offset_end = $filesize - $id3v1_tag_size; | ||
1507 | |||
1508 | } elsif (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $ape_tag_header_size), 8) eq $ape_tag_id) { | ||
1509 | |||
1510 | $tag_offset_end = $filesize; | ||
1511 | } | ||
1512 | |||
1513 | seek($fh, $tag_offset_end - $ape_tag_header_size, 0); | ||
1514 | |||
1515 | read($fh, my $ape_footer_data, 32); | ||
1516 | |||
1517 | my $ape_footer = _parse_ape_header_or_footer($ape_footer_data); | ||
1518 | |||
1519 | if (keys %{$ape_footer}) { | ||
1520 | |||
1521 | my $ape_tag_data = ''; | ||
1522 | |||
1523 | if ($ape_footer->{'flags'}->{'header'}) { | ||
1524 | |||
1525 | seek($fh, ($tag_offset_end - $ape_footer->{'tag_size'} - $ape_tag_header_size), 0); | ||
1526 | |||
1527 | $tag_offset_start = tell($fh); | ||
1528 | |||
1529 | read($fh, $ape_tag_data, $ape_footer->{'tag_size'} + $ape_tag_header_size); | ||
1530 | |||
1531 | } else { | ||
1532 | |||
1533 | $tag_offset_start = $tag_offset_end - $ape_footer->{'tag_size'}; | ||
1534 | |||
1535 | seek($fh, $tag_offset_start, 0); | ||
1536 | |||
1537 | read($fh, $ape_tag_data, $ape_footer->{'tag_size'}); | ||
1538 | } | ||
1539 | |||
1540 | my $ape_header_data = substr($ape_tag_data, 0, $ape_tag_header_size, ''); | ||
1541 | my $ape_header = _parse_ape_header_or_footer($ape_header_data); | ||
1542 | |||
1543 | for (my $c = 0; $c < $ape_header->{'tag_items'}; $c++) { | ||
1544 | |||
1545 | # Loop through the tag items | ||
1546 | my $tag_len = _grab_int_32(\$ape_tag_data); | ||
1547 | my $tag_flags = _grab_int_32(\$ape_tag_data); | ||
1548 | |||
1549 | $ape_tag_data =~ s/^(.*?)\0//; | ||
1550 | |||
1551 | my $tag_item_key = uc($1 || 'UNKNOWN'); | ||
1552 | |||
1553 | $info->{$tag_item_key} = substr($ape_tag_data, 0, $tag_len, ''); | ||
1554 | } | ||
1555 | } | ||
1556 | |||
1557 | seek($fh, 0, 0); | ||
1558 | |||
1559 | return 1; | ||
1560 | } | ||
1561 | |||
1562 | sub _parse_ape_header_or_footer { | ||
1563 | my $bytes = shift; | ||
1564 | my %data = (); | ||
1565 | |||
1566 | if (substr($bytes, 0, 8, '') eq 'APETAGEX') { | ||
1567 | |||
1568 | $data{'version'} = _grab_int_32(\$bytes); | ||
1569 | $data{'tag_size'} = _grab_int_32(\$bytes); | ||
1570 | $data{'tag_items'} = _grab_int_32(\$bytes); | ||
1571 | $data{'global_flags'} = _grab_int_32(\$bytes); | ||
1572 | |||
1573 | # trim the reseved bytes | ||
1574 | _grab_int_32(\$bytes); | ||
1575 | _grab_int_32(\$bytes); | ||
1576 | |||
1577 | $data{'flags'}->{'header'} = ($data{'global_flags'} & 0x80000000) ? 1 : 0; | ||
1578 | $data{'flags'}->{'footer'} = ($data{'global_flags'} & 0x40000000) ? 1 : 0; | ||
1579 | $data{'flags'}->{'is_header'} = ($data{'global_flags'} & 0x20000000) ? 1 : 0; | ||
1580 | } | ||
1581 | |||
1582 | return \%data; | ||
1583 | } | ||
1584 | |||
1585 | sub _close { | ||
1586 | my($file, $fh) = @_; | ||
1587 | unless (ref $file) { # filehandle not passed | ||
1588 | close $fh or carp "Problem closing '$file': $!"; | ||
1589 | } | ||
1590 | } | ||
1591 | |||
1592 | BEGIN { | ||
1593 | @mp3_genres = ( | ||
1594 | 'Blues', | ||
1595 | 'Classic Rock', | ||
1596 | 'Country', | ||
1597 | 'Dance', | ||
1598 | 'Disco', | ||
1599 | 'Funk', | ||
1600 | 'Grunge', | ||
1601 | 'Hip-Hop', | ||
1602 | 'Jazz', | ||
1603 | 'Metal', | ||
1604 | 'New Age', | ||
1605 | 'Oldies', | ||
1606 | 'Other', | ||
1607 | 'Pop', | ||
1608 | 'R&B', | ||
1609 | 'Rap', | ||
1610 | 'Reggae', | ||
1611 | 'Rock', | ||
1612 | 'Techno', | ||
1613 | 'Industrial', | ||
1614 | 'Alternative', | ||
1615 | 'Ska', | ||
1616 | 'Death Metal', | ||
1617 | 'Pranks', | ||
1618 | 'Soundtrack', | ||
1619 | 'Euro-Techno', | ||
1620 | 'Ambient', | ||
1621 | 'Trip-Hop', | ||
1622 | 'Vocal', | ||
1623 | 'Jazz+Funk', | ||
1624 | 'Fusion', | ||
1625 | 'Trance', | ||
1626 | 'Classical', | ||
1627 | 'Instrumental', | ||
1628 | 'Acid', | ||
1629 | 'House', | ||
1630 | 'Game', | ||
1631 | 'Sound Clip', | ||
1632 | 'Gospel', | ||
1633 | 'Noise', | ||
1634 | 'AlternRock', | ||
1635 | 'Bass', | ||
1636 | 'Soul', | ||
1637 | 'Punk', | ||
1638 | 'Space', | ||
1639 | 'Meditative', | ||
1640 | 'Instrumental Pop', | ||
1641 | 'Instrumental Rock', | ||
1642 | 'Ethnic', | ||
1643 | 'Gothic', | ||
1644 | 'Darkwave', | ||
1645 | 'Techno-Industrial', | ||
1646 | 'Electronic', | ||
1647 | 'Pop-Folk', | ||
1648 | 'Eurodance', | ||
1649 | 'Dream', | ||
1650 | 'Southern Rock', | ||
1651 | 'Comedy', | ||
1652 | 'Cult', | ||
1653 | 'Gangsta', | ||
1654 | 'Top 40', | ||
1655 | 'Christian Rap', | ||
1656 | 'Pop/Funk', | ||
1657 | 'Jungle', | ||
1658 | 'Native American', | ||
1659 | 'Cabaret', | ||
1660 | 'New Wave', | ||
1661 | 'Psychadelic', | ||
1662 | 'Rave', | ||
1663 | 'Showtunes', | ||
1664 | 'Trailer', | ||
1665 | 'Lo-Fi', | ||
1666 | 'Tribal', | ||
1667 | 'Acid Punk', | ||
1668 | 'Acid Jazz', | ||
1669 | 'Polka', | ||
1670 | 'Retro', | ||
1671 | 'Musical', | ||
1672 | 'Rock & Roll', | ||
1673 | 'Hard Rock', | ||
1674 | ); | ||
1675 | |||
1676 | @winamp_genres = ( | ||
1677 | @mp3_genres, | ||
1678 | 'Folk', | ||
1679 | 'Folk-Rock', | ||
1680 | 'National Folk', | ||
1681 | 'Swing', | ||
1682 | 'Fast Fusion', | ||
1683 | 'Bebop', | ||
1684 | 'Latin', | ||
1685 | 'Revival', | ||
1686 | 'Celtic', | ||
1687 | 'Bluegrass', | ||
1688 | 'Avantgarde', | ||
1689 | 'Gothic Rock', | ||
1690 | 'Progressive Rock', | ||
1691 | 'Psychedelic Rock', | ||
1692 | 'Symphonic Rock', | ||
1693 | 'Slow Rock', | ||
1694 | 'Big Band', | ||
1695 | 'Chorus', | ||
1696 | 'Easy Listening', | ||
1697 | 'Acoustic', | ||
1698 | 'Humour', | ||
1699 | 'Speech', | ||
1700 | 'Chanson', | ||
1701 | 'Opera', | ||
1702 | 'Chamber Music', | ||
1703 | 'Sonata', | ||
1704 | 'Symphony', | ||
1705 | 'Booty Bass', | ||
1706 | 'Primus', | ||
1707 | 'Porn Groove', | ||
1708 | 'Satire', | ||
1709 | 'Slow Jam', | ||
1710 | 'Club', | ||
1711 | 'Tango', | ||
1712 | 'Samba', | ||
1713 | 'Folklore', | ||
1714 | 'Ballad', | ||
1715 | 'Power Ballad', | ||
1716 | 'Rhythmic Soul', | ||
1717 | 'Freestyle', | ||
1718 | 'Duet', | ||
1719 | 'Punk Rock', | ||
1720 | 'Drum Solo', | ||
1721 | 'Acapella', | ||
1722 | 'Euro-House', | ||
1723 | 'Dance Hall', | ||
1724 | 'Goa', | ||
1725 | 'Drum & Bass', | ||
1726 | 'Club-House', | ||
1727 | 'Hardcore', | ||
1728 | 'Terror', | ||
1729 | 'Indie', | ||
1730 | 'BritPop', | ||
1731 | 'Negerpunk', | ||
1732 | 'Polsk Punk', | ||
1733 | 'Beat', | ||
1734 | 'Christian Gangsta Rap', | ||
1735 | 'Heavy Metal', | ||
1736 | 'Black Metal', | ||
1737 | 'Crossover', | ||
1738 | 'Contemporary Christian', | ||
1739 | 'Christian Rock', | ||
1740 | 'Merengue', | ||
1741 | 'Salsa', | ||
1742 | 'Thrash Metal', | ||
1743 | 'Anime', | ||
1744 | 'JPop', | ||
1745 | 'Synthpop', | ||
1746 | ); | ||
1747 | |||
1748 | @t_bitrate = ([ | ||
1749 | [0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256], | ||
1750 | [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160], | ||
1751 | [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160] | ||
1752 | ],[ | ||
1753 | [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448], | ||
1754 | [0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384], | ||
1755 | [0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320] | ||
1756 | ]); | ||
1757 | |||
1758 | @t_sampling_freq = ( | ||
1759 | [11025, 12000, 8000], | ||
1760 | [undef, undef, undef], # reserved | ||
1761 | [22050, 24000, 16000], | ||
1762 | [44100, 48000, 32000] | ||
1763 | ); | ||
1764 | |||
1765 | @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 } | ||
1766 | map { @$_ } @t_sampling_freq; | ||
1767 | |||
1768 | @mp3_info_fields = qw( | ||
1769 | VERSION | ||
1770 | LAYER | ||
1771 | STEREO | ||
1772 | VBR | ||
1773 | BITRATE | ||
1774 | FREQUENCY | ||
1775 | SIZE | ||
1776 | OFFSET | ||
1777 | SECS | ||
1778 | MM | ||
1779 | SS | ||
1780 | MS | ||
1781 | TIME | ||
1782 | COPYRIGHT | ||
1783 | PADDING | ||
1784 | MODE | ||
1785 | FRAMES | ||
1786 | FRAME_LENGTH | ||
1787 | VBR_SCALE | ||
1788 | ); | ||
1789 | |||
1790 | %rva2_channel_types = ( | ||
1791 | 0x00 => 'OTHER', | ||
1792 | 0x01 => 'MASTER', | ||
1793 | 0x02 => 'FRONT_RIGHT', | ||
1794 | 0x03 => 'FRONT_LEFT', | ||
1795 | 0x04 => 'BACK_RIGHT', | ||
1796 | 0x05 => 'BACK_LEFT', | ||
1797 | 0x06 => 'FRONT_CENTER', | ||
1798 | 0x07 => 'BACK_CENTER', | ||
1799 | 0x08 => 'SUBWOOFER', | ||
1800 | ); | ||
1801 | |||
1802 | %v1_tag_fields = | ||
1803 | (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4); | ||
1804 | |||
1805 | @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE); | ||
1806 | |||
1807 | %v2_to_v1_names = ( | ||
1808 | # v2.2 tags | ||
1809 | 'TT2' => 'TITLE', | ||
1810 | 'TP1' => 'ARTIST', | ||
1811 | 'TAL' => 'ALBUM', | ||
1812 | 'TYE' => 'YEAR', | ||
1813 | 'COM' => 'COMMENT', | ||
1814 | 'TRK' => 'TRACKNUM', | ||
1815 | 'TCO' => 'GENRE', # not clean mapping, but ... | ||
1816 | # v2.3 tags | ||
1817 | 'TIT2' => 'TITLE', | ||
1818 | 'TPE1' => 'ARTIST', | ||
1819 | 'TALB' => 'ALBUM', | ||
1820 | 'TYER' => 'YEAR', | ||
1821 | 'COMM' => 'COMMENT', | ||
1822 | 'TRCK' => 'TRACKNUM', | ||
1823 | 'TCON' => 'GENRE', | ||
1824 | # v2.3 tags - needed for MusicBrainz | ||
1825 | 'UFID' => 'Unique file identifier', | ||
1826 | 'TXXX' => 'User defined text information frame', | ||
1827 | ); | ||
1828 | |||
1829 | %v2_tag_names = ( | ||
1830 | # v2.2 tags | ||
1831 | 'BUF' => 'Recommended buffer size', | ||
1832 | 'CNT' => 'Play counter', | ||
1833 | 'COM' => 'Comments', | ||
1834 | 'CRA' => 'Audio encryption', | ||
1835 | 'CRM' => 'Encrypted meta frame', | ||
1836 | 'ETC' => 'Event timing codes', | ||
1837 | 'EQU' => 'Equalization', | ||
1838 | 'GEO' => 'General encapsulated object', | ||
1839 | 'IPL' => 'Involved people list', | ||
1840 | 'LNK' => 'Linked information', | ||
1841 | 'MCI' => 'Music CD Identifier', | ||
1842 | 'MLL' => 'MPEG location lookup table', | ||
1843 | 'PIC' => 'Attached picture', | ||
1844 | 'POP' => 'Popularimeter', | ||
1845 | 'REV' => 'Reverb', | ||
1846 | 'RVA' => 'Relative volume adjustment', | ||
1847 | 'SLT' => 'Synchronized lyric/text', | ||
1848 | 'STC' => 'Synced tempo codes', | ||
1849 | 'TAL' => 'Album/Movie/Show title', | ||
1850 | 'TBP' => 'BPM (Beats Per Minute)', | ||
1851 | 'TCM' => 'Composer', | ||
1852 | 'TCO' => 'Content type', | ||
1853 | 'TCR' => 'Copyright message', | ||
1854 | 'TDA' => 'Date', | ||
1855 | 'TDY' => 'Playlist delay', | ||
1856 | 'TEN' => 'Encoded by', | ||
1857 | 'TFT' => 'File type', | ||
1858 | 'TIM' => 'Time', | ||
1859 | 'TKE' => 'Initial key', | ||
1860 | 'TLA' => 'Language(s)', | ||
1861 | 'TLE' => 'Length', | ||
1862 | 'TMT' => 'Media type', | ||
1863 | 'TOA' => 'Original artist(s)/performer(s)', | ||
1864 | 'TOF' => 'Original filename', | ||
1865 | 'TOL' => 'Original Lyricist(s)/text writer(s)', | ||
1866 | 'TOR' => 'Original release year', | ||
1867 | 'TOT' => 'Original album/Movie/Show title', | ||
1868 | 'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group', | ||
1869 | 'TP2' => 'Band/Orchestra/Accompaniment', | ||
1870 | 'TP3' => 'Conductor/Performer refinement', | ||
1871 | 'TP4' => 'Interpreted, remixed, or otherwise modified by', | ||
1872 | 'TPA' => 'Part of a set', | ||
1873 | 'TPB' => 'Publisher', | ||
1874 | 'TRC' => 'ISRC (International Standard Recording Code)', | ||
1875 | 'TRD' => 'Recording dates', | ||
1876 | 'TRK' => 'Track number/Position in set', | ||
1877 | 'TSI' => 'Size', | ||
1878 | 'TSS' => 'Software/hardware and settings used for encoding', | ||
1879 | 'TT1' => 'Content group description', | ||
1880 | 'TT2' => 'Title/Songname/Content description', | ||
1881 | 'TT3' => 'Subtitle/Description refinement', | ||
1882 | 'TXT' => 'Lyricist/text writer', | ||
1883 | 'TXX' => 'User defined text information frame', | ||
1884 | 'TYE' => 'Year', | ||
1885 | 'UFI' => 'Unique file identifier', | ||
1886 | 'ULT' => 'Unsychronized lyric/text transcription', | ||
1887 | 'WAF' => 'Official audio file webpage', | ||
1888 | 'WAR' => 'Official artist/performer webpage', | ||
1889 | 'WAS' => 'Official audio source webpage', | ||
1890 | 'WCM' => 'Commercial information', | ||
1891 | 'WCP' => 'Copyright/Legal information', | ||
1892 | 'WPB' => 'Publishers official webpage', | ||
1893 | 'WXX' => 'User defined URL link frame', | ||
1894 | |||
1895 | # v2.3 tags | ||
1896 | 'AENC' => 'Audio encryption', | ||
1897 | 'APIC' => 'Attached picture', | ||
1898 | 'COMM' => 'Comments', | ||
1899 | 'COMR' => 'Commercial frame', | ||
1900 | 'ENCR' => 'Encryption method registration', | ||
1901 | 'EQUA' => 'Equalization', | ||
1902 | 'ETCO' => 'Event timing codes', | ||
1903 | 'GEOB' => 'General encapsulated object', | ||
1904 | 'GRID' => 'Group identification registration', | ||
1905 | 'IPLS' => 'Involved people list', | ||
1906 | 'LINK' => 'Linked information', | ||
1907 | 'MCDI' => 'Music CD identifier', | ||
1908 | 'MLLT' => 'MPEG location lookup table', | ||
1909 | 'OWNE' => 'Ownership frame', | ||
1910 | 'PCNT' => 'Play counter', | ||
1911 | 'POPM' => 'Popularimeter', | ||
1912 | 'POSS' => 'Position synchronisation frame', | ||
1913 | 'PRIV' => 'Private frame', | ||
1914 | 'RBUF' => 'Recommended buffer size', | ||
1915 | 'RVAD' => 'Relative volume adjustment', | ||
1916 | 'RVRB' => 'Reverb', | ||
1917 | 'SYLT' => 'Synchronized lyric/text', | ||
1918 | 'SYTC' => 'Synchronized tempo codes', | ||
1919 | 'TALB' => 'Album/Movie/Show title', | ||
1920 | 'TBPM' => 'BPM (beats per minute)', | ||
1921 | 'TCOM' => 'Composer', | ||
1922 | 'TCON' => 'Content type', | ||
1923 | 'TCOP' => 'Copyright message', | ||
1924 | 'TDAT' => 'Date', | ||
1925 | 'TDLY' => 'Playlist delay', | ||
1926 | 'TENC' => 'Encoded by', | ||
1927 | 'TEXT' => 'Lyricist/Text writer', | ||
1928 | 'TFLT' => 'File type', | ||
1929 | 'TIME' => 'Time', | ||
1930 | 'TIT1' => 'Content group description', | ||
1931 | 'TIT2' => 'Title/songname/content description', | ||
1932 | 'TIT3' => 'Subtitle/Description refinement', | ||
1933 | 'TKEY' => 'Initial key', | ||
1934 | 'TLAN' => 'Language(s)', | ||
1935 | 'TLEN' => 'Length', | ||
1936 | 'TMED' => 'Media type', | ||
1937 | 'TOAL' => 'Original album/movie/show title', | ||
1938 | 'TOFN' => 'Original filename', | ||
1939 | 'TOLY' => 'Original lyricist(s)/text writer(s)', | ||
1940 | 'TOPE' => 'Original artist(s)/performer(s)', | ||
1941 | 'TORY' => 'Original release year', | ||
1942 | 'TOWN' => 'File owner/licensee', | ||
1943 | 'TPE1' => 'Lead performer(s)/Soloist(s)', | ||
1944 | 'TPE2' => 'Band/orchestra/accompaniment', | ||
1945 | 'TPE3' => 'Conductor/performer refinement', | ||
1946 | 'TPE4' => 'Interpreted, remixed, or otherwise modified by', | ||
1947 | 'TPOS' => 'Part of a set', | ||
1948 | 'TPUB' => 'Publisher', | ||
1949 | 'TRCK' => 'Track number/Position in set', | ||
1950 | 'TRDA' => 'Recording dates', | ||
1951 | 'TRSN' => 'Internet radio station name', | ||
1952 | 'TRSO' => 'Internet radio station owner', | ||
1953 | 'TSIZ' => 'Size', | ||
1954 | 'TSRC' => 'ISRC (international standard recording code)', | ||
1955 | 'TSSE' => 'Software/Hardware and settings used for encoding', | ||
1956 | 'TXXX' => 'User defined text information frame', | ||
1957 | 'TYER' => 'Year', | ||
1958 | 'UFID' => 'Unique file identifier', | ||
1959 | 'USER' => 'Terms of use', | ||
1960 | 'USLT' => 'Unsychronized lyric/text transcription', | ||
1961 | 'WCOM' => 'Commercial information', | ||
1962 | 'WCOP' => 'Copyright/Legal information', | ||
1963 | 'WOAF' => 'Official audio file webpage', | ||
1964 | 'WOAR' => 'Official artist/performer webpage', | ||
1965 | 'WOAS' => 'Official audio source webpage', | ||
1966 | 'WORS' => 'Official internet radio station homepage', | ||
1967 | 'WPAY' => 'Payment', | ||
1968 | 'WPUB' => 'Publishers official webpage', | ||
1969 | 'WXXX' => 'User defined URL link frame', | ||
1970 | |||
1971 | # v2.4 additional tags | ||
1972 | # note that we don't restrict tags from 2.3 or 2.4, | ||
1973 | 'ASPI' => 'Audio seek point index', | ||
1974 | 'EQU2' => 'Equalisation (2)', | ||
1975 | 'RVA2' => 'Relative volume adjustment (2)', | ||
1976 | 'SEEK' => 'Seek frame', | ||
1977 | 'SIGN' => 'Signature frame', | ||
1978 | 'TDEN' => 'Encoding time', | ||
1979 | 'TDOR' => 'Original release time', | ||
1980 | 'TDRC' => 'Recording time', | ||
1981 | 'TDRL' => 'Release time', | ||
1982 | 'TDTG' => 'Tagging time', | ||
1983 | 'TIPL' => 'Involved people list', | ||
1984 | 'TMCL' => 'Musician credits list', | ||
1985 | 'TMOO' => 'Mood', | ||
1986 | 'TPRO' => 'Produced notice', | ||
1987 | 'TSOA' => 'Album sort order', | ||
1988 | 'TSOP' => 'Performer sort order', | ||
1989 | 'TSOT' => 'Title sort order', | ||
1990 | 'TSST' => 'Set subtitle', | ||
1991 | |||
1992 | # grrrrrrr | ||
1993 | 'COM ' => 'Broken iTunes comments', | ||
1994 | ); | ||
1995 | } | ||
1996 | |||
1997 | 1; | ||
1998 | |||
1999 | __END__ | ||
2000 | |||
2001 | =pod | ||
2002 | |||
2003 | =back | ||
2004 | |||
2005 | =head1 TROUBLESHOOTING | ||
2006 | |||
2007 | If you find a bug, please send me a patch (see the project page in L<"SEE ALSO">). | ||
2008 | If you cannot figure out why it does not work for you, please put the MP3 file in | ||
2009 | a place where I can get it (preferably via FTP, or HTTP, or .Mac iDisk) and send me | ||
2010 | mail regarding where I can get the file, with a detailed description of the problem. | ||
2011 | |||
2012 | If I download the file, after debugging the problem I will not keep the MP3 file | ||
2013 | if it is not legal for me to have it. Just let me know if it is legal for me to | ||
2014 | keep it or not. | ||
2015 | |||
2016 | |||
2017 | =head1 TODO | ||
2018 | |||
2019 | =over 4 | ||
2020 | |||
2021 | =item ID3v2 Support | ||
2022 | |||
2023 | Still need to do more for reading tags, such as using Compress::Zlib to decompress | ||
2024 | compressed tags. But until I see this in use more, I won't bother. If something | ||
2025 | does not work properly with reading, follow the instructions above for | ||
2026 | troubleshooting. | ||
2027 | |||
2028 | ID3v2 I<writing> is coming soon. | ||
2029 | |||
2030 | =item Get data from scalar | ||
2031 | |||
2032 | Instead of passing a file spec or filehandle, pass the | ||
2033 | data itself. Would take some work, converting the seeks, etc. | ||
2034 | |||
2035 | =item Padding bit ? | ||
2036 | |||
2037 | Do something with padding bit. | ||
2038 | |||
2039 | =item Test suite | ||
2040 | |||
2041 | Test suite could use a bit of an overhaul and update. Patches very welcome. | ||
2042 | |||
2043 | =over 4 | ||
2044 | |||
2045 | =item * | ||
2046 | |||
2047 | Revamp getset.t. Test all the various get_mp3tag args. | ||
2048 | |||
2049 | =item * | ||
2050 | |||
2051 | Test Unicode. | ||
2052 | |||
2053 | =item * | ||
2054 | |||
2055 | Test OOP API. | ||
2056 | |||
2057 | =item * | ||
2058 | |||
2059 | Test error handling, check more for missing files, bad MP3s, etc. | ||
2060 | |||
2061 | =back | ||
2062 | |||
2063 | =item Other VBR | ||
2064 | |||
2065 | Right now, only Xing VBR is supported. | ||
2066 | |||
2067 | =back | ||
2068 | |||
2069 | |||
2070 | =head1 THANKS | ||
2071 | |||
2072 | Edward Allen, | ||
2073 | Vittorio Bertola, | ||
2074 | Michael Blakeley, | ||
2075 | Per Bolmstedt, | ||
2076 | Tony Bowden, | ||
2077 | Tom Brown, | ||
2078 | Sergio Camarena, | ||
2079 | Chris Dawson, | ||
2080 | Anthony DiSante, | ||
2081 | Luke Drumm, | ||
2082 | Kyle Farrell, | ||
2083 | Jeffrey Friedl, | ||
2084 | brian d foy, | ||
2085 | Ben Gertzfield, | ||
2086 | Brian Goodwin, | ||
2087 | Todd Hanneken, | ||
2088 | Todd Harris, | ||
2089 | Woodrow Hill, | ||
2090 | Kee Hinckley, | ||
2091 | Roman Hodek, | ||
2092 | Ilya Konstantinov, | ||
2093 | Peter Kovacs, | ||
2094 | Johann Lindvall, | ||
2095 | Alex Marandon, | ||
2096 | Peter Marschall, | ||
2097 | michael, | ||
2098 | Trond Michelsen, | ||
2099 | Dave O'Neill, | ||
2100 | Christoph Oberauer, | ||
2101 | Jake Palmer, | ||
2102 | Andrew Phillips, | ||
2103 | David Reuteler, | ||
2104 | John Ruttenberg, | ||
2105 | Matthew Sachs, | ||
2106 | scfc_de, | ||
2107 | Hermann Schwaerzler, | ||
2108 | Chris Sidi, | ||
2109 | Roland Steinbach, | ||
2110 | Brian S. Stephan, | ||
2111 | Stuart, | ||
2112 | Dan Sully, | ||
2113 | Jeffery Sumler, | ||
2114 | Predrag Supurovic, | ||
2115 | Bogdan Surdu, | ||
2116 | Pierre-Yves Thoulon, | ||
2117 | tim, | ||
2118 | Pass F. B. Travis, | ||
2119 | Tobias Wagener, | ||
2120 | Ronan Waide, | ||
2121 | Andy Waite, | ||
2122 | Ken Williams, | ||
2123 | Ben Winslow, | ||
2124 | Meng Weng Wong. | ||
2125 | |||
2126 | |||
2127 | =head1 CURRENT AUTHOR | ||
2128 | |||
2129 | Dan Sully E<lt>dan | at | slimdevices.comE<gt> & Slim Devices, Inc. | ||
2130 | |||
2131 | =head1 AUTHOR EMERITUS | ||
2132 | |||
2133 | Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/ | ||
2134 | |||
2135 | =head1 COPYRIGHT AND LICENSE | ||
2136 | |||
2137 | Copyright (c) 2006 Dan Sully & Slim Devices, Inc. All rights reserved. | ||
2138 | |||
2139 | Copyright (c) 1998-2005 Chris Nandor. All rights reserved. | ||
2140 | |||
2141 | This program is free software; you can redistribute it and/or modify it under | ||
2142 | the same terms as Perl itself. | ||
2143 | |||
2144 | =head1 SEE ALSO | ||
2145 | |||
2146 | =over 4 | ||
2147 | |||
2148 | =item Slim Devices | ||
2149 | |||
2150 | http://www.slimdevices.com/ | ||
2151 | |||
2152 | =item mp3tools | ||
2153 | |||
2154 | http://www.zevils.com/linux/mp3tools/ | ||
2155 | |||
2156 | =item mpgtools | ||
2157 | |||
2158 | http://www.dv.co.yu/mpgscript/mpgtools.htm | ||
2159 | http://www.dv.co.yu/mpgscript/mpeghdr.htm | ||
2160 | |||
2161 | =item mp3tool | ||
2162 | |||
2163 | http://www.dtek.chalmers.se/~d2linjo/mp3/mp3tool.html | ||
2164 | |||
2165 | =item ID3v2 | ||
2166 | |||
2167 | http://www.id3.org/ | ||
2168 | |||
2169 | =item Xing Variable Bitrate | ||
2170 | |||
2171 | http://www.xingtech.com/support/partner_developer/mp3/vbr_sdk/ | ||
2172 | |||
2173 | =item MP3Ext | ||
2174 | |||
2175 | http://rupert.informatik.uni-stuttgart.de/~mutschml/MP3ext/ | ||
2176 | |||
2177 | =item Xmms | ||
2178 | |||
2179 | http://www.xmms.org/ | ||
2180 | |||
2181 | |||
2182 | =back | ||
2183 | |||
2184 | =cut | ||
diff --git a/tools/songdb.pl b/tools/songdb.pl new file mode 100755 index 0000000000..cba30492da --- /dev/null +++ b/tools/songdb.pl | |||
@@ -0,0 +1,448 @@ | |||
1 | #!/usr/bin/perl | ||
2 | # | ||
3 | # Rockbox song database docs: | ||
4 | # http://www.rockbox.org/twiki/bin/view/Main/TagCache | ||
5 | # | ||
6 | |||
7 | use mp3info; | ||
8 | use vorbiscomm; | ||
9 | |||
10 | # configuration settings | ||
11 | my $db = "tagcache"; | ||
12 | my $dir; | ||
13 | my $strip; | ||
14 | my $add; | ||
15 | my $verbose; | ||
16 | my $help; | ||
17 | my $dirisalbum; | ||
18 | my $littleendian = 0; | ||
19 | my $dbver = 0x54434804; | ||
20 | |||
21 | # file data | ||
22 | my %entries; | ||
23 | |||
24 | while($ARGV[0]) { | ||
25 | if($ARGV[0] eq "--path") { | ||
26 | $dir = $ARGV[1]; | ||
27 | shift @ARGV; | ||
28 | shift @ARGV; | ||
29 | } | ||
30 | elsif($ARGV[0] eq "--db") { | ||
31 | $db = $ARGV[1]; | ||
32 | shift @ARGV; | ||
33 | shift @ARGV; | ||
34 | } | ||
35 | elsif($ARGV[0] eq "--strip") { | ||
36 | $strip = $ARGV[1]; | ||
37 | shift @ARGV; | ||
38 | shift @ARGV; | ||
39 | } | ||
40 | elsif($ARGV[0] eq "--add") { | ||
41 | $add = $ARGV[1]; | ||
42 | shift @ARGV; | ||
43 | shift @ARGV; | ||
44 | } | ||
45 | elsif($ARGV[0] eq "--dirisalbum") { | ||
46 | $dirisalbum = 1; | ||
47 | shift @ARGV; | ||
48 | } | ||
49 | elsif($ARGV[0] eq "--littleendian") { | ||
50 | $littleendian = 1; | ||
51 | shift @ARGV; | ||
52 | } | ||
53 | elsif($ARGV[0] eq "--verbose") { | ||
54 | $verbose = 1; | ||
55 | shift @ARGV; | ||
56 | } | ||
57 | elsif($ARGV[0] eq "--help" or ($ARGV[0] eq "-h")) { | ||
58 | $help = 1; | ||
59 | shift @ARGV; | ||
60 | } | ||
61 | else { | ||
62 | shift @ARGV; | ||
63 | } | ||
64 | } | ||
65 | |||
66 | if(! -d $dir or $help) { | ||
67 | print "'$dir' is not a directory\n" if ($dir ne "" and ! -d $dir); | ||
68 | print <<MOO | ||
69 | |||
70 | songdb --path <dir> [--db <file>] [--strip <path>] [--add <path>] [--dirisalbum] [--littleendian] [--verbose] [--help] | ||
71 | |||
72 | Options: | ||
73 | |||
74 | --path <dir> Where your music collection is found | ||
75 | --db <file> Prefix for output files. Defaults to tagcache. | ||
76 | --strip <path> Removes this string from the left of all file names | ||
77 | --add <path> Adds this string to the left of all file names | ||
78 | --dirisalbum Use dir name as album name if the album name is missing in the | ||
79 | tags | ||
80 | --littleendian Write out data as little endian (for simulator) | ||
81 | --verbose Shows more details while working | ||
82 | --help This text | ||
83 | MOO | ||
84 | ; | ||
85 | exit; | ||
86 | } | ||
87 | |||
88 | sub get_oggtag { | ||
89 | my $fn = shift; | ||
90 | my %hash; | ||
91 | |||
92 | my $ogg = vorbiscomm->new($fn); | ||
93 | |||
94 | my $h= $ogg->load; | ||
95 | |||
96 | # Convert this format into the same format used by the id3 parser hash | ||
97 | |||
98 | foreach my $k ($ogg->comment_tags()) | ||
99 | { | ||
100 | foreach my $cmmt ($ogg->comment($k)) | ||
101 | { | ||
102 | my $n; | ||
103 | if($k =~ /^artist$/i) { | ||
104 | $n = 'ARTIST'; | ||
105 | } | ||
106 | elsif($k =~ /^album$/i) { | ||
107 | $n = 'ALBUM'; | ||
108 | } | ||
109 | elsif($k =~ /^title$/i) { | ||
110 | $n = 'TITLE'; | ||
111 | } | ||
112 | $hash{$n}=$cmmt if($n); | ||
113 | } | ||
114 | } | ||
115 | |||
116 | return \%hash; | ||
117 | } | ||
118 | |||
119 | sub get_ogginfo { | ||
120 | my $fn = shift; | ||
121 | my %hash; | ||
122 | |||
123 | my $ogg = vorbiscomm->new($fn); | ||
124 | |||
125 | my $h= $ogg->load; | ||
126 | |||
127 | return $ogg->{'INFO'}; | ||
128 | } | ||
129 | |||
130 | # return ALL directory entries in the given dir | ||
131 | sub getdir { | ||
132 | my ($dir) = @_; | ||
133 | |||
134 | $dir =~ s|/$|| if ($dir ne "/"); | ||
135 | |||
136 | if (opendir(DIR, $dir)) { | ||
137 | my @all = readdir(DIR); | ||
138 | closedir DIR; | ||
139 | return @all; | ||
140 | } | ||
141 | else { | ||
142 | warn "can't opendir $dir: $!\n"; | ||
143 | } | ||
144 | } | ||
145 | |||
146 | sub extractmp3 { | ||
147 | my ($dir, @files) = @_; | ||
148 | my @mp3; | ||
149 | for(@files) { | ||
150 | if( (/\.mp[23]$/i || /\.ogg$/i) && -f "$dir/$_" ) { | ||
151 | push @mp3, $_; | ||
152 | } | ||
153 | } | ||
154 | return @mp3; | ||
155 | } | ||
156 | |||
157 | sub extractdirs { | ||
158 | my ($dir, @files) = @_; | ||
159 | $dir =~ s|/$||; | ||
160 | my @dirs; | ||
161 | for(@files) { | ||
162 | if( -d "$dir/$_" && ($_ !~ /^\.(|\.)$/)) { | ||
163 | push @dirs, $_; | ||
164 | } | ||
165 | } | ||
166 | return @dirs; | ||
167 | } | ||
168 | |||
169 | sub singlefile { | ||
170 | my ($file) = @_; | ||
171 | my $hash; | ||
172 | my $info; | ||
173 | |||
174 | if($file =~ /\.ogg$/i) { | ||
175 | $hash = get_oggtag($file); | ||
176 | $info = get_ogginfo($file); | ||
177 | } | ||
178 | else { | ||
179 | $hash = get_mp3tag($file); | ||
180 | $info = get_mp3info($file); | ||
181 | if (defined $$info{'BITRATE'}) { | ||
182 | $$hash{'BITRATE'} = $$info{'BITRATE'}; | ||
183 | } | ||
184 | |||
185 | if (defined $$info{'SECS'}) { | ||
186 | $$hash{'SECS'} = $$info{'SECS'}; | ||
187 | } | ||
188 | } | ||
189 | |||
190 | return $hash; | ||
191 | } | ||
192 | |||
193 | sub dodir { | ||
194 | my ($dir)=@_; | ||
195 | |||
196 | my %lcartists; | ||
197 | my %lcalbums; | ||
198 | |||
199 | print "$dir\n"; | ||
200 | |||
201 | # getdir() returns all entries in the given dir | ||
202 | my @a = getdir($dir); | ||
203 | |||
204 | # extractmp3 filters out only the mp3 files from all given entries | ||
205 | my @m = extractmp3($dir, @a); | ||
206 | |||
207 | my $f; | ||
208 | |||
209 | for $f (sort @m) { | ||
210 | |||
211 | my $id3 = singlefile("$dir/$f"); | ||
212 | |||
213 | if (not defined $$id3{'ARTIST'} or $$id3{'ARTIST'} eq "") { | ||
214 | $$id3{'ARTIST'} = "<Untagged>"; | ||
215 | } | ||
216 | |||
217 | # Only use one case-variation of each artist | ||
218 | if (exists($lcartists{lc($$id3{'ARTIST'})})) { | ||
219 | $$id3{'ARTIST'} = $lcartists{lc($$id3{'ARTIST'})}; | ||
220 | } | ||
221 | else { | ||
222 | $lcartists{lc($$id3{'ARTIST'})} = $$id3{'ARTIST'}; | ||
223 | } | ||
224 | #printf "Artist: %s\n", $$id3{'ARTIST'}; | ||
225 | |||
226 | if (not defined $$id3{'ALBUM'} or $$id3{'ALBUM'} eq "") { | ||
227 | $$id3{'ALBUM'} = "<Untagged>"; | ||
228 | if ($dirisalbum) { | ||
229 | $$id3{'ALBUM'} = $dir; | ||
230 | } | ||
231 | } | ||
232 | |||
233 | # Only use one case-variation of each album | ||
234 | if (exists($lcalbums{lc($$id3{'ALBUM'})})) { | ||
235 | $$id3{'ALBUM'} = $lcalbums{lc($$id3{'ALBUM'})}; | ||
236 | } | ||
237 | else { | ||
238 | $lcalbums{lc($$id3{'ALBUM'})} = $$id3{'ALBUM'}; | ||
239 | } | ||
240 | #printf "Album: %s\n", $$id3{'ALBUM'}; | ||
241 | |||
242 | if (not defined $$id3{'GENRE'} or $$id3{'GENRE'} eq "") { | ||
243 | $$id3{'GENRE'} = "<Untagged>"; | ||
244 | } | ||
245 | #printf "Genre: %s\n", $$id3{'GENRE'}; | ||
246 | |||
247 | if (not defined $$id3{'TITLE'} or $$id3{'TITLE'} eq "") { | ||
248 | # fall back on basename of the file if no title tag. | ||
249 | ($$id3{'TITLE'} = $f) =~ s/\.\w+$//; | ||
250 | } | ||
251 | #printf "Title: %s\n", $$id3{'TITLE'}; | ||
252 | |||
253 | my $path = "$dir/$f"; | ||
254 | if ($strip ne "" and $path =~ /^$strip(.*)/) { | ||
255 | $path = $1; | ||
256 | } | ||
257 | |||
258 | if ($add ne "") { | ||
259 | $path = $add . $path; | ||
260 | } | ||
261 | #printf "Path: %s\n", $path; | ||
262 | |||
263 | if (not defined $$id3{'COMPOSER'} or $$id3{'COMPOSER'} eq "") { | ||
264 | $$id3{'COMPOSER'} = "<Untagged>"; | ||
265 | } | ||
266 | #printf "Composer: %s\n", $$id3{'COMPOSER'}; | ||
267 | |||
268 | if (not defined $$id3{'YEAR'} or $$id3{'YEAR'} eq "") { | ||
269 | $$id3{'YEAR'} = "-1"; | ||
270 | } | ||
271 | #printf "Year: %s\n", $$id3{'YEAR'}; | ||
272 | |||
273 | if (not defined $$id3{'TRACKNUM'} or $$id3{'TRACKNUM'} eq "") { | ||
274 | $$id3{'TRACKNUM'} = "-1"; | ||
275 | } | ||
276 | #printf "Track num: %s\n", $$id3{'TRACKNUM'}; | ||
277 | |||
278 | if (not defined $$id3{'BITRATE'} or $$id3{'BITRATE'} eq "") { | ||
279 | $$id3{'BITRATE'} = "-1"; | ||
280 | } | ||
281 | #printf "Bitrate: %s\n", $$id3{'BITRATE'}; | ||
282 | |||
283 | if (not defined $$id3{'SECS'} or $$id3{'SECS'} eq "") { | ||
284 | $$id3{'SECS'} = "-1"; | ||
285 | } | ||
286 | #printf "Length: %s\n", $$id3{'SECS'}; | ||
287 | |||
288 | $$id3{'PATH'} = $path; | ||
289 | $entries{$path} = $id3; | ||
290 | } | ||
291 | |||
292 | # extractdirs filters out only subdirectories from all given entries | ||
293 | my @d = extractdirs($dir, @a); | ||
294 | my $d; | ||
295 | |||
296 | for $d (sort @d) { | ||
297 | $dir =~ s|/$||; | ||
298 | dodir("$dir/$d"); | ||
299 | } | ||
300 | } | ||
301 | |||
302 | use_mp3_utf8(1); | ||
303 | dodir($dir); | ||
304 | print "\n"; | ||
305 | |||
306 | sub dumpshort { | ||
307 | my ($num)=@_; | ||
308 | |||
309 | # print "int: $num\n"; | ||
310 | |||
311 | if ($littleendian) { | ||
312 | print DB pack "v", $num; | ||
313 | } | ||
314 | else { | ||
315 | print DB pack "n", $num; | ||
316 | } | ||
317 | } | ||
318 | |||
319 | sub dumpint { | ||
320 | my ($num)=@_; | ||
321 | |||
322 | # print "int: $num\n"; | ||
323 | |||
324 | if ($littleendian) { | ||
325 | print DB pack "V", $num; | ||
326 | } | ||
327 | else { | ||
328 | print DB pack "N", $num; | ||
329 | } | ||
330 | } | ||
331 | |||
332 | sub dump_tag_string { | ||
333 | my ($s, $index) = @_; | ||
334 | |||
335 | my $strlen = length($s)+1; | ||
336 | my $padding = $strlen%4; | ||
337 | if ($padding > 0) { | ||
338 | $padding = 4 - $padding; | ||
339 | $strlen += $padding; | ||
340 | } | ||
341 | |||
342 | dumpshort($strlen); | ||
343 | dumpshort($index); | ||
344 | print DB $s."\0"; | ||
345 | |||
346 | for (my $i = 0; $i < $padding; $i++) { | ||
347 | print DB "X"; | ||
348 | } | ||
349 | } | ||
350 | |||
351 | sub dump_tag_header { | ||
352 | my ($entry_count) = @_; | ||
353 | |||
354 | my $size = tell(DB) - 12; | ||
355 | seek(DB, 0, 0); | ||
356 | |||
357 | dumpint($dbver); | ||
358 | dumpint($size); | ||
359 | dumpint($entry_count); | ||
360 | } | ||
361 | |||
362 | sub openfile { | ||
363 | my ($f) = @_; | ||
364 | open(DB, "> $f") || die "couldn't open $f"; | ||
365 | binmode(DB); | ||
366 | } | ||
367 | |||
368 | sub create_tagcache_index_file { | ||
369 | my ($index, $key, $unique) = @_; | ||
370 | |||
371 | my $num = 0; | ||
372 | my $prev = ""; | ||
373 | my $offset = 12; | ||
374 | |||
375 | openfile $db ."_".$index.".tcd"; | ||
376 | dump_tag_header(0); | ||
377 | |||
378 | for(sort {uc($entries{$a}->{$key}) cmp uc($entries{$b}->{$key})} keys %entries) { | ||
379 | if (!$unique || !($entries{$_}->{$key} eq $prev)) { | ||
380 | my $index; | ||
381 | |||
382 | $num++; | ||
383 | $prev = $entries{$_}->{$key}; | ||
384 | $offset = tell(DB); | ||
385 | printf(" %s\n", $prev) if ($verbose); | ||
386 | |||
387 | if ($unique) { | ||
388 | $index = 0xFFFF; | ||
389 | } | ||
390 | else { | ||
391 | $index = $entries{$_}->{'INDEX'}; | ||
392 | } | ||
393 | dump_tag_string($prev, $index); | ||
394 | } | ||
395 | $entries{$_}->{$key."_OFFSET"} = $offset; | ||
396 | } | ||
397 | |||
398 | dump_tag_header($num); | ||
399 | close(DB); | ||
400 | } | ||
401 | |||
402 | if (!scalar keys %entries) { | ||
403 | print "No songs found. Did you specify the right --path ?\n"; | ||
404 | print "Use the --help parameter to see all options.\n"; | ||
405 | exit; | ||
406 | } | ||
407 | |||
408 | my $i = 0; | ||
409 | for (sort keys %entries) { | ||
410 | $entries{$_}->{'INDEX'} = $i; | ||
411 | $i++; | ||
412 | } | ||
413 | |||
414 | if ($db) { | ||
415 | # Artists | ||
416 | create_tagcache_index_file(0, 'ARTIST', 1); | ||
417 | # Albums | ||
418 | create_tagcache_index_file(1, 'ALBUM', 1); | ||
419 | # Genres | ||
420 | create_tagcache_index_file(2, 'GENRE', 1); | ||
421 | # Titles | ||
422 | create_tagcache_index_file(3, 'TITLE', 0); | ||
423 | # Filenames | ||
424 | create_tagcache_index_file(4, 'PATH', 0); | ||
425 | # Composers | ||
426 | create_tagcache_index_file(5, 'COMPOSER', 1); | ||
427 | |||
428 | # Master index file | ||
429 | openfile $db ."_idx.tcd"; | ||
430 | dump_tag_header(0); | ||
431 | |||
432 | for (sort keys %entries) { | ||
433 | dumpint($entries{$_}->{'ARTIST_OFFSET'}); | ||
434 | dumpint($entries{$_}->{'ALBUM_OFFSET'}); | ||
435 | dumpint($entries{$_}->{'GENRE_OFFSET'}); | ||
436 | dumpint($entries{$_}->{'TITLE_OFFSET'}); | ||
437 | dumpint($entries{$_}->{'PATH_OFFSET'}); | ||
438 | dumpint($entries{$_}->{'COMPOSER_OFFSET'}); | ||
439 | dumpint($entries{$_}->{'YEAR'}); | ||
440 | dumpint($entries{$_}->{'TRACKNUM'}); | ||
441 | dumpint($entries{$_}->{'BITRATE'}); | ||
442 | dumpint($entries{$_}->{'SECS'}); | ||
443 | dumpint(0); | ||
444 | } | ||
445 | |||
446 | dump_tag_header(scalar keys %entries); | ||
447 | close(DB); | ||
448 | } | ||
diff --git a/tools/vorbiscomm.pm b/tools/vorbiscomm.pm new file mode 100644 index 0000000000..f2e48e8632 --- /dev/null +++ b/tools/vorbiscomm.pm | |||
@@ -0,0 +1,732 @@ | |||
1 | ############################################################################# | ||
2 | # This is | ||
3 | # http://search.cpan.org/~amolloy/Ogg-Vorbis-Header-PurePerl-0.07/PurePerl.pm | ||
4 | # written by Andrew Molloy | ||
5 | # Code under GNU GENERAL PUBLIC LICENCE v2 | ||
6 | # $Id$ | ||
7 | ############################################################################# | ||
8 | |||
9 | package vorbiscomm; | ||
10 | |||
11 | use 5.005; | ||
12 | use strict; | ||
13 | use warnings; | ||
14 | |||
15 | use Fcntl qw/SEEK_END/; | ||
16 | |||
17 | our $VERSION = '0.07'; | ||
18 | |||
19 | sub new | ||
20 | { | ||
21 | my $class = shift; | ||
22 | my $file = shift; | ||
23 | |||
24 | return load($class, $file); | ||
25 | } | ||
26 | |||
27 | sub load | ||
28 | { | ||
29 | my $class = shift; | ||
30 | my $file = shift; | ||
31 | my $from_new = shift; | ||
32 | my %data; | ||
33 | my $self; | ||
34 | |||
35 | # there must be a better way... | ||
36 | if ($class eq 'vorbiscomm') | ||
37 | { | ||
38 | $self = bless \%data, $class; | ||
39 | } | ||
40 | else | ||
41 | { | ||
42 | $self = $class; | ||
43 | } | ||
44 | |||
45 | if ($self->{'FILE_LOADED'}) | ||
46 | { | ||
47 | return $self; | ||
48 | } | ||
49 | |||
50 | $self->{'FILE_LOADED'} = 1; | ||
51 | |||
52 | # check that the file exists and is readable | ||
53 | unless ( -e $file && -r _ ) | ||
54 | { | ||
55 | warn "File does not exist or cannot be read."; | ||
56 | # file does not exist, can't do anything | ||
57 | return undef; | ||
58 | } | ||
59 | # open up the file | ||
60 | open FILE, $file; | ||
61 | # make sure dos-type systems can handle it... | ||
62 | binmode FILE; | ||
63 | |||
64 | $data{'filename'} = $file; | ||
65 | $data{'fileHandle'} = \*FILE; | ||
66 | |||
67 | if (_init(\%data)) { | ||
68 | _loadInfo(\%data); | ||
69 | _loadComments(\%data); | ||
70 | _calculateTrackLength(\%data); | ||
71 | } | ||
72 | |||
73 | close FILE; | ||
74 | |||
75 | return $self; | ||
76 | } | ||
77 | |||
78 | sub info | ||
79 | { | ||
80 | my $self = shift; | ||
81 | my $key = shift; | ||
82 | |||
83 | # if the user did not supply a key, return the entire hash | ||
84 | unless ($key) | ||
85 | { | ||
86 | return $self->{'INFO'}; | ||
87 | } | ||
88 | |||
89 | # otherwise, return the value for the given key | ||
90 | return $self->{'INFO'}{lc $key}; | ||
91 | } | ||
92 | |||
93 | sub comment_tags | ||
94 | { | ||
95 | my $self = shift; | ||
96 | |||
97 | if ( $self && $self->{'COMMENT_KEYS'} ) { | ||
98 | return @{$self->{'COMMENT_KEYS'}}; | ||
99 | } | ||
100 | |||
101 | return undef; | ||
102 | } | ||
103 | |||
104 | sub comment | ||
105 | { | ||
106 | my $self = shift; | ||
107 | my $key = shift; | ||
108 | |||
109 | # if the user supplied key does not exist, return undef | ||
110 | unless($self->{'COMMENTS'}{lc $key}) | ||
111 | { | ||
112 | return undef; | ||
113 | } | ||
114 | |||
115 | return @{$self->{'COMMENTS'}{lc $key}}; | ||
116 | } | ||
117 | |||
118 | sub add_comments | ||
119 | { | ||
120 | warn "Ogg::Vorbis::Header::PurePerl add_comments() unimplemented."; | ||
121 | } | ||
122 | |||
123 | sub edit_comment | ||
124 | { | ||
125 | warn "Ogg::Vorbis::Header::PurePerl edit_comment() unimplemented."; | ||
126 | } | ||
127 | |||
128 | sub delete_comment | ||
129 | { | ||
130 | warn "Ogg::Vorbis::Header::PurePerl delete_comment() unimplemented."; | ||
131 | } | ||
132 | |||
133 | sub clear_comments | ||
134 | { | ||
135 | warn "Ogg::Vorbis::Header::PurePerl clear_comments() unimplemented."; | ||
136 | } | ||
137 | |||
138 | sub path | ||
139 | { | ||
140 | my $self = shift; | ||
141 | |||
142 | return $self->{'fileName'}; | ||
143 | } | ||
144 | |||
145 | sub write_vorbis | ||
146 | { | ||
147 | warn "Ogg::Vorbis::Header::PurePerl write_vorbis unimplemented."; | ||
148 | } | ||
149 | |||
150 | # "private" methods | ||
151 | |||
152 | sub _init | ||
153 | { | ||
154 | my $data = shift; | ||
155 | my $fh = $data->{'fileHandle'}; | ||
156 | my $byteCount = 0; | ||
157 | |||
158 | # check the header to make sure this is actually an Ogg-Vorbis file | ||
159 | $byteCount = _checkHeader($data); | ||
160 | |||
161 | unless($byteCount) | ||
162 | { | ||
163 | # if it's not, we can't do anything | ||
164 | return undef; | ||
165 | } | ||
166 | |||
167 | $data->{'startInfoHeader'} = $byteCount; | ||
168 | return 1; # Success | ||
169 | } | ||
170 | |||
171 | sub _checkHeader | ||
172 | { | ||
173 | my $data = shift; | ||
174 | my $fh = $data->{'fileHandle'}; | ||
175 | my $buffer; | ||
176 | my $pageSegCount; | ||
177 | my $byteCount = 0; # stores how far into the file we've read, | ||
178 | # so later reads into the file can skip right | ||
179 | # past all of the header stuff | ||
180 | |||
181 | # check that the first four bytes are 'OggS' | ||
182 | read($fh, $buffer, 4); | ||
183 | if ($buffer ne 'OggS') | ||
184 | { | ||
185 | warn "This is not an Ogg bitstream (no OggS header)."; | ||
186 | return undef; | ||
187 | } | ||
188 | $byteCount += 4; | ||
189 | |||
190 | # check the stream structure version (1 byte, should be 0x00) | ||
191 | read($fh, $buffer, 1); | ||
192 | if (ord($buffer) != 0x00) | ||
193 | { | ||
194 | warn "This is not an Ogg bitstream (invalid structure version)."; | ||
195 | return undef; | ||
196 | } | ||
197 | $byteCount += 1; | ||
198 | |||
199 | # check the header type flag | ||
200 | # This is a bitfield, so technically we should check all of the bits | ||
201 | # that could potentially be set. However, the only value this should | ||
202 | # possibly have at the beginning of a proper Ogg-Vorbis file is 0x02, | ||
203 | # so we just check for that. If it's not that, we go on anyway, but | ||
204 | # give a warning (this behavior may (should?) be modified in the future. | ||
205 | read($fh, $buffer, 1); | ||
206 | if (ord($buffer) != 0x02) | ||
207 | { | ||
208 | warn "Invalid header type flag (trying to go ahead anyway)."; | ||
209 | } | ||
210 | $byteCount += 1; | ||
211 | |||
212 | # skip to the page_segments count | ||
213 | read($fh, $buffer, 20); | ||
214 | $byteCount += 20; | ||
215 | # we do nothing with this data | ||
216 | |||
217 | # read the number of page segments | ||
218 | read($fh, $buffer, 1); | ||
219 | $pageSegCount = ord($buffer); | ||
220 | $byteCount += 1; | ||
221 | |||
222 | # read $pageSegCount bytes, then throw 'em out | ||
223 | read($fh, $buffer, $pageSegCount); | ||
224 | $byteCount += $pageSegCount; | ||
225 | |||
226 | # check packet type. Should be 0x01 (for indentification header) | ||
227 | read($fh, $buffer, 1); | ||
228 | if (ord($buffer) != 0x01) | ||
229 | { | ||
230 | warn "Wrong vorbis header type, giving up."; | ||
231 | return undef; | ||
232 | } | ||
233 | $byteCount += 1; | ||
234 | |||
235 | # check that the packet identifies itself as 'vorbis' | ||
236 | read($fh, $buffer, 6); | ||
237 | if ($buffer ne 'vorbis') | ||
238 | { | ||
239 | warn "This does not appear to be a vorbis stream, giving up."; | ||
240 | return undef; | ||
241 | } | ||
242 | $byteCount += 6; | ||
243 | |||
244 | # at this point, we assume the bitstream is valid | ||
245 | return $byteCount; | ||
246 | } | ||
247 | |||
248 | sub _loadInfo | ||
249 | { | ||
250 | my $data = shift; | ||
251 | my $start = $data->{'startInfoHeader'}; | ||
252 | my $fh = $data->{'fileHandle'}; | ||
253 | my $buffer; | ||
254 | my $byteCount = $start; | ||
255 | my %info; | ||
256 | |||
257 | seek $fh, $start, 0; | ||
258 | |||
259 | # read the vorbis version | ||
260 | read($fh, $buffer, 4); | ||
261 | $info{'version'} = _decodeInt($buffer); | ||
262 | $byteCount += 4; | ||
263 | |||
264 | # read the number of audio channels | ||
265 | read($fh, $buffer, 1); | ||
266 | $info{'channels'} = ord($buffer); | ||
267 | $byteCount += 1; | ||
268 | |||
269 | # read the sample rate | ||
270 | read($fh, $buffer, 4); | ||
271 | $info{'rate'} = _decodeInt($buffer); | ||
272 | $byteCount += 4; | ||
273 | |||
274 | # read the bitrate maximum | ||
275 | read($fh, $buffer, 4); | ||
276 | $info{'bitrate_upper'} = _decodeInt($buffer); | ||
277 | $byteCount += 4; | ||
278 | |||
279 | # read the bitrate nominal | ||
280 | read($fh, $buffer, 4); | ||
281 | $info{'bitrate_nominal'} = _decodeInt($buffer); | ||
282 | $byteCount += 4; | ||
283 | |||
284 | # read the bitrate minimal | ||
285 | read($fh, $buffer, 4); | ||
286 | $info{'bitrate_lower'} = _decodeInt($buffer); | ||
287 | $byteCount += 4; | ||
288 | |||
289 | # read the blocksize_0 and blocksize_1 | ||
290 | read($fh, $buffer, 1); | ||
291 | # these are each 4 bit fields, whose actual value is 2 to the power | ||
292 | # of the value of the field | ||
293 | $info{'blocksize_0'} = 2 << ((ord($buffer) & 0xF0) >> 4); | ||
294 | $info{'blocksize_1'} = 2 << (ord($buffer) & 0x0F); | ||
295 | $byteCount += 1; | ||
296 | |||
297 | # read the framing_flag | ||
298 | read($fh, $buffer, 1); | ||
299 | $info{'framing_flag'} = ord($buffer); | ||
300 | $byteCount += 1; | ||
301 | |||
302 | # bitrate_window is -1 in the current version of vorbisfile | ||
303 | $info{'bitrate_window'} = -1; | ||
304 | |||
305 | $data->{'startCommentHeader'} = $byteCount; | ||
306 | |||
307 | $data->{'INFO'} = \%info; | ||
308 | } | ||
309 | |||
310 | sub _loadComments | ||
311 | { | ||
312 | my $data = shift; | ||
313 | my $fh = $data->{'fileHandle'}; | ||
314 | my $start = $data->{'startCommentHeader'}; | ||
315 | my $buffer; | ||
316 | my $page_segments; | ||
317 | my $vendor_length; | ||
318 | my $user_comment_count; | ||
319 | my $byteCount = $start; | ||
320 | my %comments; | ||
321 | |||
322 | seek $fh, $start, 0; | ||
323 | |||
324 | # check that the first four bytes are 'OggS' | ||
325 | read($fh, $buffer, 4); | ||
326 | if ($buffer ne 'OggS') | ||
327 | { | ||
328 | warn "No comment header?"; | ||
329 | return undef; | ||
330 | } | ||
331 | $byteCount += 4; | ||
332 | |||
333 | # skip over next ten bytes | ||
334 | read($fh, $buffer, 10); | ||
335 | $byteCount += 10; | ||
336 | |||
337 | # read the stream serial number | ||
338 | read($fh, $buffer, 4); | ||
339 | push @{$data->{'commentSerialNumber'}}, _decodeInt($buffer); | ||
340 | $byteCount += 4; | ||
341 | |||
342 | # read the page sequence number (should be 0x01) | ||
343 | read($fh, $buffer, 4); | ||
344 | if (_decodeInt($buffer) != 0x01) | ||
345 | { | ||
346 | warn "Comment header page sequence number is not 0x01: " + | ||
347 | _decodeInt($buffer); | ||
348 | warn "Going to keep going anyway."; | ||
349 | } | ||
350 | $byteCount += 4; | ||
351 | |||
352 | # and ignore the page checksum for now | ||
353 | read($fh, $buffer, 4); | ||
354 | $byteCount += 4; | ||
355 | |||
356 | # get the number of entries in the segment_table... | ||
357 | read($fh, $buffer, 1); | ||
358 | $page_segments = _decodeInt($buffer); | ||
359 | $byteCount += 1; | ||
360 | # then skip on past it | ||
361 | read($fh, $buffer, $page_segments); | ||
362 | $byteCount += $page_segments; | ||
363 | |||
364 | # check the header type (should be 0x03) | ||
365 | read($fh, $buffer, 1); | ||
366 | if (ord($buffer) != 0x03) | ||
367 | { | ||
368 | warn "Wrong header type: " . ord($buffer); | ||
369 | } | ||
370 | $byteCount += 1; | ||
371 | |||
372 | # now we should see 'vorbis' | ||
373 | read($fh, $buffer, 6); | ||
374 | if ($buffer ne 'vorbis') | ||
375 | { | ||
376 | warn "Missing comment header. Should have found 'vorbis', found " . | ||
377 | $buffer; | ||
378 | } | ||
379 | $byteCount += 6; | ||
380 | |||
381 | # get the vendor length | ||
382 | read($fh, $buffer, 4); | ||
383 | $vendor_length = _decodeInt($buffer); | ||
384 | $byteCount += 4; | ||
385 | |||
386 | # read in the vendor | ||
387 | read($fh, $buffer, $vendor_length); | ||
388 | $comments{'vendor'} = $buffer; | ||
389 | $byteCount += $vendor_length; | ||
390 | |||
391 | # read in the number of user comments | ||
392 | read($fh, $buffer, 4); | ||
393 | $user_comment_count = _decodeInt($buffer); | ||
394 | $byteCount += 4; | ||
395 | |||
396 | $data->{'COMMENT_KEYS'} = []; | ||
397 | |||
398 | # finally, read the comments | ||
399 | for (my $i = 0; $i < $user_comment_count; $i++) | ||
400 | { | ||
401 | # first read the length | ||
402 | read($fh, $buffer, 4); | ||
403 | my $comment_length = _decodeInt($buffer); | ||
404 | $byteCount += 4; | ||
405 | |||
406 | # then the comment itself | ||
407 | read($fh, $buffer, $comment_length); | ||
408 | $byteCount += $comment_length; | ||
409 | |||
410 | my ($key) = $buffer =~ /^([^=]+)/; | ||
411 | my ($value) = $buffer =~ /=(.*)$/; | ||
412 | |||
413 | push @{$comments{lc $key}}, $value; | ||
414 | push @{$data->{'COMMENT_KEYS'}}, lc $key; | ||
415 | } | ||
416 | |||
417 | # read past the framing_bit | ||
418 | read($fh, $buffer, 1); | ||
419 | $byteCount += 1; | ||
420 | |||
421 | $data->{'INFO'}{'offset'} = $byteCount; | ||
422 | |||
423 | $data->{'COMMENTS'} = \%comments; | ||
424 | |||
425 | # Now find the offset of the first page | ||
426 | # with audio data. | ||
427 | while(_findPage($fh)) | ||
428 | { | ||
429 | $byteCount = tell($fh) - 4; | ||
430 | |||
431 | # version flag | ||
432 | read($fh, $buffer, 1); | ||
433 | if (ord($buffer) != 0x00) | ||
434 | { | ||
435 | warn "Invalid stream structure version: " . | ||
436 | sprintf("%x", ord($buffer)); | ||
437 | return; | ||
438 | } | ||
439 | |||
440 | # header type flag | ||
441 | read($fh, $buffer, 1); | ||
442 | # Audio data starts as a fresh packet on a new page, so | ||
443 | # if header_type is odd it's not a fresh packet | ||
444 | next if ( ord($buffer) % 2 ); | ||
445 | |||
446 | # skip past granule position, stream_serial_number, | ||
447 | # page_sequence_number, and crc | ||
448 | read($fh, $buffer, 20); | ||
449 | |||
450 | # page_segments | ||
451 | read($fh, $buffer, 1); | ||
452 | my $page_segments = ord($buffer); | ||
453 | |||
454 | # skip past the segment table | ||
455 | read($fh, $buffer, $page_segments); | ||
456 | |||
457 | # read packet_type byte | ||
458 | read($fh, $buffer, 1); | ||
459 | |||
460 | # Not an audio packet. All audio packet numbers are even | ||
461 | next if ( ord($buffer) % 2 ); | ||
462 | |||
463 | # Found the first audio packet | ||
464 | last; | ||
465 | } | ||
466 | |||
467 | $data->{'INFO'}{'audio_offset'} = $byteCount; | ||
468 | } | ||
469 | |||
470 | sub _calculateTrackLength | ||
471 | { | ||
472 | my $data = shift; | ||
473 | my $fh = $data->{'fileHandle'}; | ||
474 | my $buffer; | ||
475 | my $pageSize; | ||
476 | my $granule_position; | ||
477 | |||
478 | seek($fh,-8500,SEEK_END); # that magic number is from vorbisfile.c | ||
479 | # in the constant CHUNKSIZE, which comes | ||
480 | # with the comment /* a shade over 8k; | ||
481 | # anyone using pages well over 8k gets | ||
482 | # what they deserve */ | ||
483 | |||
484 | # we just keep looking through the headers until we get to the last one | ||
485 | # (there might be a couple of blocks here) | ||
486 | while(_findPage($fh)) | ||
487 | { | ||
488 | # stream structure version - must be 0x00 | ||
489 | read($fh, $buffer, 1); | ||
490 | if (ord($buffer) != 0x00) | ||
491 | { | ||
492 | warn "Invalid stream structure version: " . | ||
493 | sprintf("%x", ord($buffer)); | ||
494 | return; | ||
495 | } | ||
496 | |||
497 | # header type flag | ||
498 | read($fh, $buffer, 1); | ||
499 | # we should check this, but for now we'll just ignore it | ||
500 | |||
501 | # absolute granule position - this is what we need! | ||
502 | read($fh, $buffer, 8); | ||
503 | $granule_position = _decodeInt($buffer); | ||
504 | |||
505 | # skip past stream_serial_number, page_sequence_number, and crc | ||
506 | read($fh, $buffer, 12); | ||
507 | |||
508 | # page_segments | ||
509 | read($fh, $buffer, 1); | ||
510 | my $page_segments = ord($buffer); | ||
511 | |||
512 | # reset pageSize | ||
513 | $pageSize = 0; | ||
514 | |||
515 | # calculate approx. page size | ||
516 | for (my $i = 0; $i < $page_segments; $i++) | ||
517 | { | ||
518 | read($fh, $buffer, 1); | ||
519 | $pageSize += ord($buffer); | ||
520 | } | ||
521 | |||
522 | seek $fh, $pageSize, 1; | ||
523 | } | ||
524 | |||
525 | $data->{'INFO'}{'length'} = | ||
526 | int($granule_position / $data->{'INFO'}{'rate'}); | ||
527 | } | ||
528 | |||
529 | sub _findPage | ||
530 | { | ||
531 | # search forward in the file for the 'OggS' page header | ||
532 | my $fh = shift; | ||
533 | my $char; | ||
534 | my $curStr = ''; | ||
535 | |||
536 | while (read($fh, $char, 1)) | ||
537 | { | ||
538 | $curStr = $char . $curStr; | ||
539 | $curStr = substr($curStr, 0, 4); | ||
540 | |||
541 | # we are actually looking for the string 'SggO' because we | ||
542 | # tack character on to our test string backwards, to make | ||
543 | # trimming it to 4 characters easier. | ||
544 | if ($curStr eq 'SggO') | ||
545 | { | ||
546 | return 1; | ||
547 | } | ||
548 | } | ||
549 | |||
550 | return undef; | ||
551 | } | ||
552 | |||
553 | sub _decodeInt | ||
554 | { | ||
555 | my $bytes = shift; | ||
556 | my $num = 0; | ||
557 | my @byteList = split //, $bytes; | ||
558 | my $numBytes = @byteList; | ||
559 | my $mult = 1; | ||
560 | |||
561 | for (my $i = 0; $i < $numBytes; $i ++) | ||
562 | { | ||
563 | $num += ord($byteList[$i]) * $mult; | ||
564 | $mult *= 256; | ||
565 | } | ||
566 | |||
567 | return $num; | ||
568 | } | ||
569 | |||
570 | sub _decodeInt5Bit | ||
571 | { | ||
572 | my $byte = ord(shift); | ||
573 | |||
574 | $byte = $byte & 0xF8; # clear out the bottm 3 bits | ||
575 | $byte = $byte >> 3; # and shifted down to where it belongs | ||
576 | |||
577 | return $byte; | ||
578 | } | ||
579 | |||
580 | sub _decodeInt4Bit | ||
581 | { | ||
582 | my $byte = ord(shift); | ||
583 | |||
584 | $byte = $byte & 0xFC; # clear out the bottm 4 bits | ||
585 | $byte = $byte >> 4; # and shifted down to where it belongs | ||
586 | |||
587 | return $byte; | ||
588 | } | ||
589 | |||
590 | sub _ilog | ||
591 | { | ||
592 | my $x = shift; | ||
593 | my $ret = 0; | ||
594 | |||
595 | unless ($x > 0) | ||
596 | { | ||
597 | return 0; | ||
598 | } | ||
599 | |||
600 | while ($x > 0) | ||
601 | { | ||
602 | $ret++; | ||
603 | $x = $x >> 1; | ||
604 | } | ||
605 | |||
606 | return $ret; | ||
607 | } | ||
608 | |||
609 | 1; | ||
610 | __DATA__ | ||
611 | |||
612 | =head1 NAME | ||
613 | |||
614 | Ogg::Vorbis::Header::PurePerl - An object-oriented interface to Ogg Vorbis | ||
615 | information and comment fields, implemented entirely in Perl. Intended to be | ||
616 | a drop in replacement for Ogg::Vobis::Header. | ||
617 | |||
618 | Unlike Ogg::Vorbis::Header, this module will go ahead and fill in all of the | ||
619 | information fields as soon as you construct the object. In other words, | ||
620 | the C<new> and C<load> constructors have identical behavior. | ||
621 | |||
622 | =head1 SYNOPSIS | ||
623 | |||
624 | use Ogg::Vorbis::Header::PurePerl; | ||
625 | my $ogg = Ogg::Vorbis::Header::PurePerl->new("song.ogg"); | ||
626 | while (my ($k, $v) = each %{$ogg->info}) { | ||
627 | print "$k: $v\n"; | ||
628 | } | ||
629 | foreach my $com ($ogg->comment_tags) { | ||
630 | print "$com: $_\n" foreach $ogg->comment($com); | ||
631 | } | ||
632 | |||
633 | =head1 DESCRIPTION | ||
634 | |||
635 | This module is intended to be a drop in replacement for Ogg::Vorbis::Header, | ||
636 | implemented entirely in Perl. It provides an object-oriented interface to | ||
637 | Ogg Vorbis information and comment fields. (NOTE: This module currently | ||
638 | supports only read operations). | ||
639 | |||
640 | =head1 CONSTRUCTORS | ||
641 | |||
642 | =head2 C<new ($filename)> | ||
643 | |||
644 | Opens an Ogg Vorbis file, ensuring that it exists and is actually an | ||
645 | Ogg Vorbis stream. This method does not actually read any of the | ||
646 | information or comment fields, and closes the file immediately. | ||
647 | |||
648 | =head2 C<load ([$filename])> | ||
649 | |||
650 | Opens an Ogg Vorbis file, ensuring that it exists and is actually an | ||
651 | Ogg Vorbis stream, then loads the information and comment fields. This | ||
652 | method can also be used without a filename to load the information | ||
653 | and fields of an already constructed instance. | ||
654 | |||
655 | =head1 INSTANCE METHODS | ||
656 | |||
657 | =head2 C<info ([$key])> | ||
658 | |||
659 | Returns a hashref containing information about the Ogg Vorbis file from | ||
660 | the file's information header. Hash fields are: version, channels, rate, | ||
661 | bitrate_upper, bitrate_nominal, bitrate_lower, bitrate_window, and length. | ||
662 | The bitrate_window value is not currently used by the vorbis codec, and | ||
663 | will always be -1. | ||
664 | |||
665 | The optional parameter, key, allows you to retrieve a single value from | ||
666 | the object's hash. Returns C<undef> if the key is not found. | ||
667 | |||
668 | =head2 C<comment_tags ()> | ||
669 | |||
670 | Returns an array containing the key values for the comment fields. | ||
671 | These values can then be passed to C<comment> to retrieve their values. | ||
672 | |||
673 | =head2 C<comment ($key)> | ||
674 | |||
675 | Returns an array of comment values associated with the given key. | ||
676 | |||
677 | =head2 C<add_comments ($key, $value, [$key, $value, ...])> | ||
678 | |||
679 | Unimplemented. | ||
680 | |||
681 | =head2 C<edit_comment ($key, $value, [$num])> | ||
682 | |||
683 | Unimplemented. | ||
684 | |||
685 | =head2 C<delete_comment ($key, [$num])> | ||
686 | |||
687 | Unimplemented. | ||
688 | |||
689 | =head2 C<clear_comments ([@keys])> | ||
690 | |||
691 | Unimplemented. | ||
692 | |||
693 | =head2 C<write_vorbis ()> | ||
694 | |||
695 | Unimplemented. | ||
696 | |||
697 | =head2 C<path ()> | ||
698 | |||
699 | Returns the path/filename of the file the object represents. | ||
700 | |||
701 | =head1 NOTE | ||
702 | |||
703 | This is ALPHA SOFTWARE. It may very well be very broken. Do not use it in | ||
704 | a production environment. You have been warned. | ||
705 | |||
706 | =head1 ACKNOWLEDGEMENTS | ||
707 | |||
708 | Dave Brown <cpan@dagbrown.com> made this module significantly faster | ||
709 | at calculating the length of ogg files. | ||
710 | |||
711 | Robert Moser II <rlmoser@earthlink.net> fixed a problem with files that | ||
712 | have no comments. | ||
713 | |||
714 | =head1 AUTHOR | ||
715 | |||
716 | Andrew Molloy E<lt>amolloy@kaizolabs.comE<gt> | ||
717 | |||
718 | =head1 COPYRIGHT | ||
719 | |||
720 | Copyright (c) 2003, Andrew Molloy. All Rights Reserved. | ||
721 | |||
722 | This program is free software; you can redistribute it and/or modify it | ||
723 | under the terms of the GNU General Public License as published by the | ||
724 | Free Software Foundation; either version 2 of the License, or (at | ||
725 | your option) any later version. A copy of this license is included | ||
726 | with this module (LICENSE.GPL). | ||
727 | |||
728 | =head1 SEE ALSO | ||
729 | |||
730 | L<Ogg::Vorbis::Header>, L<Ogg::Vorbis::Decoder> | ||
731 | |||
732 | =cut | ||