view release on metacpan or  search on metacpan

lib/Audio/M4P/QuickTime.pm  view on Meta::CPAN

package Audio::M4P::QuickTime;

require 5.008;
use strict;
use warnings;
use Carp;
use Scalar::Util 'weaken';
our $VERSION = '0.57';

use Audio::M4P::Atom;

#-------------- useful hashes and arrays ------------------------------------#

our %meta_info_types = (
    aART   => 1,   # album artist
    aaid   => 1,   # album artist
    '©alb' => 1,   # album
    akid   => 1,   # ? alternate id ?
    apid   => 1,   # apple id
    '©ART' => 1,   # artist (performing)
    atid   => 1,   # apple itunes id ?
    catg   => 1,   # category
    '©cmt' => 1,   # comment field
    '©com' => 1,   # composer
    covr   => 1,   # cover art
    cpil   => 1,   # 1 if compilation => 0 if not ?
    cprt   => 1,   # copyrighted material purchaser ?
    '©day' => 1,   # date of release--often just the year
    disk   => 1,   # CD set number: cut is from, disk [field 1] of [field 2]
    geid   => 1,   # iTMS store ID ?
    gnre   => 1,   # genre
    '©grp' => 1,   # group(?)
    '©lyr' => 1,   # lyrics
    '©nam' => 1,   # title of track
    pcst   => 1,   # podcast flag
    pgap   => 1,   # iTunes gapless playback ?
    pinf   => 1,   # iTunes 7.2+ purchaser info ?
    plid   => 1,   # purchase id ?
    purd   => 1,   # iTunes 6+ purchase date
    purl   => 1,   # program URL
    rtng   => 1,   # rating (integer)
    sfid   => 1,   # ? itms ID info
    sign   => 1,   # ? file hash signature
    stik   => 1,   # movie type: 0x1 default, 0x5 bookmarkable, 0x6 music video,
                   # 0xA TV show, ?? 0x2 newsreel, 0xE ringtone
    tmpo   => 1,   # tempo (beats per minute)
    '©too' => 1,   # encoder
    trkn   => 1,   # two fields: [field 1] track num. of [field 2] total tracks
    tves   => 1,   # TV show episode
    tvsh   => 1,   # TV show
    '©wrt' => 1,   # composer
    '----' => 1,   # itunes specific info
);

our %utf8_atoms = (
    aART   => 1,    # album artist
    aaid   => 1,    # album artist
    '©alb' => 1,    # album
    '©ART' => 1,    # artist (performing)
    catg   => 1,    # category
    '©cmt' => 1,    # comment field
    '©com' => 1,    # composer
    cprt   => 1,    # copyrighted material purchaser ?
    '©day' => 1,    # date of release--often just the year
    '©grp' => 1,    # group(?)
    '©lyr' => 1,    # lyrics
    '©nam' => 1,    # title of track

lib/Audio/M4P/QuickTime.pm  view on Meta::CPAN

    COMMENT   => 'dscp',    # caption or description for the media
    COPYRIGHT => 'cprt',    # notice about organisation holding copyright
    GENRE     => 'gnre',    # genre (category and style) of the media
    RTNG      => 'rtng',    # media rating
    TITLE     => 'titl',    # title for the media
    YEAR      => 'yrrc',    # recording year for the media

    # these exist in 3GP but not really in iTMS meta data
    CLASS    => 'clsf',     # classification of the media
    KEYWORDS => 'kywd',     # media keywords
    LOCATION => 'loci',     # location information
);

our $default_asset_3GP_lang = 'eng';

#------------------- object methods -----------------------------------------#

sub new {
    my ( $class, %args ) = @_;
    my $self = {};
    bless( $self, $class );
    $self->{meta} = {};
    foreach my $k (qw( DEBUG DEBUGDUMPFILE file)) {
        $self->{$k} = $args{$k} if exists $args{$k};
    }
    $self->{DEBUG} = 0 unless exists $self->{DEBUG};
    if ( exists $self->{file} ) {
        $self->ReadFile( $self->{file} );
        $self->ParseBuffer();
    }
    return $self;    
}
 
sub DESTROY {
    my($self) = @_;
    if( ref $self->{root} ) {
        $self->{root}->DESTROY;
    }
}
 
sub ReadFile {
    my ( $self, $infile ) = @_;
    open( my $infh, '<', $infile ) or croak "Cannot open input $infile: $!";
    binmode $infh;
    read( $infh, $self->{buffer}, -s $infile ) or croak "Bad file read: $!";
    close $infh;
    $self->{meta}->{filesize} = length $self->{buffer};
}

sub ParseBuffer {
    my ($self) = @_;
    $self->{atom_count} = 0;
    $self->{root}       = new Audio::M4P::Atom(
        rbuf                  => \$self->{buffer},
        type                  => 'file',
        size                  => length $self->{buffer},
        read_buffer_position  => 0,
        offset                => 8,
        parent                => 0,
    );
    weaken $self->{root};
    my $fsize = length $self->{buffer};
    print "Buffer size is $fsize\n" if $self->{DEBUG};
    $self->ParseMP4Container( $self->{root}->node, 0, $fsize );
    print "Found $self->{atom_count} atoms.\n" if $self->{DEBUG};
    $self->DumpTree( $self->{DEBUGDUMPFILE} )  if $self->{DEBUG} > 1;
}

sub WriteFile {
    my ( $self, $outfile ) = @_;
    open( my $outfh, '>', $outfile ) or croak "Cannot open output $outfile: $!";
    binmode $outfh;
    my $retval = print $outfh $self->{buffer};
    close $outfh;
    return $retval;
}

sub ParseMP4Container {
    my ( $self, $parent, $posit, $end_posit ) = @_;
    my $pAtom = $parent->getNodeValue() or croak "Cannot get atom from node";
    $posit     = $pAtom->start + $pAtom->offset unless defined $posit;
    $end_posit = $pAtom->start + $pAtom->size   unless $end_posit;
    while ( $posit < $end_posit ) {
        my $atom = new Audio::M4P::Atom(
            parent               => $parent,
            rbuf                 => \$self->{buffer},
            read_buffer_position => $posit
        );
        print $atom->type, " at $posit size ", $atom->size, "\n"
          if $self->{DEBUG};
        last unless $atom->size > 7;    # sanity check
        $self->{atom_count}++;
        if    ( $atom->type =~ /stsd/i ) { $self->ParseStsd($atom) }
        elsif ( $atom->type =~ /mp4a/i ) { $self->ParseMp4a($atom) }
        elsif ( $atom->type =~ /drms/i ) { $self->ParseDrms($atom) }
        elsif ( $atom->type =~ /meta/i ) { $self->ParseMeta($atom) }
        elsif ( $atom->isContainer() ) {
            $self->ParseMP4Container(
                $atom->node,
                $posit + $atom->offset,
                $posit + $atom->size - $atom->offset
            );
        }
        else {
            print( "done with noncontainer atom of atom of type ",
                $atom->type, "\n" )
              if $self->{DEBUG};
        }
        $posit += $atom->size;
    }
}

sub ParseStsd {
    my ( $self, $stsd ) = @_;
    $self->ParseMP4Container(
        $stsd->node,
        $stsd->start + 16,
        $stsd->start + $stsd->size - 16
    );
}