Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Comment on

by gods
on Feb 11, 2000 at 00:06 UTC ( #3333=superdoc: 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

In reply to Updated QuickTime format movie file dumper by GrandFather

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (8)
    As of 2016-10-01 19:23 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      How many different varieties (color, size, etc) of socks do you have in your sock drawer?






      Results (6 votes). Check out past polls.