Beefy Boxes and Bandwidth Generously Provided by pair Networks DiBona
laziness, impatience, and hubris
 
PerlMonks  

QuickTime format movie file dumper

by GrandFather (Cardinal)
on Feb 14, 2006 at 03:29 UTC ( #530009=CUFP: print w/ replies, xml ) Need Help??

This code parses a QuickTime format movie file and dumps a report of the structure of the file to STDOUT.

Note that subs named as dump_xxxx handle atoms of type xxxx. If x is not a suitable character for use in an identifier it is replaced by the two hex digits of its value. If your QuickTime movie file has atoms in it that aren't being dumped then simply adding the handler sub will fix the problem.

Update: There is an updated version of this code here

package DumpQuicktime;

use strict;
use Video::Info;
use base qw(Video::Info);

our $VERSION = '0.01';
use constant DEBUG => 0;
use Class::MakeMethods::Emulator::MethodMaker
    get_set => [qw(acodec tracks indent lastErr)],
    ;

sub init {
    my $self = shift;
    my %param = @_;
    $self->init_attributes(@_);
    return $self;
}

sub read
{
    my $self = shift;
    my ($len, $offset) = @_;
    my $buf;
    
    seek $self->handle, $offset, 0 if defined $offset;
    
    my $n = read $self->handle, $buf, $len;
    $self->lastErr ('read failed') unless defined $n;
    $self->lastErr ("short read ($len/$n)") unless $n == $len;
    return $buf;
}

sub probe { # Find top level atoms
    my $self = shift;
    my $pos = 0;
    
    $pos = $self->describeAtom ($pos) while ! eof ($self->handle);
    return 1;
}

sub pr {
    my $self = shift;
    print $self->indent, join '', @_;
}

sub describeAtom {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));
 
    if ($len == 0) {
        $self->pr ("End entry\n");
        return $pos + 4;
    }
    
    $key = 'x' . unpack ('H8', $key) if $key =~ /[\x00-\x1f]/;
    $key =~ tr/ /_/;
    $key =~ s/([^\w \d_])/sprintf "%02X", ord ($1)/ge;
    
    if (! length $key) {
        return $pos;
    }
    
    my $member = "dump_$key";

    $self->pr (sprintf "%s @  %d (0x%08x):\n", $key, $pos, $pos);
    $self->indent ($self->indent . '.  ');
    if ($self->can($member)) {
        $self->$member ($pos);
    } else {
        $self->pr ("   Unhandled: length = $len\n");
    }
    $self->indent (substr $self->indent, 3);
    return $pos + $len;
}

sub describeAtoms {
    my $self = shift;
    my ($pos, $count) = @_;
    
    $pos = $self->describeAtom ($pos) while $count--;
    return $pos;
}

sub describeAtomsIn {
    my $self = shift;
    my ($pos, $end) = @_;
    
    $pos = $self->describeAtom ($pos) while $pos < $end;
}

sub construct_hash {
    my ( $input ) = @_;
    my %hash;
    
    while (length($input) > 0) {
        my($len)   = NToSigned (substr( $input, 0, 4, ''));
        my($cntnt) = substr( $input, 0, $len-4, '');
        my($type)  = substr( $cntnt, 0, 4, '');

        if ( exists $hash{$type} ) {
            my @a = grep($type,keys %hash);
            $hash{$type.length(@a)} = $cntnt;
        } else {
            $hash{$type} = $cntnt;
        }
    }
    %hash;
}

sub dump_moov {
    my $self = shift;
    my $pos = shift;

    $pos = $self->describeAtoms ($pos + 8, 2);
    $pos = $self->describeAtoms ($pos, $self->tracks);
    $pos = $self->describeAtoms ($pos, 1);
}        

sub dump_cmov {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));
    my $end = $pos + $len;
    
    $pos += 8;
    while ($pos < $end) {
        $pos = $self->describeAtoms ($pos, 1);
    }
}        

sub dump_mvhd {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));
    my $buffer = $self->read ($len - 8, $pos + 8);

    $self->pr ('Version:   ', unpack( 'C', substr($buffer,0,1,'') ) . 
+"\n");
    $self->pr ('Flags:     ', unpack ('B24', substr($buffer,0,3,'')) .
+ "\n");
    $self->pr ('Created:   ', $self->showDate (substr($buffer,0,4,''))
+ . "\n");   
    $self->pr ('Modified:  ', $self->showDate (substr($buffer,0,4,''))
+ . "\n");   
    $self->pr ('Timescale: ', unpack( "N", substr($buffer,0,4,'')) . "
+\n");  
    $self->pr ('Duration:  ', unpack( "N", substr($buffer,0,4,'')) . "
+\n");  
    $self->pr ('Pref rate: ', unpack( "N", substr($buffer,0,4,'')) . "
+\n");
    $self->pr ('Pref vol:  ', unpack( "n", substr($buffer,0,2,'')) . "
+\n");
    $self->pr ('reserved:  ', unpack( "H20", substr($buffer,0,10,'')) 
+. "\n");
    $self->pr ('Matrix:    ', showMatrix (substr($buffer,0,36,'')) . "
+\n");
    $self->pr ('Preview start: ', unpack( "N", substr($buffer,0,4,''))
+ . "\n");  
    $self->pr ('Preview time:  ', unpack( "N", substr($buffer,0,4,''))
+ . "\n");  
    $self->pr ('Poster loc:    ', unpack( "N", substr($buffer,0,4,''))
+ . "\n");  
    $self->pr ('Sel start:  ', unpack( "N", substr($buffer,0,4,'')) . 
+"\n");  
    $self->pr ('Sel time:   ', unpack( "N", substr($buffer,0,4,'')) . 
+"\n");  
    $self->pr ('Time now:   ', unpack( "N", substr($buffer,0,4,'')) . 
+"\n");
    my $nextTrackId = unpack( "N", substr($buffer,0,4,''));
    $self->pr ("Next track: $nextTrackId\n");
    $self->tracks ($nextTrackId - 1);
}

sub dump_udta {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));
    
    $self->describeAtomsIn ($pos + 8, $pos + $len);
}

sub dump_mdat {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));

    $self->pr ("$len bytes of media data\n");
}

sub dump_free {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));

    $self->pr ("Padding = $len\n");
}

sub dump_wide {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));

    $self->pr ("64 bit expansion place holder\n");
}

sub dump_trak {
    my $self = shift;
    my $pos = shift;

    $self->describeAtoms ($pos + 8, 4);
}

sub dump_edts {
    my $self = shift;
    my $pos = shift;

    $self->describeAtoms ($pos + 8, 1);
}

sub dump_tkhd {
    my $self = shift;
    my $pos = shift;

    seek ($self->handle, $pos + 8, 0);
    $self->pr ('Version:  ', unpack ('C', $self->read (1)), "\n");
    $self->pr ('Flags:    ', unpack ('B24', $self->read (3)), "\n");
    $self->pr ('Creation time:     ', $self->showDate ($self->read (4)
+), "\n");
    $self->pr ('Modification time: ', $self->showDate ($self->read (4)
+), "\n");
    $self->pr ('Track ID:          ', unpack( "N", $self->read (4)), "
+\n");
    $self->pr ('Reserved:          ', unpack( "N", $self->read (4)), "
+\n");
    $self->pr ('Duration:          ', NToSigned ($self->read (4)), "\n
+");
    $self->pr ('Reserved:          ', unpack( "NN", $self->read (8)), 
+"\n");
    $self->pr ('Layer:             ', nToSigned ($self->read (2)), "\n
+");
    $self->pr ('Alternate group:   ', nToSigned ($self->read (2)), "\n
+");
    $self->pr ('Volume:            ', nToUnsigned($self->read (2)), "\
+n");
    $self->pr ('Reserved:          ', unpack( "n", $self->read (2)), "
+\n");
    $self->pr ('Matrix structure:  ', showMatrix ($self->read (36)), "
+\n");
    $self->pr ('Track width:       ', NToFixed ($self->read (4)), "\n"
+);
    $self->pr ('Track height:      ', NToFixed ($self->read (4)), "\n"
+);
}

sub dump_elst {
    my $self = shift;
    my $pos = shift;

    seek ($self->handle, $pos + 8, 0);
    $self->pr ('Version:  ', unpack ('C', $self->read (1)), "\n");
    $self->pr ('Flags:    ', unpack ('B24', $self->read (3)), "\n");
    
    my $items = NToSigned ($self->read (4));
    $self->pr ("Items:     $items\n");
    for (1..$items) {
        $self->pr ("  Item $_\n");
        $self->pr ('    Duration: ', NToSigned ($self->read (4)), "\n"
+);
        $self->pr ('    Start:    ', NToSigned ($self->read (4)), "\n"
+);
        $self->pr ('    Rate:     ', NToFixed ($self->read (4)), "\n")
+;
    }
}

sub dump_dcom {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));
    my $buffer = $self->read ($len - 8, $pos + 8);
}

sub dump_stts {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));
    my $buffer = $self->read ($len - 8, $pos + 8);
    my %h;
    
    $h{'Version'}          = hex(unpack("H*", substr($buffer,0,2,'') )
+);
    $h{'Flags'}            = unpack("H*", substr($buffer,0,6,'') );   
+ 
    ### number of image frames in this atom
    $h{'count'}            = hex(unpack("H*", substr($buffer,0,4,'') )
+);
    ### number of tens-of-seconds per image
    $h{'duration'}         = hex(unpack("H*", substr($buffer,0,4,'') )
+);
    ### count * duration / mvhd->Time_scale = length of movie (in seco
+nds)
    %h;
}

sub dump_stsd {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));
    my $buffer = $self->read ($len - 8, $pos + 8);
    my %h;

    $h{'Version'}          = unpack( "n2", substr($buffer,0,2,'') );  
+  
    $h{'Flags'}            = unpack("H*", substr($buffer,0,6,'') );   
+ 
    my $dataLen = unpack("Na", substr($buffer,0,4,''));
    ($h{'compression type'} = substr($buffer,0,8,'')) =~ s/\W(.*?)\W/$
+1/g;
    $h{'Version'}           = unpack( "n2", substr($buffer,0,2,'') );
    $h{'Revision_level'}    = unpack( "n2", substr($buffer,0,2,'') );
    ($h{'Vendor'}           = unpack("a8",substr($buffer,0,8,'')))=~s/
+\W//g;
    
    if ( length($h{'Vendor'}) eq 0 ) {
        $h{'audio channels'} = hex(unpack( "H*", substr($buffer,0,2,''
+)));  
        $h{'audio sample size'}  = hex(unpack( "H*", substr($buffer,0,
+2,'')));  
        # $h{'audio compression'}  = unpack( "H*", substr($buffer,0,2,
+''));  /
        $h{'audio packet size'}  = hex(unpack( "H*", substr($buffer,0,
+2,'')));  
        $h{'audio sample rate'}  = hex(unpack( "H*", substr($buffer,0,
+4,'')));  
        substr($buffer,0,18,'');
    } else {
        $h{'Temporal_Quality'} = unpack( "Na", substr($buffer,0,4,''))
+;  
        $h{'Spatial_Quality'}  = unpack( "Na", substr($buffer,0,4,''))
+;  
        $h{'Width'}           = hex( unpack( "H4", substr($buffer,0,2,
+'')));
        $h{'Height'}          = hex( unpack( "H4", substr($buffer,0,2,
+'')));
        $h{'Horz_res'}        = hex( unpack("H4",substr($buffer,0,4,''
+)));
        $h{'Vert_res'}        = hex( unpack("H4",substr($buffer,0,4,''
+)));
        $h{'Data_size'}       = hex( unpack("H2",substr($buffer,0,2,''
+)));
        $h{'Frames_per_sample'} = hex( unpack("H*",substr($buffer,0,4,
+'')));
        $h{'Compressor_name'} = $1 if
            ( substr($buffer,0,32,'') =~ m/\W(.+?)\x00+$/) ;
        $h{'Depth'}           = hex( unpack( "H4", substr($buffer,0,2,
+'')));
        $h{'Color_table_ID'}  = unpack( "s", substr($buffer,0,2,'')); 
+ 
    }
    
    # Collect any table extensions:
    while (length($buffer)>0) {
        my($atomLen, $sig) = unpack("Na4", substr($buffer,0,8,''));
        $h{$sig} = unpack("H".2*($len-4),substr($buffer,0,$atomLen-4,'
+'));
    }
    $self->pr (length($buffer)."\t".unpack("H".2*length($buffer),$buff
+er)."\n");
    $self->pr ("   $_ => " . show ($h{$_}) . "\n") for sort keys %h;
    %h;
}

sub dump_clip {
    my $self = shift;
    my $pos = shift;
    
    $self->describeAtoms ($pos + 8, 1);
}

sub dump_MCPS {
    my $self = shift;
    $self->showText (shift);
}

sub dump_name {
    my $self = shift;
    $self->showText (shift);
}

sub dump_A9nam {
    my $self = shift;
    $self->showStr (shift);
}

sub dump_A9cpy {
    my $self = shift;
    $self->showStr (shift);
}

sub dump_A9cmt {
    my $self = shift;
    $self->showStr (shift);
}

sub dump_A9des {
    my $self = shift;
    $self->showStr (shift);
}

sub dump_A9inf {
    my $self = shift;
    $self->showStr (shift);
}

sub dump_WLOC {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));

    $len = 2 * $len - 16;
    $self->pr (unpack ("H$len\n", $self->read ($len)), "\n");
}

sub dump_ftyp {
    my $self = shift;
    my $pos = shift;

    $self->pr (unpack ("a4", $self->read (4, $pos + 8)), "\n");
}

sub showText {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));

    $len -= 8;
    $self->pr (unpack ("a$len", $self->read ($len)), "\n");
}

sub showStr {
    my $self = shift;
    my $pos = shift;
    my ($len, $key) = unpack ("Na4", $self->read (8, $pos));

    $len -= 12;
    $self->pr (unpack ("a$len", $self->read ($len, $pos + 12)), "\n");
}

sub show {
    local $_;
    my $thing = shift;
    if ($thing =~ /^([^\x00]*)\x00\Z/) {
        return $1;
    } elsif ($thing =~ /[\x00-\x1f]/) {
        my $sum = 0;
        my @chars = split '', $thing;
        $sum = $sum * 256 + ord ($_) for @chars;
        return sprintf "0x%0x", $sum;
    }
    
    return $thing;
}

sub showMatrix {
    my $matrix = shift;
    my $str = '';
    for (1..3) {
        my $sub = substr $matrix, 0, 12, '';
        $str .= join " ", unpack ('(l)3', pack ('(l)3', unpack ('(n)3'
+, $sub)));
        $str .= ' / ' if $_ != 3;
    }
    
    return $str;
}

sub NToFixed {
    my $str = shift;
    return unpack ('l', pack ('l', unpack( "N", $str))) / 0x10000;
}

sub NToSigned {
    my $str = shift;
    return unpack ('l', pack ('l', unpack( "N", $str)));
}

sub NToUnsigned {
    my $str = shift;
    return unpack ('L', pack ('L', unpack( "N", $str)));
}

sub nToSigned {
    my $str = shift;
    return unpack ('s', pack ('s', unpack( "n", $str)));
}

sub nToUnsigned {
    my $str = shift;
    return unpack ('S', pack ('S', unpack( "n", $str)));
}

sub showDate {
    my $self = shift;
    my $stamp = NToUnsigned shift;
    
    # seconds difference between Mac epoch and Unix/Windows.
    my $mod = ($^O =~ /MSWin32/) ? (2063824538 - 12530100 + 31536000) 
+: (2063824538 - 12530100);
    my $date = ($^O =~ /Mac/) ? localtime($stamp) : localtime($stamp-$
+mod);
    return $date;
}


#1;

package main;

my $file = shift;

if (defined $file) {
    print "Dumping $file\n";
    
    $file = DumpQuicktime->new(-file=>$file);
    $file->probe;
} else {
    print <<HELP;
DumpQuicktime parses a QuickTime movie file and dumps a report of the 
+file's
structure to STDOUT.

Run DumpQuicktime as:

DumpQuicktime filename
HELP
}

[download]
Dumping C:\Delme~~\sample.mov
moov @  0 (0x00000000):
.  mvhd @  8 (0x00000008):
.  .  Version:   0
.  .  Flags:     000000000000000000000000
.  .  Created:   Tue Feb 20 09:45:16 2001
.  .  Modified:  Tue Feb 20 09:45:17 2001
.  .  Timescale: 600
.  .  Duration:  3000
.  .  Pref rate: 65536
.  .  Pref vol:  255
.  .  reserved:  00000000000000000000
.  .  Matrix:    1 0 0 / 0 0 1 / 0 0 0
.  .  Preview start: 0
.  .  Preview time:  0
.  .  Poster loc:    2100
.  .  Sel start:  0
.  .  Sel time:   0
.  .  Time now:   0
.  .  Next track: 3
.  trak @  116 (0x00000074):
.  .  tkhd @  124 (0x0000007c):
.  .  .  Version:  0
.  .  .  Flags:    000000000000000000001111
.  .  .  Creation time:     Sat Feb 10 03:41:57 2001
.  .  .  Modification time: Tue Feb 20 09:45:17 2001
.  .  .  Track ID:          1
.  .  .  Reserved:          0
.  .  .  Duration:          3000
.  .  .  Reserved:          00
.  .  .  Layer:             0
.  .  .  Alternate group:   0
.  .  .  Volume:            0
.  .  .  Reserved:          0
.  .  .  Matrix structure:  1 0 0 / 0 0 1 / 0 0 0
.  .  .  Track width:       190
.  .  .  Track height:      240
.  .  load @  216 (0x000000d8):
.  .  .     Unhandled: length = 24
.  .  edts @  240 (0x000000f0):
.  .  .  elst @  248 (0x000000f8):
.  .  .  .  Version:  0
.  .  .  .  Flags:    000000000000000000000000
.  .  .  .  Items:     1
.  .  .  .    Item 1
.  .  .  .      Duration: 3000
.  .  .  .      Start:    0
.  .  .  .      Rate:     1
.  .  mdia @  276 (0x00000114):
.  .  .     Unhandled: length = 813
.  trak @  1101 (0x0000044d):
.  .  tkhd @  1109 (0x00000455):
.  .  .  Version:  0
.  .  .  Flags:    000000000000000000001111
.  .  .  Creation time:     Sat Feb 10 03:41:57 2001
.  .  .  Modification time: Tue Feb 20 09:45:17 2001
.  .  .  Track ID:          2
.  .  .  Reserved:          0
.  .  .  Duration:          2953
.  .  .  Reserved:          00
.  .  .  Layer:             0
.  .  .  Alternate group:   0
.  .  .  Volume:            256
.  .  .  Reserved:          0
.  .  .  Matrix structure:  1 0 0 / 0 0 1 / 0 0 0
.  .  .  Track width:       0
.  .  .  Track height:      0
.  .  edts @  1201 (0x000004b1):
.  .  .  elst @  1209 (0x000004b9):
.  .  .  .  Version:  0
.  .  .  .  Flags:    000000000000000000000000
.  .  .  .  Items:     1
.  .  .  .    Item 1
.  .  .  .      Duration: 2953
.  .  .  .      Start:    0
.  .  .  .      Rate:     1
.  .  mdia @  1237 (0x000004d5):
.  .  .     Unhandled: length = 579
.  .  udta @  1816 (0x00000718):
.  .  .  End entry
.  udta @  1828 (0x00000724):
.  .  MCPS @  1836 (0x0000072c):
.  .  .  MCPR-for Macintosh-5.0.0
.  .  play @  1868 (0x0000074c):
.  .  .     Unhandled: length = 16
.  .  A9nam @  1884 (0x0000075c):
.  .  .  QuickTime Sample Movie
.  .  A9cpy @  1918 (0x0000077e):
.  .  .  © Apple Computer, Inc. 2001
.  .  WLOC @  1957 (0x000007a5):
.  .  .  00320017
.  .  End entry
.  free @  1973 (0x000007b5):
.  .  Padding = 16
free @  1973 (0x000007b5):
.  Padding = 16
wide @  1989 (0x000007c5):
.  64 bit expansion place holder
mdat @  1997 (0x000007cd):
.  80398 bytes of media data
End entry

[download]
DWIM is Perl's answer to Gödel

Comment on QuickTime format movie file dumper
Select or Download Code
Re: QuickTime format movie file dumper
by baboo (Initiate) on Mar 03, 2006 at 09:55 UTC
    I'd love to run it but all I got is: "Can't locate object method "new" via package "DumpQuicktime" at DumpQuicktime line 462." :( If I have added dummy "sub new" then I stopped in the first "$self->handle" appearence as there are no "handle" method as well. Did I missed something?
[reply]

      Do you have the Class::MakeMethods::Emulator::MethodMaker module? It provides the new.

      Update: wrong module mentioned

      DWIM is Perl's answer to Gödel
[reply]
[d/l]
        Sure, otherwise it wouldn't compile. I have Class-MakeMethods version 1.01. May be it somehow distorted code on the web?
[reply]

Back to Cool Uses for Perl

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://530009]
Approved by McDarren
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2013-05-26 02:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best material for plates (tableware) is:









    Results (524 votes), past polls