/[amv]/amv.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /amv.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 8 - (hide annotations)
Fri Jul 20 11:13:55 2007 UTC (16 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 7252 byte(s)
- dump all frames into (currently still invaild) jpeg files
- hex_dump can accept offset to dump data which is not from file (e.g. jpeg header)
- better output
1 dpavlin 3 #!/usr/bin/perl -w
2    
3     # amv.pl
4     #
5     # 07/19/07 19:21:39 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6 dpavlin 7 #
7     # Various useful links used to produce this:
8     # http://www.moviecodec.com/topics/15431p1.html
9     # http://en.wikipedia.org/wiki/RIFF_(File_format)
10 dpavlin 8 # http://www.obrador.com/essentialjpeg/HeaderInfo.htm
11     # http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html
12 dpavlin 3
13     use strict;
14    
15     use Data::Dump qw/dump/;
16     use Carp qw/confess/;
17 dpavlin 8 use File::Path;
18 dpavlin 3
19 dpavlin 8 my $dump = 0;
20     my $debug = 0;
21    
22 dpavlin 3 my $path = shift @ARGV || die "usage: $0 movie.amv\n";
23    
24 dpavlin 8 my $dump_dir = '/tmp/dump/';
25     if ( ! -e $dump_dir ) {
26     mkpath $dump_dir || die "can't create $dump_dir: $!";
27     }
28    
29 dpavlin 3 open(my $fh, '<', $path) || die "can't open $path: $!";
30    
31 dpavlin 4 # offset in file
32     my $o = 0;
33    
34     # shared data hash
35     my $d;
36    
37 dpavlin 3 sub hex_dump {
38 dpavlin 8 return unless $dump;
39 dpavlin 3
40 dpavlin 8 my ( $bytes, $offset ) = @_;
41     return unless $bytes;
42    
43     my $old_o;
44     if (defined($offset)) {
45     $old_o = $o;
46     $o = $offset;
47     }
48    
49 dpavlin 3 my $ascii = $bytes;
50     $ascii =~ s/\W/./gs;
51 dpavlin 8 my $hex = uc( unpack('h*', $bytes) );
52 dpavlin 3 $hex =~ s/(..)/$1 /g;
53     # calculate number of characters for offset
54 dpavlin 4 #my $d = length( sprintf("%x",length($bytes)) );
55     my $d = 4;
56 dpavlin 6 my $prefix = '#.';
57 dpavlin 3 while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
58 dpavlin 6 printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
59     $prefix = '##';
60 dpavlin 3 if ( length($ascii) >= 16 ) {
61     $ascii = substr( $ascii, 16 );
62 dpavlin 4 $o += 16;
63 dpavlin 3 } else {
64 dpavlin 4 $o += length($ascii);
65 dpavlin 3 last;
66     }
67     }
68 dpavlin 8
69     $o = $old_o if $old_o;
70 dpavlin 3 }
71    
72     sub x {
73     my ($len,$format) = @_;
74    
75     my $bytes;
76     read($fh, $bytes, $len);
77    
78     my $r_len = length($bytes);
79     confess "read $r_len bytes, expected $len" if $len != $r_len;
80    
81     hex_dump( $bytes );
82    
83 dpavlin 4 if ( $bytes eq 'AMV_END_' ) {
84 dpavlin 5 warn "> end of file marker AMV_END_\n";
85 dpavlin 4 $d->{eof}++;
86     return;
87     }
88    
89 dpavlin 3 if ( $format ) {
90     my @data = unpack($format, $bytes);
91 dpavlin 8 warn "## unpacked = ",dump(@data),"\n" if $debug;
92 dpavlin 3 return @data;
93     } else {
94     return $bytes;
95     }
96     }
97    
98     sub next_part {
99     my ( $expected_part, $expected_len, $skip ) = @_;
100     my ( $part, $len ) = x(8,'A4V');
101 dpavlin 4 return unless $len;
102 dpavlin 3 confess "not $expected_part but $part" if $expected_part ne $part;
103     if ( $expected_len ) {
104     confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
105     }
106 dpavlin 8 printf "<< %s - %d 0x%x bytes\n", $part, $len, $len;
107 dpavlin 3 x($len) if $skip;
108     return $len;
109     }
110    
111 dpavlin 8 sub huffman {
112 dpavlin 3
113 dpavlin 8 # JPEG DHT Segment for YCrCb omitted from MJPG data
114     return
115     "\xFF\xC4\x01\xA2" .
116     "\x00\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00" .
117     "\x00\x00\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x01" .
118     "\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00" .
119     "\x00\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x10\x00" .
120     "\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D" .
121     "\x01\x02\x03\x00\x04\x11\x05\x12\x21\x31\x41\x06\x13\x51\x61" .
122     "\x07\x22\x71\x14\x32\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52" .
123     "\xD1\xF0\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A\x25" .
124     "\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39\x3A\x43\x44\x45" .
125     "\x46\x47\x48\x49\x4A\x53\x54\x55\x56\x57\x58\x59\x5A\x63\x64" .
126     "\x65\x66\x67\x68\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83" .
127     "\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98\x99" .
128     "\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2\xB3\xB4\xB5\xB6" .
129     "\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3" .
130     "\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8" .
131     "\xE9\xEA\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\x11\x00\x02" .
132     "\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04\x00\x01\x02\x77\x00" .
133     "\x01\x02\x03\x11\x04\x05\x21\x31\x06\x12\x41\x51\x07\x61\x71" .
134     "\x13\x22\x32\x81\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52" .
135     "\xF0\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17\x18\x19" .
136     "\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38\x39\x3A\x43\x44\x45" .
137     "\x46\x47\x48\x49\x4A\x53\x54\x55\x56\x57\x58\x59\x5A\x63\x64" .
138     "\x65\x66\x67\x68\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82" .
139     "\x83\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98" .
140     "\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2\xB3\xB4\xB5" .
141     "\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2" .
142     "\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8" .
143     "\xE9\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA";
144    
145     }
146    
147     sub mkjpg {
148     my ($path,$data) = @_;
149     open(my $fh, '>', $path) || die "can't create $path: $!";
150    
151     confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
152     $data = substr($data,2);
153    
154     my $header =
155     "\xFF\xD8". # Start of Image (SOI) marker
156     #------------------------------------------------------------------
157     "\xFF\xE0". # JFIF marker
158     pack("nZ5CCCnnCC",
159     16, # length
160     'JFIF', # identifier
161     1,1, # version
162     0, # units (none)
163     1,1, # X,Y density
164     0,0, # X,Y thumbnail
165     ).
166     #------------------------------------------------------------------
167     "\xFF\xDB". # Define Quantization table marker
168     "\x00\x43". # len
169     "\x00". # the precision and the quantization table index
170     "\x00" x 64 .
171     #------------------------------------------------------------------
172     "\xFF\xC0". # Start of frame
173     pack("ncnncc9",
174     17, # len
175     8, # sample precision in bits
176     120,160, # X,Y size
177     3, # number of components
178     1,0x22,0, # Component ID, H+V sampling factors, Quantization table number
179     2,0x11,0,
180     3,0x11,0,
181     ).
182     #------------------------------------------------------------------
183     # huffman("\x00"). # 0 DC
184     huffman("\x01"). # 1 DC
185     # huffman("\x10"). # 0 AC
186     # huffman("\x11"). # 1 AC
187     #------------------------------------------------------------------
188     "\xFF\xDA". # Start of Scan marker
189     pack("nC11",
190     12, # length
191     3, # number of components
192     1,0, # components DC+AC table numbers
193     2,17,
194     3,17,
195     0,63, # Ss, Se
196     0,165, # Ah, Ai
197     );
198     #------------------------------------------------------------------
199    
200    
201     warn "## created JPEG header...", dump( $header );
202     hex_dump( $header, 0 );
203    
204     print $fh $header . $data || die "can't write frame into $path: $!";
205     close $fh || die "can't close $path: $!";
206     print ">> created $path ", -s $path, " bytes\n";
207     }
208    
209     my ( $riff, $amv ) = x(12, 'Z4x4Z4');
210     die "$path not RIFF but $riff" if $riff ne 'RIFF';
211     die "$path not AMV but $amv" if $amv ne 'AMV ';
212    
213 dpavlin 4 while ( ! defined($d->{eof}) ) {
214 dpavlin 3 my ( $list, $name ) = x(12,'A4x4A4');
215     die "not LIST but $list" if $list ne 'LIST';
216 dpavlin 8 print "< $list * $name\n";
217 dpavlin 3
218     if ( $name eq 'hdrl' ) {
219    
220     my $len = next_part( 'amvh', hex(38) );
221    
222     my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
223     my $h;
224     map {
225     my $v = $_;
226     my $n = shift @names || die "no more names?";
227     $h->{$n} = $v;
228     } x($len, 'Vx28VVVx8CCv');
229    
230     printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",
231 dpavlin 8 $path,
232 dpavlin 3 $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
233     $h->{hh}, $h->{mm}, $h->{ss};
234    
235     $d->{amvh} = $h;
236    
237     } elsif ( $name eq 'strl' ) {
238    
239     next_part( 'strh', 0, 1 );
240     next_part( 'strf', 0, 1 );
241    
242 dpavlin 4 } elsif ( $name eq 'movi' ) {
243    
244     while (1) {
245     my $frame = $d->{movi}++;
246    
247 dpavlin 8 my $len = next_part( '00dc' );
248 dpavlin 4 last unless $len;
249 dpavlin 8 printf "<< %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len;
250     mkjpg( sprintf("$dump_dir/%03d.jpg", $frame ), x($len) );
251 dpavlin 4
252 dpavlin 8 $len = next_part( '01wb', 0, 1 );
253     printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;
254 dpavlin 4 };
255    
256 dpavlin 3 } else {
257     die "unknown $list $name";
258     }
259     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26