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 seconds)
    %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),$buffer)."\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
}