← Back to branch summary

~ubuntu-branches/ubuntu/karmic/libimage-exiftool-perl/karmic

« back to all changes in this revision

Viewing changes to lib/Image/ExifTool/ID3.pm

  • Committer: Bazaar Package Importer
  • Author(s): Mari Wang
  • Date: 2008-02-04 20:32:53 UTC
  • mfrom: (1.1.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20080204203253-mpbal8trlfe1fz5d
Tags: 7.00-1
http://bugs.debian.org/456430
http://bugs.debian.org/435589
http://bugs.debian.org/436100
* Upload of new production release (Closes: #456430)
* Added Recommends: libcompress-zlib-perl (Closes: #435589)
* Package now includes iptc2xmp.args and xmp2iptc.args, they are put
  into /usr/share/libimage-exiftool/ (Closes: #436100)
* Updated standards-version (3.7.2 -> 3.7.3). No changes needed.
* Lots of updates and bugfixes compared to last debian version
  (6.90).  See the Changes file for details
* Upload sponsored by Petter Reinholdtsen

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Image/ExifTool/ID3.pm
15
15
use vars qw($VERSION);
16
16
use Image::ExifTool qw(:DataAccess :Utils);
17
17
 
18
 
$VERSION = '1.09';
 
18
$VERSION = '1.11';
19
19
 
20
20
sub ProcessID3v2($$$);
 
21
sub ProcessPrivate($$$);
21
22
 
22
23
# audio formats that we process after an ID3v2 header (in order)
23
24
my @audioFormats = qw(APE MPC FLAC OGG MP3);
313
314
  # GEOB => 'GeneralEncapsulatedObject',
314
315
  # GRID => 'GroupIdentification',
315
316
  # LINK => 'LinkedInformation',
316
 
  # MCDI => 'MusicCDIdentifier',
 
317
    MCDI => { Name => 'MusicCDIdentifier', Binary => 1 },
317
318
  # MLLT => 'MPEGLocationLookupTable',
318
319
  # OWNE => 'Ownership', # enc(1), _price, 00, _date(8), Seller
319
320
    PCNT => 'PlayCounter',
320
321
  # POPM => 'Popularimeter', # _email, 00, rating(1), counter(4-N)
321
322
  # POSS => 'PostSynchronization',
322
 
  # PRIV => 'Private',
 
323
    PRIV => {
 
324
        Name => 'Private',
 
325
        SubDirectory => { TagTable => 'Image::ExifTool::ID3::Private' },
 
326
    },
323
327
  # RBUF => 'RecommendedBufferSize',
324
328
  # RVRB => 'Reverb',
325
329
  # SYLT => 'SynchronizedLyricText',
421
425
    TSST => 'SetSubtitle',
422
426
);
423
427
 
 
428
# ID3 PRIV tags (ref PH)
 
429
%Image::ExifTool::ID3::Private = (
 
430
    PROCESS_PROC => \&Image::ExifTool::ID3::ProcessPrivate,
 
431
    GROUPS => { 1 => 'ID3', 2 => 'Audio' },
 
432
    NOTES => 'ID3 private (PRIV) tags.',
 
433
    XMP => {
 
434
        SubDirectory => {
 
435
            DirName => 'XMP',
 
436
            TagTable => 'Image::ExifTool::XMP::Main',
 
437
        },
 
438
    },
 
439
    PeakValue => {
 
440
        ValueConv => 'length($val)==4 ? unpack("V",$val) : \$val',
 
441
    },
 
442
    AverageLevel => {
 
443
        ValueConv => 'length($val)==4 ? unpack("V",$val) : \$val',
 
444
    },
 
445
);
 
446
 
424
447
# can't share tagInfo hashes between two tables, so we must make
425
448
# copies of the necessary hashes
426
449
{
433
456
}
434
457
 
435
458
#------------------------------------------------------------------------------
 
459
# Process ID3 PRIV data
 
460
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
 
461
sub ProcessPrivate($$$)
 
462
{
 
463
    my ($exifTool, $dirInfo, $tagTablePtr) = @_;
 
464
    my $dataPt = $$dirInfo{DataPt};
 
465
    my ($tag, $start);
 
466
    if ($$dataPt =~ /^(.*?)\0/) {
 
467
        $tag = $1;
 
468
        $start = length($tag) + 1;
 
469
    } else {
 
470
        $tag = '';
 
471
        $start = 0;
 
472
    }
 
473
    unless ($$tagTablePtr{$tag}) {
 
474
        $tag =~ tr{/ }{_}d; # translate '/' to '_' and remove spaces
 
475
        $tag = 'private' unless $tag =~ /^[-\w]{1,24}$/;
 
476
        unless ($$tagTablePtr{$tag}) {
 
477
            Image::ExifTool::AddTagToTable($tagTablePtr, $tag,
 
478
                { Name => ucfirst($tag), Binary => 1 });
 
479
        }
 
480
    }
 
481
    my $key = $exifTool->HandleTag($tagTablePtr, $tag, undef,
 
482
        Size  => length($$dataPt) - $start,
 
483
        Start => $start,
 
484
        DataPt => $dataPt,
 
485
    );
 
486
    # set group1 name
 
487
    $exifTool->SetGroup1($key, $$exifTool{ID3_Ver}) if $key;
 
488
}
 
489
 
 
490
#------------------------------------------------------------------------------
436
491
# Print ID3v2 Genre
437
492
# Inputs: TCON or TCO frame data
438
493
# Returns: Content type with decoded genre numbers
464
519
    return '' unless length $val;
465
520
    my $enc = unpack('C', $val);
466
521
    $val = substr($val, 1); # remove encoding byte
467
 
    $val =~ s/\0+$//;       # remove null padding if it exists
468
522
    my @vals;
469
523
    if ($enc == 0) {        # ISO 8859-1
 
524
        $val =~ s/\0+$//;   # remove any null padding
470
525
        $val = $exifTool->Latin2Charset($val);
471
526
        @vals = split "\0", $val;
472
527
    } elsif ($enc == 3) {   # UTF-8
 
528
        $val =~ s/\0+$//;
473
529
        $val = $exifTool->UTF82Charset($val);
474
530
        @vals = split "\0", $val;
475
531
    } elsif ($enc == 1 or $enc == 2) {  # UTF-16 with BOM, or UTF-16BE
476
 
        my $bom = $val =~ s/^(\xfe\xff|\xff\xfe)// ? $1 : "\xfe\xff";
 
532
        my $bom = "\xfe\xff";
477
533
        my %order = ( "\xfe\xff" => 'MM', "\xff\xfe", => 'II' );
478
 
        @vals = split "\0\0", $val;
479
 
        foreach $val (@vals) {
480
 
            $val =~ s/^$bom//;          # remove BOM if it exists
481
 
            $val = $exifTool->Unicode2Charset($val, $order{$bom});
 
534
        for (;;) {
 
535
            my $v;
 
536
            # split string at null terminators on word boundaries
 
537
            if ($val =~ s/((..)*?)\0\0//) {
 
538
                $v = $1;
 
539
            } else {
 
540
                last unless length $val > 1;
 
541
                $v = $val;
 
542
                $val = '';
 
543
            }
 
544
            $bom = $1 if $v =~ s/^(\xfe\xff|\xff\xfe)//;
 
545
            push @vals, $exifTool->Unicode2Charset($v, $order{$bom});
482
546
        }
483
547
    } else {
 
548
        $val =~ s/\0+$//;
484
549
        return "<Unknown encoding $enc> $val";
485
550
    }
486
551
    return @vals if wantarray;
500
565
}
501
566
#------------------------------------------------------------------------------
502
567
# Process ID3v2 information
503
 
# Inputs: 0) ExifTool object reference, 1) directory information reference
504
 
#         2) tag table reference
 
568
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
505
569
sub ProcessID3v2($$$)
506
570
{
507
571
    my ($exifTool, $dirInfo, $tagTablePtr) = @_;
533
597
        }
534
598
        last if $offset + $len > $size;
535
599
        my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $id);
536
 
        next unless $tagInfo or $verbose;
537
 
 
 
600
        unless ($tagInfo) {
 
601
            next unless $verbose or $exifTool->Options('Unknown');
 
602
            $id =~ tr/-A-Za-z0-9_//dc;
 
603
            $id = 'unknown' unless length $id;
 
604
            unless ($$tagTablePtr{$id}) {
 
605
                $tagInfo = { Name => "ID3_$id", Binary => 1 };
 
606
                Image::ExifTool::AddTagToTable($tagTablePtr, $id, $tagInfo);
 
607
            }
 
608
        }
538
609
        # decode v2.3 and v2.4 flags
539
610
        my %flags;
540
611
        if ($flags) {
603
674
# decode data in this frame
604
675
#
605
676
        my $valLen = length($val);  # actual value length (after decompression, etc)
606
 
        if ($id =~ /^T[^X]/ or $id =~ /^(IPL|IPLS)$/) {
607
 
            $val = DecodeString($exifTool, $val);
608
 
        } elsif ($id =~ /^(TXX|TXXX|WXX|WXXX)$/) {
 
677
        if ($id =~ /^(TXX|TXXX)$/) {
 
678
            # two encoded strings separated by a null
609
679
            my @vals = DecodeString($exifTool, $val);
610
680
            foreach (0..1) { $vals[$_] = '' unless defined $vals[$_]; }
611
681
            ($val = "($vals[0]) $vals[1]") =~ s/^\(\) //;
 
682
        } elsif ($id =~ /^T/ or $id =~ /^(IPL|IPLS)$/) {
 
683
            $val = DecodeString($exifTool, $val);
 
684
        } elsif ($id =~ /^(WXX|WXXX)$/) {
 
685
            # one encoded string and one Latin string separated by a null
 
686
            my $enc = unpack('C', $val);
 
687
            my $url;
 
688
            if ($enc == 1 or $enc == 2) {
 
689
                ($val, $url) = ($val =~ /^(.(?:..)*?)\0\0(.*)/);
 
690
            } else {
 
691
                ($val, $url) = ($val =~ /^(..*?)\0(.*)/);
 
692
            }
 
693
            unless (defined $val and defined $url) {
 
694
                $exifTool->Warn("Invalid $id frame value");
 
695
                next;
 
696
            }               
 
697
            $val = DecodeString($exifTool, $val);
 
698
            $url =~ s/\0.*//;
 
699
            $val = length($val) ? "($val) $url" : $url;
 
700
        } elsif ($id =~ /^W/) {
 
701
            $val =~ s/\0.*//;   # truncate at null
612
702
        } elsif ($id =~ /^(COM|COMM|ULT|USLT)$/) {
613
703
            $valLen > 4 or $exifTool->Warn("Short $id frame"), next;
614
704
            substr($val, 1, 3) = '';    # remove language code
615
705
            my @vals = DecodeString($exifTool, $val);
616
706
            foreach (0..1) { $vals[$_] = '' unless defined $vals[$_]; }
617
 
            ($val = "($vals[0]) $vals[1]") =~ s/^\(\) //;
 
707
            $val = length($vals[0]) ? "($vals[0]) $vals[1]" : $vals[1];
618
708
        } elsif ($id eq 'USER') {
619
709
            $valLen > 4 or $exifTool->Warn('Short USER frame'), next;
620
710
            substr($val, 1, 3) = '';    # remove language code
634
724
            # remove header (encoding, image format or MIME type, picture type, description)
635
725
            $val =~ s/$hdr//s or $exifTool->Warn("Invalid $id frame"), next;
636
726
            $enc and $val =~ s/^\0//;   # remove 2nd terminator if Unicode encoding
637
 
        } else {
 
727
        } elsif ($id eq 'PRIV') {
 
728
            # save version number to set group1 name for tag later
 
729
            $exifTool->{ID3_Ver} = $tagTablePtr->{GROUPS}->{1};
 
730
            $exifTool->HandleTag($tagTablePtr, $id, $val);
 
731
            next;
 
732
        } elsif (not $$tagInfo{Binary}) {
638
733
            $exifTool->Warn("Don't know how to handle $id frame");
639
734
            next;
640
735
        }