summaryrefslogtreecommitdiff
path: root/tools/mp3info.pm
diff options
context:
space:
mode:
Diffstat (limited to 'tools/mp3info.pm')
-rwxr-xr-xtools/mp3info.pm2184
1 files changed, 2184 insertions, 0 deletions
diff --git a/tools/mp3info.pm b/tools/mp3info.pm
new file mode 100755
index 0000000..d900777
--- /dev/null
+++ b/tools/mp3info.pm
@@ -0,0 +1,2184 @@
+package mp3info;
+
+require 5.006;
+
+use overload;
+use strict;
+use Carp;
+
+use vars qw(
+ @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $REVISION
+ @mp3_genres %mp3_genres @winamp_genres %winamp_genres $try_harder
+ @t_bitrate @t_sampling_freq @frequency_tbl %v1_tag_fields
+ @v1_tag_names %v2_tag_names %v2_to_v1_names $AUTOLOAD
+ @mp3_info_fields %rva2_channel_types
+);
+
+@ISA = 'Exporter';
+@EXPORT = qw(
+ set_mp3tag get_mp3tag get_mp3info remove_mp3tag
+ use_winamp_genres, use_mp3_utf8
+);
+@EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8);
+%EXPORT_TAGS = (
+ genres => [qw(@mp3_genres %mp3_genres)],
+ utf8 => [qw(use_mp3_utf8)],
+ all => [@EXPORT, @EXPORT_OK]
+);
+
+# $Id$
+($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/;
+$VERSION = '1.20';
+
+=pod
+
+=head1 NAME
+
+MP3::Info - Manipulate / fetch info from MP3 audio files
+
+=head1 SYNOPSIS
+
+ #!perl -w
+ use MP3::Info;
+ my $file = 'Pearls_Before_Swine.mp3';
+ set_mp3tag($file, 'Pearls Before Swine', q"77's",
+ 'Sticks and Stones', '1990',
+ q"(c) 1990 77's LTD.", 'rock & roll');
+
+ my $tag = get_mp3tag($file) or die "No TAG info";
+ $tag->{GENRE} = 'rock';
+ set_mp3tag($file, $tag);
+
+ my $info = get_mp3info($file);
+ printf "$file length is %d:%d\n", $info->{MM}, $info->{SS};
+
+=cut
+
+{
+ my $c = -1;
+ # set all lower-case and regular-cased versions of genres as keys
+ # with index as value of each key
+ %mp3_genres = map {($_, ++$c, lc, $c)} @mp3_genres;
+
+ # do it again for winamp genres
+ $c = -1;
+ %winamp_genres = map {($_, ++$c, lc, $c)} @winamp_genres;
+}
+
+=pod
+
+ my $mp3 = new MP3::Info $file;
+ $mp3->title('Perls Before Swine');
+ printf "$file length is %s, title is %s\n",
+ $mp3->time, $mp3->title;
+
+
+=head1 DESCRIPTION
+
+=over 4
+
+=item $mp3 = MP3::Info-E<gt>new(FILE)
+
+OOP interface to the rest of the module. The same keys
+available via get_mp3info and get_mp3tag are available
+via the returned object (using upper case or lower case;
+but note that all-caps "VERSION" will return the module
+version, not the MP3 version).
+
+Passing a value to one of the methods will set the value
+for that tag in the MP3 file, if applicable.
+
+=cut
+
+sub new {
+ my($pack, $file) = @_;
+
+ my $info = get_mp3info($file) or return undef;
+ my $tags = get_mp3tag($file) || { map { ($_ => undef) } @v1_tag_names };
+ my %self = (
+ FILE => $file,
+ TRY_HARDER => 0
+ );
+
+ @self{@mp3_info_fields, @v1_tag_names, 'file'} = (
+ @{$info}{@mp3_info_fields},
+ @{$tags}{@v1_tag_names},
+ $file
+ );
+
+ return bless \%self, $pack;
+}
+
+sub can {
+ my $self = shift;
+ return $self->SUPER::can(@_) unless ref $self;
+ my $name = uc shift;
+ return sub { $self->$name(@_) } if exists $self->{$name};
+ return undef;
+}
+
+sub AUTOLOAD {
+ my($self) = @_;
+ (my $name = uc $AUTOLOAD) =~ s/^.*://;
+
+ if (exists $self->{$name}) {
+ my $sub = exists $v1_tag_fields{$name}
+ ? sub {
+ if (defined $_[1]) {
+ $_[0]->{$name} = $_[1];
+ set_mp3tag($_[0]->{FILE}, $_[0]);
+ }
+ return $_[0]->{$name};
+ }
+ : sub {
+ return $_[0]->{$name}
+ };
+
+ no strict 'refs';
+ *{$AUTOLOAD} = $sub;
+ goto &$AUTOLOAD;
+
+ } else {
+ carp(sprintf "No method '$name' available in package %s.",
+ __PACKAGE__);
+ }
+}
+
+sub DESTROY {
+
+}
+
+
+=item use_mp3_utf8([STATUS])
+
+Tells MP3::Info to (or not) return TAG info in UTF-8.
+TRUE is 1, FALSE is 0. Default is TRUE, if available.
+
+Will only be able to turn it on if Encode is available. ID3v2
+tags will be converted to UTF-8 according to the encoding specified
+in each tag; ID3v1 tags will be assumed Latin-1 and converted
+to UTF-8.
+
+Function returns status (TRUE/FALSE). If no argument is supplied,
+or an unaccepted argument is supplied, function merely returns status.
+
+This function is not exported by default, but may be exported
+with the C<:utf8> or C<:all> export tag.
+
+=cut
+
+my $unicode_module = eval { require Encode; require Encode::Guess };
+my $UNICODE = use_mp3_utf8($unicode_module ? 1 : 0);
+
+sub use_mp3_utf8 {
+ my($val) = @_;
+ if ($val == 1) {
+ if ($unicode_module) {
+ $UNICODE = 1;
+ $Encode::Guess::NoUTFAutoGuess = 1;
+ }
+ } elsif ($val == 0) {
+ $UNICODE = 0;
+ }
+ return $UNICODE;
+}
+
+=pod
+
+=item use_winamp_genres()
+
+Puts WinAmp genres into C<@mp3_genres> and C<%mp3_genres>
+(adds 68 additional genres to the default list of 80).
+This is a separate function because these are non-standard
+genres, but they are included because they are widely used.
+
+You can import the data structures with one of:
+
+ use MP3::Info qw(:genres);
+ use MP3::Info qw(:DEFAULT :genres);
+ use MP3::Info qw(:all);
+
+=cut
+
+sub use_winamp_genres {
+ %mp3_genres = %winamp_genres;
+ @mp3_genres = @winamp_genres;
+ return 1;
+}
+
+=pod
+
+=item remove_mp3tag (FILE [, VERSION, BUFFER])
+
+Can remove ID3v1 or ID3v2 tags. VERSION should be C<1> for ID3v1
+(the default), C<2> for ID3v2, and C<ALL> for both.
+
+For ID3v1, removes last 128 bytes from file if those last 128 bytes begin
+with the text 'TAG'. File will be 128 bytes shorter.
+
+For ID3v2, removes ID3v2 tag. Because an ID3v2 tag is at the
+beginning of the file, we rewrite the file after removing the tag data.
+The buffer for rewriting the file is 4MB. BUFFER (in bytes) ca
+change the buffer size.
+
+Returns the number of bytes removed, or -1 if no tag removed,
+or undef if there is an error.
+
+=cut
+
+sub remove_mp3tag {
+ my($file, $version, $buf) = @_;
+ my($fh, $return);
+
+ $buf ||= 4096*1024; # the bigger the faster
+ $version ||= 1;
+
+ if (not (defined $file && $file ne '')) {
+ $@ = "No file specified";
+ return undef;
+ }
+
+ if (not -s $file) {
+ $@ = "File is empty";
+ return undef;
+ }
+
+ if (ref $file) { # filehandle passed
+ $fh = $file;
+ } else {
+ if (not open $fh, '+<', $file) {
+ $@ = "Can't open $file: $!";
+ return undef;
+ }
+ }
+
+ binmode $fh;
+
+ if ($version eq 1 || $version eq 'ALL') {
+ seek $fh, -128, 2;
+ my $tell = tell $fh;
+ if (<$fh> =~ /^TAG/) {
+ truncate $fh, $tell or carp "Can't truncate '$file': $!";
+ $return += 128;
+ }
+ }
+
+ if ($version eq 2 || $version eq 'ALL') {
+ my $v2h = _get_v2head($fh);
+ if ($v2h) {
+ local $\;
+ seek $fh, 0, 2;
+ my $eof = tell $fh;
+ my $off = $v2h->{tag_size};
+
+ while ($off < $eof) {
+ seek $fh, $off, 0;
+ read $fh, my($bytes), $buf;
+ seek $fh, $off - $v2h->{tag_size}, 0;
+ print $fh $bytes;
+ $off += $buf;
+ }
+
+ truncate $fh, $eof - $v2h->{tag_size}
+ or carp "Can't truncate '$file': $!";
+ $return += $v2h->{tag_size};
+ }
+ }
+
+ _close($file, $fh);
+
+ return $return || -1;
+}
+
+
+=pod
+
+=item set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
+
+=item set_mp3tag (FILE, $HASHREF)
+
+Adds/changes tag information in an MP3 audio file. Will clobber
+any existing information in file.
+
+Fields are TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE. All fields have
+a 30-byte limit, except for YEAR, which has a four-byte limit, and GENRE,
+which is one byte in the file. The GENRE passed in the function is a
+case-insensitive text string representing a genre found in C<@mp3_genres>.
+
+Will accept either a list of values, or a hashref of the type
+returned by C<get_mp3tag>.
+
+If TRACKNUM is present (for ID3v1.1), then the COMMENT field can only be
+28 bytes.
+
+ID3v2 support may come eventually. Note that if you set a tag on a file
+with ID3v2, the set tag will be for ID3v1[.1] only, and if you call
+C<get_mp3tag> on the file, it will show you the (unchanged) ID3v2 tags,
+unless you specify ID3v1.
+
+=cut
+
+sub set_mp3tag {
+ my($file, $title, $artist, $album, $year, $comment, $genre, $tracknum) = @_;
+ my(%info, $oldfh, $ref, $fh);
+ local %v1_tag_fields = %v1_tag_fields;
+
+ # set each to '' if undef
+ for ($title, $artist, $album, $year, $comment, $tracknum, $genre,
+ (@info{@v1_tag_names}))
+ {$_ = defined() ? $_ : ''}
+
+ ($ref) = (overload::StrVal($title) =~ /^(?:.*\=)?([^=]*)\((?:[^\(]*)\)$/)
+ if ref $title;
+ # populate data to hashref if hashref is not passed
+ if (!$ref) {
+ (@info{@v1_tag_names}) =
+ ($title, $artist, $album, $year, $comment, $tracknum, $genre);
+
+ # put data from hashref into hashref if hashref is passed
+ } elsif ($ref eq 'HASH') {
+ %info = %$title;
+
+ # return otherwise
+ } else {
+ carp(<<'EOT');
+Usage: set_mp3tag (FILE, TITLE, ARTIST, ALBUM, YEAR, COMMENT, GENRE [, TRACKNUM])
+ set_mp3tag (FILE, $HASHREF)
+EOT
+ return undef;
+ }
+
+ if (not (defined $file && $file ne '')) {
+ $@ = "No file specified";
+ return undef;
+ }
+
+ if (not -s $file) {
+ $@ = "File is empty";
+ return undef;
+ }
+
+ # comment field length 28 if ID3v1.1
+ $v1_tag_fields{COMMENT} = 28 if $info{TRACKNUM};
+
+
+ # only if -w is on
+ if ($^W) {
+ # warn if fields too long
+ foreach my $field (keys %v1_tag_fields) {
+ $info{$field} = '' unless defined $info{$field};
+ if (length($info{$field}) > $v1_tag_fields{$field}) {
+ carp "Data too long for field $field: truncated to " .
+ "$v1_tag_fields{$field}";
+ }
+ }
+
+ if ($info{GENRE}) {
+ carp "Genre `$info{GENRE}' does not exist\n"
+ unless exists $mp3_genres{$info{GENRE}};
+ }
+ }
+
+ if ($info{TRACKNUM}) {
+ $info{TRACKNUM} =~ s/^(\d+)\/(\d+)$/$1/;
+ unless ($info{TRACKNUM} =~ /^\d+$/ &&
+ $info{TRACKNUM} > 0 && $info{TRACKNUM} < 256) {
+ carp "Tracknum `$info{TRACKNUM}' must be an integer " .
+ "from 1 and 255\n" if $^W;
+ $info{TRACKNUM} = '';
+ }
+ }
+
+ if (ref $file) { # filehandle passed
+ $fh = $file;
+ } else {
+ if (not open $fh, '+<', $file) {
+ $@ = "Can't open $file: $!";
+ return undef;
+ }
+ }
+
+ binmode $fh;
+ $oldfh = select $fh;
+ seek $fh, -128, 2;
+ # go to end of file if no tag, beginning of file if tag
+ seek $fh, (<$fh> =~ /^TAG/ ? -128 : 0), 2;
+
+ # get genre value
+ $info{GENRE} = $info{GENRE} && exists $mp3_genres{$info{GENRE}} ?
+ $mp3_genres{$info{GENRE}} : 255; # some default genre
+
+ local $\;
+ # print TAG to file
+ if ($info{TRACKNUM}) {
+ print pack 'a3a30a30a30a4a28xCC', 'TAG', @info{@v1_tag_names};
+ } else {
+ print pack 'a3a30a30a30a4a30C', 'TAG', @info{@v1_tag_names[0..4, 6]};
+ }
+
+ select $oldfh;
+
+ _close($file, $fh);
+
+ return 1;
+}
+
+=pod
+
+=item get_mp3tag (FILE [, VERSION, RAW_V2])
+
+Returns hash reference containing tag information in MP3 file. The keys
+returned are the same as those supplied for C<set_mp3tag>, except in the
+case of RAW_V2 being set.
+
+If VERSION is C<1>, the information is taken from the ID3v1 tag (if present).
+If VERSION is C<2>, the information is taken from the ID3v2 tag (if present).
+If VERSION is not supplied, or is false, the ID3v1 tag is read if present, and
+then, if present, the ID3v2 tag information will override any existing ID3v1
+tag info.
+
+If RAW_V2 is C<1>, the raw ID3v2 tag data is returned, without any manipulation
+of text encoding. The key name is the same as the frame ID (ID to name mappings
+are in the global %v2_tag_names).
+
+If RAW_V2 is C<2>, the ID3v2 tag data is returned, manipulating for Unicode if
+necessary, etc. It also takes multiple values for a given key (such as comments)
+and puts them in an arrayref.
+
+If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will
+not be read.
+
+Strings returned will be in Latin-1, unless UTF-8 is specified (L<use_mp3_utf8>),
+(unless RAW_V2 is C<1>).
+
+Also returns a TAGVERSION key, containing the ID3 version used for the returned
+data (if TAGVERSION argument is C<0>, may contain two versions).
+
+=cut
+
+sub get_mp3tag {
+ my ($file, $ver, $raw_v2, $find_ape) = @_;
+ my ($tag, $v2h, $fh);
+
+ my $v1 = {};
+ my $v2 = {};
+ my $ape = {};
+ my %info = ();
+ my @array = ();
+
+ $raw_v2 ||= 0;
+ $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0;
+
+ if (not (defined $file && $file ne '')) {
+ $@ = "No file specified";
+ return undef;
+ }
+
+ my $filesize = -s $file;
+
+ if (!$filesize) {
+ $@ = "File is empty";
+ return undef;
+ }
+
+ if (ref $file) { # filehandle passed
+ $fh = $file;
+ } else {
+ if (not open $fh, '<', $file) {
+ $@ = "Can't open $file: $!";
+ return undef;
+ }
+ }
+
+ binmode $fh;
+
+ # Try and find an APE Tag - this is where FooBar2k & others
+ # store ReplayGain information
+ if ($find_ape) {
+
+ $ape = _parse_ape_tag($fh, $filesize, \%info);
+ }
+
+ if ($ver < 2) {
+
+ $v1 = _get_v1tag($fh, \%info);
+
+ if ($ver == 1 && !$v1) {
+ _close($file, $fh);
+ $@ = "No ID3v1 tag found";
+ return undef;
+ }
+ }
+
+ if ($ver == 2 || $ver == 0) {
+ ($v2, $v2h) = _get_v2tag($fh);
+ }
+
+ if (!$v1 && !$v2 && !$ape) {
+ _close($file, $fh);
+ $@ = "No ID3 tag found";
+ return undef;
+ }
+
+ if (($ver == 0 || $ver == 2) && $v2) {
+
+ if ($raw_v2 == 1 && $ver == 2) {
+
+ %info = %$v2;
+
+ $info{'TAGVERSION'} = $v2h->{'version'};
+
+ } else {
+
+ _parse_v2tag($raw_v2, $v2, \%info);
+
+ if ($ver == 0 && $info{'TAGVERSION'}) {
+ $info{'TAGVERSION'} .= ' / ' . $v2h->{'version'};
+ } else {
+ $info{'TAGVERSION'} = $v2h->{'version'};
+ }
+ }
+ }
+
+ unless ($raw_v2 && $ver == 2) {
+ foreach my $key (keys %info) {
+ if (defined $info{$key}) {
+ $info{$key} =~ s/\000+.*//g;
+ $info{$key} =~ s/\s+$//;
+ }
+ }
+
+ for (@v1_tag_names) {
+ $info{$_} = '' unless defined $info{$_};
+ }
+ }
+
+ if (keys %info && exists $info{'GENRE'} && ! defined $info{'GENRE'}) {
+ $info{'GENRE'} = '';
+ }
+
+ _close($file, $fh);
+
+ return keys %info ? {%info} : undef;
+}
+
+sub _get_v1tag {
+ my ($fh, $info) = @_;
+
+ seek $fh, -128, 2;
+ read($fh, my $tag, 128);
+
+ if (!defined($tag) || $tag !~ /^TAG/) {
+
+ return 0;
+ }
+
+ if (substr($tag, -3, 2) =~ /\000[^\000]/) {
+
+ (undef, @{$info}{@v1_tag_names}) =
+ (unpack('a3a30a30a30a4a28', $tag),
+ ord(substr($tag, -2, 1)),
+ $mp3_genres[ord(substr $tag, -1)]);
+
+ $info->{'TAGVERSION'} = 'ID3v1.1';
+
+ } else {
+
+ (undef, @{$info}{@v1_tag_names[0..4, 6]}) =
+ (unpack('a3a30a30a30a4a30', $tag),
+ $mp3_genres[ord(substr $tag, -1)]);
+
+ $info->{'TAGVERSION'} = 'ID3v1';
+ }
+
+ if ($UNICODE) {
+
+ # Save off the old suspects list, since we add
+ # iso-8859-1 below, but don't want that there
+ # for possible ID3 v2.x parsing below.
+ my $oldSuspects = $Encode::Encoding{'Guess'}->{'Suspects'};
+
+ for my $key (keys %{$info}) {
+
+ next unless $info->{$key};
+
+ # Try and guess the encoding.
+ my $value = $info->{$key};
+ my $icode = Encode::Guess->guess($value);
+
+ unless (ref($icode)) {
+
+ # Often Latin1 bytes are
+ # stuffed into a 1.1 tag.
+ Encode::Guess->add_suspects('iso-8859-1');
+
+ while (length($value)) {
+
+ $icode = Encode::Guess->guess($value);
+
+ last if ref($icode);
+
+ # Remove garbage and retry
+ # (string is truncated in the
+ # middle of a multibyte char?)
+ $value =~ s/(.)$//;
+ }
+ }
+
+ $info->{$key} = Encode::decode(ref($icode) ? $icode->name : 'iso-8859-1', $info->{$key});
+ }
+
+ Encode::Guess->set_suspects(keys %{$oldSuspects});
+ }
+
+ return 1;
+}
+
+sub _parse_v2tag {
+ my ($raw_v2, $v2, $info) = @_;
+
+ # Make sure any existing TXXX flags are an array.
+ # As we might need to append comments to it below.
+ if ($v2->{'TXXX'} && ref($v2->{'TXXX'}) ne 'ARRAY') {
+
+ $v2->{'TXXX'} = [ $v2->{'TXXX'} ];
+ }
+
+ # J.River Media Center sticks RG tags in comments.
+ # Ugh. Make them look like TXXX tags, which is really what they are.
+ if (ref($v2->{'COMM'}) eq 'ARRAY' && grep { /Media Jukebox/ } @{$v2->{'COMM'}}) {
+
+ for my $comment (@{$v2->{'COMM'}}) {
+
+ if ($comment =~ /Media Jukebox/) {
+
+ # we only want one null to lead.
+ $comment =~ s/^\000+//g;
+
+ push @{$v2->{'TXXX'}}, "\000$comment";
+ }
+ }
+ }
+
+ my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names;
+
+ for my $id (keys %$hash) {
+
+ next if !exists $v2->{$id};
+
+ if ($id =~ /^UFID?$/) {
+
+ my @ufid_list = split(/\0/, $v2->{$id});
+
+ $info->{$hash->{$id}} = $ufid_list[1] if ($#ufid_list > 0);
+
+ } elsif ($id =~ /^RVA[D2]?$/) {
+
+ # Expand these binary fields. See the ID3 spec for Relative Volume Adjustment.
+ if ($id eq 'RVA2') {
+
+ # ID is a text string
+ ($info->{$hash->{$id}}->{'ID'}, my $rvad) = split /\0/, $v2->{$id};
+
+ my $channel = $rva2_channel_types{ ord(substr($rvad, 0, 1, '')) };
+
+ $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_GAIN'} =
+ sprintf('%f', _grab_int_16(\$rvad) / 512);
+
+ my $peakBytes = ord(substr($rvad, 0, 1, ''));
+
+ if (int($peakBytes / 8)) {
+
+ $info->{$hash->{$id}}->{$channel}->{'REPLAYGAIN_TRACK_PEAK'} =
+ sprintf('%f', _grab_int_16(\$rvad) / 512);
+ }
+
+ } elsif ($id eq 'RVAD' || $id eq 'RVA') {
+
+ my $rvad = $v2->{$id};
+ my $flags = ord(substr($rvad, 0, 1, ''));
+ my $desc = ord(substr($rvad, 0, 1, ''));
+
+ # iTunes appears to be the only program that actually writes
+ # out a RVA/RVAD tag. Everyone else punts.
+ for my $type (qw(REPLAYGAIN_TRACK_GAIN REPLAYGAIN_TRACK_PEAK)) {
+
+ for my $channel (qw(RIGHT LEFT)) {
+
+ my $val = _grab_uint_16(\$rvad) / 256;
+
+ # iTunes uses a range of -255 to 255
+ # to be -100% (silent) to 100% (+6dB)
+ if ($val == -255) {
+ $val = -96.0;
+ } else {
+ $val = 20.0 * log(($val+255)/255)/log(10);
+ }
+
+ $info->{$hash->{$id}}->{$channel}->{$type} = $flags & 0x01 ? $val : -$val;
+ }
+ }
+ }
+
+ } elsif ($id =~ /^A?PIC$/) {
+
+ my $pic = $v2->{$id};
+
+ # if there is more than one picture, just grab the first one.
+ if (ref($pic) eq 'ARRAY') {
+ $pic = (@$pic)[0];
+ }
+
+ use bytes;
+
+ my $valid_pic = 0;
+ my $pic_len = 0;
+ my $pic_format = '';
+
+ # look for ID3 v2.2 picture
+ if ($pic && $id eq 'PIC') {
+
+ # look for ID3 v2.2 picture
+ my ($encoding, $format, $picture_type, $description) = unpack 'Ca3CZ*', $pic;
+ $pic_len = length($description) + 1 + 5;
+
+ # skip extra terminating null if unicode
+ if ($encoding) { $pic_len++; }
+
+ if ($pic_len < length($pic)) {
+ $valid_pic = 1;
+ $pic_format = $format;
+ }
+
+ } elsif ($pic && $id eq 'APIC') {
+
+ # look for ID3 v2.3 picture
+ my ($encoding, $format) = unpack 'C Z*', $pic;
+
+ $pic_len = length($format) + 2;
+
+ if ($pic_len < length($pic)) {
+
+ my ($picture_type, $description) = unpack "x$pic_len C Z*", $pic;
+
+ $pic_len += 1 + length($description) + 1;
+
+ # skip extra terminating null if unicode
+ if ($encoding) { $pic_len++; }
+
+ $valid_pic = 1;
+ $pic_format = $format;
+ }
+ }
+
+ # Proceed if we have a valid picture.
+ if ($valid_pic && $pic_format) {
+
+ my ($data) = unpack("x$pic_len A*", $pic);
+
+ if (length($data) && $pic_format) {
+
+ $info->{$hash->{$id}} = {
+ 'DATA' => $data,
+ 'FORMAT' => $pic_format,
+ }
+ }
+ }
+
+ } else {
+ my $data1 = $v2->{$id};
+
+ # this is tricky ... if this is an arrayref,
+ # we want to only return one, so we pick the
+ # first one. but if it is a comment, we pick
+ # the first one where the first charcter after
+ # the language is NULL and not an additional
+ # sub-comment, because that is most likely to be
+ # the user-supplied comment
+ if (ref $data1 && !$raw_v2) {
+ if ($id =~ /^COMM?$/) {
+ my($newdata) = grep /^(....\000)/, @{$data1};
+ $data1 = $newdata || $data1->[0];
+ } elsif ($id !~ /^(?:TXXX?|PRIV)$/) {
+ # We can get multiple User Defined Text frames in a mp3 file
+ $data1 = $data1->[0];
+ }
+ }
+
+ $data1 = [ $data1 ] if ! ref $data1;
+
+ for my $data (@$data1) {
+ # TODO : this should only be done for certain frames;
+ # using RAW still gives you access, but we should be smarter
+ # about how individual frame types are handled. it's not
+ # like the list is infinitely long.
+ $data =~ s/^(.)//; # strip first char (text encoding)
+ my $encoding = $1;
+ my $desc;
+
+ # Comments & Unsyncronized Lyrics have the same format.
+ if ($id =~ /^(COM[M ]?|USLT)$/) { # space for iTunes brokenness
+
+ $data =~ s/^(?:...)//; # strip language
+ }
+
+ if ($UNICODE) {
+
+ if ($encoding eq "\001" || $encoding eq "\002") { # UTF-16, UTF-16BE
+ # text fields can be null-separated lists;
+ # UTF-16 therefore needs special care
+ #
+ # foobar2000 encodes tags in UTF-16LE
+ # (which is apparently illegal)
+ # Encode dies on a bad BOM, so it is
+ # probably wise to wrap it in an eval
+ # anyway
+ $data = eval { Encode::decode('utf16', $data) } || Encode::decode('utf16le', $data);
+
+ } elsif ($encoding eq "\003") { # UTF-8
+
+ # make sure string is UTF8, and set flag appropriately
+ $data = Encode::decode('utf8', $data);
+
+ } elsif ($encoding eq "\000") {
+
+ # Only guess if it's not ascii.
+ if ($data && $data !~ /^[\x00-\x7F]+$/) {
+
+ # Try and guess the encoding, otherwise just use latin1
+ my $dec = Encode::Guess->guess($data);
+
+ if (ref $dec) {
+ $data = $dec->decode($data);
+ } else {
+ # Best try
+ $data = Encode::decode('iso-8859-1', $data);
+ }
+ }
+ }
+
+ } else {
+
+ # If the string starts with an
+ # UTF-16 little endian BOM, use a hack to
+ # convert to ASCII per best-effort
+ my $pat;
+ if ($data =~ s/^\xFF\xFE//) {
+ $pat = 'v';
+ } elsif ($data =~ s/^\xFE\xFF//) {
+ $pat = 'n';
+ }
+
+ if ($pat) {
+ $data = pack 'C*', map {
+ (chr =~ /[[:ascii:]]/ && chr =~ /[[:print:]]/)
+ ? $_
+ : ord('?')
+ } unpack "$pat*", $data;
+ }
+ }
+
+ # We do this after decoding so we could be certain we're dealing
+ # with 8-bit text.
+ if ($id =~ /^(COM[M ]?|USLT)$/) { # space for iTunes brokenness
+
+ $data =~ s/^(.*?)\000//; # strip up to first NULL(s),
+ # for sub-comments (TODO:
+ # handle all comment data)
+ $desc = $1;
+
+ } elsif ($id =~ /^TCON?$/) {
+
+ my ($index, $name);
+
+ # Turn multiple nulls into a single.
+ $data =~ s/\000+/\000/g;
+
+ # Handle the ID3v2.x spec -
+ #
+ # just an index number, possibly
+ # paren enclosed - referer to the v1 genres.
+ if ($data =~ /^ \(? (\d+) \)?\000?$/sx) {
+
+ $index = $1;
+
+ # Paren enclosed index with refinement.
+ # (4)Eurodisco
+ } elsif ($data =~ /^ \( (\d+) \)\000? ([^\(].+)$/x) {
+
+ ($index, $name) = ($1, $2);
+
+ # List of indexes: (37)(38)
+ } elsif ($data =~ /^ \( (\d+) \)\000?/x) {
+
+ my @genres = ();
+
+ while ($data =~ s/^ \( (\d+) \)\000?//x) {
+
+ push @genres, $mp3_genres[$1];
+ }
+
+ $data = \@genres;
+ }
+
+ # Text based genres will fall through.
+ if ($name && $name ne "\000") {
+ $data = $name;
+ } elsif (defined $index) {
+ $data = $mp3_genres[$index];
+ }
+ }
+
+ if ($raw_v2 == 2 && $desc) {
+ $data = { $desc => $data };
+ }
+
+ if ($raw_v2 == 2 && exists $info->{$hash->{$id}}) {
+
+ if (ref $info->{$hash->{$id}} eq 'ARRAY') {
+ push @{$info->{$hash->{$id}}}, $data;
+ } else {
+ $info->{$hash->{$id}} = [ $info->{$hash->{$id}}, $data ];
+ }
+
+ } else {
+
+ # User defined frame
+ if ($id eq 'TXXX') {
+
+ my ($key, $val) = split(/\0/, $data);
+ $info->{uc($key)} = $val;
+
+ } elsif ($id eq 'PRIV') {
+
+ my ($key, $val) = split(/\0/, $data);
+ $info->{uc($key)} = unpack('v', $val);
+
+ } else {
+
+ $info->{$hash->{$id}} = $data;
+ }
+ }
+ }
+ }
+ }
+}
+
+sub _get_v2tag {
+ my($fh) = @_;
+ my($off, $end, $myseek, $v2, $v2h, $hlen, $num, $wholetag);
+
+ $v2 = {};
+ $v2h = _get_v2head($fh) or return;
+
+ if ($v2h->{major_version} < 2) {
+ carp "This is $v2h->{version}; " .
+ "ID3v2 versions older than ID3v2.2.0 not supported\n"
+ if $^W;
+ return;
+ }
+
+ # use syncsafe bytes if using version 2.4
+ # my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256;
+
+ # alas, that's what the spec says, but iTunes and others don't syncsafe
+ # the length, which breaks MP3 files with v2.4 tags longer than 128 bytes,
+ # like every image file.
+ my $bytesize = 256;
+
+ if ($v2h->{major_version} == 2) {
+ $hlen = 6;
+ $num = 3;
+ } else {
+ $hlen = 10;
+ $num = 4;
+ }
+
+ $off = $v2h->{ext_header_size} + 10;
+ $end = $v2h->{tag_size} + 10; # should we read in the footer too?
+
+ seek $fh, $v2h->{offset}, 0;
+ read $fh, $wholetag, $end;
+
+ $wholetag =~ s/\xFF\x00/\xFF/gs if $v2h->{unsync};
+
+ $myseek = sub {
+ my $bytes = substr($wholetag, $off, $hlen);
+ return unless $bytes =~ /^([A-Z0-9]{$num})/
+ || ($num == 4 && $bytes =~ /^(COM )/); # stupid iTunes
+ my($id, $size) = ($1, $hlen);
+ my @bytes = reverse unpack "C$num", substr($bytes, $num, $num);
+
+ for my $i (0 .. ($num - 1)) {
+ $size += $bytes[$i] * $bytesize ** $i;
+ }
+
+ my $flags = {};
+ if ($v2h->{major_version} > 3) {
+ my @bits = split //, unpack 'B16', substr($bytes, 8, 2);
+ $flags->{frame_unsync} = $bits[14];
+ $flags->{data_len_indicator} = $bits[15];
+ }
+
+ return($id, $size, $flags);
+ };
+
+ while ($off < $end) {
+ my($id, $size, $flags) = &$myseek or last;
+
+ my $bytes = substr($wholetag, $off+$hlen, $size-$hlen);
+
+ my $data_len;
+ if ($flags->{data_len_indicator}) {
+ $data_len = 0;
+ my @data_len_bytes = reverse unpack 'C4', substr($bytes, 0, 4);
+ $bytes = substr($bytes, 4);
+ for my $i (0..3) {
+ $data_len += $data_len_bytes[$i] * 128 ** $i;
+ }
+ }
+
+ # perform frame-level unsync if needed (skip if already done for whole tag)
+ $bytes =~ s/\xFF\x00/\xFF/gs if $flags->{frame_unsync} && !$v2h->{unsync};
+
+ # if we know the data length, sanity check it now.
+ if ($flags->{data_len_indicator} && defined $data_len) {
+ carp "Size mismatch on $id\n" unless $data_len == length($bytes);
+ }
+
+ if (exists $v2->{$id}) {
+ if (ref $v2->{$id} eq 'ARRAY') {
+ push @{$v2->{$id}}, $bytes;
+ } else {
+ $v2->{$id} = [$v2->{$id}, $bytes];
+ }
+ } else {
+ $v2->{$id} = $bytes;
+ }
+ $off += $size;
+ }
+
+ return($v2, $v2h);
+}
+
+
+=pod
+
+=item get_mp3info (FILE)
+
+Returns hash reference containing file information for MP3 file.
+This data cannot be changed. Returned data:
+
+ VERSION MPEG audio version (1, 2, 2.5)
+ LAYER MPEG layer description (1, 2, 3)
+ STEREO boolean for audio is in stereo
+
+ VBR boolean for variable bitrate
+ BITRATE bitrate in kbps (average for VBR files)
+ FREQUENCY frequency in kHz
+ SIZE bytes in audio stream
+ OFFSET bytes offset that stream begins
+
+ SECS total seconds
+ MM minutes
+ SS leftover seconds
+ MS leftover milliseconds
+ TIME time in MM:SS
+
+ COPYRIGHT boolean for audio is copyrighted
+ PADDING boolean for MP3 frames are padded
+ MODE channel mode (0 = stereo, 1 = joint stereo,
+ 2 = dual channel, 3 = single channel)
+ FRAMES approximate number of frames
+ FRAME_LENGTH approximate length of a frame
+ VBR_SCALE VBR scale from VBR header
+
+On error, returns nothing and sets C<$@>.
+
+=cut
+
+sub get_mp3info {
+ my($file) = @_;
+ my($off, $byte, $eof, $h, $tot, $fh);
+
+ if (not (defined $file && $file ne '')) {
+ $@ = "No file specified";
+ return undef;
+ }
+
+ if (not -s $file) {
+ $@ = "File is empty";
+ return undef;
+ }
+
+ if (ref $file) { # filehandle passed
+ $fh = $file;
+ } else {
+ if (not open $fh, '<', $file) {
+ $@ = "Can't open $file: $!";
+ return undef;
+ }
+ }
+
+ $off = 0;
+ $tot = 8192;
+
+ # Let the caller change how far we seek in looking for a header.
+ if ($try_harder) {
+ $tot *= $try_harder;
+ }
+
+ binmode $fh;
+ seek $fh, $off, 0;
+ read $fh, $byte, 4;
+
+ if ($off == 0) {
+ if (my $v2h = _get_v2head($fh)) {
+ $tot += $off += $v2h->{tag_size};
+ seek $fh, $off, 0;
+ read $fh, $byte, 4;
+ }
+ }
+
+ $h = _get_head($byte);
+ my $is_mp3 = _is_mp3($h);
+
+ # the head wasn't where we were expecting it.. dig deeper.
+ unless ($is_mp3) {
+
+ # do only one read - it's _much_ faster
+ $off++;
+ seek $fh, $off, 0;
+ read $fh, $byte, $tot;
+
+ my $i;
+
+ # now walk the bytes looking for the head
+ for ($i = 0; $i < $tot; $i++) {
+
+ last if ($tot - $i) < 4;
+
+ my $head = substr($byte, $i, 4) || last;
+
+ next if (ord($head) != 0xff);
+
+ $h = _get_head($head);
+ $is_mp3 = _is_mp3($h);
+ last if $is_mp3;
+ }
+
+ # adjust where we are for _get_vbr()
+ $off += $i;
+
+ if ($off > $tot && !$try_harder) {
+ _close($file, $fh);
+ $@ = "Couldn't find MP3 header (perhaps set " .
+ '$MP3::Info::try_harder and retry)';
+ return undef;
+ }
+ }
+
+ my $vbr = _get_vbr($fh, $h, \$off);
+
+ seek $fh, 0, 2;
+ $eof = tell $fh;
+ seek $fh, -128, 2;
+ $eof -= 128 if <$fh> =~ /^TAG/ ? 1 : 0;
+
+ _close($file, $fh);
+
+ $h->{size} = $eof - $off;
+ $h->{offset} = $off;
+
+ return _get_info($h, $vbr);
+}
+
+sub _get_info {
+ my($h, $vbr) = @_;
+ my $i;
+
+ # No bitrate or sample rate? Something's wrong.
+ unless ($h->{bitrate} && $h->{fs}) {
+ return {};
+ }
+
+ $i->{VERSION} = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 :
+ $h->{IDR} == 0 ? 2.5 : 0;
+ $i->{LAYER} = 4 - $h->{layer};
+ $i->{VBR} = defined $vbr ? 1 : 0;
+
+ $i->{COPYRIGHT} = $h->{copyright} ? 1 : 0;
+ $i->{PADDING} = $h->{padding_bit} ? 1 : 0;
+ $i->{STEREO} = $h->{mode} == 3 ? 0 : 1;
+ $i->{MODE} = $h->{mode};
+
+ $i->{SIZE} = $vbr && $vbr->{bytes} ? $vbr->{bytes} : $h->{size};
+ $i->{OFFSET} = $h->{offset};
+
+ my $mfs = $h->{fs} / ($h->{ID} ? 144000 : 72000);
+ $i->{FRAMES} = int($vbr && $vbr->{frames}
+ ? $vbr->{frames}
+ : $i->{SIZE} / ($h->{bitrate} / $mfs)
+ );
+
+ if ($vbr) {
+ $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale};
+ $h->{bitrate} = $i->{SIZE} / $i->{FRAMES} * $mfs;
+ if (not $h->{bitrate}) {
+ $@ = "Couldn't determine VBR bitrate";
+ return undef;
+ }
+ }
+
+ $h->{'length'} = ($i->{SIZE} * 8) / $h->{bitrate} / 10;
+ $i->{SECS} = $h->{'length'} / 100;
+ $i->{MM} = int $i->{SECS} / 60;
+ $i->{SS} = int $i->{SECS} % 60;
+ $i->{MS} = (($i->{SECS} - ($i->{MM} * 60) - $i->{SS}) * 1000);
+# $i->{LF} = ($i->{MS} / 1000) * ($i->{FRAMES} / $i->{SECS});
+# int($i->{MS} / 100 * 75); # is this right?
+ $i->{TIME} = sprintf "%.2d:%.2d", @{$i}{'MM', 'SS'};
+
+ $i->{BITRATE} = int $h->{bitrate};
+ # should we just return if ! FRAMES?
+ $i->{FRAME_LENGTH} = int($h->{size} / $i->{FRAMES}) if $i->{FRAMES};
+ $i->{FREQUENCY} = $frequency_tbl[3 * $h->{IDR} + $h->{sampling_freq}];
+
+ return $i;
+}
+
+sub _get_head {
+ my($byte) = @_;
+ my($bytes, $h);
+
+ $bytes = _unpack_head($byte);
+ @$h{qw(IDR ID layer protection_bit
+ bitrate_index sampling_freq padding_bit private_bit
+ mode mode_extension copyright original
+ emphasis version_index bytes)} = (
+ ($bytes>>19)&3, ($bytes>>19)&1, ($bytes>>17)&3, ($bytes>>16)&1,
+ ($bytes>>12)&15, ($bytes>>10)&3, ($bytes>>9)&1, ($bytes>>8)&1,
+ ($bytes>>6)&3, ($bytes>>4)&3, ($bytes>>3)&1, ($bytes>>2)&1,
+ $bytes&3, ($bytes>>19)&3, $bytes
+ );
+
+ $h->{bitrate} = $t_bitrate[$h->{ID}][3 - $h->{layer}][$h->{bitrate_index}];
+ $h->{fs} = $t_sampling_freq[$h->{IDR}][$h->{sampling_freq}];
+
+ return $h;
+}
+
+sub _is_mp3 {
+ my $h = $_[0] or return undef;
+ return ! ( # all below must be false
+ $h->{bitrate_index} == 0
+ ||
+ $h->{version_index} == 1
+ ||
+ ($h->{bytes} & 0xFFE00000) != 0xFFE00000
+ ||
+ !$h->{fs}
+ ||
+ !$h->{bitrate}
+ ||
+ $h->{bitrate_index} == 15
+ ||
+ !$h->{layer}
+ ||
+ $h->{sampling_freq} == 3
+ ||
+ $h->{emphasis} == 2
+ ||
+ !$h->{bitrate_index}
+ ||
+ ($h->{bytes} & 0xFFFF0000) == 0xFFFE0000
+ ||
+ ($h->{ID} == 1 && $h->{layer} == 3 && $h->{protection_bit} == 1)
+ # mode extension should only be applicable when mode = 1
+ # however, failing just becuase mode extension is used when unneeded is a bit strict
+ # ||
+ #($h->{mode_extension} != 0 && $h->{mode} != 1)
+ );
+}
+
+sub _vbr_seek {
+ my $fh = shift;
+ my $off = shift;
+ my $bytes = shift;
+ my $n = shift || 4;
+
+ seek $fh, $$off, 0;
+ read $fh, $$bytes, $n;
+
+ $$off += $n;
+}
+
+sub _get_vbr {
+ my($fh, $h, $roff) = @_;
+ my($off, $bytes, @bytes, %vbr);
+
+ $off = $$roff;
+
+ $off += 4;
+
+ if ($h->{ID}) { # MPEG1
+ $off += $h->{mode} == 3 ? 17 : 32;
+ } else { # MPEG2
+ $off += $h->{mode} == 3 ? 9 : 17;
+ }
+
+ _vbr_seek($fh, \$off, \$bytes);
+ return unless $bytes eq 'Xing';
+
+ _vbr_seek($fh, \$off, \$bytes);
+ $vbr{flags} = _unpack_head($bytes);
+
+ if ($vbr{flags} & 1) {
+ _vbr_seek($fh, \$off, \$bytes);
+ $vbr{frames} = _unpack_head($bytes);
+ }
+
+ if ($vbr{flags} & 2) {
+ _vbr_seek($fh, \$off, \$bytes);
+ $vbr{bytes} = _unpack_head($bytes);
+ }
+
+ if ($vbr{flags} & 4) {
+ _vbr_seek($fh, \$off, \$bytes, 100);
+# Not used right now ...
+# $vbr{toc} = _unpack_head($bytes);
+ }
+
+ if ($vbr{flags} & 8) { # (quality ind., 0=best 100=worst)
+ _vbr_seek($fh, \$off, \$bytes);
+ $vbr{scale} = _unpack_head($bytes);
+ } else {
+ $vbr{scale} = -1;
+ }
+
+ $$roff = $off;
+ return \%vbr;
+}
+
+sub _get_v2head {
+ my $fh = $_[0] or return;
+ my($v2h, $bytes, @bytes);
+ $v2h->{offset} = 0;
+
+ # check first three bytes for 'ID3'
+ seek $fh, 0, 0;
+ read $fh, $bytes, 3;
+
+ # TODO: add support for tags at the end of the file
+ if ($bytes eq 'RIF' || $bytes eq 'FOR') {
+ _find_id3_chunk($fh, $bytes) or return;
+ $v2h->{offset} = tell $fh;
+ read $fh, $bytes, 3;
+ }
+
+ return unless $bytes eq 'ID3';
+
+ # get version
+ read $fh, $bytes, 2;
+ $v2h->{version} = sprintf "ID3v2.%d.%d",
+ @$v2h{qw[major_version minor_version]} =
+ unpack 'c2', $bytes;
+
+ # get flags
+ read $fh, $bytes, 1;
+ my @bits = split //, unpack 'b8', $bytes;
+ if ($v2h->{major_version} == 2) {
+ $v2h->{unsync} = $bits[7];
+ $v2h->{compression} = $bits[8];
+ $v2h->{ext_header} = 0;
+ $v2h->{experimental} = 0;
+ } else {
+ $v2h->{unsync} = $bits[7];
+ $v2h->{ext_header} = $bits[6];
+ $v2h->{experimental} = $bits[5];
+ $v2h->{footer} = $bits[4] if $v2h->{major_version} == 4;
+ }
+
+ # get ID3v2 tag length from bytes 7-10
+ $v2h->{tag_size} = 10; # include ID3v2 header size
+ $v2h->{tag_size} += 10 if $v2h->{footer};
+ read $fh, $bytes, 4;
+ @bytes = reverse unpack 'C4', $bytes;
+ foreach my $i (0 .. 3) {
+ # whoaaaaaa nellllllyyyyyy!
+ $v2h->{tag_size} += $bytes[$i] * 128 ** $i;
+ }
+
+ # get extended header size
+ $v2h->{ext_header_size} = 0;
+ if ($v2h->{ext_header}) {
+ read $fh, $bytes, 4;
+ @bytes = reverse unpack 'C4', $bytes;
+
+ # use syncsafe bytes if using version 2.4
+ my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256;
+ for my $i (0..3) {
+ $v2h->{ext_header_size} += $bytes[$i] * $bytesize ** $i;
+ }
+ }
+
+ return $v2h;
+}
+
+sub _find_id3_chunk {
+ my($fh, $filetype) = @_;
+ my($bytes, $size, $tag, $pat, $mat);
+
+ read $fh, $bytes, 1;
+ if ($filetype eq 'RIF') { # WAV
+ return 0 if $bytes ne 'F';
+ $pat = 'a4V';
+ $mat = 'id3 ';
+ } elsif ($filetype eq 'FOR') { # AIFF
+ return 0 if $bytes ne 'M';
+ $pat = 'a4N';
+ $mat = 'ID3 ';
+ }
+ seek $fh, 12, 0; # skip to the first chunk
+
+ while ((read $fh, $bytes, 8) == 8) {
+ ($tag, $size) = unpack $pat, $bytes;
+ return 1 if $tag eq $mat;
+ seek $fh, $size, 1;
+ }
+
+ return 0;
+}
+
+sub _unpack_head {
+ unpack('l', pack('L', unpack('N', $_[0])));
+}
+
+sub _grab_int_16 {
+ my $data = shift;
+ my $value = unpack('s',substr($$data,0,2));
+ $$data = substr($$data,2);
+ return $value;
+}
+
+sub _grab_uint_16 {
+ my $data = shift;
+ my $value = unpack('S',substr($$data,0,2));
+ $$data = substr($$data,2);
+ return $value;
+}
+
+sub _grab_int_32 {
+ my $data = shift;
+ my $value = unpack('V',substr($$data,0,4));
+ $$data = substr($$data,4);
+ return $value;
+}
+
+sub _parse_ape_tag {
+ my ($fh, $filesize, $info) = @_;
+
+ my $ape_tag_id = 'APETAGEX';
+
+ seek $fh, -256, 2;
+ read($fh, my $tag, 256);
+ my $pre_tag = substr($tag, 0, 128, '');
+
+ # Try and bail early if there's no ape tag.
+ if (substr($pre_tag, 96, 8) ne $ape_tag_id && substr($tag, 96, 8) ne $ape_tag_id) {
+
+ seek($fh, 0, 0);
+ return 0;
+ }
+
+ my $id3v1_tag_size = 128;
+ my $ape_tag_header_size = 32;
+ my $lyrics3_tag_size = 10;
+ my $tag_offset_start = 0;
+ my $tag_offset_end = 0;
+
+ seek($fh, (0 - $id3v1_tag_size - $ape_tag_header_size - $lyrics3_tag_size), 2);
+
+ read($fh, my $ape_footer_id3v1, $id3v1_tag_size + $ape_tag_header_size + $lyrics3_tag_size);
+
+ if (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $id3v1_tag_size - $ape_tag_header_size), 8) eq $ape_tag_id) {
+
+ $tag_offset_end = $filesize - $id3v1_tag_size;
+
+ } elsif (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $ape_tag_header_size), 8) eq $ape_tag_id) {
+
+ $tag_offset_end = $filesize;
+ }
+
+ seek($fh, $tag_offset_end - $ape_tag_header_size, 0);
+
+ read($fh, my $ape_footer_data, 32);
+
+ my $ape_footer = _parse_ape_header_or_footer($ape_footer_data);
+
+ if (keys %{$ape_footer}) {
+
+ my $ape_tag_data = '';
+
+ if ($ape_footer->{'flags'}->{'header'}) {
+
+ seek($fh, ($tag_offset_end - $ape_footer->{'tag_size'} - $ape_tag_header_size), 0);
+
+ $tag_offset_start = tell($fh);
+
+ read($fh, $ape_tag_data, $ape_footer->{'tag_size'} + $ape_tag_header_size);
+
+ } else {
+
+ $tag_offset_start = $tag_offset_end - $ape_footer->{'tag_size'};
+
+ seek($fh, $tag_offset_start, 0);
+
+ read($fh, $ape_tag_data, $ape_footer->{'tag_size'});
+ }
+
+ my $ape_header_data = substr($ape_tag_data, 0, $ape_tag_header_size, '');
+ my $ape_header = _parse_ape_header_or_footer($ape_header_data);
+
+ for (my $c = 0; $c < $ape_header->{'tag_items'}; $c++) {
+
+ # Loop through the tag items
+ my $tag_len = _grab_int_32(\$ape_tag_data);
+ my $tag_flags = _grab_int_32(\$ape_tag_data);
+
+ $ape_tag_data =~ s/^(.*?)\0//;
+
+ my $tag_item_key = uc($1 || 'UNKNOWN');
+
+ $info->{$tag_item_key} = substr($ape_tag_data, 0, $tag_len, '');
+ }
+ }
+
+ seek($fh, 0, 0);
+
+ return 1;
+}
+
+sub _parse_ape_header_or_footer {
+ my $bytes = shift;
+ my %data = ();
+
+ if (substr($bytes, 0, 8, '') eq 'APETAGEX') {
+
+ $data{'version'} = _grab_int_32(\$bytes);
+ $data{'tag_size'} = _grab_int_32(\$bytes);
+ $data{'tag_items'} = _grab_int_32(\$bytes);
+ $data{'global_flags'} = _grab_int_32(\$bytes);
+
+ # trim the reseved bytes
+ _grab_int_32(\$bytes);
+ _grab_int_32(\$bytes);
+
+ $data{'flags'}->{'header'} = ($data{'global_flags'} & 0x80000000) ? 1 : 0;
+ $data{'flags'}->{'footer'} = ($data{'global_flags'} & 0x40000000) ? 1 : 0;
+ $data{'flags'}->{'is_header'} = ($data{'global_flags'} & 0x20000000) ? 1 : 0;
+ }
+
+ return \%data;
+}
+
+sub _close {
+ my($file, $fh) = @_;
+ unless (ref $file) { # filehandle not passed
+ close $fh or carp "Problem closing '$file': $!";
+ }
+}
+
+BEGIN {
+ @mp3_genres = (
+ 'Blues',
+ 'Classic Rock',
+ 'Country',
+ 'Dance',
+ 'Disco',
+ 'Funk',
+ 'Grunge',
+ 'Hip-Hop',
+ 'Jazz',
+ 'Metal',
+ 'New Age',
+ 'Oldies',
+ 'Other',
+ 'Pop',
+ 'R&B',
+ 'Rap',
+ 'Reggae',
+ 'Rock',
+ 'Techno',
+ 'Industrial',
+ 'Alternative',
+ 'Ska',
+ 'Death Metal',
+ 'Pranks',
+ 'Soundtrack',
+ 'Euro-Techno',
+ 'Ambient',
+ 'Trip-Hop',
+ 'Vocal',
+ 'Jazz+Funk',
+ 'Fusion',
+ 'Trance',
+ 'Classical',
+ 'Instrumental',
+ 'Acid',
+ 'House',
+ 'Game',
+ 'Sound Clip',
+ 'Gospel',
+ 'Noise',
+ 'AlternRock',
+ 'Bass',
+ 'Soul',
+ 'Punk',
+ 'Space',
+ 'Meditative',
+ 'Instrumental Pop',
+ 'Instrumental Rock',
+ 'Ethnic',
+ 'Gothic',
+ 'Darkwave',
+ 'Techno-Industrial',
+ 'Electronic',
+ 'Pop-Folk',
+ 'Eurodance',
+ 'Dream',
+ 'Southern Rock',
+ 'Comedy',
+ 'Cult',
+ 'Gangsta',
+ 'Top 40',
+ 'Christian Rap',
+ 'Pop/Funk',
+ 'Jungle',
+ 'Native American',
+ 'Cabaret',
+ 'New Wave',
+ 'Psychadelic',
+ 'Rave',
+ 'Showtunes',
+ 'Trailer',
+ 'Lo-Fi',
+ 'Tribal',
+ 'Acid Punk',
+ 'Acid Jazz',
+ 'Polka',
+ 'Retro',
+ 'Musical',
+ 'Rock & Roll',
+ 'Hard Rock',
+ );
+
+ @winamp_genres = (
+ @mp3_genres,
+ 'Folk',
+ 'Folk-Rock',
+ 'National Folk',
+ 'Swing',
+ 'Fast Fusion',
+ 'Bebop',
+ 'Latin',
+ 'Revival',
+ 'Celtic',
+ 'Bluegrass',
+ 'Avantgarde',
+ 'Gothic Rock',
+ 'Progressive Rock',
+ 'Psychedelic Rock',
+ 'Symphonic Rock',
+ 'Slow Rock',
+ 'Big Band',
+ 'Chorus',
+ 'Easy Listening',
+ 'Acoustic',
+ 'Humour',
+ 'Speech',
+ 'Chanson',
+ 'Opera',
+ 'Chamber Music',
+ 'Sonata',
+ 'Symphony',
+ 'Booty Bass',
+ 'Primus',
+ 'Porn Groove',
+ 'Satire',
+ 'Slow Jam',
+ 'Club',
+ 'Tango',
+ 'Samba',
+ 'Folklore',
+ 'Ballad',
+ 'Power Ballad',
+ 'Rhythmic Soul',
+ 'Freestyle',
+ 'Duet',
+ 'Punk Rock',
+ 'Drum Solo',
+ 'Acapella',
+ 'Euro-House',
+ 'Dance Hall',
+ 'Goa',
+ 'Drum & Bass',
+ 'Club-House',
+ 'Hardcore',
+ 'Terror',
+ 'Indie',
+ 'BritPop',
+ 'Negerpunk',
+ 'Polsk Punk',
+ 'Beat',
+ 'Christian Gangsta Rap',
+ 'Heavy Metal',
+ 'Black Metal',
+ 'Crossover',
+ 'Contemporary Christian',
+ 'Christian Rock',
+ 'Merengue',
+ 'Salsa',
+ 'Thrash Metal',
+ 'Anime',
+ 'JPop',
+ 'Synthpop',
+ );
+
+ @t_bitrate = ([
+ [0, 32, 48, 56, 64, 80, 96, 112, 128, 144, 160, 176, 192, 224, 256],
+ [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160],
+ [0, 8, 16, 24, 32, 40, 48, 56, 64, 80, 96, 112, 128, 144, 160]
+ ],[
+ [0, 32, 64, 96, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416, 448],
+ [0, 32, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320, 384],
+ [0, 32, 40, 48, 56, 64, 80, 96, 112, 128, 160, 192, 224, 256, 320]
+ ]);
+
+ @t_sampling_freq = (
+ [11025, 12000, 8000],
+ [undef, undef, undef], # reserved
+ [22050, 24000, 16000],
+ [44100, 48000, 32000]
+ );
+
+ @frequency_tbl = map { $_ ? eval "${_}e-3" : 0 }
+ map { @$_ } @t_sampling_freq;
+
+ @mp3_info_fields = qw(
+ VERSION
+ LAYER
+ STEREO
+ VBR
+ BITRATE
+ FREQUENCY
+ SIZE
+ OFFSET
+ SECS
+ MM
+ SS
+ MS
+ TIME
+ COPYRIGHT
+ PADDING
+ MODE
+ FRAMES
+ FRAME_LENGTH
+ VBR_SCALE
+ );
+
+ %rva2_channel_types = (
+ 0x00 => 'OTHER',
+ 0x01 => 'MASTER',
+ 0x02 => 'FRONT_RIGHT',
+ 0x03 => 'FRONT_LEFT',
+ 0x04 => 'BACK_RIGHT',
+ 0x05 => 'BACK_LEFT',
+ 0x06 => 'FRONT_CENTER',
+ 0x07 => 'BACK_CENTER',
+ 0x08 => 'SUBWOOFER',
+ );
+
+ %v1_tag_fields =
+ (TITLE => 30, ARTIST => 30, ALBUM => 30, COMMENT => 30, YEAR => 4);
+
+ @v1_tag_names = qw(TITLE ARTIST ALBUM YEAR COMMENT TRACKNUM GENRE);
+
+ %v2_to_v1_names = (
+ # v2.2 tags
+ 'TT2' => 'TITLE',
+ 'TP1' => 'ARTIST',
+ 'TAL' => 'ALBUM',
+ 'TYE' => 'YEAR',
+ 'COM' => 'COMMENT',
+ 'TRK' => 'TRACKNUM',
+ 'TCO' => 'GENRE', # not clean mapping, but ...
+ # v2.3 tags
+ 'TIT2' => 'TITLE',
+ 'TPE1' => 'ARTIST',
+ 'TALB' => 'ALBUM',
+ 'TYER' => 'YEAR',
+ 'COMM' => 'COMMENT',
+ 'TRCK' => 'TRACKNUM',
+ 'TCON' => 'GENRE',
+ # v2.3 tags - needed for MusicBrainz
+ 'UFID' => 'Unique file identifier',
+ 'TXXX' => 'User defined text information frame',
+ );
+
+ %v2_tag_names = (
+ # v2.2 tags
+ 'BUF' => 'Recommended buffer size',
+ 'CNT' => 'Play counter',
+ 'COM' => 'Comments',
+ 'CRA' => 'Audio encryption',
+ 'CRM' => 'Encrypted meta frame',
+ 'ETC' => 'Event timing codes',
+ 'EQU' => 'Equalization',
+ 'GEO' => 'General encapsulated object',
+ 'IPL' => 'Involved people list',
+ 'LNK' => 'Linked information',
+ 'MCI' => 'Music CD Identifier',
+ 'MLL' => 'MPEG location lookup table',
+ 'PIC' => 'Attached picture',
+ 'POP' => 'Popularimeter',
+ 'REV' => 'Reverb',
+ 'RVA' => 'Relative volume adjustment',
+ 'SLT' => 'Synchronized lyric/text',
+ 'STC' => 'Synced tempo codes',
+ 'TAL' => 'Album/Movie/Show title',
+ 'TBP' => 'BPM (Beats Per Minute)',
+ 'TCM' => 'Composer',
+ 'TCO' => 'Content type',
+ 'TCR' => 'Copyright message',
+ 'TDA' => 'Date',
+ 'TDY' => 'Playlist delay',
+ 'TEN' => 'Encoded by',
+ 'TFT' => 'File type',
+ 'TIM' => 'Time',
+ 'TKE' => 'Initial key',
+ 'TLA' => 'Language(s)',
+ 'TLE' => 'Length',
+ 'TMT' => 'Media type',
+ 'TOA' => 'Original artist(s)/performer(s)',
+ 'TOF' => 'Original filename',
+ 'TOL' => 'Original Lyricist(s)/text writer(s)',
+ 'TOR' => 'Original release year',
+ 'TOT' => 'Original album/Movie/Show title',
+ 'TP1' => 'Lead artist(s)/Lead performer(s)/Soloist(s)/Performing group',
+ 'TP2' => 'Band/Orchestra/Accompaniment',
+ 'TP3' => 'Conductor/Performer refinement',
+ 'TP4' => 'Interpreted, remixed, or otherwise modified by',
+ 'TPA' => 'Part of a set',
+ 'TPB' => 'Publisher',
+ 'TRC' => 'ISRC (International Standard Recording Code)',
+ 'TRD' => 'Recording dates',
+ 'TRK' => 'Track number/Position in set',
+ 'TSI' => 'Size',
+ 'TSS' => 'Software/hardware and settings used for encoding',
+ 'TT1' => 'Content group description',
+ 'TT2' => 'Title/Songname/Content description',
+ 'TT3' => 'Subtitle/Description refinement',
+ 'TXT' => 'Lyricist/text writer',
+ 'TXX' => 'User defined text information frame',
+ 'TYE' => 'Year',
+ 'UFI' => 'Unique file identifier',
+ 'ULT' => 'Unsychronized lyric/text transcription',
+ 'WAF' => 'Official audio file webpage',
+ 'WAR' => 'Official artist/performer webpage',
+ 'WAS' => 'Official audio source webpage',
+ 'WCM' => 'Commercial information',
+ 'WCP' => 'Copyright/Legal information',
+ 'WPB' => 'Publishers official webpage',
+ 'WXX' => 'User defined URL link frame',
+
+ # v2.3 tags
+ 'AENC' => 'Audio encryption',
+ 'APIC' => 'Attached picture',
+ 'COMM' => 'Comments',
+ 'COMR' => 'Commercial frame',
+ 'ENCR' => 'Encryption method registration',
+ 'EQUA' => 'Equalization',
+ 'ETCO' => 'Event timing codes',
+ 'GEOB' => 'General encapsulated object',
+ 'GRID' => 'Group identification registration',
+ 'IPLS' => 'Involved people list',
+ 'LINK' => 'Linked information',
+ 'MCDI' => 'Music CD identifier',
+ 'MLLT' => 'MPEG location lookup table',
+ 'OWNE' => 'Ownership frame',
+ 'PCNT' => 'Play counter',
+ 'POPM' => 'Popularimeter',
+ 'POSS' => 'Position synchronisation frame',
+ 'PRIV' => 'Private frame',
+ 'RBUF' => 'Recommended buffer size',
+ 'RVAD' => 'Relative volume adjustment',
+ 'RVRB' => 'Reverb',
+ 'SYLT' => 'Synchronized lyric/text',
+ 'SYTC' => 'Synchronized tempo codes',
+ 'TALB' => 'Album/Movie/Show title',
+ 'TBPM' => 'BPM (beats per minute)',
+ 'TCOM' => 'Composer',
+ 'TCON' => 'Content type',
+ 'TCOP' => 'Copyright message',
+ 'TDAT' => 'Date',
+ 'TDLY' => 'Playlist delay',
+ 'TENC' => 'Encoded by',
+ 'TEXT' => 'Lyricist/Text writer',
+ 'TFLT' => 'File type',
+ 'TIME' => 'Time',
+ 'TIT1' => 'Content group description',
+ 'TIT2' => 'Title/songname/content description',
+ 'TIT3' => 'Subtitle/Description refinement',
+ 'TKEY' => 'Initial key',
+ 'TLAN' => 'Language(s)',
+ 'TLEN' => 'Length',
+ 'TMED' => 'Media type',
+ 'TOAL' => 'Original album/movie/show title',
+ 'TOFN' => 'Original filename',
+ 'TOLY' => 'Original lyricist(s)/text writer(s)',
+ 'TOPE' => 'Original artist(s)/performer(s)',
+ 'TORY' => 'Original release year',
+ 'TOWN' => 'File owner/licensee',
+ 'TPE1' => 'Lead performer(s)/Soloist(s)',
+ 'TPE2' => 'Band/orchestra/accompaniment',
+ 'TPE3' => 'Conductor/performer refinement',
+ 'TPE4' => 'Interpreted, remixed, or otherwise modified by',
+ 'TPOS' => 'Part of a set',
+ 'TPUB' => 'Publisher',
+ 'TRCK' => 'Track number/Position in set',
+ 'TRDA' => 'Recording dates',
+ 'TRSN' => 'Internet radio station name',
+ 'TRSO' => 'Internet radio station owner',
+ 'TSIZ' => 'Size',
+ 'TSRC' => 'ISRC (international standard recording code)',
+ 'TSSE' => 'Software/Hardware and settings used for encoding',
+ 'TXXX' => 'User defined text information frame',
+ 'TYER' => 'Year',
+ 'UFID' => 'Unique file identifier',
+ 'USER' => 'Terms of use',
+ 'USLT' => 'Unsychronized lyric/text transcription',
+ 'WCOM' => 'Commercial information',
+ 'WCOP' => 'Copyright/Legal information',
+ 'WOAF' => 'Official audio file webpage',
+ 'WOAR' => 'Official artist/performer webpage',
+ 'WOAS' => 'Official audio source webpage',
+ 'WORS' => 'Official internet radio station homepage',
+ 'WPAY' => 'Payment',
+ 'WPUB' => 'Publishers official webpage',
+ 'WXXX' => 'User defined URL link frame',
+
+ # v2.4 additional tags
+ # note that we don't restrict tags from 2.3 or 2.4,
+ 'ASPI' => 'Audio seek point index',
+ 'EQU2' => 'Equalisation (2)',
+ 'RVA2' => 'Relative volume adjustment (2)',
+ 'SEEK' => 'Seek frame',
+ 'SIGN' => 'Signature frame',
+ 'TDEN' => 'Encoding time',
+ 'TDOR' => 'Original release time',
+ 'TDRC' => 'Recording time',
+ 'TDRL' => 'Release time',
+ 'TDTG' => 'Tagging time',
+ 'TIPL' => 'Involved people list',
+ 'TMCL' => 'Musician credits list',
+ 'TMOO' => 'Mood',
+ 'TPRO' => 'Produced notice',
+ 'TSOA' => 'Album sort order',
+ 'TSOP' => 'Performer sort order',
+ 'TSOT' => 'Title sort order',
+ 'TSST' => 'Set subtitle',
+
+ # grrrrrrr
+ 'COM ' => 'Broken iTunes comments',
+ );
+}
+
+1;
+
+__END__
+
+=pod
+
+=back
+
+=head1 TROUBLESHOOTING
+
+If you find a bug, please send me a patch (see the project page in L<"SEE ALSO">).
+If you cannot figure out why it does not work for you, please put the MP3 file in
+a place where I can get it (preferably via FTP, or HTTP, or .Mac iDisk) and send me
+mail regarding where I can get the file, with a detailed description of the problem.
+
+If I download the file, after debugging the problem I will not keep the MP3 file
+if it is not legal for me to have it. Just let me know if it is legal for me to
+keep it or not.
+
+
+=head1 TODO
+
+=over 4
+
+=item ID3v2 Support
+
+Still need to do more for reading tags, such as using Compress::Zlib to decompress
+compressed tags. But until I see this in use more, I won't bother. If something
+does not work properly with reading, follow the instructions above for
+troubleshooting.
+
+ID3v2 I<writing> is coming soon.
+
+=item Get data from scalar
+
+Instead of passing a file spec or filehandle, pass the
+data itself. Would take some work, converting the seeks, etc.
+
+=item Padding bit ?
+
+Do something with padding bit.
+
+=item Test suite
+
+Test suite could use a bit of an overhaul and update. Patches very welcome.
+
+=over 4
+
+=item *
+
+Revamp getset.t. Test all the various get_mp3tag args.
+
+=item *
+
+Test Unicode.
+
+=item *
+
+Test OOP API.
+
+=item *
+
+Test error handling, check more for missing files, bad MP3s, etc.
+
+=back
+
+=item Other VBR
+
+Right now, only Xing VBR is supported.
+
+=back
+
+
+=head1 THANKS
+
+Edward Allen,
+Vittorio Bertola,
+Michael Blakeley,
+Per Bolmstedt,
+Tony Bowden,
+Tom Brown,
+Sergio Camarena,
+Chris Dawson,
+Anthony DiSante,
+Luke Drumm,
+Kyle Farrell,
+Jeffrey Friedl,
+brian d foy,
+Ben Gertzfield,
+Brian Goodwin,
+Todd Hanneken,
+Todd Harris,
+Woodrow Hill,
+Kee Hinckley,
+Roman Hodek,
+Ilya Konstantinov,
+Peter Kovacs,
+Johann Lindvall,
+Alex Marandon,
+Peter Marschall,
+michael,
+Trond Michelsen,
+Dave O'Neill,
+Christoph Oberauer,
+Jake Palmer,
+Andrew Phillips,
+David Reuteler,
+John Ruttenberg,
+Matthew Sachs,
+scfc_de,
+Hermann Schwaerzler,
+Chris Sidi,
+Roland Steinbach,
+Brian S. Stephan,
+Stuart,
+Dan Sully,
+Jeffery Sumler,
+Predrag Supurovic,
+Bogdan Surdu,
+Pierre-Yves Thoulon,
+tim,
+Pass F. B. Travis,
+Tobias Wagener,
+Ronan Waide,
+Andy Waite,
+Ken Williams,
+Ben Winslow,
+Meng Weng Wong.
+
+
+=head1 CURRENT AUTHOR
+
+Dan Sully E<lt>dan | at | slimdevices.comE<gt> & Slim Devices, Inc.
+
+=head1 AUTHOR EMERITUS
+
+Chris Nandor E<lt>pudge@pobox.comE<gt>, http://pudge.net/
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2006 Dan Sully & Slim Devices, Inc. All rights reserved.
+
+Copyright (c) 1998-2005 Chris Nandor. All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item Slim Devices
+
+ http://www.slimdevices.com/
+
+=item mp3tools
+
+ http://www.zevils.com/linux/mp3tools/
+
+=item mpgtools
+
+ http://www.dv.co.yu/mpgscript/mpgtools.htm
+ http://www.dv.co.yu/mpgscript/mpeghdr.htm
+
+=item mp3tool
+
+ http://www.dtek.chalmers.se/~d2linjo/mp3/mp3tool.html
+
+=item ID3v2
+
+ http://www.id3.org/
+
+=item Xing Variable Bitrate
+
+ http://www.xingtech.com/support/partner_developer/mp3/vbr_sdk/
+
+=item MP3Ext
+
+ http://rupert.informatik.uni-stuttgart.de/~mutschml/MP3ext/
+
+=item Xmms
+
+ http://www.xmms.org/
+
+
+=back
+
+=cut
generated by cgit v1.1 at 2026-05-15 12:19:58 +0000