/[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

Contents of /amv.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 8 - (show annotations)
Fri Jul 20 11:13:55 2007 UTC (11 years, 9 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 #!/usr/bin/perl -w
2
3 # amv.pl
4 #
5 # 07/19/07 19:21:39 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6 #
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 # http://www.obrador.com/essentialjpeg/HeaderInfo.htm
11 # http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html
12
13 use strict;
14
15 use Data::Dump qw/dump/;
16 use Carp qw/confess/;
17 use File::Path;
18
19 my $dump = 0;
20 my $debug = 0;
21
22 my $path = shift @ARGV || die "usage: $0 movie.amv\n";
23
24 my $dump_dir = '/tmp/dump/';
25 if ( ! -e $dump_dir ) {
26 mkpath $dump_dir || die "can't create $dump_dir: $!";
27 }
28
29 open(my $fh, '<', $path) || die "can't open $path: $!";
30
31 # offset in file
32 my $o = 0;
33
34 # shared data hash
35 my $d;
36
37 sub hex_dump {
38 return unless $dump;
39
40 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 my $ascii = $bytes;
50 $ascii =~ s/\W/./gs;
51 my $hex = uc( unpack('h*', $bytes) );
52 $hex =~ s/(..)/$1 /g;
53 # calculate number of characters for offset
54 #my $d = length( sprintf("%x",length($bytes)) );
55 my $d = 4;
56 my $prefix = '#.';
57 while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
58 printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
59 $prefix = '##';
60 if ( length($ascii) >= 16 ) {
61 $ascii = substr( $ascii, 16 );
62 $o += 16;
63 } else {
64 $o += length($ascii);
65 last;
66 }
67 }
68
69 $o = $old_o if $old_o;
70 }
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 if ( $bytes eq 'AMV_END_' ) {
84 warn "> end of file marker AMV_END_\n";
85 $d->{eof}++;
86 return;
87 }
88
89 if ( $format ) {
90 my @data = unpack($format, $bytes);
91 warn "## unpacked = ",dump(@data),"\n" if $debug;
92 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 return unless $len;
102 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 printf "<< %s - %d 0x%x bytes\n", $part, $len, $len;
107 x($len) if $skip;
108 return $len;
109 }
110
111 sub huffman {
112
113 # 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 while ( ! defined($d->{eof}) ) {
214 my ( $list, $name ) = x(12,'A4x4A4');
215 die "not LIST but $list" if $list ne 'LIST';
216 print "< $list * $name\n";
217
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 $path,
232 $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 } elsif ( $name eq 'movi' ) {
243
244 while (1) {
245 my $frame = $d->{movi}++;
246
247 my $len = next_part( '00dc' );
248 last unless $len;
249 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
252 $len = next_part( '01wb', 0, 1 );
253 printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;
254 };
255
256 } else {
257 die "unknown $list $name";
258 }
259 }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26