view release on metacpan or  search on metacpan

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

    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 ownr );

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",

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

        }
        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 ) );