Audio::M4P::QuickTime - Perl M4P/MP4/M4a audio / video tools

 use Audio::M4P::QuickTime;

 my $mp4file = "file.m4p";

 my $qt = new Audio::M4P::QuickTime(file => $mp4file);

 my $tags = $qt->GetMetaInfo;

 print "Artist is $tags->{ARTIST}\n" if $tags->{ARTIST};

package Audio::M4P::QuickTime;

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

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
    purl   => 1,    # program URL
    '©too' => 1,    # encoder
    tves   => 1,    # TV show episode
    tvsh   => 1,    # TV show
    '©wrt' => 1,    # composer
);

our %tag_types = (
    AAID     => 'aaid',
    AAID     => 'aART',
    ALB      => '©alb',
    ALBUM    => '©alb',
    ARTIST   => '©ART',
    CMT      => '©cmt',
    COMMENT  => '©cmt',
    COM      => '©com',
    CPIL     => 'cpil',
    CPRT     => 'cprt',
    DAY      => '©day',
    DISK     => 'disk',
    GENRE    => 'gnre',
    GNRE     => 'gnre',
    GRP      => '©grp',
    NAM      => '©nam',
    RTNG     => 'rtng',
    SONG     => '©nam',
    TITLE    => '©nam',
    TMPO     => 'tmpo',
    TOO      => '©too',
    TRACKNUM => 'trkn',
    TRKN     => 'trkn',
    WRT      => '©wrt',
    COVR     => 'covr',
    LYRICS   => '©lyr',
    GENRE_   => '©gen',
    YEAR     => '©day',
);

our %alternate_tag_types = (
    GENRE   => 'GNRE',
    NAM     => 'TITLE',
    ARTIST  => 'ART',
    ALBUM   => 'ALB',
    YEAR    => 'DAY',
    COMMENT => 'CMT',
    TRKN    => 'TRACKNUM',
    SONG    => 'TITLE',
);

our @m4p_not_m4a_atom_types = qw( sinf cnID apID atID plID geID akID ---- );
our @apple_user_id_atoms = qw( pinf apID cnID atID plID geID sfID akID purd );

our %iTMS_dict_meta_types = (
    copyright          => 'cprt',
    comments           => '©cmt',
    songName           => '©nam',
    genre              => 'gnre',
    playlistArtistName => '©ART',
    genreID            => '©gen',
    composerName       => '©wrt',
    playlistName       => '©alb',
    year               => '©day',
    trackNumber        => 'trkn',
    trackCount         => 'trkn',
    discNumber         => 'disk',
    discCount          => 'disk',
    artworkURL         => 'covr',
);

our @genre_strings = (
    "Blues",             "Classic Rock",
    "Country",           "Dance",
    "Disco",             "Funk",
    "Grunge",            "Hip-Hop",
    "Jazz",              "Metal",
    "New Age",           "Oldies",
    "Other",             "Pop",
    "R&B",               "Rap",
    "Reggae",            "Rock",
    "Techno",            "Industrial",
    "Alternative",       "Ska",
    "Death Metal",       "Pranks",
    "Soundtrack",        "Euro-Techno",
    "Ambient",           "Trip-Hop",
    "Vocal",             "Jazz+Funk",
    "Fusion",            "Trance",
    "Classical",         "Instrumental",
    "Acid",              "House",
    "Game",              "Sound Clip",
    "Gospel",            "Noise",
    "AlternRock",        "Bass",
    "Soul",              "Punk",
    "Space",             "Meditative",
    "Instrumental Pop",  "Instrumental Rock",
    "Ethnic",            "Gothic",
    "Darkwave",          "Techno-Industrial",
    "Electronic",        "Pop-Folk",
    "Eurodance",         "Dream",
    "Southern Rock",     "Comedy",
    "Cult",              "Gangsta",
    "Top 40",            "Christian Rap",
    "Pop/Funk",          "Jungle",
    "Native American",   "Cabaret",
    "New Wave",          "Psychadelic",
    "Rave",              "Showtunes",
    "Trailer",           "Lo-Fi",
    "Tribal",            "Acid Punk",
    "Acid Jazz",         "Polka",
    "Retro",             "Musical",
    "Rock & Roll",       "Hard Rock",
    "Folk",              "Folk/Rock",
    "National Folk",     "Swing",
    "Fast-Fusion",       "BeBop",
    "Latin",             "Revival",
    "Celtic",            "Bluegrass",
    "Avantgarde",        "Gothic Rock",
    "Progressive Rock",  "Psychedelic Rock",
    "Symphonic Rock",    "Slow Rock",
    "Big Band",          "Chorus",
    "Easy Listening",    "Acoustic",
    "Humour",            "Speech",
    "Chanson",           "Opera",
    "Chamber Music",     "Sonata",
    "Symphony",          "Booty Bass",
    "Primus",            "Porn Groove",
    "Satire",            "Slow Jam",
    "Club",              "Tango",
    "Samba",             "Folklore",
    "Ballad",            "Power Ballad",
    "Rhythmic Soul",     "Freestyle",
    "Duet",              "Punk Rock",
    "Drum Solo",         "A capella",
    "Euro-House",        "Dance Hall",
    "Goa",               "Drum & Bass",
    "Club House",        "Hardcore",
    "Terror",            "Indie",
    "BritPop",           "NegerPunk",
    "Polsk Punk",        "Beat",
    "Christian Gangsta", "Heavy Metal",
    "Black Metal",       "Crossover",
    "Contemporary C",    "Christian Rock",
    "Merengue",          "Salsa",
    "Thrash Metal",      "Anime",
    "JPop",              "SynthPop",
    "INVALID_GENRE"
);

our %genre_text_to_genre_numbers;
my $genre_num = 1;
foreach my $genre (@genre_strings) {
    $genre_text_to_genre_numbers{$genre} = $genre_num;
    ++$genre_num;
}
our %genre_numbers_to_genre_text = reverse %genre_text_to_genre_numbers;

our %asset_3GP_types = (
    ALBUM     => 'albm',    # album title and track number for the media
    ARTIST    => 'perf',    # performer or artist
    COM       => 'auth',    # author/composer of the media
    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
    );
}

sub ParseMp4a {
    my ( $self, $mp4a ) = @_;
    $self->ParseMP4Container(
        $mp4a->node,
        $mp4a->start + 36,
        $mp4a->start + $mp4a->size - 36
    );
}
sub ParseDrms {
    my ( $self, $drms ) = @_;
    $self->ParseMP4Container(
        $drms->node,
        $drms->start + 36,
        $drms->start + $drms->size - 36
    );
    $self->{userID} = unpack 'N*', $self->FindAtomData('user');
    my $key = $self->FindAtomData('key ');
    $self->{keyID} = unpack 'N', $key if $key;
    $self->{priv} = $self->FindAtomData('priv');
    my $name = $self->FindAtomData('name');
    $self->{name} = substr( $name, 0, index( $name, "\0" ) );
    $self->{iviv} = $self->FindAtomData('iviv');
    print "userID ", $self->{userID}, " keyID ", $self->{keyID}, "\n"
      if $self->{DEBUG};
}

sub ParseMeta {
    my ( $self, $meta ) = @_;
    $self->ParseMP4Container(
        $meta->node,
        $meta->start + 12,
        $meta->start + $meta->size - 12
    );
    foreach my $type ( keys %meta_info_types ) {
        my $atom = $self->FindAtom($type) or next;
        my $adata =
          substr( $self->{buffer}, $atom->start + 24, $atom->size - 24 );
        next if length $adata > 300;
        if ( $type eq 'disk' ) {
            my ( $field1, $field2 ) = unpack "nn",
              substr( $self->{buffer}, $atom->start + $atom->size - 4, 4 );
            $adata = "Disk $field1 of $field2";
        }
        elsif ( $type eq 'trkn' ) {
            my ( $fld1, $fld2 ) = unpack "nn",
              substr( $self->{buffer}, $atom->start + $atom->size - 6, 4 );
            $adata = "Track $fld1 of $fld2";
        }
        elsif ( $type eq 'genre' ) {
            $adata = unpack 'n',
              substr( $self->{buffer}, $atom->start + $atom->size - 2, 2 );
        }
        $self->{meta}->{$type} = $adata unless length $adata > 300;
    }
    print $self->MetaInfo() if $self->{DEBUG};
}

sub AtomList {
    my ($self) = @_;
    return $self->{root}->getAllRelatives();    # returns ref to list of atoms
}

sub FindAtom {
    my ( $self, $type ) = @_;
    my @atoms =
      grep { $type and $_->type and $_->type =~ /$type$/i }
      @{ $self->AtomList() };
    return @atoms if wantarray;
    return unless scalar @atoms > 0;
    return $atoms[0];
}

sub FindAtomData {
    my ( $self, $type ) = @_;
    my $a = $self->FindAtom($type) or return;
    return $a->data;
}

sub MetaInfo {
    my ($self)    = @_;
    my $meta_info = '';
    my $file_type = $self->GetFtype();
    $meta_info = "File type is $file_type\n" if $file_type;
    while ( my ( $mtype, $mdata ) = each %{ $self->{meta} } ) {
        $meta_info .= "Meta type $mtype, meta data $mdata\n";
    }
    return $meta_info;
}

sub AtomTree {
    my ($self) = @_;
    return $self->{root}->AtomTree();
}

sub DumpTree {
    my ( $self, $outfile ) = @_;
    if ( $outfile and open( my $dumpfh, ">$outfile" ) ) {
        print $dumpfh $self->AtomTree();
        close $dumpfh;
    }
    else { print $self->AtomTree() }
}

sub ConvertDrmsToMp4a {
    my ($self) = @_;
    my $diff = 0;
    my $drms = $self->FindAtom('drms') or return;
    foreach my $a (@m4p_not_m4a_atom_types) {
        my @unwanted = $self->FindAtom($a) or next;
        foreach my $u (@unwanted) { $diff += $u->size; $u->selfDelete() }
    }
    print "Shrunk file by $diff bytes during conversion\n" if $self->{DEBUG};
    $self->FixStco( $diff, $drms->start );
    $drms->type('mp4a');
}

sub FixStco {
    my ( $self, $sinf_sz, $change_position ) = @_;
    my @stco_atoms = $self->FindAtom('stco');
    my @co64_atoms = $self->FindAtom('co64');
    my @tfhd_atoms = $self->FindAtom('tfhd');

    # all Quicktime files should have at least one stco or co64 atom
    croak 'No stco or co64 atom' unless @stco_atoms || @co64_atoms;

    # if mdat is before change postion will not need to do anything
    my @mdat = $self->FindAtom('mdat') or return;
    my $all_mdat_before = 1;
    foreach my $mdt (@mdat) {
        $all_mdat_before = 0 if $mdt->start > $change_position;
    }
    return if $all_mdat_before;

    foreach my $stco (@stco_atoms) {
        my @samples =
          map { ( $_ > $change_position ) ? $_ - $sinf_sz : $_ }
          unpack( "N*",
            substr( $self->{buffer}, $stco->start + 16, $stco->size - 16 ) );
        substr(
            $self->{buffer},
            $stco->start + 16,
            $stco->size - 16,
            pack( 'N*', @samples )
        );
    }
    foreach my $co64 (@co64_atoms) {
        my @samples =
          unpack( "N*",
            substr( $self->{buffer}, $co64->start + 16, $co64->size - 16 ) );
        my $num_longs = scalar @samples;
        for ( my $i = 0 ; $i < $num_longs ; $i += 2 ) {
            my $high32bits = $samples[$i];
            my $low32bits  = $samples[ $i + 1 ];
            my $offset64   = ( $high32bits * ( 2**32 ) ) + $low32bits;
            $offset64 -= $sinf_sz if $offset64 > $change_position;
            $samples[ $i + 1 ] = $offset64 % ( 2**32 );
            $samples[$i] = int( $offset64 / ( 2**32 ) + 0.0001 );
        }
        substr(
            $self->{buffer},
            $co64->start + 16,
            $co64->size - 16,
            pack( 'N*', @samples )
        );
    }
    foreach my $tfhd (@tfhd_atoms) {
        my ( $tf_flags, undef, $offset_high32, $offset_low32 ) =
          unpack( 'NNNN', substr( $self->{buffer}, $tfhd->start + 8, 16 ) );

        # we only need to adjust if the 1st movie fragment tf_flags bit is set
        next unless ( ( $tf_flags % 2 ) == 1 );
        
        my $offset64 = ( $offset_high32 * ( 2**32 ) ) + $offset_low32;
        next if $offset64 < $change_position;
        
        $offset64 -= $sinf_sz;
        $offset_high32 = int( $offset64 / ( 2**32 ) + 0.0001 );
        $offset_low32 = $offset64 % ( 2**32 );
        substr( $self->{buffer}, $tfhd->start + 16,
            8, pack( 'NN', $offset_high32, $offset_low32 ) );
    }
}

sub GetSampleTable {
    my ($self) = @_;
    my $stsz = $self->FindAtom('stsz') or croak "No stsz table found";
    my $sampleCount = unpack 'N',
      substr( $self->{buffer}, $stsz->start + 16, 4 );
    my @samples = unpack 'N*',
      substr( $self->{buffer}, $stsz->start + 20, $sampleCount * 4 );
    print "There are $sampleCount samples in stsz atom.\n" if $self->{DEBUG};
    return \@samples;
}

sub DeleteAtom {
    my ( $self, $unwanted ) = @_;
    my $atom = $self->FindAtom($unwanted) or return;
    return $atom->selfDelete();
}

sub DeleteAtomWithStcoFix {
    my ( $self, $unwanted ) = @_;
    my $atom = $self->FindAtom($unwanted) or return;
    my $siz  = $atom->size;
    my $pos  = $atom->start;
    $atom->selfDelete() or return;
    $self->FixStco( $siz, $pos );
    return 1;
}

sub CleanAppleM4aPersonalData {
    my ( $self, %args ) = @_;
    if( $self->FindAtom("mp4a") or $args{force} ) {
        foreach my $atm (@apple_user_id_atoms) {
            $self->DeleteAtomWithStcoFix($atm);
        }
    }
    if( $args{zero_free_atoms} ) {
        my @free_atoms = $self->FindAtom("free");
        foreach my $atm (@free_atoms) {
            my $data_size = $atm->{size} - $atm->{offset};
            substr( ${ $atm->{rbuf} }, $atm->{start} + $atm->{offset},
                $data_size, "\x0" x $data_size );
        }
    }
}

sub GetFtype {
    my ($self) = @_;
    my $atom = $self->FindAtom('ftyp') or return;
    my $ftyp = substr( $atom->data, 0, 4 );
    $ftyp =~ s/^(\S+)\s+$/$1/;
    return $ftyp;
}

sub Get3GPInfo {
    my ($self) = @_;
    while ( my ( $meta_type, $atom_type ) = each %asset_3GP_types ) {
        my $atom = $self->FindAtom($atom_type) or next;
        my $data =
          substr( $atom->{buffer}, $atom->start + 14, $atom->size - 14 );
        $self->{MP4Info}->{$meta_type} = $data;
    }
    while ( my ( $tag, $alt_tag ) = each %alternate_tag_types ) {
        $self->{MP4Info}->{$alt_tag} = $self->{MP4Info}->{$tag}
          if exists $self->{MP4Info}->{$tag};
    }
    my $file_type = $self->GetFtype();
    $self->{MP4Info}->{FTYP} = $file_type if $file_type;
    return $self->{MP4Info};
}

sub Set3GPInfo {
    my ( $self, $field, $value, $delete_old ) = @_;
    my $asset_type = $asset_3GP_types{$field};
    my $moov = $self->FindAtom('moov') or croak "No moov atom found";
    my ( $asset, $udta );
    foreach my $typ ( values %asset_3GP_types ) {
        $asset = $self->FindAtom($typ) or next;
        $udta = $asset->GetParent();
        last if $udta and $udta->{type} =~ /udta/i;
        $udta = 0;
    }

    # if cannot find any asset atoms, look for the udta child of moov
    $udta = $moov->DirectChildren('udta') unless $udta;

    # if no direct child of moov udta, make one
    unless ($udta) {
        $moov->insertNew( 'udta', '' );
        $self->FixStco( -8, $moov->start );
        $udta = $moov->Contained('udta');
    }
    my $entry = $udta->Contained($asset_type);
    my $diff  = 0;
    if ( $entry and $delete_old ) {
        my @unwanted = $udta->Contained($asset_type);
        foreach my $u (@unwanted) {
            $diff += $u->size;
            $u->selfDelete;
        }
    }

    # now we can add the data
    # we set language code to 'eng'
    my $lang        = $default_asset_3GP_lang;
    my $packed_lang = asset_language_pack_iso_639_2T($lang);
    my $data_packet = pack( 'Nn', 0, $packed_lang ) . $value;
    my $new_atom    = $udta->insertNew( $asset_type, $data_packet );
    $diff -= $new_atom->size;
    $self->FixStco( $diff, $udta->start );
    return $new_atom;
}

sub GetMetaInfo {
    my ( $self, $as_text ) = @_;

    # if we have a 3gp file, dispatch
    return $self->Get3GPInfo() if $self->GetFtype() =~ /^3g/;

    my %meta_tags;
    while ( my ( $meta_tag, $type ) = each %tag_types ) {
        $type =~ s/\W//g;
        my $atm      = $self->FindAtom($type)  or next;
        my $data_atm = $atm->Contained('data') or next;
        my $data     = $data_atm->data;
        if ( $type eq 'gnre' ) {
            ( undef, undef, $data ) = unpack 'NNn', $data;
        }
        elsif ( $type eq 'trkn' ) {
            ( undef, undef, undef, $data, $self->{MP4Info}->{TRACKCOUNT} ) =
              unpack 'NNnnn', $data;
        }
        else {
            my $firstchar = unpack( 'C', $data );
            if ( $firstchar == 0 ) {
               $data = substr( $data, 8 );
               utf8::decode($data) if ($utf8_atoms{$type});
            } 
        }
        $self->{MP4Info}->{$meta_tag} = $data;
        while ( my ( $tag, $alt_tag ) = each %alternate_tag_types ) {
            $self->{MP4Info}->{$alt_tag} = $self->{MP4Info}->{$tag}
              if defined $self->{MP4Info}->{$tag};
        }
    }
    
    if( !$self->{MP4Info}->{GENRE} ) {
        my $gen_atom = $self->FindAtom('©gen');
        if($gen_atom) {
            my $genre_txt = substr $gen_atom->data, 16;
            my $genre_num = $genre_text_to_genre_numbers{$genre_txt};
            $self->{MP4Info}->{GENRE} = $self->{MP4Info}->{GNRE} = $genre_num;
        }
    }
    
    if ($as_text) {
        # if as_text, we need to convert the tags to text
        if ( defined $self->{MP4Info}->{DISK} ) {
            ( undef, my $disknum, my $disks ) = unpack 'nnn',
              $self->{MP4Info}->{DISK};
            $self->{MP4Info}->{DISK} = "Disk $disknum of $disks";
        }
        if ( defined $self->{MP4Info}->{TRKN} ) {
            ( undef, my $tracknum, my $tracks ) = unpack 'nnn',
              $self->{MP4Info}->{TRKN};
            $self->{MP4Info}->{TRKN} = "Track $tracknum of $tracks"
              if $tracknum && $tracks;
        }
        if ( defined $self->{MP4Info}->{TMPO} ) {
            my $tempo = unpack 'n', $self->{MP4Info}->{TMPO};
            $self->{MP4Info}->{TMPO} = $tempo || "Undefined";
        }
        if( defined $self->{MP4Info}->{CPRT} && 
          length( $self->{MP4Info}->{CPRT} ) > 3 ) { 
            $self->{MP4Info}->{CPRT} = substr( $self->{MP4Info}->{CPRT}, 3 );
        }
        if ( defined $self->{MP4Info}->{COVR} ) {
            $self->{MP4Info}->{COVR} = "Coverart present";
        }
        if (    defined $self->{MP4Info}->{GENRE}
            and $self->{MP4Info}->{GENRE} =~ /^\d+$/
            and $self->{MP4Info}->{GENRE} < 128 )
        {
            $self->{MP4Info}->{GENRE} =
              $genre_strings[ $self->{MP4Info}->{GENRE} - 1 ];
        }
    }
    $self->{MP4Info}->{FTYP} = $self->GetFtype();
    return $self->{MP4Info};
}

sub GetMP4Info {
    my ($self) = @_;
    my $meta = $self->GetMetaInfo();
    $meta->{LAYER}     = 1;
    $meta->{VERSION}   = 4;
    $meta->{COPYRIGHT} = ( exists $meta->{CPRT} ) ? 1 : 0;
    my $mdat = $self->FindAtom('mdat');
    $meta->{SIZE} = $mdat->size || 1;
    $meta->{ENCRYPTED} = $self->FindAtom('drms');
    my $mvhd_data = $self->FindAtomData('mvhd');
    my ( $timescale, $duration );

    if ($mvhd_data) {
        my @mvhd = unpack( 'Ca3NNNNNN', $mvhd_data );
        if ( $mvhd[0] == 1 ) {
            $timescale = $mvhd[6];
            $duration = ( $mvhd[7] * ( 2**32 ) + $mvhd[8] ) / $mvhd[6];
        }
        else {
            $timescale = $mvhd[4];
            $duration  = $mvhd[5];
        }
        $meta->{SECONDS} = int( $duration / $timescale + 0.5 );
        $meta->{MM}      = int( $meta->{SECONDS} / 60 );
        $meta->{SS}      = $meta->{SECONDS} % 60;
        $meta->{BITRATE} = int( $meta->{SIZE} / $meta->{SECONDS} + 0.5 );
    }
    return $meta;
}

sub SetMetaInfo {
    my ( $self, $field, $value, $delete_old, $before, $as_text ) = @_;
    $self->GetMetaInfo;    # fill default fields like TRACKCOUNT

    # if we have a 3gp file, dispatch
    return $self->Set3GPInfo( $self, $field, $value, $delete_old )
      if $self->GetFtype() =~ /^3g/;

    my $type = $tag_types{$field} || lc substr( $field, 0, 4 );
    my $ilst = $self->FindAtom('ilst') || $self->MakeIlstAtom || return;
    my $typ = $type;
    $typ =~ s/\W//g;
    my $entry = $ilst->Contained($typ);
    my $diff  = 0;
    if ( $entry and $delete_old ) {
        my @unwanted = $ilst->Contained($typ);
        foreach my $u (@unwanted) {
            $diff += $u->size;
            $u->selfDelete;
        }
    }
    if ($as_text) {
        my %iTMS_meta_atoms = reverse %iTMS_dict_meta_types;
        if ( $iTMS_meta_atoms{$type} ) {
            my %h;
            if ( $type eq 'disk' and $value =~ m/(\d+)\D+(\d+)/ ) {
                $h{discNumber} = $1;
                $h{discCount}  = $2;
            }
            elsif ( $type eq 'trkn' and $value =~ m/(\d+)\D+(\d+)/ ) {
                $h{trackNumber} = $1;
                $h{trackCount}  = $2;
            }
            elsif ( $type eq 'gnre' ) {
                $value = genre_text_to_genre_num($value);
            }
            else { $h{ $iTMS_meta_atoms{$type} } = $value }
            $self->FixStco( $diff, $ilst->start ) if $diff;
            return $self->iTMS_MetaInfo( \%h, 1 );
        }
    }
    if ( $typ eq 'covr' and $ilst->Contained($typ) ) {
        $ilst->addMoreArtwork($value);
        $diff -= 16;
    }
    else {
        utf8::encode($value) if ($utf8_atoms{$type}); 
        $ilst->insertNewMetaData( $type, $value, $before );
        $diff -= 24;
    }
    $diff -= length $value;
    $self->FixStco( $diff, $ilst->start );
}

sub MakeIlstAtom {
    my ($self) = @_;
    my $moov = $self->FindAtom('moov') or croak "No moov atom found";
    my $udta = $moov->DirectChildren('udta');

    # if no udta under moov, make one under moov
    unless ($udta) {
        $moov->insertNew( 'udta', '' );
        $self->FixStco( -8, $moov->start );
        $udta = $moov->Contained('udta');
    }

    # if we have a meta atom, add an hdlr atom and ilst to it
    # if we do not have one make one
    my ( $meta, $hdlr, $ilst );
    $meta = $udta->Contained('meta');
    unless ($meta) {
        $udta->insertNew( 'meta', "\0\0\0\0" );
        $self->FixStco( -12, $udta->start );
        $meta = $udta->Contained('meta');
    }
    $hdlr = $meta->Contained('hdlr');
    unless ($hdlr) {
        $meta->insertNew( 'hdlr',
            "\0\0\0\0\0\0\0\0mdirappl\0\0\0\0\0\0\0\0\0" );
        $self->FixStco( -33, $meta->start );
        $hdlr = $meta->Contained('hdlr');
    }
    $ilst = $meta->Contained('ilst');
    unless ($ilst) {
        $meta->insertNew( 'ilst', '' );
        $self->FixStco( -8, $meta->start );
        $ilst = $meta->Contained('ilst');
    }
    return $ilst;
}

sub iTMS_MetaInfo {
    my ( $self, $dict, $keep_old ) = @_;
    my ( $key, $type, %info );
    if ($dict) {
        while ( ( $key, $type ) = each %iTMS_dict_meta_types ) {
            next if $key =~ /Count$/;
            next unless exists $dict->{$key};
            my $data = $dict->{$key};
            if ( $key eq 'discNumber' ) {
                my $count = $dict->{discCount} or next;
                $data = pack "nnn", 0, $data, $count;
            }
            if ( $key eq 'trackNumber' ) {
                my $count = $dict->{trackCount} || 0;
                $data = pack "nnnn", 0, $data, $count, 0;
            }
            if ( $key eq 'artworkURL' ) {
                eval 'require LWP::Simple; $data = get($data)';
            }
            if ( $key eq 'copyright' ) {
                $data = "\xE2\x84\x97 " . $data;
            }
            if ( $key eq 'genre' ) {
                my $gnre = genre_text_to_genre_num($data);
                $data = pack "n", $gnre unless $gnre eq 'INVALID_GENRE';
            }
            $self->SetMetaInfo( $type, $data, $keep_old ? undef: 1,
                undef, undef );
        }
    }
    while ( ( $key, $type ) = each %iTMS_dict_meta_types ) {
        my $meta = $self->FindAtom($type) or next;
        my $data = substr( $meta->data, 16 );
        if ( $type eq 'trkn' ) {
            ( undef, $info{trackNumber}, $info{trackCount} ) = unpack "nnn",
              $data;
        }
        elsif ( $type eq 'disk' ) {
            ( undef, $info{diskNumber}, $info{discCount} ) = unpack "nnn",
              $data;
        }
        elsif ( $type eq 'cprt' ) {
            ( undef, $info{'copyright'} ) = split( /\s+/, $data, 2 );
        }
        else { $info{$key} = $data }
    }
    return \%info;
}

# Get cover art--returns a reference to an array of cover artwork
sub GetCoverArt {
    my ($self) = @_;
    my @covr = $self->FindAtom('covr') or return;
    my @artwork;
    foreach my $atm (@covr) {
        my $data_atm = $atm->Contained('data') or next;
        push @artwork, substr( $data_atm->data, 8 );
    }
    return \@artwork;
}

#-----------------------------------------------------------

# MP3::Tag analogs, but more fields, and allow setting of tags

sub autoinfo {
    my ($self) = @_;
    my $tags = $self->GetMetaInfo;
    return (
        $tags->{TITLE},   $tags->{TRKN}, $tags->{ARTIST}, $tags->{ALBUM},
        $tags->{COMMENT}, $tags->{YEAR}, $tags->{GENRE}
    );
}

sub title {
    my ( $self, $new_tag ) = @_;
    $self->SetMetaInfo( 'TITLE', $new_tag, 1 ) if $new_tag;
    my $tags = $self->GetMetaInfo;
    return $tags->{TITLE} || '';
}

sub album {
    my ( $self, $new_tag ) = @_;
    $self->SetMetaInfo( 'ALBUM', $new_tag, 1 ) if $new_tag;
    my $tags = $self->GetMetaInfo;
    return $tags->{ALBUM} || '';
}

sub artist {
    my ( $self, $new_tag ) = @_;
    $self->SetMetaInfo( 'ARTIST', $new_tag, 1 ) if $new_tag;
    my $tags = $self->GetMetaInfo;
    return $tags->{ARTIST} || '';
}

sub comment {
    my ( $self, $new_tag ) = @_;
    $self->SetMetaInfo( 'COMMENT', $new_tag, 1 ) if $new_tag;
    my $tags = $self->GetMetaInfo;
    return $tags->{COMMENT} || '';
}

sub year {
    my ( $self, $new_tag ) = @_;
    $self->SetMetaInfo( 'YEAR', $new_tag, 1 ) if $new_tag;
    my $tags = $self->GetMetaInfo;
    return $tags->{YEAR} || 0;
}

sub genre {
    my ( $self, $new_tag ) = @_;
    $self->SetMetaInfo( 'GENRE', pack( "n", $new_tag ), 1 ) if $new_tag;
    my $tags = $self->GetMetaInfo;
    return $tags->{GENRE} || '';
}

sub genre_as_text {
    my ( $self, $new_tag ) = @_;
    my ( $i, $genre_num );
    if ($new_tag) {
        $self->genre( genre_text_to_genre_num($new_tag) );
    }
    return genre_num_to_genre_text( $self->genre );
}

sub track {
    my ( $self, $new_trkn ) = @_;
    my $tags = $self->GetMetaInfo(1);
    if ($new_trkn) {
        my $tcount = $tags->{TRACKCOUNT} || 0;
        $self->SetMetaInfo( 'TRKN', "$new_trkn of $tcount", 1, 0, 1 );
        $tags = $self->GetMetaInfo(1);
    }
    return $tags->{TRKN} || 0;
}

sub tracks {
    my ( $self, $new_trkn, $new_tcount ) = @_;
    $self->SetMetaInfo( 'TRKN', "$new_trkn of $new_tcount", 1, 0, 1 )
      if ( $new_trkn and $new_tcount );
    my $tags   = $self->GetMetaInfo;
    my $trkn   = $tags->{TRKN} || 0;
    my $tcount = $tags->{TRACKCOUNT} || 0;
    return ( $trkn, $tcount );
}

sub total {
    my ( $self, $new_tcount ) = @_;
    my $tags;
    if ($new_tcount) {
        $tags = $self->GetMetaInfo;
        $self->SetMetaInfo( 'TRKN', $tags->{TRKN} . " of $new_tcount", 1, 0,
            1 );
    }
    $tags = $self->GetMetaInfo;
    my $trkn   = $tags->{TRKN}       || 0;
    my $tcount = $tags->{TRACKCOUNT} || 0;
    return $tcount;
}

sub all_tags {
    my ( $self, $tags_href ) = @_;
    if ( ref $tags_href ) {
        $self->title( $tags_href->{title} )     if $tags_href->{title};
        $self->artist( $tags_href->{artist} )   if $tags_href->{artist};
        $self->album( $tags_href->{album} )     if $tags_href->{album};
        $self->comment( $tags_href->{comment} ) if $tags_href->{comment};
        $self->genre( $tags_href->{genre} )     if $tags_href->{genre};
        $self->year( $tags_href->{year} )       if $tags_href->{year};
        $self->track( $tags_href->{track} )     if $tags_href->{track};
        $self->total( $tags_href->{total} )     if $tags_href->{total};
    }
    return {
        title   => $self->title(),
        artist  => $self->artist(),
        album   => $self->album(),
        comment => $self->comment(),
        genre   => $self->genre(),
        year    => $self->year(),
        track   => $self->track(),
        total   => $self->total(),
    };
}

#------------ other compatibility functions with Audio::TagLib -----------------#

sub setTitle   { title(@_) }
sub setArtist  { artist(@_) }
sub setAlbum   { album(@_) }
sub setComment { comment(@_) }
sub setGenre   { genre(@_) }
sub setTrack   { track(@_) }
sub setTracks  { tracks(@_) }
sub setTotal   { total(@_) }

#-------------- non-self helper functions --------------------------#

sub isMetaDataType {
    return $meta_info_types{shift};
}

sub genre_text_to_genre_num {
    my $text = shift;
    return $genre_text_to_genre_numbers{$text};
}

sub genre_num_to_genre_text {
    my $num = shift;
    return $genre_numbers_to_genre_text{$num};
}

sub asset_language_pack_iso_639_2T {
    my ($lang3chars) = @_;
    my ( $c1, $c2, $c3 ) =
      map { $_ ? ord($_) - 60 : 0 } split( //, $lang3chars );
    return ( $c1 * ( 2**10 ) ) + ( $c2 * ( 2**5 ) ) + $c3;
}

1;