view release on metacpan or  search on metacpan

lib/Image/ExifTool/ID3.pm  view on Meta::CPAN

    if ($$dataPt =~ /^(.*?)\0/s) {
        $tag = $1;
        $start = length($tag) + 1;
    } else {
        $tag = '';
        $start = 0;
    }
    unless ($$tagTablePtr{$tag}) {
        $tag =~ tr{/ }{_}d; # translate '/' to '_' and remove spaces
        $tag = 'private' unless $tag =~ /^[-\w]{1,24}$/;
        unless ($$tagTablePtr{$tag}) {
            AddTagToTable($tagTablePtr, $tag,
                { Name => ucfirst($tag), Binary => 1 });
        }
    }
    my $key = $et->HandleTag($tagTablePtr, $tag, undef,
        Size  => length($$dataPt) - $start,
        Start => $start,
        DataPt => $dataPt,
    );
    # set group1 name
    $et->SetGroup($key, $$et{ID3_Ver}) if $key;
}

#------------------------------------------------------------------------------
# Print ID3v2 Genre
# Inputs: TCON or TCO frame data
# Returns: Content type with decoded genre numbers
sub PrintGenre($)
{
    my $val = shift;
    # make sure that %genre has an entry for all numbers we are interested in
    # (genre numbers are in brackets for ID3v2.2 and v2.3)
    while ($val =~ /\((\d+)\)/g) {
        $genre{$1} or $genre{$1} = "Unknown ($1)";
    }
    # (genre numbers are separated by nulls in ID3v2.4,
    #  but nulls are converted to '/' by DecodeString())
    while ($val =~ /(?:^|\/)(\d+)(\/|$)/g) {
        $genre{$1} or $genre{$1} = "Unknown ($1)";
    }
    $val =~ s/\((\d+)\)/\($genre{$1}\)/g;
    $val =~ s/(^|\/)(\d+)(?=\/|$)/$1$genre{$2}/g;
    $val =~ s/^\(([^)]+)\)\1?$/$1/; # clean up by removing brackets and duplicates
    return $val;
}

#------------------------------------------------------------------------------
# Get Genre ID
# Inputs: 0) Genre name
# Returns: genre ID number, or undef
sub GetGenreID($)
{
    return Image::ExifTool::ReverseLookup(shift, \%genre);
}

#------------------------------------------------------------------------------
# Decode ID3 string
# Inputs: 0) ExifTool object reference
#         1) string beginning with encoding byte unless specified as argument
#         2) optional encoding (0=ISO-8859-1, 1=UTF-16 BOM, 2=UTF-16BE, 3=UTF-8)
# Returns: Decoded string in scalar context, or list of strings in list context
sub DecodeString($$;$)
{
    my ($et, $val, $enc) = @_;
    return '' unless length $val;
    unless (defined $enc) {
        $enc = unpack('C', $val);
        $val = substr($val, 1); # remove encoding byte
    }
    my @vals;
    if ($enc == 0 or $enc == 3) { # ISO 8859-1 or UTF-8
        $val =~ s/\0+$//;   # remove any null padding
        # (must split before converting because conversion routines truncate at null)
        @vals = split "\0", $val;
        foreach $val (@vals) {
            $val = $et->Decode($val, $enc ? 'UTF8' : 'Latin');
        }
    } elsif ($enc == 1 or $enc == 2) {  # UTF-16 with BOM, or UTF-16BE
        my $bom = "\xfe\xff";
        my %order = ( "\xfe\xff" => 'MM', "\xff\xfe", => 'II' );
        for (;;) {
            my $v;
            # split string at null terminators on word boundaries
            if ($val =~ s/((..)*?)\0\0//s) {
                $v = $1;
            } else {
                last unless length $val > 1;
                $v = $val;
                $val = '';
            }
            $bom = $1 if $v =~ s/^(\xfe\xff|\xff\xfe)//;
            push @vals, $et->Decode($v, 'UTF16', $order{$bom});
        }
    } else {
        $val =~ s/\0+$//;
        return "<Unknown encoding $enc> $val";
    }
    return @vals if wantarray;
    return join('/',@vals);
}

#------------------------------------------------------------------------------
# Convert sync-safe integer to a number we can use
# Inputs: 0) int32u sync-safe value
# Returns: actual number or undef on invalid value
sub UnSyncSafe($)
{
    my $val = shift;
    return undef if $val & 0x80808080;
    return ($val & 0x0000007f) |
          (($val & 0x00007f00) >> 1) |
          (($val & 0x007f0000) >> 2) |
          (($val & 0x7f000000) >> 3);
}

#------------------------------------------------------------------------------
# Process ID3v2 information
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
sub ProcessID3v2($$$)
{
    my ($et, $dirInfo, $tagTablePtr) = @_;
    my $dataPt  = $$dirInfo{DataPt};
    my $offset  = $$dirInfo{DirStart};
    my $size    = $$dirInfo{DirLen};
    my $vers    = $$dirInfo{Version};
    my $verbose = $et->Options('Verbose');
    my $len;    # frame data length
    my $otherTable;

    $et->VerboseDir($tagTablePtr->{GROUPS}->{1}, 0, $size);
    $et->VerboseDump($dataPt, Len => $size, Start => $offset);

    for (;;$offset+=$len) {
        my ($id, $flags, $hi);
        if ($vers < 0x0300) {
            # version 2.2 frame header is 6 bytes
            last if $offset + 6 > $size;
            ($id, $hi, $len) = unpack("x${offset}a3Cn",$$dataPt);