tools: Update mp3info perl module to final upstream version
rockbox-gerrit-noreply--- via rockbox-cvs <[email protected]> Mon, 1 Jun 2026 17:18:23 -0400
| Newsgroups | gmane.comp.systems.archos.rockbox.cvs |
|---|---|
| Message-ID | <[email protected]> |
commit addcc159c2ef2163ec0c1407cea8bcfaca1a36d7 Author: Solomon Peachy <[email protected]> Date: Mon Jun 1 16:08:00 2026 -0400 tools: Update mp3info perl module to final upstream version 1.20 -> 1.26 https://github.com/dsully/perl-mp3-info/commits/master/Info.pm Change-Id: I0d58f56265a463784f45673764b9fdc054887c2a diff --git a/tools/mp3info.pm b/tools/mp3info.pm index d2f6ce9708..10c5c20920 100644 --- a/tools/mp3info.pm +++ b/tools/mp3info.pm @@ -1,10 +1,19 @@ package mp3info; +# JJ: fixed bugs and stuff and added META info +# JRF: Added support for ID3v2.4 spec-valid frame size processing (falling back to old +# non-spec valid frame size processing) +# Added support for ID3v2.4 footers. +# Updated text frames to correct mis-terminated frame content. +# Added ignoring of encrypted frames. +# TODO: sort out flags for compression / DLI + require 5.006; -use overload; use strict; +use overload; use Carp; +use Fcntl qw(:seek); use vars qw( @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $REVISION @@ -12,12 +21,13 @@ use vars qw( @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 + $debug_24 $debug_Tencoding ); @ISA = 'Exporter'; @EXPORT = qw( set_mp3tag get_mp3tag get_mp3info remove_mp3tag - use_winamp_genres, use_mp3_utf8 + use_winamp_genres ); @EXPORT_OK = qw(@mp3_genres %mp3_genres use_mp3_utf8); %EXPORT_TAGS = ( @@ -26,8 +36,13 @@ use vars qw( all => [@EXPORT, @EXPORT_OK] ); +# $Id$ ($REVISION) = ' $Revision$ ' =~ /\$Revision:\s+([^\s]+)/; -$VERSION = '1.20'; +$VERSION = '1.26'; # Just adds metadata + +# JRF: Whether we're debugging the ID3v2.4 support +$debug_24 = 0; +$debug_Tencoding = 0; =pod @@ -166,19 +181,28 @@ 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); +my $unicode_base_module = eval { require Encode; require Encode::Guess }; + +my $UNICODE = use_mp3_utf8($unicode_base_module ? 1 : 0); + +eval { require Encode::Detect::Detector }; + +my $unicode_detect_module = $@ ? 0 : 1; sub use_mp3_utf8 { - my($val) = @_; + my $val = shift; + + $UNICODE = 0; + if ($val == 1) { - if ($unicode_module) { - $UNICODE = 1; + + if ($unicode_base_module) { + $Encode::Guess::NoUTFAutoGuess = 1; + $UNICODE = 1; } - } elsif ($val == 0) { - $UNICODE = 0; } + return $UNICODE; } @@ -254,7 +278,7 @@ sub remove_mp3tag { binmode $fh; if ($version eq 1 || $version eq 'ALL') { - seek $fh, -128, 2; + seek $fh, -128, SEEK_END; my $tell = tell $fh; if (<$fh> =~ /^TAG/) { truncate $fh, $tell or carp "Can't truncate '$file': $!"; @@ -266,14 +290,14 @@ sub remove_mp3tag { my $v2h = _get_v2head($fh); if ($v2h) { local $\; - seek $fh, 0, 2; + seek $fh, 0, SEEK_END; my $eof = tell $fh; my $off = $v2h->{tag_size}; while ($off < $eof) { - seek $fh, $off, 0; + seek $fh, $off, SEEK_SET; read $fh, my($bytes), $buf; - seek $fh, $off - $v2h->{tag_size}, 0; + seek $fh, $off - $v2h->{tag_size}, SEEK_SET; print $fh $bytes; $off += $buf; } @@ -282,6 +306,9 @@ sub remove_mp3tag { or carp "Can't truncate '$file': $!"; $return += $v2h->{tag_size}; } + + # JRF: I've not written the code to strip ID3v2.4 footers. + # Sorry, I'm lazy. } _close($file, $fh); @@ -399,9 +426,9 @@ EOT 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; + seek $fh, -128, SEEK_END; + # go to end of file if no ID3v1 tag, beginning of existing tag if tag present + seek $fh, (<$fh> =~ /^TAG/ ? -128 : 0), SEEK_END; # get genre value $info{GENRE} = $info{GENRE} && exists $mp3_genres{$info{GENRE}} ? @@ -424,7 +451,7 @@ EOT =pod -=item get_mp3tag (FILE [, VERSION, RAW_V2]) +=item get_mp3tag (FILE [, VERSION, RAW_V2, APE2]) 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 @@ -444,6 +471,8 @@ 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 APE is C<1>, an APE tag will be located before all other tags. + If the ID3v2 version is older than ID3v2.2.0 or newer than ID3v2.4.0, it will not be read. @@ -456,19 +485,21 @@ 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; + my $file = shift; + my $ver = shift || 0; + my $raw = shift || 0; + my $find_ape = shift || 0; + my $fh; + + my $has_v1 = 0; + my $has_v2 = 0; + my $has_ape = 0; + my %info = (); + + # See if a version number was passed. Make sure it's a 1 or a 2 $ver = !$ver ? 0 : ($ver == 2 || $ver == 1) ? $ver : 0; - if (not (defined $file && $file ne '')) { + if (!(defined $file && $file ne '')) { $@ = "No file specified"; return undef; } @@ -480,13 +511,17 @@ sub get_mp3tag { return undef; } - if (ref $file) { # filehandle passed + # filehandle passed + if (ref $file) { + $fh = $file; + } else { - if (not open $fh, '<', $file) { + + open($fh, $file) || do { $@ = "Can't open $file: $!"; return undef; - } + }; } binmode $fh; @@ -495,14 +530,14 @@ sub get_mp3tag { # store ReplayGain information if ($find_ape) { - $ape = _parse_ape_tag($fh, $filesize, \%info); + $has_ape = _parse_ape_tag($fh, $filesize, \%info); } if ($ver < 2) { - $v1 = _get_v1tag($fh, \%info); + $has_v1 = _get_v1tag($fh, \%info); - if ($ver == 1 && !$v1) { + if ($ver == 1 && !$has_v1) { _close($file, $fh); $@ = "No ID3v1 tag found"; return undef; @@ -510,37 +545,20 @@ sub get_mp3tag { } if ($ver == 2 || $ver == 0) { - ($v2, $v2h) = _get_v2tag($fh); + $has_v2 = _get_v2tag($fh, $ver, $raw, \%info); } - if (!$v1 && !$v2 && !$ape) { + if (!$has_v1 && !$has_v2 && !$has_ape) { _close($file, $fh); - $@ = "No ID3 tag found"; + $@ = "No ID3 or APE 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); + unless ($raw && $ver == 2) { - if ($ver == 0 && $info{'TAGVERSION'}) { - $info{'TAGVERSION'} .= ' / ' . $v2h->{'version'}; - } else { - $info{'TAGVERSION'} = $v2h->{'version'}; - } - } - } - - unless ($raw_v2 && $ver == 2) { + # Strip out NULLs unless we want the raw data. foreach my $key (keys %info) { + if (defined $info{$key}) { $info{$key} =~ s/\000+.*//g; $info{$key} =~ s/\s+$//; @@ -552,19 +570,19 @@ sub get_mp3tag { } } - if (keys %info && exists $info{'GENRE'} && ! defined $info{'GENRE'}) { + if (keys %info && !defined $info{'GENRE'}) { $info{'GENRE'} = ''; } _close($file, $fh); - return keys %info ? {%info} : undef; + return keys %info ? \%info : undef; } sub _get_v1tag { my ($fh, $info) = @_; - seek $fh, -128, 2; + seek $fh, -128, SEEK_END; read($fh, my $tag, 128); if (!defined($tag) || $tag !~ /^TAG/) { @@ -590,51 +608,69 @@ sub _get_v1tag { $info->{'TAGVERSION'} = 'ID3v1'; } - if ($UNICODE) { + if (!$UNICODE) { + return 1; + } - # 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'}; + # 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}) { + for my $key (keys %{$info}) { - next unless $info->{$key}; + next unless $info->{$key}; - # Try and guess the encoding. - my $value = $info->{$key}; - my $icode = Encode::Guess->guess($value); + # Try and guess the encoding. + if ($unicode_detect_module) { - unless (ref($icode)) { + my $charset = Encode::Detect::Detector::detect($info->{$key}) || 'iso-8859-1'; + my $enc = Encode::find_encoding($charset); - # Often Latin1 bytes are - # stuffed into a 1.1 tag. - Encode::Guess->add_suspects('iso-8859-1'); + if ($enc) { - while (length($value)) { + $info->{$key} = $enc->decode($info->{$key}, 0); - $icode = Encode::Guess->guess($value); + next; + } + } - last if ref($icode); + my $value = $info->{$key}; + my $icode = Encode::Guess->guess($value); - # Remove garbage and retry - # (string is truncated in the - # middle of a multibyte char?) - $value =~ s/(.)$//; - } - } + if (!ref($icode)) { + + # Often Latin1 bytes are + # stuffed into a 1.1 tag. + Encode::Guess->add_suspects('iso-8859-1'); + + while (length($value)) { - $info->{$key} = Encode::decode(ref($icode) ? $icode->name : 'iso-8859-1', $info->{$key}); + $icode = Encode::Guess->guess($value); + + last if ref($icode); + + # Remove garbage and retry + # (string is truncated in the + # middle of a multibyte char?) + # Changed thanks to https://rt.cpan.org/Ticket/Display.html?id=101620 + substr($value, -1, 1, ''); + } } - Encode::Guess->set_suspects(keys %{$oldSuspects}); + $info->{$key} = Encode::decode(ref($icode) ? $icode->name : 'iso-8859-1', $info->{$key}); + + # Trim any trailing nuls + $info->{$key} =~ s/\x00+$//g; } + Encode::Guess->set_suspects(keys %{$oldSuspects}); + return 1; } sub _parse_v2tag { - my ($raw_v2, $v2, $info) = @_; + my ($ver, $raw_v2, $v2, $info) = @_; # Make sure any existing TXXX flags are an array. # As we might need to append comments to it below. @@ -661,7 +697,7 @@ sub _parse_v2tag { my $hash = $raw_v2 == 2 ? { map { ($_, $_) } keys %v2_tag_names } : \%v2_to_v1_names; - for my $id (keys %$hash) { + for my $id (keys %{$hash}) { next if !exists $v2->{$id}; @@ -724,6 +760,11 @@ sub _parse_v2tag { my $pic = $v2->{$id}; # if there is more than one picture, just grab the first one. + # JRF: Should consider looking for either the thumbnail or the front cover, + # rather than just returning the first one. + # Possibly also checking that the format is actually understood, + # but that's really down to the caller - we can't say whether the + # format is understood here. if (ref($pic) eq 'ARRAY') { $pic = (@$pic)[0]; } @@ -751,7 +792,7 @@ sub _parse_v2tag { } elsif ($pic && $id eq 'APIC') { - # look for ID3 v2.3 picture + # look for ID3 v2.3/2.4 picture my ($encoding, $format) = unpack 'C Z*', $pic; $pic_len = length($format) + 2; @@ -762,8 +803,8 @@ sub _parse_v2tag { $pic_len += 1 + length($description) + 1; - # skip extra terminating null if unicode - if ($encoding) { $pic_len++; } + # skip extra terminating null if UTF-16 (encoding 1 or 2) + if ( $encoding == 1 || $encoding == 2 ) { $pic_len++; } $valid_pic = 1; $pic_format = $format; @@ -787,24 +828,7 @@ sub _parse_v2tag { } 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; + $data1 = [ $data1 ] if ref($data1) ne 'ARRAY'; for my $data (@$data1) { # TODO : this should only be done for certain frames; @@ -816,11 +840,13 @@ sub _parse_v2tag { my $desc; # Comments & Unsyncronized Lyrics have the same format. - if ($id =~ /^(COM[M ]?|USLT)$/) { # space for iTunes brokenness + if ($id =~ /^(COM[M ]?|US?LT)$/) { # space for iTunes brokenness $data =~ s/^(?:...)//; # strip language } + # JRF: I believe this should probably only be applied to the text frames + # and not every single frame. if ($UNICODE) { if ($encoding eq "\001" || $encoding eq "\002") { # UTF-16, UTF-16BE @@ -844,14 +870,26 @@ sub _parse_v2tag { # 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 ($unicode_detect_module) { + + my $charset = Encode::Detect::Detector::detect($data) || 'iso-8859-1'; + my $enc = Encode::find_encoding($charset); + + if ($enc) { + $data = $enc->decode($data, 0); + } - if (ref $dec) { - $data = $dec->decode($data); } else { - # Best try - $data = Encode::decode('iso-8859-1', $data); + + # 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); + } } } } @@ -863,12 +901,18 @@ sub _parse_v2tag { # convert to ASCII per best-effort my $pat; if ($data =~ s/^\xFF\xFE//) { + # strip additional BOMs as seen in COM(M?) and TXX(X?) + $data = join ("",map { ( /^(..)$/ && ! /(\xFF\xFE)/ )? $_: "" } (split /(..)/, $data)); $pat = 'v'; } elsif ($data =~ s/^\xFE\xFF//) { + # strip additional BOMs as seen in COM(M?) and TXX(X?) + $data = join ("",map { ( /^(..)$/ && ! /(\xFF\xFE)/ )? $_: "" } (split /(..)/, $data)); $pat = 'n'; } if ($pat) { + # strip additional 0s + $data = join ("",map { ( /^(..)$/ && ! /(\x00\x00)/ )? $_: "" } (split /(..)/, $data)); $data = pack 'C*', map { (chr =~ /[[:ascii:]]/ && chr =~ /[[:print:]]/) ? $_ @@ -879,13 +923,18 @@ sub _parse_v2tag { # 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 + if ($id =~ /^(COM[M ]?|US?LT)$/) { # space for iTunes brokenness $data =~ s/^(.*?)\000//; # strip up to first NULL(s), # for sub-comments (TODO: # handle all comment data) $desc = $1; + if ($encoding eq "\001" || $encoding eq "\002") { + + $data =~ s/^\x{feff}//; + } + } elsif ($id =~ /^TCON?$/) { my ($index, $name); @@ -912,12 +961,27 @@ sub _parse_v2tag { my @genres = (); - while ($data =~ s/^ \( (\d+) \)\000?//x) { + while ($data =~ s/^ \( (\d+) \)//x) { + + # The indexes might have a refinement + # not sure why one wouldn't just use + # the proper genre in the first place.. + if ($data =~ s/^ ( [^\(]\D+ ) ( \000 | \( | \Z)/$2/x) { + + push @genres, $1; + + } else { - push @genres, $mp3_genres[$1]; + push @genres, $mp3_genres[$1]; + } } $data = \@genres; + + } elsif ($data =~ /^[^\000]+\000/) { + + # name genres separated by nulls. + $data = [ split /\000/, $data ]; } # Text based genres will fall through. @@ -926,10 +990,52 @@ sub _parse_v2tag { } elsif (defined $index) { $data = $mp3_genres[$index]; } + + # Collapse single genres down, as we may have another tag. + if ($data && ref($data) eq 'ARRAY' && scalar @$data == 1) { + + $data = $data->[0]; + } + + } elsif ($id =~ /^T...?$/ && $id ne 'TXXX') { + + # In ID3v2.4 there's a slight content change for text fields. + # They can contain multiple values which are nul terminated + # within the frame. We ONLY want to split these into multiple + # array values if they didn't request raw values (1). + # raw_v2 = 0 => parse simply + # raw_v2 = 1 => don't parse + # raw_v2 = 2 => do split into arrayrefs + + # Strip off any trailing NULs, which would indicate an empty + # field and cause an array with no elements to be created. + $data =~ s/\x00+$//; + + + if ($data =~ /\x00/ && ($raw_v2 == 2 || $raw_v2 == 0)) + { + # There are embedded nuls in the string, which means an ID3v2.4 + # multi-value frame. And they wanted arrays rather than simple + # values. + # Strings are already UTF-8, so any double nuls from 16 bit + # characters will have already been reduced to single nuls. + $data = [ split /\000/, $data ]; + } } - if ($raw_v2 == 2 && $desc) { - $data = { $desc => $data }; + if ($desc) + { + # It's a frame with a description, so we may need to construct a hash + # for the data, rather than an array. + if ($raw_v2 == 2) { + + $data = { $desc => $data }; + + } elsif ($desc =~ /^iTun/) { + + # leave iTunes tags alone. + $data = join(' ', $desc, $data); + } } if ($raw_v2 == 2 && exists $info->{$hash->{$id}}) { @@ -946,6 +1052,13 @@ sub _parse_v2tag { if ($id eq 'TXXX') { my ($key, $val) = split(/\0/, $data); + + # Some programs - such as FB2K leave a UTF-16 BOM on the value + if ($encoding eq "\001" || $encoding eq "\002") { + + $val =~ s/^\x{feff}//; + } + $info->{uc($key)} = $val; } elsif ($id eq 'PRIV') { @@ -955,7 +1068,38 @@ sub _parse_v2tag { } else { - $info->{$hash->{$id}} = $data; + my $key = $hash->{$id}; + + # If we have multiple values + # for the same key - turn them + # into an array ref. + if ($ver == 2 && $info->{$key} && !ref($info->{$key})) { + + if (ref($data) eq "ARRAY") { + + $info->{$key} = [ $info->{$key}, @$data ]; + } else { + + my $old = delete $info->{$key}; + + @{$info->{$key}} = ($old, $data); + } + + } elsif ($ver == 2 && ref($info->{$key}) eq 'ARRAY') { + + if (ref($data) eq "ARRAY") { + + push @{$info->{$key}}, @$data; + + } else { + + push @{$info->{$key}}, $data; + } + + } else { + + $info->{$key} = $data; + } } } } @@ -964,26 +1108,113 @@ sub _parse_v2tag { } sub _get_v2tag { - my($fh) = @_; + my ($fh, $ver, $raw, $info, $start) = @_; + my $eof; + my $gotanyv2 = 0; + + # First we need to check the end of the file for any footer + + seek $fh, -128, SEEK_END; + $eof = (tell $fh) + 128; + + # go to end of file if no ID3v1 tag, beginning of existing tag if tag present + if (<$fh> =~ /^TAG/) { + $eof -= 128; + } + + seek $fh, $eof, SEEK_SET; + # print STDERR "Checking for footer at $eof\n"; + + if (my $v2f = _get_v2foot($fh)) { + $eof -= $v2f->{tag_size}; + # We have a ID3v2.4 footer. Must read it. + $gotanyv2 |= (_get_v2tagdata($fh, $ver, $raw, $info, $eof) ? 2 : 0); + } + + # Now read any ID3v2 header + $gotanyv2 |= (_get_v2tagdata($fh, $ver, $raw, $info, $start) ? 1 : 0); + + # Because we've merged the entries it makes sense to trim any duplicated + # values - for example if there's a footer and a header that contain the same + # data then this results in every entry being an array containing two + # identical values. + for my $name (keys %{$info}) + { + # Note: We must not sort these elements to do the comparison because that + # changes the order in which they are claimed to appear. Whilst this + # probably isn't important, it may matter for default display - for + # example a lyric should be shown by default with the first entry + # in the tag in the case where the user has not specified a language + # preference. If we sorted the array it would destroy that order. + # This is a longwinded way of checking for duplicates and only writing the + # first element - we check the array for duplicates and clear all subsequent + # entries which are duplicates of earlier ones. + if (ref $info->{$name} eq 'ARRAY') + { + my @array = (); + my ($i, $o); + my @chk = @{$info->{$name}}; + for $i ( 0..$#chk ) + { + my $ielement = $chk[$i]; + if (defined $ielement) + { + for $o ( ($i+1)..$#chk ) + { + $chk[$o] = undef if (defined $o && defined $chk[$o] && ($ielement eq $chk[$o])); + } + push @array, $ielement; + } + } + # We may have reduced the array to a single element. If so, just assign + # a regular scalar instead of the array. + if ($#array == 0) + { + $info->{$name} = $array[0]; + } + else + { + $info->{$name} = \@array; + } + } + } + + return $gotanyv2; +} + +# $has_v2 = &_get_v2tagdata($filehandle, $ver, $raw, $info, $startinfile); +# $info is a hash reference which will be updated with the new ID3v2 details +# if the updated bit is set, and set to the new details if the updated bit +# is clear. +# If undefined, $startinfile will be treated as 0 (see _get_v2head). +# $v2h is a reference to a hash of the frames present within the tag. +# Any frames which are repeated within the tag (eg USLT with different +# languages) will be supplied as an array rather than a scalar. All client +# code needs to be aware that any frame may be duplicated. +sub _get_v2tagdata { + my($fh, $ver, $raw, $info, $start) = @_; my($off, $end, $myseek, $v2, $v2h, $hlen, $num, $wholetag); $v2 = {}; - $v2h = _get_v2head($fh) or return; + $v2h = _get_v2head($fh, $start) or return 0; if ($v2h->{major_version} < 2) { carp "This is $v2h->{version}; " . "ID3v2 versions older than ID3v2.2.0 not supported\n" if $^W; - return; + return 0; } # use syncsafe bytes if using version 2.4 - # my $bytesize = ($v2h->{major_version} > 3) ? 128 : 256; + my $id3v2_4_frame_size_broken = 0; + 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; + # Because we should not break the spec conformant files due to + # spec-inconformant programs, we first try the correct form and if the + # data looks wrong we revert to broken behaviour. if ($v2h->{major_version} == 2) { $hlen = 6; @@ -996,70 +1227,308 @@ sub _get_v2tag { $off = $v2h->{ext_header_size} + 10; $end = $v2h->{tag_size} + 10; # should we read in the footer too? - seek $fh, $v2h->{offset}, 0; + # JRF: If the format was ID3v2.2 and the compression bit was set, then we can't + # actually read the content because there are no defined compression schemes + # for ID3v2.2. Perform no more processing, and return failure because we + # cannot read anything. + return 0 if ($v2h->{major_version} == 2 && $v2h->{compression}); + + # JRF: If the update flag is set then the input data is the same as that which was + # passed in. ID3v2.4 section 3.2. + if ($v2h->{update}) { + $v2 = $info; + } + + # Bug 8939, Trying to read past the end of the file may crash on win32 + my $size = -s $fh; + if ( $v2h->{offset} + $end > $size ) { + $end -= $v2h->{offset} + $end - $size; + } + + seek $fh, $v2h->{offset}, SEEK_SET; read $fh, $wholetag, $end; + # JRF: The discrepency between ID3v2.3 and ID3v2.4 is that : + # 2.3: unsync flag indicates that unsync is used on the entire tag + # 2.4: unsync flag indicates that all frames have the unsync bit set + # In 2.4 this means that the size of the frames which have the unsync bit + # set will be the unsync'd size (section 4. in the ID3v2.4.0 structure + # specification). + # This means that when processing 2.4 files we should perform all the + # unsynchronisation processing at the frame level, not the tag level. + # The tag unsync bit is redundant (IMO). + if ($v2h->{major_version} == 4) { + $v2h->{unsync} = 0 + } + $wholetag =~ s/\xFF\x00/\xFF/gs if $v2h->{unsync}; + # JRF: If we /knew/ there would be something special in the tag which meant + # that the ID3v2.4 frame size was broken we could check it here. If, + # for example, the iTunes files had the word 'iTunes' somewhere in the + # tag and we knew that it was broken for versions below 3.145 (which is + # a number I just picked out of the air), then we could do something like this : + # if ($v2h->{major_version} == 4) && + # $wholetag =~ /iTunes ([0-9]+\.[0-9]+)/ && + # $1 < 3.145) + # { + # $id3v2_4_frame_size_broken = 1; + # } + # However I have not included this because I don't have examples of broken + # files - and in any case couldn't guarentee I'd get it right. + $myseek = sub { + return unless $wholetag; + my $bytes = substr($wholetag, $off, $hlen); - return unless $bytes =~ /^([A-Z0-9]{$num})/ - || ($num == 4 && $bytes =~ /^(COM )/); # stupid iTunes - my($id, $size) = ($1, $hlen); + + # iTunes is stupid and sticks ID3v2.2 3 byte frames in a + # ID3v2.3 or 2.4 header. Ignore tags with a space in them. + if ($bytes !~ /^([A-Z0-9\? ]{$num})/) { + return; + } + + 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; } + # JRF: Now provide the fall back for the broken ID3v2.4 frame size + # (which will persist for subsequent frames if detected). + + # Part 1: If the frame size cannot be valid according to the + # specification (or if it would be larger than the tag + # size allows). + if ($v2h->{major_version}==4 && + $id3v2_4_frame_size_broken == 0 && # we haven't detected brokenness yet + ((($bytes[0] | $bytes[1] | $bytes[2] | $bytes[3]) & 0x80) != 0 || # 0-bits set in size + $off + $size > $end) # frame size would excede the tag end + ) + { + # The frame is definately not correct for the specification, so drop to + # broken frame size system instead. + $bytesize = 128; + $size -= $hlen; # hlen has alread been added, so take that off again + $size = (($size & 0x0000007f)) | + (($size & 0x00003f80)<<1) | + (($size & 0x001fc000)<<2) | + (($size & 0x0fe00000)<<3); # convert spec to non-spec sizes + + $size += $hlen; # and re-add header len so that the entire frame's size is known + + $id3v2_4_frame_size_broken = 1; + + print "Frame size cannot be valid ID3v2.4 (part 1); reverting to broken behaviour\n" if ($debug_24); + + } + + # Part 2: If the frame size would result in the following frame being + # invalid. + if ($v2h->{major_version}==4 && + $id3v2_4_frame_size_broken == 0 && # we haven't detected brokenness yet + $size > 0x80+$hlen && # ignore frames that are too short to ever be wrong + $off + $size < $end) + { + + print "Frame size might not be valid ID3v2.4 (part 2); checking for following frame validity\n" if ($debug_24); + + my $morebytes = substr($wholetag, $off+$size, 4); + + if (! ($morebytes =~ /^([A-Z0-9]{4})/ || $morebytes =~ /^\x00{4}/) ) { + + # The next tag cannot be valid because its name is wrong, which means that + # either the size must be invalid or the next frame truely is broken. + # Either way, we can try to reduce the size to see. + my $retrysize; + + print " following frame isn't valid using spec\n" if ($debug_24); + + $retrysize = $size - $hlen; # remove already added header length + $retrysize = (($retrysize & 0x0000007f)) | + (($retrysize & 0x00003f80)<<1) | + (($retrysize & 0x001fc000)<<2) | + (($retrysize & 0x0fe00000)<<3); # convert spec to non-spec sizes + + $retrysize += $hlen; # and re-add header len so that the entire frame's size is known + + if (length($wholetag) >= ($off+$retrysize+4)) { + + $morebytes = substr($wholetag, $off+$retrysize, 4); + + } else { + + $morebytes = ''; + } + + if (! ($morebytes =~ /^([A-Z0-9]{4})/ || + $morebytes =~ /^\x00{4}/ || + $off + $retrysize > $end) ) + { + # With the retry at the smaller size, the following frame still isn't valid + # so the only thing we can assume is that this frame is just broken beyond + # repair. Give up right now - there's no way we can recover. + print " and isn't valid using broken-spec support; giving up\n" if ($debug_24); + return; + } + + print " but is fine with broken-spec support; reverting to broken behaviour\n" if ($debug_24); + + # We're happy that the non-spec size looks valid to lead us to the next frame. + # We might be wrong, generating false-positives, but that's really what you + # get for trying to handle applications that don't handle the spec properly - + # use something that isn't broken. + # (this is a copy of the recovery code in part 1) + $size = $retrysize; + $bytesize = 128; + $id3v2_4_frame_size_broken = 1; + + } else { + + print " looks like valid following frame; keeping spec behaviour\n" if ($debug_24); + + } + } + my $flags = {}; - if ($v2h->{major_version} > 3) { + + # JRF: was > 3, but that's not true; future versions may be incompatible + if ($v2h->{major_version} == 4) { my @bits = split //, unpack 'B16', substr($bytes, 8, 2); + $flags->{frame_zlib} = $bits[12]; # JRF: need to know about compressed + $flags->{frame_encrypt} = $bits[13]; # JRF: ... and encrypt $flags->{frame_unsync} = $bits[14]; $flags->{data_len_indicator} = $bits[15]; } - return($id, $size, $flags); + # JRF: version 3 was in a different order + elsif ($v2h->{major_version} == 3) { + my @bits = split //, unpack 'B16', substr($bytes, 8, 2); + $flags->{frame_zlib} = $bits[8]; # JRF: need to know about compressed + $flags->{data_len_indicator} = $bits[8]; # JRF: and compression implies the DLI is present + $flags->{frame_encrypt} = $bits[9]; # JRF: ... and encrypt + } + + return ($id, $size, $flags); }; while ($off < $end) { - my($id, $size, $flags) = &$myseek or last; + my ($id, $size, $flags) = &$myseek or last; + my ($hlenextra) = 0; + + # NOTE: Wrong; the encrypt comes after the DLI. maybe. + # JRF: Encrypted frames need to be decrypted first + if ($flags->{frame_encrypt}) { + + my ($encypt_method) = substr($wholetag, $off+$hlen+$hlenextra, 1); + + $hlenextra++; + + # We don't actually know how to decrypt anything, so we'll just skip the entire frame. + $off += $size; - my $bytes = substr($wholetag, $off+$hlen, $size-$hlen); + next; + } + + my $bytes = substr($wholetag, $off+$hlen+$hlenextra, $size-$hlen-$hlenextra); 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; } } + print "got $id, length " . length($bytes) . " frameunsync: ".$flags->{frame_unsync}." tag unsync: ".$v2h->{unsync} ."\n" if ($debug_24); + # 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}; + # JRF: Decompress now if compressed. + # (FIXME: Not implemented yet) + # 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); + carp("Size mismatch on $id\n") unless $data_len == length($bytes); + } + + # JRF: Apply small sanity check on text elements - they must end with : + # a 0 if they are ISO8859-1 + # 0,0 if they are unicode + # (This is handy because it can be caught by the 'duplicate elements' + # in array checks) + # There is a question in my mind whether I should be doing this here - it + # is introducing knowledge of frame content format into the raw reader + # which is not a good idea. But if the frames are broken we at least + # recover. + if (($v2h->{major_version} == 3 || $v2h->{major_version} == 4) && $id =~ /^T/) { + + my $encoding = substr($bytes, 0, 1); + + # Both these cases are candidates for providing some warning, I feel. + # ISO-8859-1 or UTF-8 $bytes + if (($encoding eq "\x00" || $encoding eq "\x03") && $bytes !~ /\x00$/) { + + $bytes .= "\x00"; + print "Text frame $id has malformed ISO-8859-1/UTF-8 content\n" if ($debug_Tencoding); + + # # UTF-16, UTF-16BE + } elsif ( ($encoding eq "\x01" || $encoding eq "\x02") && $bytes !~ /\x00\x00$/) { + + $bytes .= "\x00\x00"; + print "Text frame $id has malformed UTF-16/UTF-16BE content\n" if ($debug_Tencoding); + + } else { + + # Other encodings cannot be fixed up (we don't know how 'cos they're not defined). + } } 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); -} + if (($ver == 0 || $ver == 2) && $v2) { + + if ($raw == 1 && $ver == 2) { + %$info = %$v2; + + $info->{'TAGVERSION'} = $v2h->{'version'}; + + } else { + + _parse_v2tag($ver, $raw, $v2, $info); + + if ($ver == 0 && $info->{'TAGVERSION'}) { + $info->{'TAGVERSION'} .= ' / ' . $v2h->{'version'}; + } else { + $info->{'TAGVERSION'} = $v2h->{'version'}; + } + } + } + + return 1; +} =pod @@ -1104,15 +1573,17 @@ sub get_mp3info { $@ = "No file specified"; return undef; } - - if (not -s $file) { - $@ = "File is empty"; - return undef; - } + + my $size = -s $file; if (ref $file) { # filehandle passed $fh = $file; } else { + if ( !$size ) { + $@ = "File is empty"; + return undef; + } + if (not open $fh, '<', $file) { $@ = "Can't open $file: $!"; return undef; @@ -1128,15 +1599,19 @@ sub get_mp3info { } binmode $fh; - seek $fh, $off, 0; + seek $fh, $off, SEEK_SET; 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; + if (my $v2h = _get_v2head($fh)) { + $tot += $off += $v2h->{tag_size}; + + if ( $off > $size - 10 ) { + # Invalid v2 tag size + $off = 0; } + + seek $fh, $off, SEEK_SET; + read $fh, $byte, 4; } $h = _get_head($byte); @@ -1147,7 +1622,7 @@ sub get_mp3info { # do only one read - it's _much_ faster $off++; - seek $fh, $off, 0; + seek $fh, $off, SEEK_SET; read $fh, $byte, $tot; my $i; @@ -1176,24 +1651,34 @@ sub get_mp3info { return undef; } } + + $h->{offset} = $off; - my $vbr = _get_vbr($fh, $h, \$off); - - seek $fh, 0, 2; + my $vbr = _get_vbr($fh, $h, \$off); + my $lame = _get_lame($fh, $h, \$off); + + seek $fh, 0, SEEK_END; $eof = tell $fh; - seek $fh, -128, 2; + seek $fh, -128, SEEK_END; $eof -= 128 if <$fh> =~ /^TAG/ ? 1 : 0; + # JRF: Check for an ID3v2.4 footer and if present, remove it from + # the size. + seek($fh, $eof, SEEK_SET); + + if (my $v2f = _get_v2foot($fh)) { + $eof -= $v2f->{tag_size}; + } + _close($file, $fh); $h->{size} = $eof - $off; - $h->{offset} = $off; - return _get_info($h, $vbr); + return _get_info($h, $vbr, $lame); } sub _get_info { - my($h, $vbr) = @_; + my($h, $vbr, $lame) = @_; my $i; # No bitrate or sample rate? Something's wrong. @@ -1201,26 +1686,30 @@ sub _get_info { return {}; } - $i->{VERSION} = $h->{IDR} == 2 ? 2 : $h->{IDR} == 3 ? 1 : - $h->{IDR} == 0 ? 2.5 : 0; + $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; + + if (ref($vbr) eq 'HASH' and $vbr->{is_vbr} == 1) { + $i->{VBR} = 1; + } else { + $i->{VBR} = 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->{SIZE} = $i->{VBR} == 1 && $vbr->{bytes} ? $vbr->{bytes} : $h->{size}; $i->{OFFSET} = $h->{offset}; my $mfs = $h->{fs} / ($h->{ID} ? 144000 : 72000); - $i->{FRAMES} = int($vbr && $vbr->{frames} + $i->{FRAMES} = int($i->{VBR} == 1 && $vbr->{frames} ? $vbr->{frames} : $i->{SIZE} / ($h->{bitrate} / $mfs) ); - if ($vbr) { + if ($i->{VBR} == 1) { $i->{VBR_SCALE} = $vbr->{scale} if $vbr->{scale}; $h->{bitrate} = $i->{SIZE} / $i->{FRAMES} * $mfs; if (not $h->{bitrate}) { @@ -1242,6 +1731,10 @@ sub _get_info { # 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}]; + + if ($lame) { + $i->{LAME} = $lame; + } return $i; } @@ -1306,15 +1799,16 @@ sub _vbr_seek { my $bytes = shift; my $n = shift || 4; - seek $fh, $$off, 0; + seek $fh, $$off, SEEK_SET; read $fh, $$bytes, $n; $$off += $n; } sub _get_vbr { - my($fh, $h, $roff) = @_; - my($off, $bytes, @bytes, %vbr); + my ($fh, $h, $roff) = @_; + my ($off, $bytes, @bytes); + my %vbr = (is_vbr => 0); $off = $$roff; @@ -1327,68 +1821,133 @@ sub _get_vbr { } _vbr_seek($fh, \$off, \$bytes); - return unless $bytes eq 'Xing'; - _vbr_seek($fh, \$off, \$bytes); - $vbr{flags} = _unpack_head($bytes); + if ($bytes =~ /(?:Xing|Info)/) { + # Info is CBR + $vbr{is_vbr} = 1 if $bytes =~ /Xing/; - if ($vbr{flags} & 1) { _vbr_seek($fh, \$off, \$bytes); - $vbr{frames} = _unpack_head($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; + } elsif ($bytes =~ /(?:VBRI)/) { + $vbr{is_vbr} = 1; + + # Fraunhofer encoder uses VBRI format + # start with quality factor at position 8 + _vbr_seek($fh, \$off, \$bytes, 4); + _vbr_seek($fh, \$off, \$bytes, 2); + $vbr{scale} = unpack('l', pack('L', unpack('n', $bytes))); - if ($vbr{flags} & 2) { + # Then Bytes, as position 10 _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) + # Finally Frames at position 14 _vbr_seek($fh, \$off, \$bytes); - $vbr{scale} = _unpack_head($bytes); - } else { - $vbr{scale} = -1; + $vbr{frames} = _unpack_head($bytes); + + $$roff = $off; } - $$roff = $off; return \%vbr; } +# Read LAME info tag +# http://gabriel.mp3-tech.org/mp3infotag.html +sub _get_lame { + my($fh, $h, $roff) = @_; + + my($off, $bytes, @bytes, %lame); + + $off = $$roff; + + # Encode version, 9 bytes + _vbr_seek($fh, \$off, \$bytes, 9); + $lame{encoder_version} = $bytes; + + return unless $bytes =~ /^LAME/; + + # There's some stuff here but it's not too useful + _vbr_seek($fh, \$off, \$bytes, 12); + + # Encoder delays (used for gapless decoding) + _vbr_seek($fh, \$off, \$bytes, 3); + my $bin = unpack 'B*', $bytes; + $lame{start_delay} = unpack('N', pack('B32', substr('0' x 32 . substr($bin, 0, 12), -32))); + $lame{end_padding} = unpack('N', pack('B32', substr('0' x 32 . substr($bin, 12, 12), -32))); + + return \%lame; +} + +# _get_v2head(file handle, start offset in file); +# The start offset can be used to check ID3v2 headers anywhere +# in the MP3 (eg for 'update' frames). sub _get_v2head { my $fh = $_[0] or return; - my($v2h, $bytes, @bytes); - $v2h->{offset} = 0; + + my $v2h = { + 'offset' => $_[1] || 0, + 'tag_size' => 0, + }; # check first three bytes for 'ID3' - seek $fh, 0, 0; - read $fh, $bytes, 3; + seek($fh, $v2h->{offset}, SEEK_SET); + read($fh, my $header, 10); + + my $tag = substr($header, 0, 3); + + # (Note: Footers are dealt with in v2foot) + if ($v2h->{offset} == 0) { - # 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; + # JRF: Only check for special headers if we're at the start of the file. + if ($tag eq 'RIF' || $tag eq 'FOR') { + _find_id3_chunk($fh, $tag) or return; + $v2h->{offset} = tell $fh; + + read($fh, $header, 10); + $tag = substr($header, 0, 3); + } } - return unless $bytes eq 'ID3'; + return if $tag ne 'ID3'; # get version - read $fh, $bytes, 2; - $v2h->{version} = sprintf "ID3v2.%d.%d", - @$v2h{qw[major_version minor_version]} = - unpack 'c2', $bytes; + my ($major, $minor, $flags) = unpack ("x3CCC", $header); + + $v2h->{version} = sprintf("ID3v2.%d.%d", $major, $minor); + $v2h->{major_version} = $major; + $v2h->{minor_version} = $minor; # get flags - read $fh, $bytes, 1; - my @bits = split //, unpack 'b8', $bytes; + my @bits = split(//, unpack('b8', pack('v', $flags))); + if ($v2h->{major_version} == 2) { $v2h->{unsync} = $bits[7]; - $v2h->{compression} = $bits[8]; + $v2h->{compression} = $bits[6]; # Should be ignored - no defined form $v2h->{ext_header} = 0; $v2h->{experimental} = 0; } else { @@ -1399,51 +1958,189 @@ sub _get_v2head { } # 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; + my $rawsize = substr($header, 6, 4); + + for my $b (unpack('C4', $rawsize)) { + + $v2h->{tag_size} = ($v2h->{tag_size} << 7) + $b; } - # get extended header size + $v2h->{tag_size} += 10; # include ID3v2 header size + $v2h->{tag_size} += 10 if $v2h->{footer}; + + # JRF: I think this is done wrongly - this should be part of the main frame, + # and therefore under ID3v2.3 it's subject to unsynchronisation + # (ID3v2.3, section 3.2). + # FIXME. + + # get extended header size (2.3/2.4 only) $v2h->{ext_header_size} = 0; + if ($v2h->{ext_header}) { - read $fh, $bytes, 4; - @bytes = reverse unpack 'C4', $bytes; + my $filesize = -s $fh; + + read $fh, my $bytes, 4; + my @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; } + + # Bug 4486 + # Don't try to read past the end of the file if we have a + # bogus extended header size. + if (($v2h->{ext_header_size} - 10 ) > -s $fh) { + + return $v2h; + } + + # Read the extended header + my $ext_data; + if ($v2h->{major_version} == 3) { + # On ID3v2.3 the extended header size excludes the whole header + read $fh, $bytes, 6 + $v2h->{ext_header_size}; + my @bits = split //, unpack 'b16', substr $bytes, 0, 2; + $v2h->{crc_present} = $bits[15]; + my $padding_size; + for my $i (0..3) { + + if (defined $bytes[2 + $i]) { + $padding_size += $bytes[2 + $i] * $bytesize ** $i; + } + } + $ext_data = substr $bytes, 6, $v2h->{ext_header_size} - $padding_size; + } + elsif ($v2h->{major_version} == 4) { + # On ID3v2.4, the extended header size includes the whole header + read $fh, $bytes, $v2h->{ext_header_size} - 4; + my @bits = split //, unpack 'b8', substr $bytes, 5, 1; + $v2h->{update} = $bits[6]; + $v2h->{crc_present} = $bits[5]; + $v2h->{tag_restrictions} = $bits[4]; + $ext_data = substr $bytes, 2, $v2h->{ext_header_size} - 6; + } + + # JRF: I'm not actually working out what the CRC or the tag + # restrictions are just yet. It doesn't seem to be + # all that worthwhile. + # However, if this is implemented... + # Under ID3v2.3, the CRC is not sync-safe (4 bytes). + # Under ID3v2.4, the CRC is sync-safe (5 bytes, excluding the flag data + # length) + # Under ID3v2.4, every flag byte that's set is given a flag data byte + # in the extended data area, the first byte of which is the size of + # the flag data (see ID3v2.4 section 3.2). } return $v2h; } +# JRF: We assume that we have seeked to the expected EOF (ie start of the ID3v1 tag) +# The 'offset' value will hold the start of the ID3v1 header (NOT the footer) +# The 'tag_size' value will hold the entire tag size, including the footer. +sub _get_v2foot { + my $fh = $_[0] or return; + my($v2h, $bytes, @bytes); + my $eof; + + $eof = tell $fh; + + # check first three bytes for 'ID3' + seek $fh, $eof-10, SEEK_SET; # back 10 bytes for footer + read $fh, $bytes, 3; + + return undef unless $bytes eq '3DI'; + + # 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} != 4) { + # JRF: This should never happen - only v4 tags should have footers. + # Think about raising some warnings or something ? + # print STDERR "Invalid ID3v2 footer version number\n"; + } else { + $v2h->{unsync} = $bits[7]; + $v2h->{ext_header} = $bits[6]; + $v2h->{experimental} = $bits[5]; + $v2h->{footer} = $bits[4]; + if (!$v2h->{footer}) + { + # JRF: This is an invalid footer marker; it doesn't make sense + # for the footer to not be marked as the tag having a footer + # so strictly it's an invalid tag. + # A warning might be nice, but for now we'll ignore. + # print STDERR "Warning: Footer doesn't have footer bit set\n"; + } + } + + # get ID3v2 tag length from bytes 7-10 + $v2h->{tag_size} = 10; # include ID3v2 header size + $v2h->{tag_size} += 10; # always account for the footer + read $fh, $bytes, 4; + @bytes = reverse unpack 'C4', $bytes; + foreach my $i (0 .. 3) { + # whoaaaaaa nellllllyyyyyy! + $v2h->{tag_size} += $bytes[$i] * 128 ** $i; + } + + # Note that there are no extended header details on the footer; it's + # just a copy of it so that clients can seek backward to find the + # footer's start. + + $v2h->{offset} = $eof - $v2h->{tag_size}; + + # Just to be really sure, read the start of the ID3v2.4 header here. + seek $fh, $v2h->{offset}, 0; # SEEK_SET + read $fh, $bytes, 3; + if ($bytes ne "ID3") { + # Not really an ID3v2.4 tag header; a warning would be nice but ignore + # for now. + # print STDERR "Invalid ID3v2 footer (header check) at " . $v2h->{offset} . "\n"; + return undef; + } + + # We could check more of the header. I'm not sure it's really worth it + # right now but at some point in the future checking the details match + # would be nice. + + return $v2h; + +}; + sub _find_id3_chunk { my($fh, $filetype) = @_; - my($bytes, $size, $tag, $pat, $mat); + my($bytes, $size, $tag, $pat, @mat); - read $fh, $bytes, 1; + # CHANGE 10616 introduced a read optimization in _get_v2head: + # 10 bytes are read, not 3, so reading one here hoping to get the last letter of the + # tag is a bad idea, as it always fails... + +# read $fh, $bytes, 1; if ($filetype eq 'RIF') { # WAV - return 0 if $bytes ne 'F'; +# return 0 if $bytes ne 'F'; $pat = 'a4V'; - $mat = 'id3 '; + @mat = ('id3 ', 'ID32'); } elsif ($filetype eq 'FOR') { # AIFF - return 0 if $bytes ne 'M'; +# return 0 if $bytes ne 'M'; $pat = 'a4N'; - $mat = 'ID3 '; + @mat = ('ID3 ', 'ID32'); } - seek $fh, 12, 0; # skip to the first chunk + seek $fh, 12, SEEK_SET; # 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; + for my $mat ( @mat ) { + return 1 if $tag eq $mat; + } + seek $fh, $size, SEEK_CUR; } return 0; @@ -1455,7 +2152,7 @@ sub _unpack_head { sub _grab_int_16 { my $data = shift; - my $value = unpack('s',substr($$data,0,2)); + my $value = unpack('s', pack('S', unpack('n',substr($$data,0,2)))); $$data = substr($$data,2); return $value; } @@ -1474,44 +2171,91 @@ sub _grab_int_32 { return $value; } -sub _parse_ape_tag { +# From getid3 - lyrics +# +# Just get the size and offset, so the APE tag can be parsed. +sub _parse_lyrics3_tag { my ($fh, $filesize, $info) = @_; - my $ape_tag_id = 'APETAGEX'; + # end - ID3v1 - LYRICSEND - [Lyrics3size] + seek($fh, (0 - 128 - 9 - 6), SEEK_END); + read($fh, my $lyrics3_id3v1, 128 + 9 + 6); - seek $fh, -256, 2; - read($fh, my $tag, 256); - my $pre_tag = substr($tag, 0, 128, ''); + my $lyrics3_lsz = substr($lyrics3_id3v1, 0, 6); # Lyrics3size + my $lyrics3_end = substr($lyrics3_id3v1, 6, 9); # LYRICSEND or LYRICS200 + my $id3v1_tag = substr($lyrics3_id3v1, 15, 128); # ID3v1 - # 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) { + my ($lyrics3_size, $lyrics3_offset, $lyrics3_version); - seek($fh, 0, 0); - return 0; + # Lyrics3v1, ID3v1, no APE + if ($lyrics3_end eq 'LYRICSEND') { + + $lyrics3_size = 5100; + $lyrics3_offset = $filesize - 128 - $lyrics3_size; + $lyrics3_version = 1; + + } elsif ($lyrics3_end eq 'LYRICS200') { + + # Lyrics3v2, ID3v1, no APE + # LSZ = lyrics + 'LYRICSBEGIN'; add 6-byte size field; add 'LYRICS200' + $lyrics3_size = $lyrics3_lsz + 6 + length('LYRICS200'); + $lyrics3_offset = $filesize - 128 - $lyrics3_size; + $lyrics3_version = 2; + + } elsif (substr(reverse($lyrics3_id3v1), 0, 9) eq 'DNESCIRYL') { + + # Lyrics3v1, no ID3v1, no APE + $lyrics3_size = 5100; + $lyrics3_offset = $filesize - $lyrics3_size; + $lyrics3_version = 1; + $lyrics3_offset = $filesize - $lyrics3_size; + + } elsif (substr(reverse($lyrics3_id3v1), 0, 9) eq '002SCIRYL') { + + # Lyrics3v2, no ID3v1, no APE + # LSZ = lyrics + 'LYRICSBEGIN'; add 6-byte size field; add 'LYRICS200' > 15 = 6 + strlen('LYRICS200') + $lyrics3_size = reverse(substr(reverse($lyrics3_id3v1), 9, 6)) + 15; + $lyrics3_offset = $filesize - $lyrics3_size; + $lyrics3_version = 2; } + return $lyrics3_offset; +} + +sub _parse_ape_tag { + my ($fh, $filesize, $info) = @_; + + my $ape_tag_id = 'APETAGEX'; 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); + if (my $offset = _parse_lyrics3_tag($fh, $filesize, $info)) { - read($fh, my $ape_footer_id3v1, $id3v1_tag_size + $ape_tag_header_size + $lyrics3_tag_size); + seek($fh, $offset - $ape_tag_header_size, SEEK_SET); + $tag_offset_end = $offset; - if (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $id3v1_tag_size - $ape_tag_header_size), 8) eq $ape_tag_id) { + } else { - $tag_offset_end = $filesize - $id3v1_tag_size; + seek($fh, (0 - $id3v1_tag_size - $ape_tag_header_size - $lyrics3_tag_size), SEEK_END); - } elsif (substr($ape_footer_id3v1, (length($ape_footer_id3v1) - $ape_tag_header_size), 8) eq $ape_tag_id) { + read($fh, my $ape_footer_id3v1, $id3v1_tag_size + $ape_tag_header_size + $lyrics3_tag_size); - $tag_offset_end = $filesize; - } + 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); + seek($fh, $tag_offset_end - $ape_tag_header_size, SEEK_SET); + } - read($fh, my $ape_footer_data, 32); + read($fh, my $ape_footer_data, $ape_tag_header_size); my $ape_footer = _parse_ape_header_or_footer($ape_footer_data); @@ -1521,7 +2265,7 @@ sub _parse_ape_tag { if ($ape_footer->{'flags'}->{'header'}) { - seek($fh, ($tag_offset_end - $ape_footer->{'tag_size'} - $ape_tag_header_size), 0); + seek($fh, ($tag_offset_end - $ape_footer->{'tag_size'} - $ape_tag_header_size), SEEK_SET); $tag_offset_start = tell($fh); @@ -1531,29 +2275,41 @@ sub _parse_ape_tag { $tag_offset_start = $tag_offset_end - $ape_footer->{'tag_size'}; - seek($fh, $tag_offset_start, 0); + seek($fh, $tag_offset_start, SEEK_SET); 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); + if ( defined $ape_header->{'version'} ) { + if ( $ape_header->{'version'} == 2000 ) { + $info->{'TAGVERSION'} = 'APEv2'; + } + else { + $info->{'TAGVERSION'} = 'APEv1'; + } + } + + if (defined $ape_header->{'tag_items'} && $ape_header->{'tag_items'} =~ /^\d+$/) { + + 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//; + $ape_tag_data =~ s/^(.*?)\0//; - my $tag_item_key = uc($1 || 'UNKNOWN'); + my $tag_item_key = uc($1 || 'UNKNOWN'); - $info->{$tag_item_key} = substr($ape_tag_data, 0, $tag_len, ''); + $info->{$tag_item_key} = substr($ape_tag_data, 0, $tag_len, ''); + } } } - seek($fh, 0, 0); + seek($fh, 0, SEEK_SET); return 1; } @@ -2076,6 +2832,7 @@ Tony Bowden, Tom Brown, Sergio Camarena, Chris Dawson, +Kevin Deane-Freeman, Anthony DiSante, Luke Drumm, Kyle Farrell, @@ -2083,6 +2840,7 @@ Jeffrey Friedl, brian d foy, Ben Gertzfield, Brian Goodwin, +Andy Grundman, Todd Hanneken, Todd Harris, Woodrow Hill, @@ -2120,12 +2878,12 @@ Ronan Waide, Andy Waite, Ken Williams, Ben Winslow, -Meng Weng Wong. - +Meng Weng Wong, +Justin Fletcher. =head1 CURRENT AUTHOR -Dan Sully E<lt>dan | at | slimdevices.comE<gt> & Slim Devices, Inc. +Dan Sully E<lt>daniel | at | cpan.orgE<gt> & Logitech. =head1 AUTHOR EMERITUS @@ -2133,7 +2891,7 @@ Chris Nandor E<lt>[email protected]<gt>, http://pudge.net/ =head1 COPYRIGHT AND LICENSE -Copyright (c) 2006 Dan Sully & Slim Devices, Inc. All rights reserved. +Copyright (c) 2006-2008 Dan Sully & Logitech. All rights reserved. Copyright (c) 1998-2005 Chris Nandor. All rights reserved. @@ -2144,7 +2902,7 @@ the same terms as Perl itself. =over 4 -=item Slim Devices +=item Logitech/Slim Devices http://www.slimdevices.com/ -- rockbox-cvs mailing list [email protected] https://lists.haxx.se/mailman/listinfo/rockbox-cvs