view release on metacpan or  search on metacpan

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

        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;