view release on metacpan or  search on metacpan

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

package Audio::M4P::Atom;

require 5.006;
use strict;
use warnings;
use Carp;
our $VERSION = '0.54';

use Scalar::Util 'weaken';

use Tree::Simple 'use_weak_refs';
use Tree::Simple::Visitor;
use Tree::Simple::View::HTML;

# see http://www.geocities.com/xhelmboyx/quicktime/formats/mp4-layout.txt
my %container_atom_types = (
    aaid   => 1,
    akid   => 1,
    '©alb' => 1,
    apid   => 1,
    aART   => 1,
    '©ART' => 1,
    atid   => 1,
    clip   => 1,
    '©cmt' => 1,
    '©com' => 1,
    covr   => 1,
    cpil   => 1,
    cprt   => 1,
    '©day' => 1,
    dinf   => 1,
    disk   => 1,
    drms   => 1,
    edts   => 1,
    geid   => 1,
    gnre   => 1,
    '©grp' => 1,
    hinf   => 1,
    hnti   => 1,
    ilst   => 1,
    matt   => 1,
    mdia   => 1,
    meta   => 1,
    minf   => 1,
    moof   => 1,
    moov   => 1,
    mp4a   => 1,
    '©nam' => 1,
    pinf   => 1,
    plid   => 1,
    rtng   => 1,
    schi   => 1,
    sinf   => 1,
    stbl   => 1,
    stik   => 1,
    stsd   => 1,
    tmpo   => 1,
    '©too' => 1,
    traf   => 1,
    trak   => 1,
    trkn   => 1,
    udta   => 1,
    '©wrt' => 1,
);

my %noncontainer_atom_types = (
    chtb   => 1,
    ctts   => 1,
    data   => 1,
    esds   => 1,
    free   => 1,
    frma   => 1,
    ftyp   => 1,
    '©gen' => 1,
    hmhd   => 1,
    iviv   => 1,
    'key ' => 1,
    mdat   => 1,
    mdhd   => 1,
    mp4s   => 1,
    mpv4   => 1,
    mvhd   => 1,
    name   => 1,
    priv   => 1,
    rtp    => 1,
    sign   => 1,
    stco   => 1,
    stsc   => 1,
    stp    => 1,
    stts   => 1,
    tfhd   => 1,
    tkhd   => 1,
    tref   => 1,
    trun   => 1,
    user   => 1,
    vmhd   => 1,
    wide   => 1,
);

sub int64toN {
    my ($int64) = @_;
    my $high32bits = pack( 'N', int( $int64 / ( 2**32 ) + 0.0001 ) );
    my $low32bits = pack( 'N', $int64 % ( 2**32 ) );
    return $high32bits . $low32bits;
}

sub int64fromN {
    my ($buf) = @_;
    my ( $high32bits, $low32bits ) = unpack( "NN", $buf );
    return ( $high32bits * ( 2**32 ) ) + $low32bits;
}

# begin class methods

sub new {
    my ( $class, %args ) = @_;
    my $self = \%args;
    bless( $self, $class );
    $self->{node} = Tree::Simple->new($self);
    if( ref $self->{parent} ) {
        $self->{parent}->addChild( $self->{node} );
        weaken $self->{node};
        weaken $self->{parent};
    }
    else {     
        $self->{parent} = 0;
    }
    if( ref $self->{rbuf} ) {
        weaken $self->{rbuf};
        $self->read_buffer( $self->{read_buffer_position} )
          if exists $self->{read_buffer_position};
    }    
    return $self;
}

sub DESTROY {
    my($self) = @_;
    delete $self->{parent};
    delete $self->{rbuf};
    return unless ref $self->{node};
    my @kids = $self->{node}->getAllChildren();
    foreach my $child (@kids) {
        next unless ref $child;
        my $val = $child->getNodeValue();
        $val->DESTROY 
                    if ref $val 
                    and ref $val->{parent}
                    and $val->{parent} eq $self;
    }
    $self->{node}->DESTROY if ref $self->{node};
    delete $self->{node};
}

sub parent { return shift->{parent} }

sub node { return shift->{node} }

sub rbuf { return shift->{rbuf} }

sub read_buffer {
    my ( $self, $starting ) = @_;
    $self->{start}  = $starting;
    $self->{offset} = 8;
    ( $self->{size}, $self->{type} ) = unpack 'Na4',
      substr( ${ $self->{rbuf} }, $starting, 8 );
    if ( $self->{size} == 1 ) {
        $self->{size} =
          int64fromN( substr( ${ $self->{rbuf} }, $starting + 8, 8 ) );
        $self->{offset} = 16;
    }
    return $self->{size};
}

sub type {
    my ( $self, $newtype ) = @_;
    if ( defined $newtype ) {
        $self->{type} = substr( $newtype, 0, 4 );
        substr( ${ $self->{rbuf} }, $self->{start} + 4, 4, $self->{type} );
    }
    return $self->{type};
}

sub start {
    my ( $self, $newstart ) = @_;
    $self->{start} = $newstart if defined $newstart;
    return $self->{start};
}

sub size {