summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Stenberg <daniel@haxx.se>2006-04-19 22:14:45 +0000
committerDaniel Stenberg <daniel@haxx.se>2006-04-19 22:14:45 +0000
commit3215ed2e85c957e3bff13cf7c49ab197bbf4974d (patch)
tree9f4e51a0be9db1724073c0f0e4174034a4ae80a4
parentf9bfd73a24b71c01f402a3310af1fad92c7256ed (diff)
downloadrockbox-3215ed2e85c957e3bff13cf7c49ab197bbf4974d.tar.gz
rockbox-3215ed2e85c957e3bff13cf7c49ab197bbf4974d.zip
use tag cache
git-svn-id: svn://svn.rockbox.org/rockbox/trunk@9734 a1c6a512-1295-4272-9138-f99709370657
Diffstat
-rwxr-xr-xtools/songdb.pl2123
-rw-r--r--tools/vorbiscomm.pm732
2 files changed, 0 insertions, 2855 deletions
diff --git a/tools/songdb.pl b/tools/songdb.pl
deleted file mode 100755
index dad7e10496..0000000000
--- a/tools/songdb.pl
+++ /dev/null
@@ -1,2123 +0,0 @@
1#!/usr/bin/perl
2#
3# Rockbox song database docs:
4# http://www.rockbox.org/twiki/bin/view/Main/TagDatabase
5#
6# MP3::Info by Chris Nandor is included verbatim in this script to make
7# it runnable standalone on removable drives. See below.
8#
9
10use vorbiscomm;
11
12my $db = "rockbox.tagdb";
13my $dir;
14my $strip;
15my $add;
16my $verbose;
17my $help;
18my $dirisalbum;
19my $dirisalbumname;
20my $crc = 1;
21
22while($ARGV[0]) {
23 if($ARGV[0] eq "--db") {
24 $db = $ARGV[1];
25 shift @ARGV;
26 shift @ARGV;
27 }
28 elsif($ARGV[0] eq "--path") {
29 $dir = $ARGV[1];
30 shift @ARGV;
31 shift @ARGV;
32 }
33 elsif($ARGV[0] eq "--strip") {
34 $strip = $ARGV[1];
35 shift @ARGV;
36 shift @ARGV;
37 }
38 elsif($ARGV[0] eq "--add") {
39 $add = $ARGV[1];
40 shift @ARGV;
41 shift @ARGV;
42 }
43 elsif($ARGV[0] eq "--verbose") {
44 $verbose = 1;
45 shift @ARGV;
46 }
47 elsif($ARGV[0] eq "--nocrc") {
48 $crc = 0;
49 shift @ARGV;
50 }
51 elsif($ARGV[0] eq "--dirisalbum") {
52 $dirisalbum = 1;
53 shift @ARGV;
54 }
55 elsif($ARGV[0] eq "--dirisalbumname") {
56 $dirisalbumname = 1;
57 shift @ARGV;
58 }
59 elsif($ARGV[0] eq "--help" or ($ARGV[0] eq "-h")) {
60 $help = 1;
61 shift @ARGV;
62 }
63 else {
64 shift @ARGV;
65 }
66}
67my %entries;
68my %genres;
69my %albums;
70my %years;
71my %filename;
72
73my %lcartists;
74my %lcalbums;
75
76my %dir2albumname;
77
78my $dbver = 3;
79
80if(! -d $dir or $help) {
81 print "'$dir' is not a directory\n" if ($dir ne "" and ! -d $dir);
82 print <<MOO
83
84songdb --path <dir> [--dirisalbum] [--dirisalbumname] [--db <file>] [--strip <path>] [--add <path>] [--verbose] [--help]
85
86Options:
87
88 --path <dir> Where your music collection is found
89 --dirisalbum Use dir name as album name if the album name is missing in the
90 tags
91 --dirisalbumname Uh, isn\'t this the same as the above?
92 --db <file> What to call the output file. Defaults to rockbox.tagdb
93 --strip <path> Removes this string from the left of all file names
94 --add <path> Adds this string to the left of all file names
95 --nocrc Disables the CRC32 checksums. It makes the output database not
96 suitable for runtimedb but it makes this script run much
97 faster.
98 --verbose Shows more details while working
99 --help This text
100MOO
101;
102 exit;
103}
104
105sub get_oggtag {
106 my $fn = shift;
107 my %hash;
108
109 my $ogg = vorbiscomm->new($fn);
110
111 my $h= $ogg->load;
112
113 # Convert this format into the same format used by the id3 parser hash
114
115 foreach my $k ($ogg->comment_tags())
116 {
117 foreach my $cmmt ($ogg->comment($k))
118 {
119 my $n;
120 if($k =~ /^artist$/i) {
121 $n = 'ARTIST';
122 }
123 elsif($k =~ /^album$/i) {
124 $n = 'ALBUM';
125 }
126 elsif($k =~ /^title$/i) {
127 $n = 'TITLE';
128 }
129 $hash{$n}=$cmmt if($n);
130 }
131 }
132
133 return \%hash;
134}
135
136sub get_ogginfo {
137 my $fn = shift;
138 my %hash;
139
140 my $ogg = vorbiscomm->new($fn);
141
142 my $h= $ogg->load;
143
144 return $ogg->{'INFO'};
145}
146
147# return ALL directory entries in the given dir
148sub getdir {
149 my ($dir) = @_;
150
151 $dir =~ s|/$|| if ($dir ne "/");
152
153 if (opendir(DIR, $dir)) {
154 my @all = readdir(DIR);
155 closedir DIR;
156 return @all;
157 }
158 else {
159 warn "can't opendir $dir: $!\n";
160 }
161}
162
163sub extractmp3 {
164 my ($dir, @files) = @_;
165 my @mp3;
166 for(@files) {
167 if( (/\.mp[23]$/i || /\.ogg$/i) && -f "$dir/$_" ) {
168 push @mp3, $_;
169 }
170 }
171 return @mp3;
172}
173
174sub extractdirs {
175 my ($dir, @files) = @_;
176 $dir =~ s|/$||;
177 my @dirs;
178 for(@files) {
179 if( -d "$dir/$_" && ($_ !~ /^\.(|\.)$/)) {
180 push @dirs, $_;
181 }
182 }
183 return @dirs;
184}
185
186# CRC32 32KB of data (use less if there isn't 32KB available)
187
188sub crc32 {
189 my ($filename, $index) = @_;
190
191 my $len = 32*1024;
192
193 if(!$crc) {
194 return 0; # fixed bad CRC when disabled!
195 # The runtimedb treats a CRC zero as CRC disabled!
196 }
197
198 if(!open(FILE, "<$filename")) {
199 print "failed to open \"$filename\" $!\n";
200 return 0;
201 }
202
203 # read $data from index $index to $buffer from the file, may return fewer
204 # bytes when dealing with a very small file.
205 #
206 # TODO: make sure we don't include a trailer with metadata when doing this.
207 # Like a id3v1 tag.
208 my $nread = sysread FILE, $buffer, $len, $index;
209
210 close(FILE);
211
212 my @crc_table =
213 ( # CRC32 lookup table for polynomial 0x04C11DB7
214 0x00000000, 0x04C11DB7, 0x09823B6E, 0x0D4326D9, 0x130476DC, 0x17C56B6B,
215 0x1A864DB2, 0x1E475005, 0x2608EDB8, 0x22C9F00F, 0x2F8AD6D6, 0x2B4BCB61,
216 0x350C9B64, 0x31CD86D3, 0x3C8EA00A, 0x384FBDBD, 0x4C11DB70, 0x48D0C6C7,
217 0x4593E01E, 0x4152FDA9, 0x5F15ADAC, 0x5BD4B01B, 0x569796C2, 0x52568B75,
218 0x6A1936C8, 0x6ED82B7F, 0x639B0DA6, 0x675A1011, 0x791D4014, 0x7DDC5DA3,
219 0x709F7B7A, 0x745E66CD, 0x9823B6E0, 0x9CE2AB57, 0x91A18D8E, 0x95609039,
220 0x8B27C03C, 0x8FE6DD8B, 0x82A5FB52, 0x8664E6E5, 0xBE2B5B58, 0xBAEA46EF,
221 0xB7A96036, 0xB3687D81, 0xAD2F2D84, 0xA9EE3033, 0xA4AD16EA, 0xA06C0B5D,
222 0xD4326D90, 0xD0F37027, 0xDDB056FE, 0xD9714B49, 0xC7361B4C, 0xC3F706FB,
223 0xCEB42022, 0xCA753D95, 0xF23A8028, 0xF6FB9D9F, 0xFBB8BB46, 0xFF79A6F1,
224 0xE13EF6F4, 0xE5FFEB43, 0xE8BCCD9A, 0xEC7DD02D, 0x34867077, 0x30476DC0,
225 0x3D044B19, 0x39C556AE, 0x278206AB, 0x23431B1C, 0x2E003DC5, 0x2AC12072,
226 0x128E9DCF, 0x164F8078, 0x1B0CA6A1, 0x1FCDBB16, 0x018AEB13, 0x054BF6A4,
227 0x0808D07D, 0x0CC9CDCA, 0x7897AB07, 0x7C56B6B0, 0x71159069, 0x75D48DDE,
228 0x6B93DDDB, 0x6F52C06C, 0x6211E6B5, 0x66D0FB02, 0x5E9F46BF, 0x5A5E5B08,
229 0x571D7DD1, 0x53DC6066, 0x4D9B3063, 0x495A2DD4, 0x44190B0D, 0x40D816BA,
230 0xACA5C697, 0xA864DB20, 0xA527FDF9, 0xA1E6E04E, 0xBFA1B04B, 0xBB60ADFC,
231 0xB6238B25, 0xB2E29692, 0x8AAD2B2F, 0x8E6C3698, 0x832F1041, 0x87EE0DF6,
232 0x99A95DF3, 0x9D684044, 0x902B669D, 0x94EA7B2A, 0xE0B41DE7, 0xE4750050,
233 0xE9362689, 0xEDF73B3E, 0xF3B06B3B, 0xF771768C, 0xFA325055, 0xFEF34DE2,
234 0xC6BCF05F, 0xC27DEDE8, 0xCF3ECB31, 0xCBFFD686, 0xD5B88683, 0xD1799B34,
235 0xDC3ABDED, 0xD8FBA05A, 0x690CE0EE, 0x6DCDFD59, 0x608EDB80, 0x644FC637,
236 0x7A089632, 0x7EC98B85, 0x738AAD5C, 0x774BB0EB, 0x4F040D56, 0x4BC510E1,
237 0x46863638, 0x42472B8F, 0x5C007B8A, 0x58C1663D, 0x558240E4, 0x51435D53,
238 0x251D3B9E, 0x21DC2629, 0x2C9F00F0, 0x285E1D47, 0x36194D42, 0x32D850F5,
239 0x3F9B762C, 0x3B5A6B9B, 0x0315D626, 0x07D4CB91, 0x0A97ED48, 0x0E56F0FF,
240 0x1011A0FA, 0x14D0BD4D, 0x19939B94, 0x1D528623, 0xF12F560E, 0xF5EE4BB9,
241 0xF8AD6D60, 0xFC6C70D7, 0xE22B20D2, 0xE6EA3D65, 0xEBA91BBC, 0xEF68060B,
242 0xD727BBB6, 0xD3E6A601, 0xDEA580D8, 0xDA649D6F, 0xC423CD6A, 0xC0E2D0DD,
243 0xCDA1F604, 0xC960EBB3, 0xBD3E8D7E, 0xB9FF90C9, 0xB4BCB610, 0xB07DABA7,
244 0xAE3AFBA2, 0xAAFBE615, 0xA7B8C0CC, 0xA379DD7B, 0x9B3660C6, 0x9FF77D71,
245 0x92B45BA8, 0x9675461F, 0x8832161A, 0x8CF30BAD, 0x81B02D74, 0x857130C3,
246 0x5D8A9099, 0x594B8D2E, 0x5408ABF7, 0x50C9B640, 0x4E8EE645, 0x4A4FFBF2,
247 0x470CDD2B, 0x43CDC09C, 0x7B827D21, 0x7F436096, 0x7200464F, 0x76C15BF8,
248 0x68860BFD, 0x6C47164A, 0x61043093, 0x65C52D24, 0x119B4BE9, 0x155A565E,
249 0x18197087, 0x1CD86D30, 0x029F3D35, 0x065E2082, 0x0B1D065B, 0x0FDC1BEC,
250 0x3793A651, 0x3352BBE6, 0x3E119D3F, 0x3AD08088, 0x2497D08D, 0x2056CD3A,
251 0x2D15EBE3, 0x29D4F654, 0xC5A92679, 0xC1683BCE, 0xCC2B1D17, 0xC8EA00A0,
252 0xD6AD50A5, 0xD26C4D12, 0xDF2F6BCB, 0xDBEE767C, 0xE3A1CBC1, 0xE760D676,
253 0xEA23F0AF, 0xEEE2ED18, 0xF0A5BD1D, 0xF464A0AA, 0xF9278673, 0xFDE69BC4,
254 0x89B8FD09, 0x8D79E0BE, 0x803AC667, 0x84FBDBD0, 0x9ABC8BD5, 0x9E7D9662,
255 0x933EB0BB, 0x97FFAD0C, 0xAFB010B1, 0xAB710D06, 0xA6322BDF, 0xA2F33668,
256 0xBCB4666D, 0xB8757BDA, 0xB5365D03, 0xB1F740B4
257 );
258
259 my $crc = 0xffffffff;
260 for ($i = 0; $i < $nread; $i++) {
261 # get the numeric for the byte of the $i index
262 $buf = ord(substr($buffer, $i, 1));
263
264 $crc = ($crc << 8) ^ $crc_table[(($crc >> 24) ^ $buf) & 0xFF];
265
266 # printf("%08x\n", $crc);
267 }
268
269 if($crc == 0) {
270 # rule out the very small risk that this actually returns a zero, as
271 # the current rockbox code assumes a zero CRC means it is disabled!
272 # TODO: fix the Rockbox code. This is just a hack.
273 return 1;
274 }
275
276 return $crc;
277}
278
279sub singlefile {
280 my ($file) = @_;
281 my $hash;
282 my $info;
283
284 if($file =~ /\.ogg$/i) {
285 $hash = get_oggtag($file);
286
287 $info = get_ogginfo($file);
288
289 $hash->{FILECRC} = crc32($file, $info->{audio_offset});
290 }
291 else {
292 $hash = get_mp3tag($file);
293
294 $info = get_mp3info($file);
295
296 $hash->{FILECRC} = crc32($file, $info->{headersize});
297 }
298
299 return $hash; # a hash reference
300}
301
302my $maxsongperalbum;
303
304sub dodir {
305 my ($dir)=@_;
306
307 print "$dir\n";
308
309 # getdir() returns all entries in the given dir
310 my @a = getdir($dir);
311
312 # extractmp3 filters out only the mp3 files from all given entries
313 my @m = extractmp3($dir, @a);
314
315 my $f;
316
317 for $f (sort @m) {
318
319 my $id3 = singlefile("$dir/$f");
320
321 # ARTIST
322 # COMMENT
323 # ALBUM
324 # TITLE
325 # GENRE
326 # TRACKNUM
327 # YEAR
328
329 # don't index songs without tags
330 # um. yes we do.
331 if (not defined $$id3{'ARTIST'} and
332 not defined $$id3{'ALBUM'} and
333 not defined $$id3{'TITLE'})
334 {
335 next;
336 }
337
338 #printf "Artist: %s\n", $id3->{'ARTIST'};
339 my $path = "$dir/$f";
340 if ($strip ne "" and $path =~ /^$strip(.*)/) {
341 $path = $1;
342 }
343
344 if ($add ne "") {
345 $path = $add . $path;
346 }
347
348 # Only use one case-variation of each album/artist
349 if (exists($lcalbums{lc($$id3{'ALBUM'})})) {
350 # if another album with different case exists
351 # use that case (store it in $$id3{'ALBUM'}
352 $$id3{'ALBUM'} = $lcalbums{lc($$id3{'ALBUM'})};
353 }
354 else {
355 # else create a new entry in the hash
356 $lcalbums{lc($$id3{'ALBUM'})} = $$id3{'ALBUM'};
357 }
358
359 if (exists($lcartists{lc($$id3{'ARTIST'})})) {
360 $$id3{'ARTIST'} = $lcartists{lc($$id3{'ARTIST'})};
361 }
362 else {
363 $lcartists{lc($$id3{'ARTIST'})} = $$id3{'ARTIST'};
364 }
365
366 $entries{$path}= $id3;
367 $artists{$id3->{'ARTIST'}}++ if($id3->{'ARTIST'});
368 $genres{$id3->{'GENRE'}}++ if($id3->{'GENRE'});
369 $years{$id3->{'YEAR'}}++ if($id3->{'YEAR'});
370
371 # fallback names
372 $$id3{'ARTIST'} = "<no artist tag>" if ($$id3{'ARTIST'} eq "");
373 # Fall back on the directory name (not full path dirname),
374 # if no album tag
375 if ($dirisalbum) {
376 if($dir2albumname{$dir} eq "") {
377 $dir2albumname{$dir} = $$id3{'ALBUM'};
378 }
379 elsif($dir2albumname{$dir} ne $$id3{'ALBUM'}) {
380 $dir2albumname{$dir} = (split m[/], $dir)[-1];
381 }
382 }
383 # if no directory
384 if ($dirisalbumname) {
385 $$id3{'ALBUM'} = (split m[/], $dir)[-1] if ($$id3{'ALBUM'} eq "");
386 }
387 $$id3{'ALBUM'} = "<no album tag>" if ($$id3{'ALBUM'} eq "");
388 # fall back on basename of the file if no title tag.
389 my $base;
390 ($base = $f) =~ s/\.\w+$//;
391 $$id3{'TITLE'} = $base if ($$id3{'TITLE'} eq "");
392
393 # Append dirname, to handle multi-artist albums
394 $$id3{'DIR'} = $dir;
395 my $albumid;
396 if ($dirisalbum) {
397 $albumid=$$id3{'DIR'};
398 }
399 else {
400 $albumid= $id3->{'ALBUM'}."___".$$id3{'DIR'};
401 }
402 #printf "album id: %s\n", $albumid;
403
404# if($id3->{'ALBUM'}."___".$id3->{'DIR'} ne "<no album tag>___<no artist tag>") {
405 my $num = ++$albums{$albumid};
406 if($num > $maxsongperalbum) {
407 $maxsongperalbum = $num;
408 $longestalbum = $albumid;
409 }
410 $album2songs{$albumid}{$$id3{TITLE}} = $id3;
411 if($dirisalbum) {
412 $artist2albums{$$id3{ARTIST}}{$$id3{DIR}} = $id3;
413 }
414 else {
415 $artist2albums{$$id3{ARTIST}}{$$id3{ALBUM}} = $id3;
416 }
417# }
418 }
419
420 if($dirisalbum and $dir2albumname{$dir} eq "") {
421 $dir2albumname{$dir} = (split m[/], $dir)[-1];
422 printf "%s\n", $dir2albumname{$dir};
423 }
424
425 # extractdirs filters out only subdirectories from all given entries
426 my @d = extractdirs($dir, @a);
427
428 for $d (sort @d) {
429 $dir =~ s|/$||;
430 dodir("$dir/$d");
431 }
432}
433
434
435dodir($dir);
436print "\n";
437
438print "File name table\n" if ($verbose);
439for(sort keys %entries) {
440 printf(" %s\n", $_) if ($verbose);
441 my $l = length($_);
442 if($l > $maxfilelen) {
443 $maxfilelen = $l;
444 $longestfilename = $_;
445 }
446}
447$maxfilelen++; # include zero termination byte
448while($maxfilelen&3) {
449 $maxfilelen++;
450}
451
452my $maxsonglen = 0;
453my $sc;
454print "\nSong title table\n" if ($verbose);
455
456for(sort {uc($entries{$a}->{'TITLE'}) cmp uc($entries{$b}->{'TITLE'})} keys %entries) {
457 printf(" %s\n", $entries{$_}->{'TITLE'} ) if ($verbose);
458 my $l = length($entries{$_}->{'TITLE'});
459 if($l > $maxsonglen) {
460 $maxsonglen = $l;
461 $longestsong = $entries{$_}->{'TITLE'};
462 }
463}
464$maxsonglen++; # include zero termination byte
465while($maxsonglen&3) {
466 $maxsonglen++;
467}
468
469my $maxartistlen = 0;
470print "\nArtist table\n" if ($verbose);
471my $i=0;
472my %artistcount;
473for(sort {uc($a) cmp uc($b)} keys %artists) {
474 printf(" %s: %d\n", $_, $i) if ($verbose);
475 $artistcount{$_}=$i++;
476 my $l = length($_);
477 if($l > $maxartistlen) {
478 $maxartistlen = $l;
479 $longestartist = $_;
480 }
481
482 $l = scalar keys %{$artist2albums{$_}};
483 if ($l > $maxalbumsperartist) {
484 $maxalbumsperartist = $l;
485 $longestartistalbum = $_;
486 }
487}
488$maxartistlen++; # include zero termination byte
489while($maxartistlen&3) {
490 $maxartistlen++;
491}
492
493print "\nGenre table\n" if ($verbose);
494for(sort keys %genres) {
495 my $l = length($_);
496 if($l > $maxgenrelen) {
497 $maxgenrelen = $l;
498 $longestgenrename = $_;
499 }
500}
501
502$maxgenrelen++; #include zero termination byte
503while($maxgenrelen&3) {
504 $maxgenrelen++;
505}
506
507
508if ($verbose) {
509 print "\nYear table\n";
510 for(sort keys %years) {
511 printf(" %s\n", $_);
512 }
513}
514
515print "\nAlbum table\n" if ($verbose);
516my $maxalbumlen = 0;
517my %albumcount;
518$i=0;
519my @albumssort;
520if($dirisalbum) {
521 @albumssort = sort {uc($dir2albumname{$a}) cmp uc($dir2albumname{$b})} keys %albums;
522}
523else {
524 @albumssort = sort {uc($a) cmp uc($b)} keys %albums;
525}
526for(@albumssort) {
527 my @moo=split(/___/, $_);
528 printf(" %s\n", $moo[0]) if ($verbose);
529 $albumcount{$_} = $i++;
530 my $l;
531 if($dirisalbum) {
532 $l = length($dir2albumname{$_});
533 }
534 else {
535 $l = length($moo[0]);
536 }
537 if($l > $maxalbumlen) {
538 $maxalbumlen = $l;
539 if($dirisalbum) {
540 $longestalbumname = $dir2albumname{$_};
541 }
542 else {
543 $longestalbumname = $moo[0];
544 }
545 }
546}
547$maxalbumlen++; # include zero termination byte
548while($maxalbumlen&3) {
549 $maxalbumlen++;
550}
551
552
553
554sub dumpshort {
555 my ($num)=@_;
556
557 # print "int: $num\n";
558
559 print DB pack "n", $num;
560}
561
562sub dumpint {
563 my ($num)=@_;
564
565# print "int: $num\n";
566
567 print DB pack "N", $num;
568}
569
570if (!scalar keys %entries) {
571 print "No songs found. Did you specify the right --path ?\n";
572 print "Use the --help parameter to see all options.\n";
573 exit;
574}
575
576if ($db) {
577 my $songentrysize = $maxsonglen + 12 + $maxgenrelen+ 12;
578 my $albumentrysize = $maxalbumlen + 4 + $maxsongperalbum*4;
579 my $artistentrysize = $maxartistlen + $maxalbumsperartist*4;
580 my $fileentrysize = $maxfilelen + 12;
581
582 printf "Number of artists : %d\n", scalar keys %artists;
583 printf "Number of albums : %d\n", scalar keys %albums;
584 printf "Number of songs / files : %d\n", scalar keys %entries;
585 print "Max artist length : $maxartistlen ($longestartist)\n";
586 print "Max album length : $maxalbumlen ($longestalbumname)\n";
587 print "Max song length : $maxsonglen ($longestsong)\n";
588 print "Max songs per album : $maxsongperalbum ($longestalbum)\n";
589 print "Max albums per artist: $maxalbumsperartist ($longestartistalbum)\n";
590 print "Max genre length : $maxgenrelen ($longestgenrename)\n";
591 print "Max file length : $maxfilelen ($longestfilename)\n";
592 print "Database version: $dbver\n" if ($verbose);
593 print "Song Entry Size : $songentrysize ($maxsonglen + 12 + $maxgenrelen + 4)\n" if ($verbose);
594 print "Album Entry Size: $albumentrysize ($maxalbumlen + 4 + $maxsongperalbum * 4)\n" if ($verbose);
595 print "Artist Entry Size: $artistentrysize ($maxartistlen + $maxalbumsperartist * 4)\n" if ($verbose);
596 print "File Entry Size: $fileentrysize ($maxfilelen + 12)\n" if ($verbose);
597
598
599 open(DB, ">$db") || die "couldn't make $db";
600 binmode(DB);
601 printf DB "RDB%c", $dbver;
602
603 $pathindex = 68; # paths always start at index 68
604
605 $artistindex = $pathindex;
606
607 # set total size of song title table
608 $sc = scalar(keys %entries) * $songentrysize;
609 my $ac = scalar(keys %albums) * $albumentrysize;
610 my $arc = scalar(keys %artists) * $artistentrysize;
611 $albumindex = $artistindex + $arc; # arc is size of all artists
612 $songindex = $albumindex + $ac; # ac is size of all albums
613 my $fileindex = $songindex + $sc; # sc is size of all songs
614
615 dumpint($artistindex); # file position index of artist table
616 dumpint($albumindex); # file position index of album table
617 dumpint($songindex); # file position index of song table
618 dumpint($fileindex); # file position index of file table
619 dumpint(scalar(keys %artists)); # number of artists
620 dumpint(scalar(keys %albums)); # number of albums
621 dumpint(scalar(keys %entries)); # number of songs
622 dumpint(scalar(keys %entries)); # number of files
623 dumpint($maxartistlen); # length of artist name field
624 dumpint($maxalbumlen); # length of album name field
625 dumpint($maxsonglen); # length of song name field
626 dumpint($maxgenrelen); #length of genre field
627 dumpint($maxfilelen); # length of file field
628 dumpint($maxsongperalbum); # number of entries in songs-per-album array
629 dumpint($maxalbumsperartist); # number of entries in albums-per-artist array
630 dumpint(-1); # rundb dirty
631
632 #### TABLE of artists ###
633 # name of artist1
634 # pointers to albums of artist1
635
636 for (sort {uc($a) cmp uc($b)} keys %artists) {
637 my $artist = $_;
638 my $str = $_."\x00" x ($maxartistlen - length($_));
639 print DB $str;
640
641 for (sort keys %{$artist2albums{$artist}}) {
642 my $id3 = $artist2albums{$artist}{$_};
643 my $a;
644 if($dirisalbum) {
645 $a = $albumcount{"$$id3{'DIR'}"} * $albumentrysize;
646 }
647 else {
648 $a = $albumcount{"$$id3{'ALBUM'}___$$id3{'DIR'}"} * $albumentrysize;
649 }
650 dumpint($a + $albumindex);
651 }
652
653 for (scalar keys %{$artist2albums{$artist}} .. $maxalbumsperartist-1) {
654 print DB "\x00\x00\x00\x00";
655 }
656
657 }
658
659 ### Build song offset info.
660 my $offset = $songindex;
661 for(sort {uc($entries{$a}->{'TITLE'}) cmp uc($entries{$b}->{'TITLE'})} keys %entries) {
662 my $id3 = $entries{$_};
663 $$id3{'songoffset'} = $offset;
664 $offset += $songentrysize;
665 }
666
667
668 #### TABLE of albums ###
669 # name of album1
670 # pointers to artists of album1
671 # pointers to songs on album1
672
673 for(@albumssort) {
674 my $albumid = $_;
675 my @moo=split(/___/, $_);
676 my $t;
677 my $str;
678 if($dirisalbum) {
679 $t = $dir2albumname{$albumid};
680 }
681 else {
682 $t = $moo[0];
683 }
684 $str = $t."\x00" x ($maxalbumlen - length($t));
685 print DB $str;
686
687 my @songlist = keys %{$album2songs{$albumid}};
688 my $id3 = $album2songs{$albumid}{$songlist[0]};
689
690 #printf "(d) albumid: %s artist: %s\n",$albumid, $id3->{'ARTIST'};
691
692 my $aoffset = $artistcount{$id3->{'ARTIST'}} * $artistentrysize;
693 dumpint($aoffset + $artistindex); # pointer to artist of this album
694
695 if (defined $id3->{'TRACKNUM'}) {
696 @songlist = sort {
697 $album2songs{$albumid}{$a}->{'TRACKNUM'} <=>
698 $album2songs{$albumid}{$b}->{'TRACKNUM'}
699 } @songlist;
700 }
701 else {
702 @songlist = sort @songlist;
703 }
704
705 for (@songlist) {
706 my $id3 = $album2songs{$albumid}{$_};
707 dumpint($$id3{'songoffset'});
708 }
709
710 for (scalar keys %{$album2songs{$albumid}} .. $maxsongperalbum-1) {
711 print DB "\x00\x00\x00\x00";
712 }
713 }
714
715 #### Build filename offset info
716 my $l=$fileindex;
717 my %filenamepos;
718 for $f (sort {uc($a) cmp uc($b)} keys %entries) {
719 $filenamepos{$f}= $l;
720 $l += $fileentrysize;
721 }
722
723 #### TABLE of songs ###
724 # title of song1
725 # pointer to artist of song1
726 # pointer to album of song1
727 # pointer to filename of song1
728
729 for(sort {uc($entries{$a}->{'TITLE'}) cmp uc($entries{$b}->{'TITLE'})} keys %entries) {
730 my $f = $_;
731 my $id3 = $entries{$f};
732 my $t = $id3->{'TITLE'};
733 my $g = $id3->{'GENRE'};
734 my $str = $t."\x00" x ($maxsonglen- length($t));
735
736 print DB $str; # title
737 $str = $g."\x00" x ($maxgenrelen - length($g));
738
739 my $a = $artistcount{$id3->{'ARTIST'}} * $artistentrysize;
740 dumpint($a + $artistindex); # pointer to artist of this song
741
742 if($dirisalbum) {
743 $a = $albumcount{"$$id3{DIR}"} * $albumentrysize;
744 }
745 else {
746 $a = $albumcount{"$$id3{ALBUM}___$$id3{DIR}"} * $albumentrysize;
747 }
748 dumpint($a + $albumindex); # pointer to album of this song
749
750 # pointer to filename of this song
751 dumpint($filenamepos{$f});
752 print DB $str; #genre
753 dumpshort(-1);
754 dumpshort($id3->{'YEAR'});
755 dumpint(-1);
756 dumpshort($id3->{'TRACKNUM'});
757 dumpshort(-1);
758 }
759
760 #### TABLE of file names ###
761 # path1
762
763 for $f (sort {uc($a) cmp uc($b)} %entries) {
764 my $str = $f."\x00" x ($maxfilelen- length($f));
765 my $id3 = $entries{$f};
766 print DB $str;
767 #print STDERR "CRC: ".."\n";
768 dumpint($id3->{'FILECRC'}); # CRC32 of the song data
769 dumpint($id3->{'songoffset'}); # offset to song data
770 dumpint(-1); # offset to rundb data. always set to -1. this is updated by rockbox code on the player.
771 }
772
773 close(DB);
774}
775
776###
777### Here follows module MP3::Info Copyright (c) 1998-2004 Chris Nandor
778### Modified by Björn Stenberg to remove use of external libraries
779###
780
781our(
782 @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION, $REVISION,
783 @mp3_genres, %mp3_genres, @winamp_genres, %winamp_genres, $try_harder,
784 @t_bitrate, @t_sampling_freq, @frequency_tbl, %v1_tag_fields,
785 @v1_tag_names, %v2_tag_names, %v2_to_v1_names, $AUTOLOAD,
786 @mp3_info_fields
787);
788
789@ISA = 'Exporter';
790@EXPORT = qw(
791 set_mp3tag get_mp3tag get_mp3info remove_mp3tag
792 use_winamp_genres
793);
794@EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8);
795%EXPORT_TAGS = (
796 genres => [qw(@mp3_genres %mp3_genres)],
797 utf8 => [qw(use_mp3_utf8)],
798 all => [@EXPORT, @EXPORT_OK]
799);
800
801# $Id$
802($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
803$VERSION = '1.02';
804
805=pod
806
807=head1 NAME
808
809MP3::Info - Manipulate / fetch info from MP3 audio files
810
811=head1 SYNOPSIS
812
813 #!perl -w
814 use MP3::Info;
815 my $file = 'Pearls_Before_Swine.mp3';
816 set_mp3tag($file, 'Pearls Before Swine', q"77's",
817 'Sticks and Stones', '1990',
818 q"(c) 1990 77's LTD.", 'rock & roll');
819
820 my $tag = get_mp3tag($file) or die "No TAG info";
821 $tag->{GENRE} = 'rock';
822 set_mp3tag($file, $tag);
823
824 my $info = get_mp3info($file);
825 printf "$file length is %d:%d\n", $info->{MM}, $info->{SS};
826
827=cut
828
829{
830 my $c = -1;
831 # set all lower-case and regular-cased versions of genres as keys
832 # with index as value of each key
833 %mp3_genres = map {($_, ++$c, lc, $c)} @mp3_genres;
834
835 # do it again for winamp genres
836 $c = -1;
837 %winamp_genres = map {($_, ++$c, lc, $c)} @winamp_genres;
838}
839
840=pod
841
842 my $mp3 = new MP3::Info $file;
843 $mp3->title('Perls Before Swine');
844 printf "$file length is %s, title is %s\n",
845 $mp3->time, $mp3->title;
846
847
848=head1 DESCRIPTION
849
850=over 4
851
852=item $mp3 = MP3::Info-E<gt>new(FILE)
853
854OOP interface to the rest of the module. The same keys
855available via get_mp3info and get_mp3tag are available
856via the returned object (using upper case or lower case;
857but note that all-caps "VERSION" will return the module
858version, not the MP3 version).
859
860Passing a value to one of the methods will set the value
861for that tag in the MP3 file, if applicable.
862
863=cut
864
865sub new {
866 my($pack, $file) = @_;
867
868 my $info = get_mp3info($file) or return undef;
869 my $tags = get_mp3tag($file) || { map { ($_ => undef) } @v1_tag_names };
870 my %self = (
871 FILE => $file,
872 TRY_HARDER => 0
873 );
874
875 @self{@mp3_info_fields, @v1_tag_names, 'file'} = (
876 @{$info}{@mp3_info_fields},
877 @{$tags}{@v1_tag_names},
878 $file
879 );
880
881 return bless \%self, $pack;
882}
883
884sub can {
885 my $self = shift;
886 return $self->SUPER::can(@_) unless ref $self;
887 my $name = uc shift;
888 return sub { $self->$name(@_) } if exists $self->{$name};
889 return undef;
890}
891
892sub AUTOLOAD {
893 my($self) = @_;
894 (my $name = uc $AUTOLOAD) =~ s/^.*://;
895
896 if (exists $self->{$name}) {
897 my $sub = exists $v1_tag_fields{$name}
898 ? sub {
899 if (defined $_[1]) {
900 $_[0]->{$name} = $_[1];
901 set_mp3tag($_[0]->{FILE}, $_[0]);
902 }
903 return $_[0]->{$name};
904 }
905 : sub {
906 return $_[0]->{$name}
907 };
908
909 *{$AUTOLOAD} = $sub;
910 goto &$AUTOLOAD;
911
912 } else {
913 warn(sprintf "No method '$name' available in package %s.",
914 __PACKAGE__);
915 }
916}
917
918sub DESTROY {
919
920}
921
922
923=item use_mp3_utf8([STATUS])
924
925Tells MP3::Info to (or not) return TAG info in UTF-8.
926TRUE is 1, FALSE is 0. Default is FALSE.
927
928Will only be able to it on if Unicode::String is available. ID3v2
929tags will be converted to UTF-8 according to the encoding specified
930in each tag; ID3v1 tags will be assumed Latin-1 and converted
931to UTF-8.
932
933Function returns status (TRUE/FALSE). If no argument is supplied,
934or an unaccepted argument is supplied, function merely returns status.
935
936This function is not exported by default, but may be exported
937with the C<:utf8> or C<:all> export tag.
938
939=cut
940
941my $unicode_module = eval { require Unicode::String };
942my $UNICODE = 0;
943
944sub use_mp3_utf8 {
945 my($val) = @_;
946 if ($val == 1) {
947 $UNICODE = 1 if $unicode_module;
948 } elsif ($val == 0) {
949 $UNICODE = 0;
950 }
951 return $UNICODE;
952}
953
954=pod
955
956=item use_winamp_genres()
957
958Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres>
959(adds 68 additional genres to the default list of 80).
960This is a separate function because these are non-standard
961genres, but they are included because they are widely used.
962
963You can import the data structures with one of:
964
965 use MP3::Info qw(:genres);
966 use MP3::Info qw(:DEFAULT :genres);
967 use MP3::Info qw(:all);
968
969=cut
970
971sub use_winamp_genres {
972 %mp3_genres = %winamp_genres;
973 @mp3_genres = @winamp_genres;
974 return 1;
975}
976
977=pod
978
979=pod
980
981=item get_mp3tag (FILE [, VERSION, RAW_V2])
982
983Returns hash reference containing tag information in MP3 file. The keys
984returned are the same as those supplied for C<set_mp3tag>, except in the
985case of RAW_V2 being set.
986
987If VERSION is C<1>, the information is taken from the ID3v1 tag (if present).
988If VERSION is C<2>, the information is taken from the ID3v2 tag (if present).
989If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and
990then, if present, the ID3v2 tag information will override any existing ID3v1
991tag info.
992
993If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation
994of text encoding. The key name is the same as the frame ID (ID to name mappings
995are in the global %v2_tag_names).
996
997If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if
998necessary, etc. It also takes multiple values for a given key (such as comments)
999and puts them in an arrayref.
1000
1001If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will
1002not be read.
1003
1004Strings returned will be in Latin-1, unless UTF-8 is specified (L<use_mp3_utf8>),
1005(unless RAW_V2 is C<1>).
1006
1007Also returns a TAGVERSION key, containing the ID3 version used for the returned
1008data (if TAGVERSION argument is C<0>, may contain two versions).
1009
1010=cut
1011
1012sub get_mp3tag {
1013 my($file, $ver, $raw_v2) = @_;
1014 my($tag, $v1, $v2, $v2h, %info, @array, $fh);
1015 $raw_v2 ||= 0;
1016 $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0;
1017
1018 if (not (defined $file && $file ne '')) {
1019 $@ = "No file specified";
1020 return undef;
1021 }
1022
1023 if (not -s $file) {
1024 $@ = "File is empty";
1025 return undef;
1026 }
1027
1028 if (ref $file) { # filehandle passed
1029 $fh = $file;
1030 } else {
1031 $fh = gensym;
1032 if (not open $fh, "< $file\0") {
1033 $@ = "Can't open $file: $!";
1034 return undef;
1035 }
1036 }
1037
1038 binmode $fh;
1039
1040 if ($ver < 2) {
1041 seek $fh, -128, 2;
1042 while(defined(my $line = <$fh>)) { $tag .= $line }
1043
1044 if ($tag =~ /^TAG/) {
1045 $v1 = 1;
1046 if (substr($tag, -3, 2) =~ /\000[^\000]/) {
1047 (undef, @info{@v1_tag_names}) =
1048 (unpack('a3a30a30a30a4a28', $tag),
1049 ord(substr($tag, -2, 1)),
1050 $mp3_genres[ord(substr $tag, -1)]);
1051 $info{TAGVERSION} = 'ID3v1.1';
1052 } else {
1053 (undef, @info{@v1_tag_names[0..4, 6]}) =
1054 (unpack('a3a30a30a30a4a30', $tag),
1055 $mp3_genres[ord(substr $tag, -1)]);
1056 $info{TAGVERSION} = 'ID3v1';
1057 }
1058 if ($UNICODE) {
1059 for my $key (keys %info) {
1060 next unless $info{$key};
1061 my $u = Unicode::String::latin1($info{$key});
1062 $info{$key} = $u->utf8;
1063 }
1064 }
1065 } elsif ($ver == 1) {
1066 _close($file, $fh);
1067 $@ = "No ID3v1 tag found";
1068 return undef;
1069 }
1070 }
1071
1072 ($v2, $v2h) = _get_v2tag($fh);
1073
1074 unless ($v1 || $v2) {
1075 _close($file, $fh);
1076 $@ = "No ID3 tag found";
1077 return undef;
1078 }
1079
1080 if (($ver == 0 || $ver == 2) && $v2) {
1081 if ($raw_v2 == 1 && $ver == 2) {
1082 %info = %$v2;
1083 $info{TAGVERSION} = $v2h->{version};
1084 } else {
1085 my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names;
1086 for my $id (keys %$hash) {
1087 if (exists $v2->{$id}) {
1088 if ($id =~ /^TCON?$/ && $v2->{$id} =~ /^.?\((\d+)\)/) {
1089 $info{$hash->{$id}} = $mp3_genres[$1];
1090 } else {
1091 my $data1 = $v2->{$id};
1092
1093 # this is tricky ... if this is an arrayref, we want
1094 # to only return one, so we pick the first one. but
1095 # if it is a comment, we pick the first one where the
1096 # first charcter after the language is NULL and not an
1097 # additional sub-comment, because that is most likely
1098 # to be the user-supplied comment
1099
1100 if (ref $data1 && !$raw_v2) {
1101 if ($id =~ /^COMM?$/) {
1102 my($newdata) = grep /^(....\000)/, @{$data1};
1103 $data1 = $newdata || $data1->[0];
1104 } else {
1105 $data1 = $data1->[0];
1106 }
1107 }
1108
1109 $data1 = [ $data1 ] if ! ref $data1;
1110
1111 for my $data (@$data1) {
1112 $data =~ s/^(.)//; # strip first char (text encoding)
1113 my $encoding = $1;
1114 my $desc;
1115 if ($id =~ /^COM[M ]?$/) {
1116 $data =~ s/^(?:...)//; # strip language
1117 $data =~ s/^(.*?)\000+//; # strip up to first NULL(s),
1118 # for sub-comment
1119 $desc = $1;
1120 }
1121
1122 if ($UNICODE) {
1123 if ($encoding eq "\001" || $encoding eq "\002") { # UTF-16, UTF-16BE
1124 my $u = Unicode::String::utf16($data);
1125 $data = $u->utf8;
1126 $data =~ s/^\xEF\xBB\xBF//; # strip BOM
1127 } elsif ($encoding eq "\000") {
1128 my $u = Unicode::String::latin1($data);
1129 $data = $u->utf8;
1130 }
1131 }
1132
1133 if ($raw_v2 == 2 && $desc) {
1134 $data = { $desc => $data };
1135 }
1136
1137 if ($raw_v2 == 2 && exists $info{$hash->{$id}}) {
1138 if (ref $info{$hash->{$id}} eq 'ARRAY') {
1139 push @{$info{$hash->{$id}}}, $data;
1140 } else {
1141 $info{$hash->{$id}} = [ $info{$hash->{$id}}, $data ];
1142 }
1143 } else {
1144 $info{$hash->{$id}} = $data;
1145 }
1146 }
1147 }
1148 }
1149 }
1150 if ($ver == 0 && $info{TAGVERSION}) {
1151 $info{TAGVERSION} .= ' / ' . $v2h->{version};
1152 } else {
1153 $info{TAGVERSION} = $v2h->{version};
1154 }
1155 }
1156 }
1157
1158 unless ($raw_v2 && $ver == 2) {
1159 foreach my $key (keys %info) {
1160 if (defined $info{$key}) {
1161 $info{$key} =~ s/\000+.*//g;
1162 $info{$key} =~ s/\s+$//;
1163 }
1164 }
1165
1166 for (@v1_tag_names) {
1167 $info{$_} = '' unless defined $info{$_};
1168 }
1169 }
1170
1171 if (keys %info && exists $info{GENRE} && ! defined $info{GENRE}) {
1172 $info{GENRE} = '';
1173 }
1174
1175 _close($file, $fh);
1176
1177 return keys %info ? {%info} : undef;
1178}
1179
1180sub _get_v2tag {
1181 my($fh) = @_;
1182 my($off, $myseek, $myseek_22, $myseek_23, $v2, $h, $hlen, $num);
1183 $h = {};
1184
1185 $v2 = _get_v2head($fh) or return;
1186 if ($v2->{major_version} < 2) {
1187 warn "This is $v2->{version}; " .
1188 "ID3v2 versions older than ID3v2.2.0 not supported\n"
1189 if $^W;
1190 return;
1191 }
1192
1193 if ($v2->{major_version} == 2) {
1194 $hlen = 6;
1195 $num = 3;
1196 } else {
1197 $hlen = 10;
1198 $num = 4;
1199 }
1200
1201 $myseek = sub {
1202 seek $fh, $off, 0;
1203 read $fh, my($bytes), $hlen;
1204 return unless $bytes =~ /^([A-Z0-9]{$num})/
1205 || ($num == 4 && $bytes =~ /^(COM )/); # stupid iTunes
1206 my($id, $size) = ($1, $hlen);
1207 my @bytes = reverse unpack "C$num", substr($bytes, $num, $num);
1208 for my $i (0 .. ($num - 1)) {
1209 $size += $bytes[$i] * 256 ** $i;
1210 }
1211 return($id, $size);
1212 };
1213
1214 $off = $v2->{ext_header_size} + 10;
1215
1216 while ($off < $v2->{tag_size}) {
1217 my($id, $size) = &$myseek or last;
1218 seek $fh, $off + $hlen, 0;
1219 read $fh, my($bytes), $size - $hlen;
1220 if (exists $h->{$id}) {
1221 if (ref $h->{$id} eq 'ARRAY') {
1222 push @{$h->{$id}}, $bytes;
1223 } else {
1224 $h->{$id} = [$h->{$id}, $bytes];
1225 }
1226 } else {
1227 $h->{$id} = $bytes;
1228 }
1229 $off += $size;
1230 }
1231
1232 return($h, $v2);
1233}
1234
1235
1236=pod
1237
1238=item get_mp3info (FILE)
1239
1240Returns hash reference containing file information for MP3 file.
1241This data cannot be changed. Returned data:
1242
1243 VERSION MPEG audio version (1, 2, 2.5)
1244 LAYER MPEG layer description (1, 2, 3)
1245 STEREO boolean for audio is in stereo
1246
1247 VBR boolean for variable bitrate
1248 BITRATE bitrate in kbps (average for VBR files)
1249 FREQUENCY frequency in kHz
1250 SIZE bytes in audio stream
1251
1252 SECS total seconds
1253 MM minutes
1254 SS leftover seconds
1255 MS leftover milliseconds
1256 TIME time in MM:SS
1257
1258 COPYRIGHT boolean for audio is copyrighted
1259 PADDING boolean for MP3 frames are padded
1260 MODE channel mode (0 = stereo, 1 = joint stereo,
1261 2 = dual channel, 3 = single channel)
1262 FRAMES approximate number of frames
1263 FRAME_LENGTH approximate length of a frame
1264 VBR_SCALE VBR scale from VBR header
1265
1266On error, returns nothing and sets C<$@>.
1267
1268=cut
1269
1270sub get_mp3info {
1271 my($file) = @_;
1272 my($off, $myseek, $byte, $eof, $h, $tot, $fh);
1273
1274 if (not (defined $file && $file ne '')) {
1275 $@ = "No file specified";
1276 return undef;
1277 }
1278
1279 if (not -s $file) {
1280 $@ = "File is empty";
1281 return undef;
1282 }
1283
1284 if (ref $file) { # filehandle passed
1285 $fh = $file;
1286 } else {
1287 $fh = gensym;
1288 if (not open $fh, "< $file\0") {
1289 $@ = "Can't open $file: $!";
1290 return undef;
1291 }
1292 }
1293
1294 $off = 0;
1295 $tot = 4096;
1296
1297 $myseek = sub {
1298 seek $fh, $off, 0;
1299 read $fh, $byte, 4;
1300 };
1301
1302 binmode $fh;
1303 &$myseek;
1304
1305 if ($off == 0) {
1306 if (my $id3v2 = _get_v2head($fh)) {
1307 $tot += $off += $id3v2->{tag_size};
1308 &$myseek;
1309 }
1310 }
1311
1312 $h = _get_head($byte);
1313 until (_is_mp3($h)) {
1314 $off++;
1315 &$myseek;
1316 $h = _get_head($byte);
1317 if ($off > $tot && !$try_harder) {
1318 _close($file, $fh);
1319 $@ = "Couldn't find MP3 header (perhaps set " .
1320 '$MP3::Info::try_harder and retry)';
1321 return undef;
1322 }
1323 }
1324
1325 my $vbr = _get_vbr($fh, $h, \$off);
1326
1327 $h->{headersize}=$off; # data size prepending the actual mp3 data
1328
1329 seek $fh, 0, 2;
1330 $eof = tell $fh;
1331 seek $fh, -128, 2;
1332 $off += 128 if <$fh> =~ /^TAG/ ? 1 : 0;
1333
1334 _close($file, $fh);
1335
1336 $h->{size} = $eof - $off;
1337
1338 return _get_info($h, $vbr);
1339}
1340
1341sub _get_info {
1342 my($h, $vbr) = @_;
1343 my $i;
1344
1345 $i->{VERSION} = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 :
1346 $h->{IDR} == 0 ? 2.5 : 0;
1347 $i->{LAYER} = 4 - $h->{layer};
1348 $i->{VBR} = defined $vbr ? 1 : 0;
1349
1350 $i->{COPYRIGHT} = $h->{copyright} ? 1 : 0;
1351 $i->{PADDING} = $h->{padding_bit} ? 1 : 0;
1352 $i->{STEREO} = $h->{mode} == 3 ? 0 : 1;
1353 $i->{MODE} = $h->{mode};
1354
1355 $i->{SIZE} = $vbr && $vbr->{bytes} ? $vbr->{bytes} : $h->{size};
1356
1357 my $mfs = $h->{fs} / ($h->{ID} ? 144000 : 72000);
1358 $i->{FRAMES} = int($vbr && $vbr->{frames}
1359 ? $vbr->{frames}
1360 : $i->{SIZE} / $h->{bitrate} / $mfs
1361 );
1362
1363 if ($vbr) {
1364 $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale};
1365 $h->{bitrate} = $i->{SIZE} / $i->{FRAMES} * $mfs;
1366 if (not $h->{bitrate}) {
1367 $@ = "Couldn't determine VBR bitrate";
1368 return undef;
1369 }
1370 }
1371
1372 $h->{'length'} = ($i->{SIZE} * 8) / $h->{bitrate} / 10;
1373 $i->{SECS} = $h->{'length'} / 100;
1374 $i->{MM} = int $i->{SECS} / 60;
1375 $i->{SS} = int $i->{SECS} % 60;
1376 $i->{MS} = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000);
1377# $i->{LF} = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS});
1378# int($i->{MS} / 100 * 75); # is this right?
1379 $i->{TIME} = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'};
1380
1381 $i->{BITRATE} = int $h->{bitrate};
1382 # should we just return if ! FRAMES?
1383 $i->{FRAME_LENGTH} = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES};
1384 $i->{FREQUENCY} = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}];
1385
1386 $i->{headersize} = $h->{headersize};
1387
1388 return $i;
1389}
1390
1391sub _get_head {
1392 my($byte) = @_;
1393 my($bytes, $h);
1394
1395 $bytes = _unpack_head($byte);
1396 @$h{qw(IDR ID layer protection_bit
1397 bitrate_index sampling_freq padding_bit private_bit
1398 mode mode_extension copyright original
1399 emphasis version_index bytes)} = (
1400 ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1,
1401 ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1,
1402 ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1,
1403 $bytes&3, ($bytes>>19)&3, $bytes
1404 );
1405
1406 $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}];
1407 $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}];
1408
1409 return $h;
1410}
1411
1412sub _is_mp3 {
1413 my $h = $_[0] or return undef;
1414 return ! ( # all below must be false
1415 $h->{bitrate_index} == 0
1416 ||
1417 $h->{version_index} == 1
1418 ||
1419 ($h->{bytes} & 0xFFE00000) != 0xFFE00000
1420 ||
1421 !$h->{fs}
1422 ||
1423 !$h->{bitrate}
1424 ||
1425 $h->{bitrate_index} == 15
1426 ||
1427 !$h->{layer}
1428 ||
1429 $h->{sampling_freq} == 3
1430 ||
1431 $h->{emphasis} == 2
1432 ||
1433 !$h->{bitrate_index}
1434 ||
1435 ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000
1436 ||
1437 ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1)
1438 ||
1439 ($h->{mode_extension} != 0 && $h->{mode} != 1)
1440 );
1441}
1442
1443sub _get_vbr {
1444 my($fh, $h, $roff) = @_;
1445 my($off, $bytes, @bytes, $myseek, %vbr);
1446
1447 $off = $$roff;
1448 @_ = (); # closure confused if we don't do this
1449
1450 $myseek = sub {
1451 my $n = $_[0] || 4;
1452 seek $fh, $off, 0;
1453 read $fh, $bytes, $n;
1454 $off += $n;
1455 };
1456
1457 $off += 4;
1458
1459 if ($h->{ID}) { # MPEG1
1460 $off += $h->{mode} == 3 ? 17 : 32;
1461 } else { # MPEG2
1462 $off += $h->{mode} == 3 ? 9 : 17;
1463 }
1464
1465 &$myseek;
1466 return unless $bytes eq 'Xing';
1467
1468 &$myseek;
1469 $vbr{flags} = _unpack_head($bytes);
1470
1471 if ($vbr{flags} & 1) {
1472 &$myseek;
1473 $vbr{frames} = _unpack_head($bytes);
1474 }
1475
1476 if ($vbr{flags} & 2) {
1477 &$myseek;
1478 $vbr{bytes} = _unpack_head($bytes);
1479 }
1480
1481 if ($vbr{flags} & 4) {
1482 $myseek->(100);
1483# Not used right now ...
1484# $vbr{toc} = _unpack_head($bytes);
1485 }
1486
1487 if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst)
1488 &$myseek;
1489 $vbr{scale} = _unpack_head($bytes);
1490 } else {
1491 $vbr{scale} = -1;
1492 }
1493
1494 $$roff = $off;
1495 return \%vbr;
1496}
1497
1498sub _get_v2head {
1499 my $fh = $_[0] or return;
1500 my($h, $bytes, @bytes);
1501
1502 # check first three bytes for 'ID3'
1503 seek $fh, 0, 0;
1504 read $fh, $bytes, 3;
1505 return unless $bytes eq 'ID3';
1506
1507 # get version
1508 read $fh, $bytes, 2;
1509 $h->{version} = sprintf "ID3v2.%d.%d",
1510 @$h{qw[major_version minor_version]} =
1511 unpack 'c2', $bytes;
1512
1513 # get flags
1514 read $fh, $bytes, 1;
1515 if ($h->{major_version} == 2) {
1516 @$h{qw[unsync compression]} =
1517 (unpack 'b8', $bytes)[7, 6];
1518 $h->{ext_header} = 0;
1519 $h->{experimental} = 0;
1520 } else {
1521 @$h{qw[unsync ext_header experimental]} =
1522 (unpack 'b8', $bytes)[7, 6, 5];
1523 }
1524
1525 # get ID3v2 tag length from bytes 7-10
1526 $h->{tag_size} = 10; # include ID3v2 header size
1527 read $fh, $bytes, 4;
1528 @bytes = reverse unpack 'C4', $bytes;
1529 foreach my $i (0 .. 3) {
1530 # whoaaaaaa nellllllyyyyyy!
1531 $h->{tag_size} += $bytes[$i] * 128 ** $i;
1532 }
1533
1534 # get extended header size
1535 $h->{ext_header_size} = 0;
1536 if ($h->{ext_header}) {
1537 $h->{ext_header_size} += 10;
1538 read $fh, $bytes, 4;
1539 @bytes = reverse unpack 'C4', $bytes;
1540 for my $i (0..3) {
1541 $h->{ext_header_size} += $bytes[$i] * 256 ** $i;
1542 }
1543 }
1544
1545 return $h;
1546}
1547
1548sub _unpack_head {
1549 unpack('l', pack('L', unpack('N', $_[0])));
1550}
1551
1552sub _close {
1553 my($file, $fh) = @_;
1554 unless (ref $file) { # filehandle not passed
1555 close $fh or warn "Problem closing '$file': $!";
1556 }
1557}
1558
1559BEGIN {
1560 @mp3_genres = (
1561 'Blues',
1562 'Classic Rock',
1563 'Country',
1564 'Dance',
1565 'Disco',
1566 'Funk',
1567 'Grunge',
1568 'Hip-Hop',
1569 'Jazz',
1570 'Metal',
1571 'New Age',
1572 'Oldies',
1573 'Other',
1574 'Pop',
1575 'R&B',
1576 'Rap',
1577 'Reggae',
1578 'Rock',
1579 'Techno',
1580 'Industrial',
1581 'Alternative',
1582 'Ska',
1583 'Death Metal',
1584 'Pranks',
1585 'Soundtrack',
1586 'Euro-Techno',
1587 'Ambient',
1588 'Trip-Hop',
1589 'Vocal',
1590 'Jazz+Funk',
1591 'Fusion',
1592 'Trance',
1593 'Classical',
1594 'Instrumental',
1595 'Acid',
1596 'House',
1597 'Game',
1598 'Sound Clip',
1599 'Gospel',
1600 'Noise',
1601 'AlternRock',
1602 'Bass',
1603 'Soul',
1604 'Punk',
1605 'Space',
1606 'Meditative',
1607 'Instrumental Pop',
1608 'Instrumental Rock',
1609 'Ethnic',
1610 'Gothic',
1611 'Darkwave',
1612 'Techno-Industrial',
1613 'Electronic',
1614 'Pop-Folk',
1615 'Eurodance',
1616 'Dream',
1617 'Southern Rock',
1618 'Comedy',
1619 'Cult',
1620 'Gangsta',
1621 'Top 40',
1622 'Christian Rap',
1623 'Pop/Funk',
1624 'Jungle',
1625 'Native American',
1626 'Cabaret',
1627 'New Wave',
1628 'Psychadelic',
1629 'Rave',
1630 'Showtunes',
1631 'Trailer',
1632 'Lo-Fi',
1633 'Tribal',
1634 'Acid Punk',
1635 'Acid Jazz',
1636 'Polka',
1637 'Retro',
1638 'Musical',
1639 'Rock & Roll',
1640 'Hard Rock',
1641 );
1642
1643 @winamp_genres = (
1644 @mp3_genres,
1645 'Folk',
1646 'Folk-Rock',
1647 'National Folk',
1648 'Swing',
1649 'Fast Fusion',
1650 'Bebob',
1651 'Latin',
1652 'Revival',
1653 'Celtic',
1654 'Bluegrass',
1655 'Avantgarde',
1656 'Gothic Rock',
1657 'Progressive Rock',
1658 'Psychedelic Rock',
1659 'Symphonic Rock',
1660 'Slow Rock',
1661 'Big Band',
1662 'Chorus',
1663 'Easy Listening',
1664 'Acoustic',
1665 'Humour',
1666 'Speech',
1667 'Chanson',
1668 'Opera',
1669 'Chamber Music',
1670 'Sonata',
1671 'Symphony',
1672 'Booty Bass',
1673 'Primus',
1674 'Porn Groove',
1675 'Satire',
1676 'Slow Jam',
1677 'Club',
1678 'Tango',
1679 'Samba',
1680 'Folklore',
1681 'Ballad',
1682 'Power Ballad',
1683 'Rhythmic Soul',
1684 'Freestyle',
1685 'Duet',
1686 'Punk Rock',
1687 'Drum Solo',
1688 'Acapella',
1689 'Euro-House',
1690 'Dance Hall',
1691 'Goa',
1692 'Drum & Bass',
1693 'Club-House',
1694 'Hardcore',
1695 'Terror',
1696 'Indie',
1697 'BritPop',
1698 'Negerpunk',
1699 'Polsk Punk',
1700 'Beat',
1701 'Christian Gangsta Rap',
1702 'Heavy Metal',
1703 'Black Metal',
1704 'Crossover',
1705 'Contemporary Christian',
1706 'Christian Rock',
1707 'Merengue',
1708 'Salsa',
1709 'Thrash Metal',
1710 'Anime',
1711 'JPop',
1712 'Synthpop',
1713 );
1714
1715 @t_bitrate = ([
1716 [0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256],
1717 [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160],
1718 [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160]
1719 ],[
1720 [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448],
1721 [0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384],
1722 [0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320]
1723 ]);
1724
1725 @t_sampling_freq = (
1726 [11025, 12000, 8000],
1727 [undef, undef, undef], # reserved
1728 [22050, 24000, 16000],
1729 [44100, 48000, 32000]
1730 );
1731
1732 @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 }
1733 map { @$_ } @t_sampling_freq;
1734
1735 @mp3_info_fields = qw(
1736 VERSION
1737 LAYER
1738 STEREO
1739 VBR
1740 BITRATE
1741 FREQUENCY
1742 SIZE
1743 SECS
1744 MM
1745 SS
1746 MS
1747 TIME
1748 COPYRIGHT
1749 PADDING
1750 MODE
1751 FRAMES
1752 FRAME_LENGTH
1753 VBR_SCALE
1754 );
1755
1756 %v1_tag_fields =
1757 (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4);
1758
1759 @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE);
1760
1761 %v2_to_v1_names = (
1762 # v2.2 tags
1763 'TT2' => 'TITLE',
1764 'TP1' => 'ARTIST',
1765 'TAL' => 'ALBUM',
1766 'TYE' => 'YEAR',
1767 'COM' => 'COMMENT',
1768 'TRK' => 'TRACKNUM',
1769 'TCO' => 'GENRE', # not clean mapping, but ...
1770 # v2.3 tags
1771 'TIT2' => 'TITLE',
1772 'TPE1' => 'ARTIST',
1773 'TALB' => 'ALBUM',
1774 'TYER' => 'YEAR',
1775 'COMM' => 'COMMENT',
1776 'TRCK' => 'TRACKNUM',
1777 'TCON' => 'GENRE',
1778 );
1779
1780 %v2_tag_names = (
1781 # v2.2 tags
1782 'BUF' => 'Recommended buffer size',
1783 'CNT' => 'Play counter',
1784 'COM' => 'Comments',
1785 'CRA' => 'Audio encryption',
1786 'CRM' => 'Encrypted meta frame',
1787 'ETC' => 'Event timing codes',
1788 'EQU' => 'Equalization',
1789 'GEO' => 'General encapsulated object',
1790 'IPL' => 'Involved people list',
1791 'LNK' => 'Linked information',
1792 'MCI' => 'Music CD Identifier',
1793 'MLL' => 'MPEG location lookup table',
1794 'PIC' => 'Attached picture',
1795 'POP' => 'Popularimeter',
1796 'REV' => 'Reverb',
1797 'RVA' => 'Relative volume adjustment',
1798 'SLT' => 'Synchronized lyric/text',
1799 'STC' => 'Synced tempo codes',
1800 'TAL' => 'Album/Movie/Show title',
1801 'TBP' => 'BPM (Beats Per Minute)',
1802 'TCM' => 'Composer',
1803 'TCO' => 'Content type',
1804 'TCR' => 'Copyright message',
1805 'TDA' => 'Date',
1806 'TDY' => 'Playlist delay',
1807 'TEN' => 'Encoded by',
1808 'TFT' => 'File type',
1809 'TIM' => 'Time',
1810 'TKE' => 'Initial key',
1811 'TLA' => 'Language(s)',
1812 'TLE' => 'Length',
1813 'TMT' => 'Media type',
1814 'TOA' => 'Original artist(s)/performer(s)',
1815 'TOF' => 'Original filename',
1816 'TOL' => 'Original Lyricist(s)/text writer(s)',
1817 'TOR' => 'Original release year',
1818 'TOT' => 'Original album/Movie/Show title',
1819 'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group',
1820 'TP2' => 'Band/Orchestra/Accompaniment',
1821 'TP3' => 'Conductor/Performer refinement',
1822 'TP4' => 'Interpreted, remixed, or otherwise modified by',
1823 'TPA' => 'Part of a set',
1824 'TPB' => 'Publisher',
1825 'TRC' => 'ISRC (International Standard Recording Code)',
1826 'TRD' => 'Recording dates',
1827 'TRK' => 'Track number/Position in set',
1828 'TSI' => 'Size',
1829 'TSS' => 'Software/hardware and settings used for encoding',
1830 'TT1' => 'Content group description',
1831 'TT2' => 'Title/Songname/Content description',
1832 'TT3' => 'Subtitle/Description refinement',
1833 'TXT' => 'Lyricist/text writer',
1834 'TXX' => 'User defined text information frame',
1835 'TYE' => 'Year',
1836 'UFI' => 'Unique file identifier',
1837 'ULT' => 'Unsychronized lyric/text transcription',
1838 'WAF' => 'Official audio file webpage',
1839 'WAR' => 'Official artist/performer webpage',
1840 'WAS' => 'Official audio source webpage',
1841 'WCM' => 'Commercial information',
1842 'WCP' => 'Copyright/Legal information',
1843 'WPB' => 'Publishers official webpage',
1844 'WXX' => 'User defined URL link frame',
1845
1846 # v2.3 tags
1847 'AENC' => 'Audio encryption',
1848 'APIC' => 'Attached picture',
1849 'COMM' => 'Comments',
1850 'COMR' => 'Commercial frame',
1851 'ENCR' => 'Encryption method registration',
1852 'EQUA' => 'Equalization',
1853 'ETCO' => 'Event timing codes',
1854 'GEOB' => 'General encapsulated object',
1855 'GRID' => 'Group identification registration',
1856 'IPLS' => 'Involved people list',
1857 'LINK' => 'Linked information',
1858 'MCDI' => 'Music CD identifier',
1859 'MLLT' => 'MPEG location lookup table',
1860 'OWNE' => 'Ownership frame',
1861 'PCNT' => 'Play counter',
1862 'POPM' => 'Popularimeter',
1863 'POSS' => 'Position synchronisation frame',
1864 'PRIV' => 'Private frame',
1865 'RBUF' => 'Recommended buffer size',
1866 'RVAD' => 'Relative volume adjustment',
1867 'RVRB' => 'Reverb',
1868 'SYLT' => 'Synchronized lyric/text',
1869 'SYTC' => 'Synchronized tempo codes',
1870 'TALB' => 'Album/Movie/Show title',
1871 'TBPM' => 'BPM (beats per minute)',
1872 'TCOM' => 'Composer',
1873 'TCON' => 'Content type',
1874 'TCOP' => 'Copyright message',
1875 'TDAT' => 'Date',
1876 'TDLY' => 'Playlist delay',
1877 'TENC' => 'Encoded by',
1878 'TEXT' => 'Lyricist/Text writer',
1879 'TFLT' => 'File type',
1880 'TIME' => 'Time',
1881 'TIT1' => 'Content group description',
1882 'TIT2' => 'Title/songname/content description',
1883 'TIT3' => 'Subtitle/Description refinement',
1884 'TKEY' => 'Initial key',
1885 'TLAN' => 'Language(s)',
1886 'TLEN' => 'Length',
1887 'TMED' => 'Media type',
1888 'TOAL' => 'Original album/movie/show title',
1889 'TOFN' => 'Original filename',
1890 'TOLY' => 'Original lyricist(s)/text writer(s)',
1891 'TOPE' => 'Original artist(s)/performer(s)',
1892 'TORY' => 'Original release year',
1893 'TOWN' => 'File owner/licensee',
1894 'TPE1' => 'Lead performer(s)/Soloist(s)',
1895 'TPE2' => 'Band/orchestra/accompaniment',
1896 'TPE3' => 'Conductor/performer refinement',
1897 'TPE4' => 'Interpreted, remixed, or otherwise modified by',
1898 'TPOS' => 'Part of a set',
1899 'TPUB' => 'Publisher',
1900 'TRCK' => 'Track number/Position in set',
1901 'TRDA' => 'Recording dates',
1902 'TRSN' => 'Internet radio station name',
1903 'TRSO' => 'Internet radio station owner',
1904 'TSIZ' => 'Size',
1905 'TSRC' => 'ISRC (international standard recording code)',
1906 'TSSE' => 'Software/Hardware and settings used for encoding',
1907 'TXXX' => 'User defined text information frame',
1908 'TYER' => 'Year',
1909 'UFID' => 'Unique file identifier',
1910 'USER' => 'Terms of use',
1911 'USLT' => 'Unsychronized lyric/text transcription',
1912 'WCOM' => 'Commercial information',
1913 'WCOP' => 'Copyright/Legal information',
1914 'WOAF' => 'Official audio file webpage',
1915 'WOAR' => 'Official artist/performer webpage',
1916 'WOAS' => 'Official audio source webpage',
1917 'WORS' => 'Official internet radio station homepage',
1918 'WPAY' => 'Payment',
1919 'WPUB' => 'Publishers official webpage',
1920 'WXXX' => 'User defined URL link frame',
1921
1922 # v2.4 additional tags
1923 # note that we don't restrict tags from 2.3 or 2.4,
1924 'ASPI' => 'Audio seek point index',
1925 'EQU2' => 'Equalisation (2)',
1926 'RVA2' => 'Relative volume adjustment (2)',
1927 'SEEK' => 'Seek frame',
1928 'SIGN' => 'Signature frame',
1929 'TDEN' => 'Encoding time',
1930 'TDOR' => 'Original release time',
1931 'TDRC' => 'Recording time',
1932 'TDRL' => 'Release time',
1933 'TDTG' => 'Tagging time',
1934 'TIPL' => 'Involved people list',
1935 'TMCL' => 'Musician credits list',
1936 'TMOO' => 'Mood',
1937 'TPRO' => 'Produced notice',
1938 'TSOA' => 'Album sort order',
1939 'TSOP' => 'Performer sort order',
1940 'TSOT' => 'Title sort order',
1941 'TSST' => 'Set subtitle',
1942
1943 # grrrrrrr
1944 'COM ' => 'Broken iTunes comments',
1945 );
1946}
1947
19481;
1949
1950__END__
1951
1952=pod
1953
1954=back
1955
1956=head1 TROUBLESHOOTING
1957
1958If you find a bug, please send me a patch (see the project page in L<"SEE ALSO">).
1959If you cannot figure out why it does not work for you, please put the MP3 file in
1960a place where I can get it (preferably via FTP, or HTTP, or .Mac iDisk) and send me
1961mail regarding where I can get the file, with a detailed description of the problem.
1962
1963If I download the file, after debugging the problem I will not keep the MP3 file
1964if it is not legal for me to have it. Just let me know if it is legal for me to
1965keep it or not.
1966
1967
1968=head1 TODO
1969
1970=over 4
1971
1972=item ID3v2 Support
1973
1974Still need to do more for reading tags, such as using Compress::Zlib to decompress
1975compressed tags. But until I see this in use more, I won't bother. If something
1976does not work properly with reading, follow the instructions above for
1977troubleshooting.
1978
1979ID3v2 I<writing> is coming soon.
1980
1981=item Get data from scalar
1982
1983Instead of passing a file spec or filehandle, pass the
1984data itself. Would take some work, converting the seeks, etc.
1985
1986=item Padding bit ?
1987
1988Do something with padding bit.
1989
1990=item Test suite
1991
1992Test suite could use a bit of an overhaul and update. Patches very welcome.
1993
1994=over 4
1995
1996=item *
1997
1998Revamp getset.t. Test all the various get_mp3tag args.
1999
2000=item *
2001
2002Test Unicode.
2003
2004=item *
2005
2006Test OOP API.
2007
2008=item *
2009
2010Test error handling, check more for missing files, bad MP3s, etc.
2011
2012=back
2013
2014=item Other VBR
2015
2016Right now, only Xing VBR is supported.
2017
2018=back
2019
2020
2021=head1 THANKS
2022
2023Edward Allen E<lt>allenej@c51844-a.spokn1.wa.home.comE<gt>,
2024Vittorio Bertola E<lt>v.bertola@vitaminic.comE<gt>,
2025Michael Blakeley E<lt>mike@blakeley.comE<gt>,
2026Per Bolmstedt E<lt>tomten@kol14.comE<gt>,
2027Tony Bowden E<lt>tony@tmtm.comE<gt>,
2028Tom Brown E<lt>thecap@usa.netE<gt>,
2029Sergio Camarena E<lt>scamarena@users.sourceforge.netE<gt>,
2030Chris Dawson E<lt>cdawson@webiphany.comE<gt>,
2031Luke Drumm E<lt>lukedrumm@mypad.comE<gt>,
2032Kyle Farrell E<lt>kyle@cantametrix.comE<gt>,
2033Jeffrey Friedl E<lt>jfriedl@yahoo.comE<gt>,
2034brian d foy E<lt>comdog@panix.comE<gt>,
2035Ben Gertzfield E<lt>che@debian.orgE<gt>,
2036Brian Goodwin E<lt>brian@fuddmain.comE<gt>,
2037Todd Hanneken E<lt>thanneken@hds.harvard.eduE<gt>,
2038Todd Harris E<lt>harris@cshl.orgE<gt>,
2039Woodrow Hill E<lt>asim@mindspring.comE<gt>,
2040Kee Hinckley E<lt>nazgul@somewhere.comE<gt>,
2041Roman Hodek E<lt>Roman.Hodek@informatik.uni-erlangen.deE<gt>,
2042Peter Kovacs E<lt>kovacsp@egr.uri.eduE<gt>,
2043Johann Lindvall,
2044Peter Marschall E<lt>peter.marschall@mayn.deE<gt>,
2045Trond Michelsen E<lt>mike@crusaders.noE<gt>,
2046Dave O'Neill E<lt>dave@nexus.carleton.caE<gt>,
2047Christoph Oberauer E<lt>christoph.oberauer@sbg.ac.atE<gt>,
2048Jake Palmer E<lt>jake.palmer@db.comE<gt>,
2049Andrew Phillips E<lt>asp@wasteland.orgE<gt>,
2050David Reuteler E<lt>reuteler@visi.comE<gt>,
2051John Ruttenberg E<lt>rutt@chezrutt.comE<gt>,
2052Matthew Sachs E<lt>matthewg@zevils.comE<gt>,
2053E<lt>scfc_de@users.sf.netE<gt>,
2054Hermann Schwaerzler E<lt>Hermann.Schwaerzler@uibk.ac.atE<gt>,
2055Chris Sidi E<lt>sidi@angband.orgE<gt>,
2056Roland Steinbach E<lt>roland@support-system.comE<gt>,
2057Stuart E<lt>schneis@users.sourceforge.netE<gt>,
2058Jeffery Sumler E<lt>jsumler@mediaone.netE<gt>,
2059Predrag Supurovic E<lt>mpgtools@dv.co.yuE<gt>,
2060Bogdan Surdu E<lt>tim@go.roE<gt>,
2061E<lt>tim@tim-landscheidt.deE<gt>,
2062Pass F. B. Travis E<lt>pftravis@bellsouth.netE<gt>,
2063Tobias Wagener E<lt>tobias@wagener.nuE<gt>,
2064Ronan Waide E<lt>waider@stepstone.ieE<gt>,
2065Andy Waite E<lt>andy@mailroute.comE<gt>,
2066Ken Williams E<lt>ken@forum.swarthmore.eduE<gt>,
2067Meng Weng Wong E<lt>mengwong@pobox.comE<gt>.
2068
2069
2070=head1 AUTHOR AND COPYRIGHT
2071
2072Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/
2073
2074Copyright (c) 1998-2003 Chris Nandor. All rights reserved. This program is
2075free software; you can redistribute it and/or modify it under the terms
2076of the Artistic License, distributed with Perl.
2077
2078
2079=head1 SEE ALSO
2080
2081=over 4
2082
2083=item MP3::Info Project Page
2084
2085 http://projects.pudge.net/
2086
2087=item mp3tools
2088
2089 http://www.zevils.com/linux/mp3tools/
2090
2091=item mpgtools
2092
2093 http://www.dv.co.yu/mpgscript/mpgtools.htm
2094 http://www.dv.co.yu/mpgscript/mpeghdr.htm
2095
2096=item mp3tool
2097
2098 http://www.dtek.chalmers.se/~d2linjo/mp3/mp3tool.html
2099
2100=item ID3v2
2101
2102 http://www.id3.org/
2103
2104=item Xing Variable Bitrate
2105
2106 http://www.xingtech.com/support/partner_developer/mp3/vbr_sdk/
2107
2108=item MP3Ext
2109
2110 http://rupert.informatik.uni-stuttgart.de/~mutschml/MP3ext/
2111
2112=item Xmms
2113
2114 http://www.xmms.org/
2115
2116
2117=back
2118
2119=head1 VERSION
2120
2121v1.02, Sunday, March 2, 2003
2122
2123=cut
diff --git a/tools/vorbiscomm.pm b/tools/vorbiscomm.pm
deleted file mode 100644
index f2e48e8632..0000000000
--- a/tools/vorbiscomm.pm
+++ /dev/null
@@ -1,732 +0,0 @@
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
9package vorbiscomm;
10
11use 5.005;
12use strict;
13use warnings;
14
15use Fcntl qw/SEEK_END/;
16
17our $VERSION = '0.07';
18
19sub new
20{
21 my $class = shift;
22 my $file = shift;
23
24 return load($class, $file);
25}
26
27sub 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
78sub 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
93sub 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
104sub 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
118sub add_comments
119{
120 warn "Ogg::Vorbis::Header::PurePerl add_comments() unimplemented.";
121}
122
123sub edit_comment
124{
125 warn "Ogg::Vorbis::Header::PurePerl edit_comment() unimplemented.";
126}
127
128sub delete_comment
129{
130 warn "Ogg::Vorbis::Header::PurePerl delete_comment() unimplemented.";
131}
132
133sub clear_comments
134{
135 warn "Ogg::Vorbis::Header::PurePerl clear_comments() unimplemented.";
136}
137
138sub path
139{
140 my $self = shift;
141
142 return $self->{'fileName'};
143}
144
145sub write_vorbis
146{
147 warn "Ogg::Vorbis::Header::PurePerl write_vorbis unimplemented.";
148}
149
150# "private" methods
151
152sub _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
171sub _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
248sub _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
310sub _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
470sub _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
529sub _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
553sub _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
570sub _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
580sub _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
590sub _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
6091;
610__DATA__
611
612=head1 NAME
613
614Ogg::Vorbis::Header::PurePerl - An object-oriented interface to Ogg Vorbis
615information and comment fields, implemented entirely in Perl. Intended to be
616a drop in replacement for Ogg::Vobis::Header.
617
618Unlike Ogg::Vorbis::Header, this module will go ahead and fill in all of the
619information fields as soon as you construct the object. In other words,
620the 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
635This module is intended to be a drop in replacement for Ogg::Vorbis::Header,
636implemented entirely in Perl. It provides an object-oriented interface to
637Ogg Vorbis information and comment fields. (NOTE: This module currently
638supports only read operations).
639
640=head1 CONSTRUCTORS
641
642=head2 C<new ($filename)>
643
644Opens an Ogg Vorbis file, ensuring that it exists and is actually an
645Ogg Vorbis stream. This method does not actually read any of the
646information or comment fields, and closes the file immediately.
647
648=head2 C<load ([$filename])>
649
650Opens an Ogg Vorbis file, ensuring that it exists and is actually an
651Ogg Vorbis stream, then loads the information and comment fields. This
652method can also be used without a filename to load the information
653and fields of an already constructed instance.
654
655=head1 INSTANCE METHODS
656
657=head2 C<info ([$key])>
658
659Returns a hashref containing information about the Ogg Vorbis file from
660the file's information header. Hash fields are: version, channels, rate,
661bitrate_upper, bitrate_nominal, bitrate_lower, bitrate_window, and length.
662The bitrate_window value is not currently used by the vorbis codec, and
663will always be -1.
664
665The optional parameter, key, allows you to retrieve a single value from
666the object's hash. Returns C<undef> if the key is not found.
667
668=head2 C<comment_tags ()>
669
670Returns an array containing the key values for the comment fields.
671These values can then be passed to C<comment> to retrieve their values.
672
673=head2 C<comment ($key)>
674
675Returns an array of comment values associated with the given key.
676
677=head2 C<add_comments ($key, $value, [$key, $value, ...])>
678
679Unimplemented.
680
681=head2 C<edit_comment ($key, $value, [$num])>
682
683Unimplemented.
684
685=head2 C<delete_comment ($key, [$num])>
686
687Unimplemented.
688
689=head2 C<clear_comments ([@keys])>
690
691Unimplemented.
692
693=head2 C<write_vorbis ()>
694
695Unimplemented.
696
697=head2 C<path ()>
698
699Returns the path/filename of the file the object represents.
700
701=head1 NOTE
702
703This is ALPHA SOFTWARE. It may very well be very broken. Do not use it in
704a production environment. You have been warned.
705
706=head1 ACKNOWLEDGEMENTS
707
708Dave Brown <cpan@dagbrown.com> made this module significantly faster
709at calculating the length of ogg files.
710
711Robert Moser II <rlmoser@earthlink.net> fixed a problem with files that
712have no comments.
713
714=head1 AUTHOR
715
716Andrew Molloy E<lt>amolloy@kaizolabs.comE<gt>
717
718=head1 COPYRIGHT
719
720Copyright (c) 2003, Andrew Molloy. All Rights Reserved.
721
722This program is free software; you can redistribute it and/or modify it
723under the terms of the GNU General Public License as published by the
724Free Software Foundation; either version 2 of the License, or (at
725your option) any later version. A copy of this license is included
726with this module (LICENSE.GPL).
727
728=head1 SEE ALSO
729
730L<Ogg::Vorbis::Header>, L<Ogg::Vorbis::Decoder>
731
732=cut
generated by cgit v1.2.3 (git 2.39.1) at 2024-10-05 21:36:28 +0000