a) Two new modules MP3::Tag::Inf and MP3::Tag::CDDB_File added; b) autoinfo() method returns the info for all ID3v1 tags; c) autoinfo() method may return the info which tag is obtained from which source; d) Methods title(), author() etc (one per each ID3v1 tag) exist and have uniform interface through all the subpackages; e) method song() is renamed to title(); method read_filename() is renamed to parse_filename(); backward compatible name still preserved; f) config() subroutine can now change all the arbitrary decisions; g) new method interpolate() for tag interpolation into strings; h) new methods filename(), abs_filename() and filename_nodir(). i) more robust parsing of filenames; year can be read from filename if appended (in parentheses) to author or title; filename can be F<.wav> as well. j) new ID3v1 method fits_tags() to check whether the info can be placed into an ID3v1 tag; k) allow multiple frames to be returned by get_frame() in ID3v2; l) new method get_frames() with better order of returned values (comparing to get_frame); m) get_frame_ids() in ID3v2 improved to take new argument 'truename' to simplify looping over repeated frames; n) File supports file names starting with track numbers as in 03_This_is_the_title.mp3 (all MP3s I saw look like this...). o) a couple of new v2.4 field names added. p) misprints in the docs corrected. --- ./MANIFEST-pre Mon Aug 6 14:21:28 2001 +++ ./MANIFEST Tue Nov 25 01:47:24 2003 @@ -7,6 +7,8 @@ Tag.pm Tag/File.pm Tag/ID3v1.pm Tag/ID3v2.pm +Tag/Inf.pm +Tag/CDDB_File.pm data_pod.PL examples/README.txt examples/extractID3v2.pl --- ./Tag.pm-pre Mon Aug 6 14:19:10 2001 +++ ./Tag.pm Mon Dec 22 01:25:34 2003 @@ -7,9 +7,12 @@ package MP3::Tag; # at the moment MP3::Tag works with MP3::Tag::ID3v1 and MP3::Tag::ID3v2 use strict; +use Cwd 'abs_path'; use MP3::Tag::ID3v1; use MP3::Tag::ID3v2; use MP3::Tag::File; +use MP3::Tag::Inf; +use MP3::Tag::CDDB_File; use vars qw/$VERSION %config/; $VERSION="0.40"; @@ -27,7 +30,8 @@ MP3::Tag - Module for reading tags of MP $mp3 = MP3::Tag->new($filename); # get some information about the file in the easiest way - ($song, $track, $artist, $album) = $mp3->autoinfo(); + ($title, $track, $artist, $album, $comment, $year, $genre) = $mp3->autoinfo(); + $comment = $mp3->comment(); # or have a closer look on the tags @@ -37,7 +41,7 @@ MP3::Tag - Module for reading tags of MP if (exists $mp3->{ID3v1}) { # read some information from the tag $id3v1 = $mp3->{ID3v1}; # $id3v1 is only a shortcut for $mp3->{ID3v1} - print $id3v1->song; + print $id3v1->title; # change the tag contents $id3v1->all("Song","Artist","Album",2001,"Comment",10,"Top 40"); @@ -53,7 +57,7 @@ MP3::Tag - Module for reading tags of MP # create a new tag $mp3->new_tag("ID3v2"); $mp3->{ID3v2}->add_frame("TALB", "Album title"); - $mp3->write_tag; + $mp3->{ID3v2}->write_tag; } $mp3->close(); @@ -65,10 +69,13 @@ Thomas Geffert, thg@users.sourceforge.ne =head1 DESCRIPTION Tag is a wrapper module to read different tags of mp3 files. -It provides an easy way to access the functions of seperate moduls +It provides an easy way to access the functions of seperate modules which do the handling of reading/writing the tags itself. -At the moment MP3::Tag::ID3v1 and MP3::Tag::ID3v2 are supported. +At the moment MP3::Tag::ID3v1 and MP3::Tag::ID3v2 are supported for read +and write; MP3::Tag::Inf, MP3::Tag::CDDB_File, and MP3::Tag::File are +supported for read access (the information obtained by parsing CDDB files, +F<.inf> file and the filename). =over 4 @@ -91,7 +98,9 @@ sub new { # later it should hopefully possible to support also http/ftp sources # with a MP3::Tag::Net module or something like that if ($mp3data) { - my $self={filename=>$mp3data}; + my $self={filename=>$mp3data, + ofilename => $filename, + abs_filename => abs_path($filename)}; bless $self, $class; return $self; } @@ -108,13 +117,14 @@ sub new { Checks which tags can be found in the mp3-object. It returns a list @tags which contains strings identifying the found tags, like -"ID3v1" or "ID3v2" . +"ID3v1", "ID3v2", "Inf", or "CDDB_File" (the last but one if the F<.inf> +information file with the same basename as MP3 file is found). Each found tag can then be accessed with $mp3->{tagname} , where tagname is -a sting returned by get_tags ; +a string returned by get_tags ; -Use the information found in L and L -to see what you can do with the tags. +Use the information found in L, L and +L, L to see what you can do with the tags. =cut @@ -122,12 +132,9 @@ to see what you can do with the tags. sub get_tags { my $self = shift; + return @{$self->{gottags}} if exists $self->{gottags}; my (@IDs, $ref); - if (exists $self->{gottags}) { - push @IDs, "ID3v1" if exists $self->{ID3v1}; - push @IDs, "ID3v2" if exists $self->{ID3v2}; - } elsif ($self->{filename}->open()) { - $self->{gottags}=1; + if ($self->{filename}->open()) { if (defined ($ref = MP3::Tag::ID3v2->new($self->{filename}))) { $self->{ID3v2} = $ref; push @IDs, "ID3v2"; @@ -137,6 +144,18 @@ sub get_tags { push @IDs, "ID3v1"; } } + if ( not exists $self->{Inf} + and defined ($ref = MP3::Tag::Inf->new($self->{filename}{filename})) ) { + $self->{Inf} = $ref; + push @IDs, "Inf"; + } + $self->{gottags} = [@IDs]; # So "guess" can use collected info + if ( not exists $self->{CDDB_File} + and defined ($ref = MP3::Tag::CDDB_File->new_guess_track($self->{filename}{filename}, $self)) ) { + $self->{CDDB_File} = $ref; + push @IDs, "CDDB_File"; + } + $self->{gottags} = [@IDs]; return @IDs; } @@ -219,54 +238,140 @@ sub genres { =item autoinfo() - ($song, $track, $artist, $album) = $mp3->autoinfo(); + ($title, $track, $artist, $album, $comment, $year, $genre) = $mp3->autoinfo(); $info_hashref = $mp3->autoinfo(); -autoinfo() returns information about the song name, song number, -artist and album name. It can get this information from an -ID3v1-tag, an ID3v2-tag and from the filename itself. +autoinfo() returns information about the title, track number, +artist, album name, the file comment, the year and genre. It can get this +information from an ID3v1-tag, an ID3v2-tag, from CDDB file, from F<.inf>-file, +and from the filename itself. It will as default first try to find a ID3v2-tag to get this -information. If this cannot be found it tries to find a ID3v1-tag and -if this is not present either, it will use the filename to retrieve -the information. +information. If this cannot be found it tries to find a ID3v1-tag, then +to read an CDDB file, an F<.inf>-file, and +if these are not present either, it will use the filename to retrieve +the title, track number, artist, album name. The comment, year and genre +are found differently, via the C, C and C methods. -You can change the order of this with the config() command. +You can change the order of lookup with the config() command. autoinfo() returns an array with the information or a hashref. The hash -has four keys 'song', 'track', 'artist' and 'album' where the information is -stored. +has four keys 'title', 'track', 'artist' and 'album' where the information is +stored. If comment, year or genre are found, the hash will have keys +'comment' and/or 'year' and/or 'genre' too. + +If an optional argument C<'from'> is given, the returned values (title, +track number, artist, album name, the file comment, the year and genre) are +array references with the first element being the value, the second the +tag (C or C or C or C or C) from which +it is taken. + +(Deprecated name 'song' can be used instead of 'title' as well.) =cut sub autoinfo() { - my ($self) = shift; + my ($self, $from) = (shift, shift); + my (@out, %out); - my @order; - if (exists $config{autoinfo}) { - @order = @{$config{autoinfo}}; - } else { - @order = ("ID3v2","ID3v1","filename"); + for my $elt ( qw( title track artist album comment year genre ) ) { + my $out = $self->$elt($from); + if (wantarray) { + push @out, $out; + } elsif (defined $out and length $out) { + $out{$elt} = $out; + } } + $out{song} = $out{title} if exists $out{title}; + + return wantarray ? @out : \%out; +} + +=item comment() + + $comment = $mp3->comment(); # empty string unless found + +comment() returns comment information. It can get this information from an +ID3v1-tag, or an ID3v2-tag (from C frame with empty field), +CDDB file (from C or C fields), or F<.inf>-file (from +C field). + +It will as default first try to find a ID3v2-tag to get this +information. If no comment is found there, it tries to find it in a ID3v1-tag, +if none present, will try CDDB file, then F<.inf>-file. It returns an empty string if +no comment is found. + +You can change the order of this with the config() command. + +If an optional argument C<'from'> is given, returns an array reference with +the first element being the value, the second the tag (ID3v2 or ID3v1) from +which the value is taken. + +=cut + +=item year() + + $year = $mp3->year(); # empty string unless found + +year() returns the year information. It can get this information from an +ID3v2-tag, or ID3v1-tag, or F<.inf>-file, or filename. + +It will as default first try to find a ID3v2-tag to get this +information. If no year is found there, it tries to find it in a ID3v1-tag, +if none present, will try CDDB file, then F<.inf>-file, +then by parsing the file name. It returns an empty string if no year is found. + +You can change the order of this with the config() command. + +If an optional argument C<'from'> is given, returns an array reference with +the first element being the value, the second the tag (ID3v2 or ID3v1 or +filename) from which the value is taken. + +=cut - $self->get_tags unless exists $self->{gottags}; +sub auto_field($;$) { + my ($self, $elt, $from) = (shift, shift, shift); - my ($song, $track, $artist, $album)=("","","",""); - foreach my $part (@order) { - if (exists $self->{$part}) { - #get the info - $song=$self->{$part}->song; - $track=$self->{$part}->track; - $artist=$self->{$part}->artist; - $album=$self->{$part}->album; - last; - } + my $parts = $config{$elt} || $config{autoinfo} + || [qw(ID3v2 ID3v1 CDDB_File Inf filename)]; + $self->get_tags; + + foreach my $part (@$parts) { + next unless exists $self->{$part}; + next unless defined (my $out = $self->{$part}->$elt()); + next unless length $out or $part ne 'ID3v1'; # Returns empty... + return [$out, $part] if $from; + return $out; } - return wantarray ? ($song, $track, $artist, $album) : - { song => $song, track => $track, artist => $artist, album => $album } ; + return ''; } -=pod +for my $elt ( qw( title track artist album comment year genre ) ) { + no strict 'refs'; + *$elt = sub (;$) { + my $self = shift; + $self->auto_field($elt, @_); + } +} + +=item genre() + + $genre = $mp3->genre(); # empty string unless found + +genre() returns the genre string. It can get this information from an +ID3v2-tag or ID3v1-tag. + +It will as default first try to find a ID3v2-tag to get this +information. If no genre is found there, it tries to find it in a ID3v1-tag, +if none present, will try F<.inf>-file, +It returns an empty string if no genre is found. + +You can change the order of this with the config() command. + +If an optional argument C<'from'> is given, returns an array reference with +the first element being the value, the second the tag (ID3v2 or ID3v1 or +filename) from which the value is taken. + =item config @@ -277,10 +382,12 @@ Possible items are: * autoinfo Configure the order in which ID3v1-, ID3v2-tag and filename are used - by autoinfo. Options can be "ID3v1","ID3v2","filename". The order + by autoinfo. Options can be "ID3v1", "ID3v2", "CDDB_File", "Inf", "filename". + The order in which they are given to config also sets the order how they are used by autoinfo. If an option is not present, it will not be used - by auotinfo. + by autoinfo (and other auto-methods if the specific overriding config + command were not issued). $mp3->config("autoinfo","ID3v1","ID3v2","filename"); @@ -298,6 +405,25 @@ Possible items are: sets the order to check first ID3v1, then ID3v2. The filename will never be used. +* title artist album year comment track genre + + Configure the order in which ID3v1- and ID3v2-tag are used + by the corresponding methods (e.g., comment()). Options can be + "ID3v1", "ID3v2", "Inf", "CDDB_File", "filename". The order + in which they are given to config also sets the order how they are + used by comment(). If an option is not present, then autoinfo option + will be used instead. + +* v2title + + Configure the elements of ID3v2-tag which are used by ID3v2::title(). + Options can be "TIT1", "TIT2", "TIT3"; the present values are combined. + If an option is not present, it will not be used by ID3v2::title(). + +* cddb_files + + List of files to look for in the directory of MP3 file to get CDDB info. + * Later there will be probably more things to configure. =cut @@ -307,7 +433,7 @@ sub config() { $item = lc $item; - if ($item ne "autoinfo") { + if ($item !~ /^(autoinfo|title|artist|album|year|comment|track|genre|v2title|cddb_files)$/) { warn "MP3::Tag::config(): Unknown option '$item' found\n"; return; } @@ -315,6 +441,155 @@ sub config() { $config{$item}=\@options; } + +=item interpolate + + $string = $mp3->interpolate($pattern) + +interpolates C<%>-escapes in $pattern using the information from $mp3 tags. +The syntax of escapes is similar to this of sprintf(): + + % [ [FLAGS] MINWIDTH] [.MAXWIDTH] ESCAPE + +The only recognized FLAGS are C<-> (to denote left-alignment inside MINWIDTH- +wide field), C<' '> (SPACE), and C<0> (denoting the fill character to use), as +well as an arbitrary character in parentheses (which becomes the fill +character). MINWIDTH and MAXWIDTH should be numbers. + +The one-letter ESCAPEs are replaced by + + t => title + a => artist + l => album + y => year + g => genre + c => comment + n => track + +Additionally, ESCAPE can be a string (with all backslashes and curlies escaped) +enclosed in curly braces C<{}>. The interpretation is the following: + +=over 4 + +=item * + +Names of ID3v2 frames are replaced by their text values (empty for missing +frames). + +=item * + +If string starts with C: if frame FNAME does not exists, the escape +is ignored; otherwise the rest of the string is reinterpreted (after stripping +backslashes from backslashes and curlies). +other + +=item * + +String starting with C are treated similarly with inverted test. + +=over + +The default for the fill character is SPACE. Fill character should preceed +C<-> if both are given. Example: + + Title: %(/)-12.12t%{TIT3:; TIT3 is %\{TIT3\}}%{!TIT3:. No TIT3 is present} + +will result in + + Title: TITLE///////; TIT3 is Op. 16 + +If title is C, and TIT3 is C<Op. 16>, and + + Title: TITLE///////. No TIT3 is present + +If title is C<TITLE>, but TIT3 is not present. + +=cut + +my %trans = ( 't' => 'title', + 'a' => 'artist', + 'l' => 'album', + 'y' => 'year', + 'g' => 'genre', + 'c' => 'comment', + 'n' => 'track', + 'f' => 'filename_nodir', + 'F' => 'abs_filename' ); + +sub interpolate { + my ($self, $pattern) = @_; + $self->get_tags(); + my $res = ""; + my $ids; + + while ($pattern =~ s/^([^%]+)|^%(?:(?:\((.)\)|([^-.\d]))?(-)?(\d+))?(?:\.(\d+))?([talygcnfF{%])//s) { + $res .= $1, next if defined $1; + my ($fill, $left, $minwidth, $maxwidth, $what) + = ((defined $2 ? $2 : $3), $4, $5, $6, $7); + my $str; + if ($what eq '{') { # id3v2 stuff + die "No ID3v2 present" unless $self->{ID3v2}; + $pattern =~ s/^((?:[^\\{}]|\\[\\{}])*)}// or die "Mismatched {} in pattern `$pattern'"; + $what = $1; + if ($what =~ /^\w{4}\d*$/) { + $str = $self->{ID3v2}->get_frame($what); + } elsif ($what =~ /^(!)?(\w{4}\d*):(.*)/s) { + $ids = $self->{ID3v2}->get_frame_ids unless $ids; + my $have = exists $ids->{$2}; + next unless $1 ? !$have : $have; + ($str = $3) =~ s/\\([\\{}])/$1/g; + $str = $self->interpolate($str); + } else { + die "unknown escape `$what'"; + } + } elsif ($what eq %') { + $str = '%'; + } else { + my $meth = $trans{$what}; + $str = $self->$meth; + } + $str = '' unless defined $str; + $str = substr $str, 0, $maxwidth if defined $maxwidth; + if (defined $minwidth) { + $fill = ' ' unless defined $fill; + if ($left) { + $str .= $fill x ($minwidth - length $str); + } else { + $str = $fill x ($minwidth - length $str) . $str; + } + } + $res .= $str; + } + die "Can't parse `$pattern'" if length $pattern; + return $res; +} + +=item filename() + +=item abs_filename(), + + $filename = $mp3->filename(); + $abs_filename = $mp3->abs_filename(); + $filename_nodir = $mp3->filename_nodir(); + +Return the name of the audio file (either as given to the new() method, or +absolute, or directory-less). + +=cut + +sub filename { + shift->{ofilename} +} + +sub abs_filename { + shift->{abs_filename} +} + +sub filename_nodir { + require File::Basename; + my ($out) = File::Basename::fileparse(shift->filename, ""); + $out +} sub DESTROY { my $self=shift; --- ./test.pl-pre Thu Jun 7 10:16:08 2001 +++ ./test.pl Tue Nov 25 20:43:36 2003 @@ -6,7 +6,7 @@ # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) -BEGIN { $| = 1; print "1..15\n"; } +BEGIN { $| = 1; print "1..44\n"; } END {print "MP3::Tag not loaded :(\n" unless $loaded;} use MP3::Tag; $loaded = 1; @@ -32,6 +32,11 @@ ok($v2,"Detecting ID3v2"); #test - reading ID3v1 ok(($v1 && ($v1->song eq "Song") && ($v1->track == 10)),"Reading ID3v1"); +ok(($mp3->title eq "Only a test with a ID3v1 and ID3v2 tag") && ($mp3->track == 10),"Reading ID3v1/2 via Tag"); +ok($mp3->comment eq "test", "Reading ID3v1 comment via Tag"); +ok($mp3->year eq 2000, "Reading ID3v1 year via Tag"); +ok($mp3->genre eq 'Ska', "Reading ID3v1 genre via Tag"); + #test - reading ID3v2 ok($v2 && $v2->get_frame("COMM")->{short} eq "Test!","Reading ID3v2"); @@ -60,18 +65,108 @@ $v2 = $mp3->{ID3v2}; #test 10 - reading new ID3v1 ok($v1 && $v1->song eq "New" && $v1->artist eq "Artist","Checking new ID3v1"); +ok($v1 && $v1->title eq "New","Checking new ID3v1"); +ok($v1 && $mp3->autoinfo->{title} eq "New","Checking new ID3v1"); + + #test 11 - reading new ID3v2 ok($v2 && $v2->get_frame("TLAN") eq "ENG" && $v2->get_frame("TLAN01") eq "GER","Checking new ID3v2"); +#test 16 - reading new ID3v2 +ok($v2 && (@f = $v2->get_frame("TLAN")) && @f == 3 && "@f[0,2]" eq "ENG GER", "Checking multi-frame ID3v2"); +ok($v2 && (@f = $v2->get_frames("TLAN")) && @f == 3 && "@f[1,2]" eq "ENG GER", "Checking multi-frame ID3v2"); + +#test 18 - comment +ok($v2 && !defined $v2->comment(), "Checking no comment"); + +ok($v2 && $v2->add_frame("COMM", "ENG", '', 'Testing...'), "Changing ID3v2 ''-comment"); +ok($v2 && $v2->write_tag,"Writing ID3v2"); + +$mp3 = MP3::Tag->new("test2.mp3"); +$mp3->get_tags; +$v2 = $mp3->{ID3v2}; +ok($v2 && $v2->comment() eq 'Testing...', "Checking any-language comment"); + +ok($v2 && $v2->comment('Another test...', '', "ENG"), "Setting ID3v2-comment"); +ok($v2 && $v2->write_tag,"Writing ID3v2"); + +$mp3 = MP3::Tag->new("test2.mp3"); +$mp3->get_tags; +$v1 = $mp3->{ID3v1}; +$v2 = $mp3->{ID3v2}; + +ok($v2 && $v2->comment() eq 'Testing...', "Checking any-language comment"); +ok($v2 && !defined $v2->_comment('GER'), "Checking no GER comment"); +ok($v2 && $v2->_comment('ENG') eq 'Testing...', "Checking ENG comment"); +ok($v2 && $mp3->comment() eq 'Testing...', "Checking ID3 comment"); + +my $s = $mp3->interpolate('Title: `%12.12t\'; %{TLAN} %{TLAN01: have %\{TLAN01\}} %{!TLAN02:, do not have TLAN02}'); +ok($s && $s eq "Title: ` New'; ENG have GER , do not have TLAN02", "Checking ID3 interpolation"); #back to original tag -open (FH, ">test2.mp3"); +open (FH, ">test2.mp3") or warn; +binmode FH; print FH "empty"; -close FH; +close FH or warn; + +# Check the .inf parsing +open FH, ">test2.inf" or warn; +print FH <<EOP; +#created by test script +# +CDINDEX_DISCID= 'nFif1ufKKowDai0uJk8E7b_B1cw-' +CDDB_DISCID= 0xe60ca011 +MCN= +ISRC= +# +Albumperformer= 'Some Choir' +Performer= 'Bach (2110)' +Albumtitle= 'Liturgy of St. John; Op 31' +Tracktitle= 'It Is Truly Meet' +Tracknumber= 11 +Trackstart= 174717 +# track length in sectors (1/75 seconds each), rest samples +Tracklength= 10533, 0 +Pre-emphasis= no +Channels= 2 +Copy_permitted= once (copyright protected) +Endianess= little +# index list +Index= 0 +Year= 1988 +Trackcomment= 'Chiribim conducts Some Choir; recorded in Mariann' +EOP +close FH or warn; + +$mp3 = MP3::Tag->new("./test2.mp3"); +$mp3->get_tags; +my $inf = $mp3->{Inf}; +#my @a = %$mp3; +#warn "@a"; + +ok($inf, ".inf file parsed"); +ok($inf && $mp3->autoinfo->{title} eq 'It Is Truly Meet', "Checking .inf title"); +ok($inf && $mp3->autoinfo->{artist} eq 'Bach (2110)', "Checking .inf artist"); +ok($inf && $mp3->autoinfo->{track} eq 11, "Checking .inf track"); +ok($inf && $mp3->autoinfo->{album} eq 'Liturgy of St. John; Op 31', "Checking .inf album"); +ok($inf && $mp3->autoinfo->{year} eq 1988, "Checking .inf year"); +ok($inf && $mp3->autoinfo->{comment} eq 'Chiribim conducts Some Choir; recorded in Mariann', "Checking .inf comment"); + +ok($inf && $mp3->autoinfo('from')->{comment}[0] eq 'Chiribim conducts Some Choir; recorded in Mariann', "Checking .inf comment+source"); +ok($inf && $mp3->autoinfo('from')->{comment}[1] eq 'Inf', "Checking .inf comment source"); + +require Cwd; +my $i = $mp3->interpolate('file=%(_)-12f, File=%F, comment="%c"'); +my $ii = 'file=test2.mp3___, File=' . Cwd::abs_path('test2.mp3') + . ', comment="Chiribim conducts Some Choir; recorded in Mariann"'; +#warn "$i\n$ii\n"; +ok($inf && $i eq $ii, "Checking interpolation"); + +ok($mp3->filename_nodir eq "test2.mp3", "Checking filename method:"); sub ok { my ($result, $test) = @_; - printf ("Test %2d %s %s", $count++, $test, '.' x (28-length($test))); + printf ("Test %2d %s %s", $count++, $test, '.' x (30-length($test))); print " not" unless $result; print " ok\n"; } --- ./examples/mp3info.pl-pre Thu Jun 7 11:10:26 2001 +++ ./examples/mp3info.pl Mon Nov 17 01:34:38 2003 @@ -17,5 +17,6 @@ while (<STDIN>) { print "* Track: $info[1]\n"; print "* Artist: $info[2]\n"; print "* Album: $info[3]\n"; + print "* Comment: $info[4]\n"; } } --- ./examples/tagged.pl-pre Thu Jun 7 11:12:16 2001 +++ ./examples/tagged.pl Mon Nov 17 01:39:14 2003 @@ -57,10 +57,12 @@ for my $filename (@ARGV) { system("xview /tmp/temp.$v2 &"); #choose this to another program if you want } $val= length($val) ." Bytes" if $key =~ /^_/; # _... means binary data - print " * $key => $val\n" unless $key eq "tagname"; + $val =~ s/\0/\\0/g; # Multiple strings in a frame + print " * $key => '$val'\n" unless $key eq "tagname"; } } else { - print "$frame $name: $info\n"; + $info =~ s/\0/', '/g; # Multiple strings in a frame + print "$frame $name: '$info'\n"; } } if (0==1) { # add a id3v2 comment --- ./Tag/File.pm-pre Sun Nov 16 23:52:44 2003 +++ ./Tag/File.pm Tue Nov 25 19:52:42 2003 @@ -16,7 +16,7 @@ MP3::Tag::File - Module for reading / wr my $mp3 = MP3::Tag->new($filename); - ($song, $artist, $no, $album) = $mp3->read_filename(); + ($title, $artist, $no, $album, $year) = $mp3->parse_filename(); see L<MP3::Tag> @@ -128,19 +128,20 @@ sub is_open { =pod -=item read_filename() +=item parse_filename() - ($song, $artist, $no, $album) = $mp3->read_filename($what, $filename); + ($title, $artist, $no, $album, $year) = $mp3->parse_filename($what, $filename); -read_filename() tries to extract information about artist, song, song number -and album from the filename. +parse_filename() tries to extract information about artist, title, track number, +album and year from the filename. (For backward compatibility it may be also +called by deprecated name read_filename().) This is likely to fail for a lot of filenames, especially the album will be often wrongly guessed, as the name of the parent directory is taken as album name. -$what and $filename are optional. $what maybe song, track, artist or album. -If $what is defined read_filename will return only this element. +$what and $filename are optional. $what maybe title, track, artist, album +or year. If $what is defined parse_filename() will return only this element. If $filename is defined this filename will be used and not the real filename which was set by L<MP3::Tag> with C<MP3::Tag->new($filename)>. @@ -159,26 +160,50 @@ Following formats will be hopefully reco - album name/artist name - 01 - song.name.mp3 +If artist or title end in C<(NUMBER)> with 4-digit NUMBER, it is considered +the year. + =cut -sub read_filename { +*read_filename = \&parse_filename; + +sub return_parsed { + my ($self,$what) = @_; + if (defined $what) { + return $self->{parsed}{album} if $what =~/^al/i; + return $self->{parsed}{artist} if $what =~/^a/i; + return $self->{parsed}{no} if $what =~/^tr/i; + return $self->{parsed}{year} if $what =~/^y/i; + return $self->{parsed}{title}; + } + + return $self->{parsed} unless wantarray; + return map $self->{parsed}{$_} , qw(title artist no album year); +} + +sub parse_filename { my ($self,$what,$filename) = @_; - my $pathandfile=$filename || $self->{filename}; + $filename = $self->{filename} unless defined $filename; + my $pathandfile = $filename; + $self->return_parsed($what) if exists $self->{parsed_filename} + and $self->{parsed_filename} eq $filename; + # prepare pathandfile for easier use - $pathandfile =~ s/\.mp3$//; # remove .mp3-extension + $pathandfile =~ s/\.(mp3|wav)$//i; # remove .mp3-extension $pathandfile =~ s/ +/ /g; # replace several spaces by one space # split pathandfile in path and file my $file = $pathandfile; $file =~ s/.*\\//; # for windows-filenames $file =~ s/.*\///; # for unix-filenames + my $orig_file = $file; my $path = substr $pathandfile,0,length($pathandfile)-length($file); chop $path; $path =~ s/.*\\//; # for windows-filenames $path =~ s/.*\///; # for unix-filenames - # check wich chars are used for seperating words + # check which chars are used for seperating words # assumption: spaces between words unless ($file =~/ /) { @@ -218,10 +243,10 @@ sub read_filename { } # get parts of name - my ($song, $artist, $no, $album)=("","","",""); + my ($title, $artist, $no, $album, $year)=("","","","",""); # try to find a track-number in front of filename - if ($file =~ /^ *(\d+)\W/) { + if ($file =~ /^ *(\d+)[\W_]/) { $no=$1; # store number $file =~ s/^ *\d+//; # and delete it $file =~ s/^$partsep// || $file =~ s/^.//; @@ -231,10 +256,10 @@ sub read_filename { $file =~ s/_+/ /g unless $partsep =~ /_/; #remove underscore unless they are needed for part seperation my @parts = split /$partsep/, $file; if ($#parts==0) { - $song=$parts[0]; + $title=$parts[0]; } elsif ($#parts==1) { $artist=$parts[0]; - $song=$parts[1]; + $title=$parts[1]; } elsif ($#parts>1) { my $temp = ""; $artist = shift @parts; @@ -248,13 +273,17 @@ sub read_filename { $temp .= $_; } } - $song=$temp; + $title=$temp; } - $song =~ s/ +$//; + $title =~ s/ +$//; $artist =~ s/ +$//; $no =~ s/ +$//; $no =~ s/^0+//; + + # Special-case names like audio12 etc created by some software + # (cdda2wav, gramofile, etc) + $no = $+ if not $no and $title =~ /^(\d+)?(?:audio|track|processed)\s*(\d+)?$/i and $+; if ($path) { unless ($artist) { @@ -263,36 +292,34 @@ sub read_filename { $album = $path; } } - - if (defined $what) { - return $album if $what =~/^al/i; - return $artist if $what =~/^a/i; - return $no if $what =~/^t/i; - return $song; - } - - if (wantarray) { - return ($song, $artist, $no, $album); - } - - return {artist=>$artist, song=>$song, no=>$no, album=>$album}; + # Keep the year in the title/artist (XXXX Should we?) + $year = $1 if $title =~ /\((\d{4})\)/ or $artist =~ /\((\d{4})\)/; + + $self->{parsed_filename} = $filename; + $self->{parsed} = { artist=>$artist, song=>$title, no=>$no, + album=>$album, title=>$title, year => $year}; + $self->return_parsed($what); } =pod -=item song() +=item title() - $song = $mp3->song($filename); + $title = $mp3->title($filename); -Returns the song name, guessed from the filename. See also read_filename() +Returns the title, guessed from the filename. See also parse_filename(). (For +backward compatibility, can be called by deprecated name song().) $filename is optional and will be used instead of the real filename if defined. =cut -sub song { - return read_filename(shift, "song", shift); +*song = \&title; + +sub title { + my $self = shift; + return $self->parse_filename("title", @_); } =pod @@ -301,14 +328,15 @@ sub song { $artist = $mp3->artist($filename); -Returns the artist name, guessed from the filename. See also read_filename() +Returns the artist name, guessed from the filename. See also parse_filename() $filename is optional and will be used instead of the real filename if defined. =cut sub artist { - return read_filename(shift, "artist", shift); + my $self = shift; + return $self->parse_filename("artist", @_); } =pod @@ -317,23 +345,41 @@ sub artist { $track = $mp3->track($filename); -Returns the track number, guessed from the filename. See also read_filename() +Returns the track number, guessed from the filename. See also parse_filename() $filename is optional and will be used instead of the real filename if defined. =cut sub track { - return read_filename(shift, "track", shift); + my $self = shift; + return $self->parse_filename("track", @_); +} + +=item year() + + $year = $mp3->year($filename); + +Returns the year, guessed from the filename. See also parse_filename() + +$filename is optional and will be used instead of the real filename if defined. + +=cut + +sub year { + my $self = shift; + my $y = $self->parse_filename("year", @_); + return $y if length $y; + return; } =pod =item album() - $album = $mp3->artist($album); + $album = $mp3->album($filename); -Returns the album name, guessed from the filename. See also read_filename() +Returns the album name, guessed from the filename. See also parse_filename() The album name is guessed from the parent directory, so it is very likely to fail. $filename is optional and will be used instead of the real filename if defined. @@ -341,7 +387,24 @@ $filename is optional and will be used i =cut sub album { - return read_filename(shift, "album", shift); + my $self = shift; + return $self->parse_filename("album", @_); } + +=item comment() + + $comment = $mp3->comment($filename); # Always undef + +=cut + +sub comment {} + +=item genre() + + $genre = $mp3->genre($filename); # Always undef + +=cut + +sub genre {} 1; --- ./Tag/ID3v1.pm-pre Mon Aug 6 13:57:38 2001 +++ ./Tag/ID3v1.pm Mon Nov 24 20:20:16 2003 @@ -5,8 +5,8 @@ use vars qw /@mp3_genres @winamp_genres $VERSION="0.60"; -# allowed fields in ID3v1.1 and max length of this fields (expect for track and genre which are coded later) -%ok_length = (song => 30, artist => 30, album => 30, comment => 28, track => 3, genre => 30, year=>4, genreID=>1); +# allowed fields in ID3v1.1 and max length of this fields (except for track and genre which are coded later) +%ok_length = (title => 30, artist => 30, album => 30, comment => 28, track => 3, genre => 30, year=>4, genreID=>1); =pod @@ -32,7 +32,7 @@ See L<MP3::Tag|according documentation> * Reading the tag - print " Song: " .$id3v1->song . "\n"; + print " Title: " .$id3v1->title . "\n"; print " Artist: " .$id3v1->artist . "\n"; print " Album: " .$id3v1->album . "\n"; print "Comment: " .$id3v1->comment . "\n"; @@ -49,7 +49,7 @@ See L<MP3::Tag|according documentation> * Changing / Writing the tag $id3v1->comment("This is only a Test Tag"); - $id3v1->song("testing"); + $id3v1->title("testing"); $id3v1->artist("Artest"); $id3v1->album("Test it"); $id3v1->year("1965"); @@ -71,7 +71,7 @@ Thomas Geffert, thg@users.sourceforge.ne =pod -=item song(), artist(), album(), year(), comment(), track(), genre() +=item title(), artist(), album(), year(), comment(), track(), genre() $artist = $id3v1->artist; $artist = $id3v1->artist($artist); @@ -101,6 +101,7 @@ sub AUTOLOAD { # is it an allowed field $attr =~ s/.*:://; return unless $attr =~ /[^A-Z]/; + $attr = 'title' if $attr eq 'song'; warn "invalid field: ->$attr()" unless $ok_length{$attr}; if (my $new = shift) { @@ -126,12 +127,12 @@ sub AUTOLOAD { =item all() @tagdata = $id3v1->all; - @tagdata = $id3v1->all($song, $artist, $album, $year, $comment, $track, $genre); + @tagdata = $id3v1->all($title, $artist, $album, $year, $comment, $track, $genre); Returns all information of the tag in a list. You can use this sub also to set the data of the complete tag. -The order of the data is always song, artist, album, year, comment, track, and genre. +The order of the data is always title, artist, album, year, comment, track, and genre. genre has to be a string with the name of the genre, or a number identifying the genre. =cut @@ -140,7 +141,7 @@ sub all { my $self=shift; if ($#_ == 6) { my $new; - for (qw/song artist album year comment track genre/) { + for (qw/title artist album year comment track genre/) { $new = shift; $new =~ s/ +$//; $new = substr $new, 0, $ok_length{$_}; @@ -154,17 +155,39 @@ sub all { $self->{genre} = id2genre($self->{genreID}); $self->{changed} = 1; } - for (qw/song artist album year comment track genre/) { + for (qw/title artist album year comment track genre/) { $self->{$_} =~ s/ +$//; } if (wantarray) { - return ($self->{song},$self->{artist},$self->{album}, + return ($self->{title},$self->{artist},$self->{album}, $self->{year},$self->{comment}, $self->{track}, $self->{genre}); } - return $self->{song}; + return $self->{title}; } + =pod +=item fits_tag() + + warn "data truncated" unless $id3v1->fits_tag($hash); + +Check whether the info in ID3v1 tag fits into the format of the file. + +=cut + +sub fits_tag { + my ($self, $hash) = (shift, shift); + my $elt; + for $elt (qw(title artist album comment year)) { + next unless defined (my $data = $hash->{$elt}); + $data = $data->[0] if ref $data; + next if $ok_length{$elt} >= length $data; + next if $elt eq 'comment' and not $hash->{track} and length $data <= 30; + return; + } + return 1; +} + =item write_tag() $id3v1->write_tag(); @@ -177,11 +200,14 @@ Writes the ID3v1 tag to the file. sub write_tag { my $self = shift; - return undef unless exists $self->{song} && exists $self->{changed}; - $self->{track}=0 unless $self->{track} =~ /^\d+$/; + return undef unless exists $self->{title} && exists $self->{changed}; + local $self->{track}=0 unless $self->{track} =~ /^\d+$/; + my $comment = $self->comment; + $comment = pack "a28 x C", $comment, $self->{track} + if $self->{track} and $self->{track} !~ /\D/; $self->{genreID}=255 unless $self->{genreID} =~ /^\d+$/; - my $data = pack("a30a30a30a4a28xCC",$self->{song},$self->{artist},$self->{album}, - $self->{year}, $self->{comment}, $self->{track}, $self->{genreID}); + my $data = pack("a30a30a30a4a30C",$self->{title},$self->{artist},$self->{album}, + $self->{year}, $comment, $self->{genreID}); my $mp3obj = $self->{mp3}; my $mp3tag; $mp3obj->close; @@ -323,19 +349,24 @@ sub read_tag { my $id3v1; if ($self->{new}) { - ($self->{song}, $self->{artist}, $self->{album}, $self->{year}, - $self->{comment}, $self->{track}, $self->{genre}, $self->{genreID}) = ("","","","","",0,"",255); + ($self->{title}, $self->{artist}, $self->{album}, $self->{year}, + $self->{comment}, $self->{track}, $self->{genre}, $self->{genreID}) = ("","","","","",'',"",255); $self->{changed} = 1; } else { - (undef, $self->{song}, $self->{artist}, $self->{album}, $self->{year}, + (undef, $self->{title}, $self->{artist}, $self->{album}, $self->{year}, $self->{comment}, $id3v1, $self->{track}, $self->{genreID}) = - unpack ("a3Z30Z30Z30Z4Z28CCC", $buffer); + unpack (($] < 5.6 + ? "a3 A30 A30 A30 A4 A28 C C C" # Trailing spaces stripped too + : "a3 Z30 Z30 Z30 Z4 Z28 C C C"), + $buffer); if ($id3v1!=0) { # ID3v1 tag found: track is not valid, comment two chars longer $self->{comment} .= chr($id3v1); - $self->{comment} .= chr($self->{track}) if $self->{track}!=32; - $self->{track} = 0; + $self->{comment} .= chr($self->{track}) + if $self->{track} and $self->{track}!=32; + $self->{track} = ''; }; + $self->{track} = '' unless $self->{track}; $self->{genre} = id2genre($self->{genreID}); } } --- ./Tag/ID3v2.pm-pre Mon Aug 6 13:57:46 2001 +++ ./Tag/ID3v2.pm Mon Nov 24 03:10:58 2003 @@ -1,8 +1,6 @@ package MP3::Tag::ID3v2; use strict; -use MP3::Tag::ID3v1; -use Compress::Zlib; use File::Basename; use vars qw /%format %long_names %res_inp $VERSION/; @@ -33,10 +31,11 @@ See L<MP3::Tag|according documentation> * Reading a tag - $frameIDs_hash = $id3v2->get_frame_ids; + $frameIDs_hash = $id3v2->get_frame_ids('truename'); foreach my $frame (keys %$frameIDs_hash) { - my ($info, $name) = $id3v2->get_frame($frame); + my ($name, @info) = $id3v2->get_frames($frame); + for my $info (@info) { if (ref $info) { print "$name ($frame):\n"; while(my ($key,$val)=each %$info) { @@ -45,6 +44,7 @@ See L<MP3::Tag|according documentation> } else { print "$name: $info\n"; } + } } * Adding / Changing / Removing / Writing a tag @@ -79,6 +79,7 @@ Thomas Geffert, thg@users.sourceforge.ne =item get_frame_ids() $frameIDs = $tag->get_frame_ids; + $frameIDs = $tag->get_frame_ids('truename'); [old name: getFrameIDs() . The old name is still available, but you should use the new name] @@ -93,16 +94,22 @@ check if a specific frame is included in If there are multiple occurences of a frame in one tag, the first frame is returned with its normal short name, following frames of this type get a -'00', '01', '02', ... appended to this name. These names can then -used with C<get_frame> to get the information of these frames. +'00', '01', '02', ... appended to this name. These names can then +used with C<get_frame> to get the information of these frames. These +fake frames are not returned if C<'truename'> argument is set; one +can still use C<get_frames()> to extract the info for all of the frames with +the given short name. =cut sub get_frame_ids { my $self=shift; + my $basic = shift; if (exists $self->{frameIDs}) { + return unless defined wantarray; my %return; foreach (keys %{$self->{frames}}) { + next if $basic and length > 4; # 01 etc. at end $return{$_}=$long_names{substr($_,0,4)}; } return \%return; @@ -137,6 +144,7 @@ sub get_frame_ids { } if ($ID ne "\000\000\000\000") { if (exists $self->{frames}->{$ID}) { + ++$self->{extra_frames}->{$ID}; $ID .= '01'; while (exists $self->{frames}->{$ID}) { $ID++; @@ -154,6 +162,7 @@ sub get_frame_ids { $self->{frameIDs} =1; my %return; foreach (keys %{$self->{frames}}) { + next if $basic and length > 4; # 01 etc. at end $return{$_}=$long_names{substr($_,0,4)}; } return \%return; @@ -165,15 +174,15 @@ sub get_frame_ids { =item get_frame() - ($info, $name) = get_frame($ID); - ($info, $name) = get_frame($ID, 'raw'); + ($info, $name, @rest) = $tag->get_frame($ID); + ($info, $name, @rest) = $tag->get_frame($ID, 'raw'); [old name: getFrame() . The old name is still available, but you should use the new name] get_frame gets the contents of a specific frame, which must be specified by the 4-character-ID (aka short name). You can use C<get_frame_ids> to get the IDs of the tag, or use IDs which you hope to find in the tag. If the ID is not found, -C<get_frame> returns (undef, undef). +C<get_frame> returns empty list, so $info and $name become undefined. Otherwise it extracts the contents of the frame. Frames in ID3v2 tags can be very small, or complex and huge. That is the reason, that C<get_frame> returns @@ -201,6 +210,9 @@ with all data (which might be binary), a See also L<MP3::Tag::ID3v2-Data> for a list of all supported frames, and some other explanations of the returned data structure. +If more than one frame with name $ID is present, @rest contains $info fields +for all consequent frames with the same name. + ! Encrypted frames are not supported yet ! ! Some frames are not supported yet, but the most common ones are supported ! @@ -210,14 +222,19 @@ some other explanations of the returned sub get_frame { my ($self, $fname, $raw)=@_; $self->get_frame_ids() unless exists $self->{frameIDs}; - return undef unless exists $self->{frames}->{$fname}; + return unless exists $self->{frames}->{$fname}; my $frame=$self->{frames}->{$fname}; - my $frame_flags = check_flags($frame->{flags},$fname); - $fname = substr ($fname, 0 ,4); + my $frame_flags = check_flags($frame->{flags},$fname); + my ($e, @extra) = 0; # More frames follow? + $e = $self->{extra_frames}->{$fname} || 0 + if wantarray and $self->{extra_frames}; + @extra = map scalar $self->get_frame((sprintf "%s%02d", $fname, $_), $raw), + 1..$e; + $fname = substr ($fname, 0 ,4); # 01 etc. at end my $start_offset=0; if ($frame_flags->{encryption}) { warn "Frame $fname: encryption not supported yet\n" ; - return undef; + return; } if ($frame_flags->{groupid}) { # groupid is ignored at the moment @@ -226,11 +243,15 @@ sub get_frame { my $data = substr($self->{tag_data}, $frame->{start}+$start_offset, $frame->{size}-$start_offset); if ($frame_flags->{compression}) { + require Compress::Zlib; my $usize=unpack("N", $data); - $data = uncompress(substr ($data, 4)); + $data = Compress::Zlib::uncompress(substr ($data, 4)); warn "$fname: Wrong size of uncompressed data\n" if $usize=!length($data); } - return ($data, $long_names{$fname}) if defined $raw; + if (defined $raw) { + return ($data, $long_names{$fname}, @extra) if wantarray; + return $data; + } my $format = get_format($fname); my $result; @@ -240,7 +261,7 @@ sub get_frame { } if (wantarray) { - return ($result, $long_names{$fname}); + return ($result, $long_names{$fname}, @extra); } else { return $result; } @@ -250,6 +271,23 @@ sub get_frame { =pod +=item get_frames() + + ($name, @info) = get_frames($ID); + ($name, @info) = get_frames($ID, 'raw'); + +Same as get_frame() with different order of the returned values. +$name and elements of the array @info have the same semantic as for +get_frame(); each frome with id $ID produces one elements of array @info. + +=cut + +sub get_frames { + my ($self, $fname, $raw) = @_; + my ($info, $name, @rest) = $self->get_frame($fname, $raw) or return; + return ($name, $info, @rest); +} + =item write_tag() $id3v2->write_tag; @@ -597,7 +635,7 @@ C< {"Other" => "\x00", sub what_data{ my ($self, $fname)=@_; - $fname = substr $fname, 0, 4; + $fname = substr $fname, 0, 4; # 01 etc. at end my $reswanted = wantarray; my $format = get_format($fname, "quiet"); return unless defined $format; @@ -624,51 +662,222 @@ sub what_data{ =pod -=item song() +=item title( [@new_title] ) + +Returns the title composed of the tags configured via C<MP3::Tag->config('v2title')> +call (with default 'Title/Songname/Content description' (TIT2)) from the tag. +(For backward compatibility may be called by deprecated name song() as well.) -Returns the song title (TIT2) from the tag. +Sets TIT2 frame if given the optional arguments @new_title. If this is an +empty string, the frame is removed. =cut -sub song { - return get_frame(shift, "TIT2"); +*song = \&title; + +sub title { + my $self = shift; + if (@_) { + $self->remove_frame('TIT2') if defined $self->get_frame( "TIT2"); + return if @_ == 1 and $_[0] eq ''; + return $self->add_frame('TIT2', @_); + } + my @order; + if (exists $MP3::Tag::config{v2title}) { + @order = @{$MP3::Tag::config{v2title}}; + } else { + @order = ("TIT2"); + } + my @parts = grep defined && length, map scalar $self->get_frame($_), @order; + return unless @parts; + my $last = pop @parts; + my $part; + for $part (@parts) { + $part =~ s(\0)(///)g; # Multiple strings + $part .= ',' unless $part =~ /[.,;:\n\t]\s*$/; + $part .= ' ' unless $part =~ /\s$/; + } + return join '', @parts, $last; +} + +=item _comment([$language]) + +Returns the file comment (COMM with an empty 'short') from the tag, or +"Subtitle/Description refinement" (TIT3) frame (unless it is considered a part +of the title). + +=cut + +sub _comment { + my $self = shift; + my $language; + $language = lc shift if @_; + my @info = get_frames($self, "COMM"); + shift @info; + for my $comment (@info) { + next unless exists $comment->{short} and not length $comment->{short}; + next if defined $language and (not exists $comment->{Language} + or lc $comment->{Language} ne $language); + return $comment->{Text}; + } + return if grep $_ eq 'TIT3', @{$MP3::Tag::config{v2title} || []}; + return scalar $self->get_frame("TIT3"); +} + +=item comment() + + $val = $id3v2->comment(); + $newframe = $id3v2->comment('Just a comment for freddy', 'eng', 'personal'); + +Returns the file comment (COMM frame with an empty 'short' field) from the +tag, or "Subtitle/Description refinement" (TIT3) frame (unless it is considered +a part of the title). + +If optional arguments ($comment, $short, $language) are present, sets the +comment frame. If $language is omited, sets C<XXX> (it should be lowercase +3-letter abbreviation according to ISO-639-2); if $short is omited, sets +to C<''>. If $comment is an empty string, the frame is removed. + +=cut + +sub comment { + my $self = shift; + my ($comment, $short, $language) = @_ or return $self->_comment(); + my @info = get_frames($self, "COMM"); + shift @info; + my $c = -1; + for my $comment (@info) { + ++$c; + next unless exists $comment->{short} and not length $comment->{short}; + next if defined $language and (not exists $comment->{Language} + or lc $comment->{Language} ne $language); + $self->remove_frame($c ? 'COMM' : sprintf 'COMM%02d', $c); + $c--; + last; + } + return if @_ == 1 and $_[0] eq ''; + $language = 'XXX' unless defined $language; + $short = '' unless defined $short; + $self->add_frame('COMM', $language, $short, $comment); +} + +=item year( [@new_year] ) + +Returns the year (TYER/TDRC) from the tag. + +Sets TYER and TDRC frames if given the optional arguments @new_year. If this +is an empty string, the frame is removed. + +=cut + +sub year { + my $self = shift; + if (@_) { + $self->remove_frame('TYER') if defined $self->get_frame( "TYER"); + $self->remove_frame('TDRC') if defined $self->get_frame( "TDRC"); + return if @_ == 1 and $_[0] eq ''; + $self->add_frame('TYER', @_); # Obsolete + return $self->add_frame('TDRC', @_); # new; allows YYYY-MM-etc as well + } + my $y; + ($y) = $self->get_frame( "TYER") and return $y; + ($y) = $self->get_frame( "TDRC") or return; + return substr $y, 0, 4; } =pod -=item track() +=item track( [$new_track] ) Returns the track number (TRCK) from the tag. +Sets TRCK frame if given the optional arguments @new_track. If this is an +empty string or 0, the frame is removed. + =cut sub track { - return get_frame(shift, "TRCK"); + my $self = shift; + if (@_) { + $self->remove_frame('TRCK') if defined $self->get_frame("TRCK"); + return if @_ == 1 and not $_[0]; + return $self->add_frame('TRCK', @_); + } + return scalar $self->get_frame("TRCK"); } =pod -=item artist() +=item artist( [ $new_artist ] ) -Returns the artist name (TPE1 (or TPE2 if TPE1 does not exist)) from the tag. +Returns the artist name (TPE1 (or TPE2 if TPE1 does not exist, of TCOM +if neither TPE1 nor TPE2 exist)) from the tag. + +Sets TPE1 frame if given the optional arguments @new_artist. If this is an +empty string, the frame is removed. =cut sub artist { my $self = shift; - return $self->get_frame("TPE1") || $self->get_frame("TPE2"); + if (@_) { + $self->remove_frame('TPE1') if defined $self->get_frame( "TPE1"); + return if @_ == 1 and $_[0] eq ''; + return $self->add_frame('TPE1', @_); + } + my $a; + ($a) = $self->get_frame("TPE1") and return $a; + ($a) = $self->get_frame("TPE2") and return $a; + ($a) = $self->get_frame("TCOM") and return $a; + return; } =pod -=item album() +=item album( [ $new_album ] ) + +Returns the album name (TALB) from the tag. If none is found, returns +the "Content group description" (TIT1) frame (unless it is considered a part +of the title). -Returns the album name (TALB) form the tag. +Sets TALB frame if given the optional arguments @new_album. If this is an +empty string, the frame is removed. =cut sub album { - return get_frame(shift, "TALB"); + my $self = shift; + if (@_) { + $self->remove_frame('TALB') if defined $self->get_frame( "TALB"); + return if @_ == 1 and $_[0] eq ''; + return $self->add_frame('TALB', @_); + } + my $a; + ($a) = $self->get_frame("TALB") and return $a; + return if grep $_ eq 'TIT1', @{$MP3::Tag::config{v2title} || []}; + return scalar $self->get_frame("TIT1"); +} + +=item genre( [ $new_genre ] ) + +Returns the genre string from TCON frame of the tag. + +Sets TCON frame if given the optional arguments @new_genre. If this is an +empty string, the frame is removed. + +=cut + +sub genre { + my $self = shift; + if (@_) { + $self->remove_frame('TCON') if defined $self->get_frame( "TCON"); + return if @_ == 1 and $_[0] eq ''; + return $self->add_frame('TCON', @_); # XXX add genreID 0x00 ? + } + my $g = $self->get_frame( "TCON"); + return unless defined $g; + $g =~ s/^\d+\0(?:.)//s; # XXX Shouldn't this be done in TCON()? + $g; } =item new() @@ -990,6 +1199,7 @@ sub COMR { } sub TCON { + require MP3::Tag::ID3v1; my $data = shift; if (defined shift) { # called by what_data my $c=0; @@ -1004,7 +1214,7 @@ sub TCON { $data =~ s/\((\d+)\)/MP3::Tag::ID3v1::genres($1)/e; } return $data; -} +} sub TFLT { my $text = shift; @@ -1123,7 +1333,9 @@ BEGIN { {len=>0, name=>"Filename"}, $description, $data], GRID => [{len=>0, name=>"Owner"}, {len=>1, name=>"Symbol", func=>\&toNumber}, $data], - IPLS => [$encoding, $text_enc], + IPLS => [$encoding, $text_enc], # in 2.4 split into TMCL, TIPL + TMCL => [$encoding, $text_enc], + TIPL => [$encoding, $text_enc], LINK => [{len=>3, name=>"_ID"}, {len=>0, name=>"URL"}, $text], MCDI => [$data], #MLLT => [], @@ -1173,6 +1385,8 @@ BEGIN { GEOB => "General encapsulated object", GRID => "Group identification registration", IPLS => "Involved people list", + TMCL => "Musician credits list", + TIPL => "Involved people list", LINK => "Linked information", MCDI => "Music CD identifier", MLLT => "MPEG location lookup table", --- ./Tag/Inf.pm-pre Sat Nov 22 20:30:44 2003 +++ ./Tag/Inf.pm Tue Nov 25 03:20:32 2003 @@ -0,0 +1,215 @@ +package MP3::Tag::Inf; + +use strict; +use vars qw /$VERSION/; + +$VERSION="0.01"; + +=pod + +=head1 NAME + +MP3::Tag::Inf - Module for parsing F<.inf> files associated with music tracks. + +=head1 SYNOPSIS + + my $mp3inf = MP3::Tag::Inf->new($filename); # Name of MP3 or .INF file + + ($title, $artist, $album, $year, $comment, $track) = $mp3inf->parse(); + +see L<MP3::Tag> + +=head1 DESCRIPTION + +MP3::Tag::Inf is designed to be called from the MP3::Tag module. + +It parses the content of F<.inf> file (created, e.g., by cdda2wav). + +=over 4 + +=cut + + +# Constructor + +sub new { + my $class = shift; + (my $filename = shift) =~ s/(?:\..{0,4})?$/.inf/; # Allow short suffices + return undef unless -f $filename; + bless {filename => $filename}, $class; +} + +# Destructor + +sub DESTROY {} + +=item parse() + + ($title, $artist, $album, $year, $comment, $track) = + $mp3inf->parse($what); + +parse_filename() extracts information about artist, title, track number, +album and year from the F<.inf> file. $what is optional; it maybe title, +track, artist, album, year or comment. If $what is defined parse() will return +only this element. + +As a side effect of this call, $mp3inf->{info} is set to the hash reference +with the content of particular elements of the F<.inf> file. Typically present +are the following fields: + + CDINDEX_DISCID + CDDB_DISCID + MCN + ISRC + Albumperformer + Performer + Albumtitle + Tracktitle + Tracknumber + Trackstart + Tracklength + Pre-emphasis + Channels + Copy_permitted + Endianess + Index + +The following fields are also recognized: + + Year + Trackcomment + +=cut + +sub return_parsed { + my ($self,$what) = @_; + if (defined $what) { + return $self->{parsed}{album} if $what =~/^al/i; + return $self->{parsed}{artist} if $what =~/^a/i; + return $self->{parsed}{track} if $what =~/^tr/i; + return $self->{parsed}{year} if $what =~/^y/i; + return $self->{parsed}{comment}if $what =~/^c/i; + return $self->{parsed}{genre} if $what =~/^g/i; + return $self->{parsed}{title}; + } + + return $self->{parsed} unless wantarray; + return map $self->{parsed}{$_} , qw(title artist album year comment track); +} + +sub parse { + my ($self,$what) = @_; + + $self->return_parsed($what) if exists $self->{parsed}; + local *IN; + open IN, "< $self->{filename}" or die "Error opening `$self->{filename}': $!"; + my ($line, %info); + for $line (<IN>) { + $self->{info}{ucfirst lc $1} = $2 + if $line =~ /^(\S+)\s*=\s*['"]?(.*?)['"]?\s*$/; + } + close IN or die "Error closing `$self->{filename}': $!"; + my %parsed; + @parsed{ qw( title artist album year comment track ) } = + @{ $self->{info} }{ qw( Tracktitle Performer Albumtitle + Year Trackcomment Tracknumber) }; + $parsed{artist} = $self->{info}{Albumperformer} + unless defined $parsed{artist}; + $self->{parsed} = \%parsed; + $self->return_parsed($what); +} + + +=pod + +=item title() + + $title = $mp3inf->title(); + +Returns the title, obtained from the C<'Tracktitle'> entry of the file. + +=cut + +*song = \&title; + +sub title { + return shift->parse("title"); +} + +=pod + +=item artist() + + $artist = $mp3inf->artist(); + +Returns the artist name, obtained from the C<'Performer'> or +C<'Albumperformer'> entries (the first which is present) of the file. + +=cut + +sub artist { + return shift->parse("artist"); +} + +=pod + +=item track() + + $track = $mp3inf->track(); + +Returns the track number, obtained from the C<'Tracknumber'> entry of the file. + +=cut + +sub track { + return shift->parse("track"); +} + +=item year() + + $year = $mp3inf->year(); + +Returns the year, obtained from the C<'Year'> entry of the file. (Often +not present.) + +=cut + +sub year { + return shift->parse("year"); +} + +=pod + +=item album() + + $album = $mp3inf->album(); + +Returns the album name, obtained from the C<'Albumtitle'> entry of the file. + +=cut + +sub album { + return shift->parse("album"); +} + +=item comment() + + $comment = $mp3inf->comment(); + +Returns the C<'Trackcomment'> entry of the file. (Often not present.) + +=cut + +sub comment { + return shift->parse("comment"); +} + +=item genre() + + $genre = $mp3inf->genre($filename); # Always undef + +=cut + +sub genre {} + +1;