Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Updated QuickTime format movie file dumper

by GrandFather (Cardinal)
on Mar 03, 2006 at 21:21 UTC ( #534371=CUFP: print w/ replies, xml ) Need Help??

This is an update to the code presented in QuickTime format movie file dumper that adds considerable new atom knowledge, removes the dependence on Video::info, generates the output as a string, and presents the output in a tree using Tk

Update: fixed a bug handling various strings

package DumpQuicktime; use strict; use Video::Info; use base qw(Video::Info); #use diagnostics; our $VERSION = '0.07'; use constant DEBUG => 0; use Class::MakeMethods::Emulator::MethodMaker get_set => [qw(acodec tracks indent indentStr lastErr result)], list => [qw(atomStack)], ; sub init { my $self = shift; my %param = @_; $self->init_attributes(@_); $self->indentStr ('. '); $self->indent (''); $self->result (''); 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 dump { # Find top level atoms my $self = shift; my $pos = 0; $pos = $self->describeAtom ($pos) while ! eof ($self->handle); return $self->result; } sub pr { my $self = shift; $self->result ($self->result . $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"; my $header = sprintf "%s @ %d (0x%08x) for %d (0x%08x):", $key, $pos, $pos, $len, $len; $self->pr ("$header\n"); $self->indent ($self->indent . $self->indentStr); if ($self->can($member)) { $self->atomStack_push ([$key, {}]); $self->$member ($pos, $len); $self->atomStack_pop (); } else { $self->pr (" Unhandled: length = $len\n"); $self->dumpBlock ($pos + 8, $len > 24 ? 16 : $len - 8) if $len + > 8; } $self->indent (substr $self->indent, length ($self->indentStr)); 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 unwrapAtoms { my $self = shift; my ($pos, $len) = @_; $self->describeAtomsIn ($pos + 8, $pos + $len); } sub atomList { my $self = shift; my ($pos, $len) = @_; $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); $self->pr ('Entries: ', NToSigned ($self->read (4)), "\n"); $self->describeAtomsIn ($pos + 16, $pos + $len); } 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_A9nam { my $self = shift; $self->showStr (@_); } sub dump_A9cpy { my $self = shift; $self->showStr (@_); } sub dump_A9cmt { my $self = shift; $self->showStr (@_); } sub dump_A9des { my $self = shift; $self->showStr (@_); } sub dump_A9inf { my $self = shift; $self->showStr (@_); } sub dump_alis { my $self = shift; $self->dump_code (@_); } sub dump_cmov { my $self = shift; $self->unwrapAtoms (@_); } sub dump_code { my $self = shift; my ($pos, $len) = @_; $len -= 8; if ($len > 16) { $self->pr ("First 16 bytes of $len\n"); $len = 16; } $self->dumpBlock ($pos, $len); } sub dump_dflt { my $self = shift; $self->atomList (@_); } sub dump_dinf { my $self = shift; $self->unwrapAtoms (@_); } sub dump_dref { my $self = shift; $self->atomList (@_); } sub dump_evnt { my $self = shift; my ($pos, $len) = @_; $self->pr ('Event type: ', $self->get4Char (), "\n"); $self->pr ('Actions: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Reserved: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } sub dump_list { my $self = shift; my ($pos, $len) = @_; $self->pr ('Id: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Items: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 8, $len - 8); } sub dump_oper { my $self = shift; my ($pos, $len) = @_; $self->pr ('Operation: ', $self->get4Char (), "\n"); $self->pr ('Operands: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Reserved: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } sub dump_oprn { my $self = shift; my ($pos, $len) = @_; $self->pr ('Unknown 1: ', NToSigned ($self->read (4)), "\n"); $self->pr ('ID: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 3: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } sub dump_actn { my $self = shift; my ($pos, $len) = @_; $self->pr ('Action type: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Actions: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Reserved: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } sub dump_whic { my $self = shift; my ($pos, $len) = @_; my %actions = ( 1024 => 'kActionMovieSetVolume', 1025 => 'kActionMovieSetRate', 1026 => 'kActionMovieSetLoopingFlags', 1027 => 'kActionMovieGoToTime', 1028 => 'kActionMovieGoToTimeByName', 1029 => 'kActionMovieGoToBeginning', 1030 => 'kActionMovieGoToEnd', 1031 => 'kActionMovieStepForward', 1032 => 'kActionMovieStepBackward', 1033 => 'kActionMovieSetSelection', 1034 => 'kActionMovieSetSelectionByName', 1035 => 'kActionMoviePlaySelection', 1036 => 'kActionMovieSetLanguage', 1037 => 'kActionMovieChanged', 1038 => 'kActionMovieRestartAtTime', 2048 => 'kActionTrackSetVolume', 2049 => 'kActionTrackSetBalance', 2050 => 'kActionTrackSetEnabled', 2051 => 'kActionTrackSetMatrix', 2052 => 'kActionTrackSetLayer', 2053 => 'kActionTrackSetClip', 2054 => 'kActionTrackSetCursor', 2055 => 'kActionTrackSetGraphicsMode', 3072 => 'kActionSpriteSetMatrix', 3073 => 'kActionSpriteSetImageIndex', 3074 => 'kActionSpriteSetVisible', 3075 => 'kActionSpriteSetLayer', 3076 => 'kActionSpriteSetGraphicsMode', 3078 => 'kActionSpritePassMouseToCodec', 3079 => 'kActionSpriteClickOnCodec', 3080 => 'kActionSpriteTranslate', 3081 => 'kActionSpriteScale', 3082 => 'kActionSpriteRotate', 3083 => 'kActionSpriteStretch', 4096 => 'kActionQTVRSetPanAngle', 4097 => 'kActionQTVRSetTiltAngle', 4098 => 'kActionQTVRSetFieldOfView', 4099 => 'kActionQTVRShowDefaultView', 4100 => 'kActionQTVRGoToNodeID', 5120 => 'kActionMusicPlayNote', 5121 => 'kActionMusicSetController', 6144 => 'kActionCase', 6145 => 'kActionWhile', 6146 => 'kActionGoToURL', 6147 => 'kActionSendQTEventToSprite', 6148 => 'kActionDebugStr', 6149 => 'kActionPushCurrentTime', 6150 => 'kActionPushCurrentTimeWithLabel', 6151 => 'kActionPopAndGotoTopTime', 6152 => 'kActionPopAndGotoLabeledTime', 6153 => 'kActionStatusString', 6154 => 'kActionSendQTEventToTrackObject', 6155 => 'kActionAddChannelSubscription', 6156 => 'kActionRemoveChannelSubscription', 6157 => 'kActionOpenCustomActionHandler', 6158 => 'kActionDoScript', 7168 => 'kActionSpriteTrackSetVariable', 7169 => 'kActionSpriteTrackNewSprite', 7170 => 'kActionSpriteTrackDisposeSprite', 7171 => 'kActionSpriteTrackSetVariableToString', 7172 => 'kActionSpriteTrackConcatVariables', 7173 => 'kActionSpriteTrackSetVariableToMovieURL', 7174 => 'kActionSpriteTrackSetVariableToMovieBaseURL', 8192 => 'kActionApplicationNumberAndString', 9216 => 'kActionQD3DNamedObjectTranslateTo', 9217 => 'kActionQD3DNamedObjectScaleTo', 9218 => 'kActionQD3DNamedObjectRotateTo', 10240 => 'kActionFlashTrackSetPan', 10241 => 'kActionFlashTrackSetZoom', 10242 => 'kActionFlashTrackSetZoomRect', 10243 => 'kActionFlashTrackGotoFrameNumber', 10244 => 'kActionFlashTrackGotoFrameLabel', 11264 => 'kActionMovieTrackAddChildMovie', 11265 => 'kActionMovieTrackLoadChildMovie', ); $self->pr ('Unknown 1: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 2: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 3: ', NToSigned ($self->read (4)), "\n"); my $action = NToSigned ($self->read (4)); my $actionStr = $actions{$action}; $actionStr = "Unknown - $action" if ! defined $actionStr; $self->pr ("Type: $actionStr\n"); } sub dump_parm { my $self = shift; my ($pos, $len) = @_; $self->pr ('Unknown 1: ', NToSigned ($self->read (4)), "\n"); $self->pr ('ID: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 3: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } sub dump_test { my $self = shift; my ($pos, $len) = @_; $self->pr ('Unknown 1: ', NToSigned ($self->read (4)), "\n"); $self->pr ('ID: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 3: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } sub dump_expr { my $self = shift; my ($pos, $len) = @_; $self->pr ('Unknown 1: ', NToSigned ($self->read (4)), "\n"); $self->pr ('ID: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 3: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } sub dump_ftyp { my $self = shift; $self->pr (unpack ("a4", $self->read (4)), "\n"); } sub dump_gmhd { my $self = shift; $self->unwrapAtoms (@_); } sub dump_gmin { my $self = shift; $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); $self->showGMode (); $self->showRGB (); $self->pr ('Balance: ', nToSigned ($self->read (2)), "\n"); $self->pr ('Reserved: ', nToSigned ($self->read (2)), "\n"); } sub dump_moov { my $self = shift; $self->unwrapAtoms (@_); } sub dump_mvhd { my $self = shift; my ($pos, $len) = @_; my $buffer = $self->read ($len - 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: ', NToFixed (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: ', $self->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; $self->unwrapAtoms (@_); } sub dump_mdia { my $self = shift; $self->unwrapAtoms (@_); } sub dump_minf { my $self = shift; $self->unwrapAtoms (@_); } sub dump_free { my $self = shift; my ($pos, $len) = @_; $self->pr ("Padding = $len bytes\n"); } sub dump_wide { my $self = shift; my ($pos, $len) = @_; $self->pr ("64 bit expansion place holder\n"); } sub dump_trak { my $self = shift; $self->unwrapAtoms (@_); } sub dump_stbl { my $self = shift; $self->unwrapAtoms (@_); } sub dump_stco { my $self = shift; my ($pos, $len) = @_; my $dataRef; my $index = -1; my $limit = $self->atomStack_count (); while (-$index < $limit) { $dataRef = \%{$self->atomStack_index ($index--)->[1]}; next if ! exists $dataRef->{'HdlrSubCmpt'}; last if $dataRef->{'HdlrSubCmpt'} ne 'alis'; } $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); my $entries = NToSigned ($self->read (4)); my $type = (defined $dataRef && $dataRef->{'HdlrSubCmpt'}) || ''; $self->pr ('Entries: ', $entries, " ($type)\n"); while ($entries--) { my $off = NToSigned ($self->read (4)); $self->pr (' Offset: ', sprintf "%d (0x%04x)\n", $off, $off +); next if $type ne 'sprt'; $self->describeAtom ($off + 12); } } sub dump_sean { my $self = shift; my ($pos, $len) = @_; my $end = $pos + $len; $pos += 20; $self->describeAtomsIn ($pos, $end); } sub dump_sprt { my $self = shift; $self->atomList (@_); } sub dump_stsh { my $self = shift; $self->dump_stsz (@_); } sub dump_stsc { my $self = shift; $self->dump_stts (@_); } sub dump_stsd { my $self = shift; $self->atomList (@_); } sub dump_stst { my $self = shift; $self->dump_dref (@_); } sub dump_stsz { my $self = shift; $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); $self->pr ('Samp size: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Entries: ', NToSigned ($self->read (4)), "\n"); } sub dump_stts { my $self = shift; $self->atomList (@_); } sub dump_stss { my $self = shift; $self->dump_stts (@_); } sub dump_edts { my $self = shift; $self->unwrapAtoms (@_); } sub dump_tkhd { my $self = shift; $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); $self->pr ('Creation time: ', $self->showDate (), "\n"); $self->pr ('Modification time: ', $self->showDate (), "\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: ', $self->showMatrix (), "\n"); $self->pr ('Track width: ', NToFixed ($self->read (4)), "\n" +); $self->pr ('Track height: ', NToFixed ($self->read (4)), "\n" +); } sub dump_mdhd { my $self = shift; $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); $self->pr ('Creation time: ', $self->showDate (), "\n"); $self->pr ('Modification time: ', $self->showDate (), "\n"); $self->pr ('Time scale: ', NToSigned ($self->read (4)), "\n +"); $self->pr ('Duration: ', NToSigned ($self->read (4)), "\n +"); $self->pr ('Locale: ', nToSigned ($self->read (2)), "\n +"); $self->pr ('Quality: ', unpack ('B16', $self->read (2)), + "\n"); } sub dump_hdlr { my $self = shift; my $dataRef = \%{$self->atomStack_index (-2)->[1]}; $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); my $cmpt = $self->get4Char (); $self->pr ('Component type: ', $cmpt, "\n"); my $subCmpt = $self->get4Char (); $self->pr ('Component sub type: ', $subCmpt, "\n"); $dataRef->{'HdlrCmpt'} = $cmpt; $dataRef->{'HdlrSubCmpt'} = $subCmpt; $self->pr ('Manufacturer: ', $self->get4Char (), "\n"); $self->pr ('Flags: ', unpack ('B32', $self->read (4)) +, "\n"); $self->pr ('Mask: ', unpack ('B32', $self->read (4)) +, "\n"); my $strLen = ord ($self->read (1)); $self->pr ('Name: ', unpack ("a$strLen", $self->read + ($strLen)), "\n"); } sub dump_elst { my $self = shift; $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, $len) = @_; my $buffer = $self->read ($len - 8); } sub dump_clip { my $self = shift; $self->unwrapAtoms (@_); } sub dump_MCPS { my $self = shift; $self->dumpText (@_); } sub dump_name { my $self = shift; $self->dumpText (@_); } sub dump_vmhd { my $self = shift; my $parent = $self->atomStack_index (-2)->[0]; if ($parent eq 'minf') { $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n" +); $self->showGraphicsXferMode (); $self->showRGB (); } else { $self->pr ("Unhandled context ($parent) for VideoMediaInfo ato +m\n"); } } sub dump_WLOC { my $self = shift; my ($pos, $len) = @_; $len = 2 * $len - 16; $self->pr (unpack ("H$len\n", $self->read ($len)), "\n"); } sub dump_x00000001 { my $self = shift; my $parentType = $self->atomStack_index (-2)->[0]; if ($parentType eq 'oprn') { my ($pos, $len) = @_; $self->pr ('Unknown 1: ', NToSigned ($self->read (4)), "\n"); $self->pr ('ID: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 3: ', NToSigned ($self->read (4)), "\n"); $self->unwrapAtoms ($pos + 12, $len - 12); } else { $self->showBogus (); $self->pr ('Matrix structure: ', $self->showMatrix (), "\n"); } } sub dump_x00000002 { my $self = shift; $self->pr ("Constant\n"); $self->pr ('Unknown 1: ', NToSigned ($self->read (4)), "\n"); $self->pr ('ID: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Unknown 3: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Value: ', nToSigned ($self->read (2)), "\n"); } sub dump_x00000004 { my $self = shift; $self->showBogus (); $self->pr ('Visible: ', nToSigned ($self->read (2)), "\n"); } sub dump_x00000005 { my $self = shift; $self->showBogus (); $self->pr ('Layer: ', nToSigned ($self->read (2)), "\n"); } sub dump_x00000006 { my $self = shift; $self->showPlayMode (); $self->showBogus (); $self->showRGB (); } sub dump_x00000015 { my $self = shift; $self->pr ("Quicktime version\n"); } sub dump_x00000064 { my $self = shift; $self->showBogus (); $self->pr ('Image index: ', nToSigned ($self->read (2)), "\n"); } sub dump_x00000065 { my $self = shift; $self->pr ("Background colour:\n"); $self->showBogus (); $self->showRGB (); } sub dump_x00000066 { my $self = shift; $self->showBogus (); $self->pr ('Offscreen bit depth: ', nToSigned ($self->read (2)), " +\n"); } sub dump_x00000067 { my $self = shift; $self->showBogus (); $self->pr ('Sample format: ', nToSigned ($self->read (2)), "\n"); } sub dump_x00000c00 { my $self = shift; $self->pr ("Sprite bounds left\n"); } sub dump_x00000c01 { my $self = shift; $self->pr ("Sprite bounds top\n"); } sub dump_x00000c03 { my $self = shift; $self->pr ("Sprite bounds bottom\n"); } sub dump_x00000c04 { my $self = shift; $self->pr ("Sprite bounds right\n"); } sub dump_x00000c05 { my $self = shift; $self->pr ("Sprite is visible\n"); } sub dump_x00000c06 { my $self = shift; $self->pr ("Sprite layer\n"); } sub dump_x00000c07 { my $self = shift; $self->pr ("Sprite track variable\n"); } sub dump_x00001400 { my $self = shift; $self->pr ("Mouse local h loc\n"); } sub dump_x00001401 { my $self = shift; $self->pr ("Mouse local v loc\n"); } sub dump_x00001402 { my $self = shift; $self->pr ("Key is down\n"); } sub dumpBlock { my $self = shift; my ($pos, $len) = @_; while ($len) { my $chunk = $len > 16 ? 16 : $len; my $str = $self->read ($chunk); $str =~ s/([\x00-\x1f\x80-\xff])/sprintf "\\x%02x", ord ($1)/g +e; $self->pr ("$str\n"); $len -= $chunk; } } sub dumpText { my $self = shift; my ($pos, $len) = @_; $len -= 8; $self->pr (unpack ("a$len", $self->read ($len)), "\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 showBogus { my $self = shift; $self->pr ('Version: ', unpack ('C', $self->read (1)), "\n"); $self->pr ('Flags: ', unpack ('B24', $self->read (3)), "\n"); $self->pr ('Reserved: ', NToSigned ($self->read (4)), "\n"); $self->pr ('Reserved: ', NToSigned ($self->read (4)), "\n"); } sub showPlayMode { my $self = shift; my $flagBits = shift; my $flags = ''; $flagBits = $self->read (4) if ! defined $flagBits; $flagBits = NToSigned ($flagBits); $flags .= 'fullScreenHideCursor ' if $flags & 1; $flags .= 'fullScreenAllowEvents ' if $flags & 2; $flags .= 'fullScreenDontChangeMenuBar ' if $flags & 4; $flags .= 'fullScreenPreflightSize ' if $flags & 8; $self->pr ("Play mode flags: $flags\n") } sub showGMode { my $self = shift; my $gMode = shift; $gMode = $self->read (2) if ! defined $gMode; $gMode = NToSigned ($gMode); my %modes = ( 0x0000 => 'Copy', 0x0040 => 'Dither copy', 0x0020 => 'Blend', 0x0024 => 'Transparent', 0x0100 => 'Straight alpha', 0x0101 => 'Premul white alpha', 0x0102 => 'Premul black alpha', 0x0104 => 'Straight alpha blend', 0x0103 => 'Composition (dither copy)', ); $self->pr ("Graphics mode: $modes{$gMode}\n") } sub showRGB { my $self = shift; my ($red, $green, $blue) = @_; $red = $self->read (2) if ! defined $red; $green = $self->read (2) if ! defined $green; $blue = $self->read (2) if ! defined $blue; $red = nToUnsigned ($red); $green = nToUnsigned ($green); $blue = nToUnsigned ($blue); $self->pr ("Red: $red\n"); $self->pr ("Green: $green\n"); $self->pr ("Blue: $blue\n"); } sub showGraphicsXferMode { my $self = shift; my $gMode = shift; $gMode = $self->read (2) if ! defined $gMode; $gMode = nToSigned ($gMode); my %modes = ( 0 => 'srcCopy', 1 => 'srcOr', 2 => 'srcXor', 3 => 'srcBic', 4 => 'notSrcCopy', 5 => 'notSrcOr', 6 => 'notSrcXor', 7 => 'notSrcBic', 8 => 'patCopy', 9 => 'patOr', 10 => 'patXor', 11 => 'patBic', 12 => 'notPatCopy', 13 => 'notPatOr', 14 => 'notPatXor', 15 => 'notPatBic', 49 => 'grayishTextOr', 50 => 'hilite', 50 => 'hilitetransfermode', 32 => 'blend', 33 => 'addPin', 34 => 'addOver', 35 => 'subPin', 37 => 'addMax', 37 => 'adMax', 38 => 'subOver', 39 => 'adMin', 64 => 'ditherCopy', 36 => 'transparent', ); if (exists $modes{$gMode}) { $self->pr ('Mode: ', $modes{$gMode}, "\n"); } else { $self->pr ('Mode: unknown - ', $gMode, "\n"); } } sub showDate { my $self = shift; my $stamp = shift; $stamp = $self->read (4) if ! defined $stamp; $stamp = NToUnsigned ($stamp); # 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; } sub showMatrix { my $self = shift; my $matrix = shift; $matrix = $self->read (36) if ! defined $matrix; my $str = ''; for (1..3) { my $sub = substr $matrix, 0, 12, ''; $str .= NToFixed (substr $sub, 0, 4, '') . ' '; $str .= NToFixed (substr $sub, 0, 4, '') . ' '; $str .= NToFrac (substr $sub, 0, 4, '') . ' '; $str .= ' / ' if $_ != 3; } return $str; } 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 get4Char { my $self = shift; return unpack ("a4", $self->read (4)); } sub NToFixed { my $str = shift; return unpack ('l', pack ('l', unpack( "N", $str))) / 0x10000; } sub NToFrac { my $str = shift; my $fract = unpack ('l', pack ('l', unpack( "N", $str))); return $fract / 0x40000000; } 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))); } #1; package main; use Tk; use Tk::Tree; local $| = 1; my $file = shift; if (defined $file) { $file = DumpQuicktime->new(-file=>$file); my $str = $file->dump; my $main = MainWindow->new (-title => "Quicktime dump of $file->{' +filename'}"); my $tree = $main->ScrlTree ( -font => 'FixedSys 8', -itemtype => 'text', -separator => '/', -scrollbars => "osoe" ); my @pathStack; my $lastLine = 0; my $savedTail; my $catchIndented; my $maxLineLenght = 0; my $maxNesting = 0; my $totalLines = 0; my $currIndent = ''; my $indentStr = $file->indentStr; push @pathStack, 0; for my $line (split "\n", $str) { chomp $line; next if length ($line) == 0; # Skip blank lines my ($newIndent, $nodeText) = $line =~ /^((?:\Q$indentStr\E)*)( +.*)/; while (length ($newIndent) > length ($currIndent)) {# new proj +ect push @pathStack, 0; $currIndent .= $indentStr; } while (length ($newIndent) < length ($currIndent)) {# new proj +ect pop @pathStack; substr $currIndent, 0, length $indentStr, ''; } $pathStack[-1]++; $maxNesting = @pathStack if $maxNesting < @pathStack; my $currPath = join "/", @pathStack; $tree->add ($currPath, -text => $nodeText); ++$totalLines; $maxLineLenght = length ($nodeText) if length ($nodeText) > $m +axLineLenght; } $totalLines = 40 if $totalLines > 40; $main->geometry (($maxLineLenght + $maxNesting * 4) * 5 . 'x' . (4 +0 + $totalLines * 20)); closeTree ($tree, ''); $tree->pack(-fill=>'both',-expand => 1); MainLoop; } 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 } sub closeTree { my $tree = shift; my ($entryPath, $hideChildren) = @_; my @children = $tree->info (children => $entryPath); return if ! @children; for (@children) { closeTree ($tree, $_, 1); $tree->hide ('entry' => $_) if $hideChildren; } $tree->setmode ($entryPath, 'open') if length $entryPath; }

DWIM is Perl's answer to Gödel

Comment on Updated QuickTime format movie file dumper
Download Code
Re: Updated QuickTime format movie file dumper
by baboo (Initiate) on Mar 04, 2006 at 09:28 UTC
    Need to say that previous version (without bells and whistles, output to STDOUT) was more flexible solution. I'm currently stragling with building of Tk module on Mac - it's not so easy as I got a batch of "Undefined symbols" while linking... Overal conclusion - more modules - more head aches for users. Could you please help me with previous version of the script? I have all modules installed. I'm able to run the program without parameters - it returns usage message. But if I feed any parameter it fails on this line: $file = DumpQuicktime->new(-file=>$file); with note "Can't locate object method "new" via package "DumpQuicktime" at 530009.pl line 465"

      Just replace the package main stuff with:

      package main; my $file = shift; if (defined $file) { $file = DumpQuicktime->new(-file=>$file); die $file->lastErr () if length $file->lastErr (); print $file->dump (); }

      For me the tree stuff is invaluable. Quicktime atoms are nested about 30 deep in stuff I'm looking at and the output is, I'd guess, a couple of thousand lines long!

      Returning a string rather than outputting directly to sdtout allows post processing of the output.


      DWIM is Perl's answer to Gödel
        Hmm, the line "$file = DumpQuicktime->new(-file=>$file);" is the same, the same is the error :( Never seen movies with nested more than 3-4 deep atoms. The same with "thousand lines" - an average movie header say with 3-4 tracks may have about hundred or so atoms. Anyway thank you ;-)

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2014-09-20 06:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (155 votes), past polls