File Coverage

blib/lib/Image/ExifTool/M2TS.pm
Criterion Covered Total %
statement 201 383 52.4
branch 85 236 36.0
condition 14 37 37.8
subroutine 7 7 100.0
pod 0 4 0.0
total 307 667 46.0


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: M2TS.pm
3             #
4             # Description: Read M2TS (AVCHD) meta information
5             #
6             # Revisions: 2009/07/03 - P. Harvey Created
7             #
8             # References: 1) http://neuron2.net/library/mpeg2/iso13818-1.pdf
9             # 2) http://www.blu-raydisc.com/Assets/Downloadablefile/BD-RE_Part3_V2.1_WhitePaper_080406-15271.pdf
10             # 3) http://www.videohelp.com/forum/archive/reading-avchd-playlist-files-bdmv-playlist-mpl-t358888.html
11             # 4) http://en.wikipedia.org/wiki/MPEG_transport_stream
12             # 5) http://www.dunod.com/documents/9782100493463/49346_DVB.pdf
13             # 6) http://trac.handbrake.fr/browser/trunk/libhb/stream.c
14             # 7) http://ieeexplore.ieee.org/stamp/stamp.jsp?arnumber=04560141
15             # 8) http://www.w6rz.net/xport.zip
16             #
17             # Notes: Variable names containing underlines are the same as in ref 1.
18             #
19             # Glossary: PES = Packetized Elementary Stream
20             # PAT = Program Association Table
21             # PMT = Program Map Table
22             # PCR = Program Clock Reference
23             # PID = Packet Identifier
24             #
25             # To Do: - parse PCR to obtain average bitrates?
26             #------------------------------------------------------------------------------
27              
28             package Image::ExifTool::M2TS;
29              
30 1     1   3488 use strict;
  1         2  
  1         26  
31 1     1   5 use vars qw($VERSION);
  1         1  
  1         32  
32 1     1   5 use Image::ExifTool qw(:DataAccess :Utils);
  1         1  
  1         3928  
33              
34             $VERSION = '1.21';
35              
36             # program map table "stream_type" lookup (ref 6/1)
37             my %streamType = (
38             0x00 => 'Reserved',
39             0x01 => 'MPEG-1 Video',
40             0x02 => 'MPEG-2 Video',
41             0x03 => 'MPEG-1 Audio',
42             0x04 => 'MPEG-2 Audio',
43             0x05 => 'ISO 13818-1 private sections',
44             0x06 => 'ISO 13818-1 PES private data',
45             0x07 => 'ISO 13522 MHEG',
46             0x08 => 'ISO 13818-1 DSM-CC',
47             0x09 => 'ISO 13818-1 auxiliary',
48             0x0A => 'ISO 13818-6 multi-protocol encap',
49             0x0B => 'ISO 13818-6 DSM-CC U-N msgs',
50             0x0C => 'ISO 13818-6 stream descriptors',
51             0x0D => 'ISO 13818-6 sections',
52             0x0E => 'ISO 13818-1 auxiliary',
53             0x0F => 'MPEG-2 AAC Audio',
54             0x10 => 'MPEG-4 Video',
55             0x11 => 'MPEG-4 LATM AAC Audio',
56             0x12 => 'MPEG-4 generic',
57             0x13 => 'ISO 14496-1 SL-packetized',
58             0x14 => 'ISO 13818-6 Synchronized Download Protocol',
59             # 0x15-0x7F => 'ISO 13818-1 Reserved',
60             0x1b => 'H.264 (AVC) Video',
61             0x24 => 'H.265 (HEVC) Video', #PH
62             0x80 => 'DigiCipher II Video',
63             0x81 => 'A52/AC-3 Audio',
64             0x82 => 'HDMV DTS Audio',
65             0x83 => 'LPCM Audio',
66             0x84 => 'SDDS Audio',
67             0x85 => 'ATSC Program ID',
68             0x86 => 'DTS-HD Audio',
69             0x87 => 'E-AC-3 Audio',
70             0x8a => 'DTS Audio',
71             0x90 => 'PGS Audio', #https://www.avsforum.com/threads/bass-eq-for-filtered-movies.2995212/page-399
72             0x91 => 'A52b/AC-3 Audio',
73             0x92 => 'DVD_SPU vls Subtitle',
74             0x94 => 'SDDS Audio',
75             0xa0 => 'MSCODEC Video',
76             0xea => 'Private ES (VC-1)',
77             # 0x80-0xFF => 'User Private',
78             );
79              
80             # "table_id" values (ref 5)
81             my %tableID = (
82             0x00 => 'Program Association',
83             0x01 => 'Conditional Access',
84             0x02 => 'Program Map',
85             0x03 => 'Transport Stream Description',
86             0x40 => 'Actual Network Information',
87             0x41 => 'Other Network Information',
88             0x42 => 'Actual Service Description',
89             0x46 => 'Other Service Description',
90             0x4a => 'Bouquet Association',
91             0x4e => 'Actual Event Information - Present/Following',
92             0x4f => 'Other Event Information - Present/Following',
93             0x50 => 'Actual Event Information - Schedule', #(also 0x51-0x5f)
94             0x60 => 'Other Event Information - Schedule', # (also 0x61-0x6f)
95             0x70 => 'Time/Date',
96             0x71 => 'Running Status',
97             0x72 => 'Stuffing',
98             0x73 => 'Time Offset',
99             0x7e => 'Discontinuity Information',
100             0x7f => 'Selection Information',
101             # 0x80-0xfe => 'User Defined',
102             );
103              
104             # PES stream ID's for which a syntax field does not exist
105             my %noSyntax = (
106             0xbc => 1, # program_stream_map
107             0xbe => 1, # padding_stream
108             0xbf => 1, # private_stream_2
109             0xf0 => 1, # ECM_stream
110             0xf1 => 1, # EMM_stream
111             0xf2 => 1, # DSMCC_stream
112             0xf8 => 1, # ITU-T Rec. H.222.1 type E stream
113             0xff => 1, # program_stream_directory
114             );
115              
116             my $knotsToKph = 1.852; # knots --> km/h
117              
118             # information extracted from the MPEG-2 transport stream
119             %Image::ExifTool::M2TS::Main = (
120             GROUPS => { 2 => 'Video' },
121             VARS => { NO_ID => 1 },
122             NOTES => q{
123             The MPEG-2 transport stream is used as a container for many different
124             audio/video formats (including AVCHD). This table lists information
125             extracted from M2TS files.
126             },
127             VideoStreamType => {
128             PrintHex => 1,
129             PrintConv => \%streamType,
130             SeparateTable => 'StreamType',
131             },
132             AudioStreamType => {
133             PrintHex => 1,
134             PrintConv => \%streamType,
135             SeparateTable => 'StreamType',
136             },
137             Duration => {
138             Notes => q{
139             the -fast option may be used to avoid scanning to the end of file to
140             calculate the Duration
141             },
142             ValueConv => '$val / 27000000', # (clock is 27MHz)
143             PrintConv => 'ConvertDuration($val)',
144             },
145             # the following tags are for documentation purposes only
146             _AC3 => { SubDirectory => { TagTable => 'Image::ExifTool::M2TS::AC3' } },
147             _H264 => { SubDirectory => { TagTable => 'Image::ExifTool::H264::Main' } },
148             );
149              
150             # information extracted from AC-3 audio streams
151             %Image::ExifTool::M2TS::AC3 = (
152             GROUPS => { 1 => 'AC3', 2 => 'Audio' },
153             VARS => { NO_ID => 1 },
154             NOTES => 'Tags extracted from AC-3 audio streams.',
155             AudioSampleRate => {
156             PrintConv => {
157             0 => '48000',
158             1 => '44100',
159             2 => '32000',
160             },
161             },
162             AudioBitrate => {
163             PrintConvColumns => 2,
164             ValueConv => {
165             0 => 32000,
166             1 => 40000,
167             2 => 48000,
168             3 => 56000,
169             4 => 64000,
170             5 => 80000,
171             6 => 96000,
172             7 => 112000,
173             8 => 128000,
174             9 => 160000,
175             10 => 192000,
176             11 => 224000,
177             12 => 256000,
178             13 => 320000,
179             14 => 384000,
180             15 => 448000,
181             16 => 512000,
182             17 => 576000,
183             18 => 640000,
184             32 => '32000 max',
185             33 => '40000 max',
186             34 => '48000 max',
187             35 => '56000 max',
188             36 => '64000 max',
189             37 => '80000 max',
190             38 => '96000 max',
191             39 => '112000 max',
192             40 => '128000 max',
193             41 => '160000 max',
194             42 => '192000 max',
195             43 => '224000 max',
196             44 => '256000 max',
197             45 => '320000 max',
198             46 => '384000 max',
199             47 => '448000 max',
200             48 => '512000 max',
201             49 => '576000 max',
202             50 => '640000 max',
203             },
204             PrintConv => 'ConvertBitrate($val)',
205             },
206             SurroundMode => {
207             PrintConv => {
208             0 => 'Not indicated',
209             1 => 'Not Dolby surround',
210             2 => 'Dolby surround',
211             },
212             },
213             AudioChannels => {
214             PrintConvColumns => 2,
215             PrintConv => {
216             0 => '1 + 1',
217             1 => 1,
218             2 => 2,
219             3 => 3,
220             4 => '2/1',
221             5 => '3/1',
222             6 => '2/2',
223             7 => '3/2',
224             8 => 1,
225             9 => '2 max',
226             10 => '3 max',
227             11 => '4 max',
228             12 => '5 max',
229             13 => '6 max',
230             },
231             },
232             );
233              
234             #------------------------------------------------------------------------------
235             # Extract information from AC-3 audio stream
236             # Inputs: 0) ExifTool ref, 1) data ref
237             # Reference: http://www.atsc.org/standards/a_52b.pdf
238             sub ParseAC3Audio($$)
239             {
240 1     1 0 3 my ($et, $dataPt) = @_;
241 1 50       7 if ($$dataPt =~ /\x0b\x77..(.)/sg) {
242 1         3 my $sampleRate = ord($1) >> 6;
243 1         3 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::AC3');
244 1         12 $et->HandleTag($tagTablePtr, AudioSampleRate => $sampleRate);
245             }
246             }
247              
248             #------------------------------------------------------------------------------
249             # Extract information from AC-3 stream descriptor
250             # Inputs: 0) ExifTool ref, 1) data ref
251             # Reference: http://www.atsc.org/standards/a_52b.pdf
252             # Note: This information is duplicated in the Audio stream, but it
253             # is somewhat easier to extract it from the descriptor instead
254             sub ParseAC3Descriptor($$)
255             {
256 1     1 0 3 my ($et, $dataPt) = @_;
257 1 50       3 return if length $$dataPt < 3;
258 1         3 my @v = unpack('C3', $$dataPt);
259 1         3 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::AC3');
260             # $et->HandleTag($tagTablePtr, 'AudioSampleRate', $v[0] >> 5);
261 1         6 $et->HandleTag($tagTablePtr, 'AudioBitrate', $v[1] >> 2);
262 1         4 $et->HandleTag($tagTablePtr, 'SurroundMode', $v[1] & 0x03);
263 1         4 $et->HandleTag($tagTablePtr, 'AudioChannels', ($v[2] >> 1) & 0x0f);
264             # don't (yet) decode any more (language codes, etc)
265             }
266              
267             #------------------------------------------------------------------------------
268             # Parse PID stream data
269             # Inputs: 0) ExifTool ref, 1) PID number, 2) PID type, 3) PID name, 4) data ref
270             # Returns: 0=stream parsed OK,
271             # 1=stream parsed but we want to parse more of these,
272             # -1=can't parse yet because we don't know the type
273             sub ParsePID($$$$$)
274             {
275 2     2 0 5 my ($et, $pid, $type, $pidName, $dataPt) = @_;
276             # can't parse until we know the type (Program Map Table may be later in the stream)
277 2 50       5 return -1 unless defined $type;
278 2         5 my $verbose = $et->Options('Verbose');
279 2 50       5 if ($verbose > 1) {
280 0         0 my $out = $et->Options('TextOut');
281 0         0 printf $out "Parsing stream 0x%.4x (%s)\n", $pid, $pidName;
282 0         0 $et->VerboseDump($dataPt);
283             }
284 2         3 my $more = 0;
285 2 50 33     18 if ($type == 0x01 or $type == 0x02) {
    50 33        
    100 33        
    50 33        
    0          
286             # MPEG-1/MPEG-2 Video
287 0         0 require Image::ExifTool::MPEG;
288 0         0 Image::ExifTool::MPEG::ParseMPEGAudioVideo($et, $dataPt);
289             } elsif ($type == 0x03 or $type == 0x04) {
290             # MPEG-1/MPEG-2 Audio
291 0         0 require Image::ExifTool::MPEG;
292 0         0 Image::ExifTool::MPEG::ParseMPEGAudio($et, $dataPt);
293             } elsif ($type == 0x1b) {
294             # H.264 Video
295 1         477 require Image::ExifTool::H264;
296 1         5 $more = Image::ExifTool::H264::ParseH264Video($et, $dataPt);
297             # force parsing additional H264 frames with ExtractEmbedded option
298 1 50       5 if ($$et{OPTIONS}{ExtractEmbedded}) {
    50          
299 0         0 $more = 1;
300             } elsif (not $$et{OPTIONS}{Validate}) {
301 1         5 $et->WarnOnce('The ExtractEmbedded option may find more tags in the video data',3);
302             }
303             } elsif ($type == 0x81 or $type == 0x87 or $type == 0x91) {
304             # AC-3 audio
305 1         3 ParseAC3Audio($et, $dataPt);
306             } elsif ($type < 0) {
307 0 0 0     0 if ($$dataPt =~ /^(.{164})?(.{24})A[NS][EW]/s) {
    0          
    0          
    0          
308             # (Blueskysea B4K, Novatek NT96670)
309             # 0000: 01 00 ff 00 30 31 32 33 34 35 37 38 61 62 63 64 [....01234578abcd]
310             # 0010: 65 66 67 0a 00 00 00 00 00 00 00 00 00 00 00 00 [efg.............]
311             # 0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
312             # 0030: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
313             # 0040: 00 00 00 00 30 31 32 33 34 35 37 38 71 77 65 72 [....01234578qwer]
314             # 0050: 74 79 75 69 6f 70 0a 00 00 00 00 00 00 00 00 00 [tyuiop..........]
315             # 0060: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
316             # 0070: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
317             # 0080: 00 00 00 00 63 38 61 61 32 35 63 66 34 35 65 65 [....c8aa25cf45ee]
318             # 0090: 61 39 65 32 34 34 32 66 61 65 62 35 65 30 39 39 [a9e2442faeb5e099]
319             # 00a0: 30 37 64 34 15 00 00 00 10 00 00 00 1b 00 00 00 [07d4............]
320             # 00b0: 15 00 00 00 01 00 00 00 09 00 00 00 41 4e 57 00 [............ANW.]
321             # 00c0: 82 9a 57 45 98 b2 00 46 66 66 e4 41 d7 e3 14 43 [..WE...Fff.A...C]
322             # 00d0: 01 00 02 00 03 00 04 00 05 00 06 00 [............]
323             # (Viofo A119V3)
324             # 0000: 08 00 00 00 07 00 00 00 18 00 00 00 15 00 00 00 [................]
325             # 0010: 03 00 00 00 0b 00 00 00 41 4e 45 00 01 f2 ac 45 [........ANE....E]
326             # 0020: 2d 7f 6e 45 b8 1e 97 41 d7 23 46 43 00 00 00 00 [-.nE...A.#FC....]
327             # pad with dummy header and parse with existing FreeGPS code (minimum 92 bytes)
328 0   0     0 my $dat = ("\0" x 16) . substr($$dataPt, length($1 || '')) . ("\0" x 20);
329 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
330 0         0 Image::ExifTool::QuickTime::ProcessFreeGPS($et, { DataPt => \$dat }, $tbl);
331 0         0 $more = 1;
332             } elsif ($$dataPt =~ /^A([NS])([EW])\0/s) {
333             # INNOVV TS video (same format is INNOVV MP4)
334 0         0 SetByteOrder('II');
335 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
336 0         0 while ($$dataPt =~ /(A[NS][EW]\0.{28})/g) {
337 0         0 my $dat = $1;
338 0         0 my $lat = abs(GetFloat(\$dat, 4)); # (abs just to be safe)
339 0         0 my $lon = abs(GetFloat(\$dat, 8)); # (abs just to be safe)
340 0         0 my $spd = GetFloat(\$dat, 12) * $knotsToKph;
341 0         0 my $trk = GetFloat(\$dat, 16);
342 0         0 my @acc = unpack('x20V3', $dat);
343 0 0       0 map { $_ = $_ - 4294967296 if $_ >= 0x80000000 } @acc;
  0         0  
344 0         0 Image::ExifTool::QuickTime::ConvertLatLon($lat, $lon);
345 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
346 0 0       0 $et->HandleTag($tagTbl, GPSLatitude => abs($lat) * (substr($dat,1,1) eq 'S' ? -1 : 1));
347 0 0       0 $et->HandleTag($tagTbl, GPSLongitude => abs($lon) * (substr($dat,2,1) eq 'W' ? -1 : 1));
348 0         0 $et->HandleTag($tagTbl, GPSSpeed => $spd);
349 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
350 0         0 $et->HandleTag($tagTbl, GPSTrack => $trk);
351 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
352 0         0 $et->HandleTag($tagTbl, Accelerometer => "@acc");
353             }
354 0         0 SetByteOrder('MM');
355 0         0 $more = 1;
356             } elsif ($$dataPt =~ /^\$(GPSINFO|GSNRINFO),/) {
357             # $GPSINFO,0x0004,2021.08.09 13:27:36,2341.54561,12031.70135,8.0,51,153,0,0,\x0d
358             # $GSNRINFO,0.01,0.04,0.25\0
359 0         0 $$dataPt =~ tr/\x0d/\x0a/;
360 0         0 $$dataPt =~ tr/\0//d;
361 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
362 0         0 my @lines = split /\x0a/, $$dataPt;
363 0         0 my ($line, $lastTime);
364 0         0 foreach $line (@lines) {
365 0 0       0 if ($line =~ /^\$GPSINFO/) {
    0          
366 0         0 my @a = split /,/, $lines[0];
367 0 0       0 next unless @a > 7;
368             # ignore duplicate fixes
369 0 0 0     0 next if $lastTime and $a[2] eq $lastTime;
370 0         0 $lastTime = $a[2];
371 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
372 0         0 $a[2] =~ tr/./:/;
373             # (untested, and probably doesn't work for S/W hemispheres)
374 0         0 my ($lat, $lon) = @a[3,4];
375 0         0 Image::ExifTool::QuickTime::ConvertLatLon($lat, $lon);
376             # $a[0] - flags? values: '0x0001','0x0004','0x0008','0x0010'
377 0         0 $et->HandleTag($tagTbl, GPSDateTime => $a[2]);
378 0         0 $et->HandleTag($tagTbl, GPSLatitude => $lat);
379 0         0 $et->HandleTag($tagTbl, GPSLongitude => $lon);
380 0         0 $et->HandleTag($tagTbl, GPSSpeed => $a[5]);
381 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
382             # $a[6] - values: 48-60
383 0         0 $et->HandleTag($tagTbl, GPSTrack => $a[7]);
384 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
385             # #a[8,9] - always 0
386             } elsif ($line =~ /^\$GSNRINFO/) {
387 0         0 my @a = split /,/, $line;
388 0         0 shift @a;
389 0         0 $et->HandleTag($tagTbl, Accelerometer => "@a");
390             }
391             }
392 0         0 $more = 1;
393             } elsif ($$dataPt =~ /^.{44}A\0{3}.{4}([NS])\0{3}.{4}([EW])\0{3}/s and length($$dataPt) >= 84) {
394             #forum11320
395 0         0 SetByteOrder('II');
396 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
397 0         0 my $lat = abs(GetFloat($dataPt, 48)); # (abs just to be safe)
398 0         0 my $lon = abs(GetFloat($dataPt, 56)); # (abs just to be safe)
399 0         0 my $spd = GetFloat($dataPt, 64);
400 0         0 my $trk = GetFloat($dataPt, 68);
401 0         0 $et->WarnOnce('GPSLatitude/Longitude encryption is not yet known, so these will be wrong');
402 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
403 0         0 my @date = unpack('x32V3x28V3', $$dataPt);
404 0         0 $date[3] += 2000;
405 0         0 $et->HandleTag($tagTbl, GPSDateTime => sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2d', @date[3..5,0..2]));
406 0 0       0 $et->HandleTag($tagTbl, GPSLatitude => abs($lat) * ($1 eq 'S' ? -1 : 1));
407 0 0       0 $et->HandleTag($tagTbl, GPSLongitude => abs($lon) * ($2 eq 'W' ? -1 : 1));
408 0         0 $et->HandleTag($tagTbl, GPSSpeed => $spd);
409 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
410 0         0 $et->HandleTag($tagTbl, GPSTrack => $trk);
411 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
412 0         0 SetByteOrder('MM');
413 0         0 $more = 1;
414             }
415 0         0 delete $$et{DOC_NUM};
416             }
417 2         4 return $more;
418             }
419              
420             #------------------------------------------------------------------------------
421             # Extract information from a M2TS file
422             # Inputs: 0) ExifTool object reference, 1) DirInfo reference
423             # Returns: 1 on success, 0 if this wasn't a valid M2TS file
424             sub ProcessM2TS($$)
425             {
426 1     1 0 3 my ($et, $dirInfo) = @_;
427 1         2 my $raf = $$dirInfo{RAF};
428 1         5 my ($buff, $pLen, $upkPrefix, $j, $fileType, $eof);
429 1         0 my (%pmt, %pidType, %data, %sectLen);
430 1         0 my ($startTime, $endTime, $fwdTime, $backScan, $maxBack);
431 1         3 my $verbose = $et->Options('Verbose');
432 1         5 my $out = $et->Options('TextOut');
433              
434             # read first packet
435 1 50       4 return 0 unless $raf->Read($buff, 8) == 8;
436             # test for magic number (sync byte is the only thing we can safely check)
437 1 50       7 return 0 unless $buff =~ /^(....)?\x47/s;
438 1 50       5 unless ($1) {
439 0         0 $pLen = 188; # no timecode
440 0         0 $fileType = 'M2T'; # (just as a way to tell there is no timecode)
441 0         0 $upkPrefix = 'N';
442             } else {
443 1         2 $pLen = 192; # 188-byte transport packet + leading 4-byte timecode (ref 4)
444 1         2 $upkPrefix = 'x4N';
445             }
446 1         2 my $prePos = $pLen - 188; # byte position of packet prefix
447 1         2 my $readSize = 64 * $pLen; # size of our read buffer
448 1         4 $raf->Seek(0,0); # rewind to start
449 1 50       3 $raf->Read($buff, $readSize) >= $pLen * 4 or return 0; # require at least 4 packets
450             # validate the sync byte in the next 3 packets
451 1         5 for ($j=1; $j<4; ++$j) {
452 3 50       9 return 0 unless substr($buff, $prePos + $pLen * $j, 1) eq 'G'; # (0x47)
453             }
454 1         6 $et->SetFileType($fileType);
455 1         4 SetByteOrder('MM');
456 1         4 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::Main');
457              
458             # PID lookup strings (will add to this with entries from program map table)
459 1         6 my %pidName = (
460             0 => 'Program Association Table',
461             1 => 'Conditional Access Table',
462             2 => 'Transport Stream Description Table',
463             0x1fff => 'Null Packet',
464             );
465 1         4 my %didPID = ( 1 => 0, 2 => 0, 0x1fff => 0 );
466 1         2 my %needPID = ( 0 => 1 ); # lookup for stream PID's that we still need to parse
467             # PID's that may contain GPS info
468 1         3 my %gpsPID = (
469             0x0300 => 1, # Novatek INNOVV
470             0x01e4 => 1, # vsys a6l dashcam
471             );
472 1         2 my $pEnd = 0;
473              
474             # scan entire file for GPS programs if ExtractEmbedded option is 3 or higher
475             # (some dashcams write these programs but don't include it in the PMT)
476 1 50 50     3 if (($et->Options('ExtractEmbedded') || 0) > 2) {
477 0         0 foreach (keys %gpsPID) {
478 0         0 $needPID{$_} = 1;
479 0         0 $pidType{$_} = -1;
480 0         0 $pidName{$_} ='unregistered dashcam GPS';
481             }
482             }
483              
484             # parse packets from MPEG-2 Transport Stream
485 1         2 for (;;) {
486              
487 8 50       14 unless (%needPID) {
488 0 0       0 last unless defined $startTime;
489             # reconfigure to seek backwards for last PCR
490 0 0       0 unless (defined $backScan) {
491 0         0 my $saveTime = $endTime;
492 0         0 undef $endTime;
493 0 0       0 last if $et->Options('FastScan');
494 0 0       0 $verbose and print $out "[Starting backscan for last PCR]\n";
495             # remember how far we got when reading forward through the file
496 0         0 my $fwdPos = $raf->Tell() - length($buff) + $pEnd;
497             # determine the position of the last packet relative to the EOF
498 0 0       0 $raf->Seek(0, 2) or last;
499 0         0 my $fsize = $raf->Tell();
500 0         0 $backScan = int($fsize / $pLen) * $pLen - $fsize;
501             # set limit on how far back we will go
502 0         0 $maxBack = $fwdPos - $fsize;
503             # scan back a maximum of 512k (have seen last PCR at -276k)
504 0         0 my $nMax = int(512000 / $pLen); # max packets to backscan
505 0 0       0 if ($nMax < int(-$maxBack / $pLen)) {
506 0         0 $maxBack = $backScan - $nMax * $pLen;
507             } else {
508             # use this time if none found in all remaining packets
509 0         0 $fwdTime = $saveTime;
510             }
511 0         0 $pEnd = 0;
512             }
513             }
514 8         10 my $pos;
515             # read more if necessary
516 8 50       11 if (defined $backScan) {
517 0 0       0 last if defined $endTime;
518 0         0 $pos = $pEnd = $pEnd - 2 * $pLen; # step back to previous packet
519 0 0       0 if ($pos < 0) {
520             # read another buffer from end of file
521 0 0       0 last if $backScan <= $maxBack;
522 0         0 my $buffLen = $backScan - $maxBack;
523 0 0       0 $buffLen = $readSize if $buffLen > $readSize;
524 0         0 $backScan -= $buffLen;
525 0 0       0 $raf->Seek($backScan, 2) or last;
526 0 0       0 $raf->Read($buff, $buffLen) == $buffLen or last;
527 0         0 $pos = $pEnd = $buffLen - $pLen;
528             }
529             } else {
530 8         11 $pos = $pEnd;
531 8 100       15 if ($pos + $pLen > length $buff) {
532 1 50       4 $raf->Read($buff, $readSize) >= $pLen or $eof = 1, last;
533 0         0 $pos = $pEnd = 0;
534             }
535             }
536 7         9 $pEnd += $pLen;
537             # decode the packet prefix
538 7         6 $pos += $prePos;
539 7         16 my $prefix = unpack("x${pos}N", $buff); # (use unpack instead of Get32u for speed)
540             # validate sync byte
541 7 50       16 unless (($prefix & 0xff000000) == 0x47000000) {
542 0 0       0 $et->Warn('M2TS synchronization error') unless defined $backScan;
543 0         0 last;
544             }
545             # my $transport_error_indicator = $prefix & 0x00800000;
546 7         9 my $payload_unit_start_indicator = $prefix & 0x00400000;
547             # my $transport_priority = $prefix & 0x00200000;
548 7         8 my $pid =($prefix & 0x001fff00) >> 8; # packet ID
549             # my $transport_scrambling_control = $prefix & 0x000000c0;
550 7         9 my $adaptation_field_exists = $prefix & 0x00000020;
551 7         8 my $payload_data_exists = $prefix & 0x00000010;
552             # my $continuity_counter = $prefix & 0x0000000f;
553 7 50       13 if ($verbose > 1) {
554 0         0 my $i = ($raf->Tell() - length($buff) + $pEnd) / $pLen - 1;
555 0         0 print $out "Transport packet $i:\n";
556 0         0 $et->VerboseDump(\$buff, Len => $pLen, Addr => $i * $pLen, Start => $pos - $prePos);
557 0 0       0 my $str = $pidName{$pid} ? " ($pidName{$pid})" : ' ';
558 0 0       0 printf $out " Timecode: 0x%.4x\n", Get32u(\$buff, $pos - $prePos) if $pLen == 192;
559 0         0 printf $out " Packet ID: 0x%.4x$str\n", $pid;
560 0 0       0 printf $out " Start Flag: %s\n", $payload_unit_start_indicator ? 'Yes' : 'No';
561             }
562              
563 7         10 $pos += 4;
564             # handle adaptation field
565 7 100       10 if ($adaptation_field_exists) {
566 1         3 my $len = Get8u(\$buff, $pos++);
567 1 50       3 $pos + $len > $pEnd and $et->Warn('Invalid adaptation field length'), last;
568             # read PCR value for calculation of Duration
569 1 50       3 if ($len > 6) {
570 1         4 my $flags = Get8u(\$buff, $pos);
571 1 50       3 if ($flags & 0x10) { # PCR_flag
572             # combine 33-bit program_clock_reference_base and 9-bit extension
573 1         5 my $pcrBase = Get32u(\$buff, $pos + 1);
574 1         4 my $pcrExt = Get16u(\$buff, $pos + 5);
575             # ignore separate programs (PID's) and store just the
576             # first and last timestamps found in the file (is this OK?)
577 1         3 $endTime = 300 * (2 * $pcrBase + ($pcrExt >> 15)) + ($pcrExt & 0x01ff);
578 1 50       4 $startTime = $endTime unless defined $startTime;
579             }
580             }
581 1         1 $pos += $len;
582             }
583              
584             # all done with this packet unless it carries a payload
585             # or if we are just looking for the last timestamp
586 7 100 66     25 next unless $payload_data_exists and not defined $backScan;
587              
588             # decode payload data
589 6 100 100     46 if ($pid == 0 or # program association table
    50          
590             defined $pmt{$pid}) # program map table(s)
591             {
592             # must interpret pointer field if payload_unit_start_indicator is set
593 3         15 my $buf2;
594 3 50       6 if ($payload_unit_start_indicator) {
595             # skip to start of section
596 3         9 my $pointer_field = Get8u(\$buff, $pos);
597 3         4 $pos += 1 + $pointer_field;
598 3 50       8 $pos >= $pEnd and $et->Warn('Bad pointer field'), last;
599 3         6 $buf2 = substr($buff, $pEnd-$pLen, $pLen);
600 3         4 $pos -= $pEnd - $pLen;
601             } else {
602             # not the start of a section
603 0 0       0 next unless $sectLen{$pid};
604 0         0 my $more = $sectLen{$pid} - length($data{$pid});
605 0         0 my $size = $pLen - $pos;
606 0 0       0 $size = $more if $size > $more;
607 0         0 $data{$pid} .= substr($buff, $pos, $size);
608 0 0       0 next unless $size == $more;
609             # we have the complete section now, so put into $buf2 for parsing
610 0         0 $buf2 = $data{$pid};
611 0         0 $pos = 0;
612 0         0 delete $data{$pid};
613 0         0 delete $sectLen{$pid};
614             }
615 3         4 my $slen = length($buf2); # section length
616 3 50       8 $pos + 8 > $slen and $et->Warn('Truncated payload'), last;
617             # validate table ID
618 3         7 my $table_id = Get8u(\$buf2, $pos);
619 3   33     16 my $name = ($tableID{$table_id} || sprintf('Unknown (0x%x)',$table_id)) . ' Table';
620 3 100       8 my $expectedID = $pid ? 0x02 : 0x00;
621 3 100       6 unless ($table_id == $expectedID) {
622 1 50       3 $verbose > 1 and print $out " (skipping $name)\n";
623 1         2 delete $needPID{$pid};
624 1         2 $didPID{$pid} = 1;
625 1         2 next;
626             }
627             # validate section syntax indicator for parsed tables (PAT, PMT)
628 2         6 my $section_syntax_indicator = Get8u(\$buf2, $pos + 1) & 0xc0;
629 2 50       6 $section_syntax_indicator == 0x80 or $et->Warn("Bad $name"), last;
630 2         5 my $section_length = Get16u(\$buf2, $pos + 1) & 0x0fff;
631 2 50       5 $section_length > 1021 and $et->Warn("Invalid $name length"), last;
632 2 50       7 if ($slen < $section_length + 3) { # (3 bytes for table_id + section_length)
633             # must wait until we have the full section
634 0         0 $data{$pid} = substr($buf2, $pos);
635 0         0 $sectLen{$pid} = $section_length + 3;
636 0         0 next;
637             }
638 2         3 my $program_number = Get16u(\$buf2, $pos + 3);
639 2         6 my $section_number = Get8u(\$buf2, $pos + 6);
640 2         4 my $last_section_number = Get8u(\$buf2, $pos + 7);
641 2 50       7 if ($verbose > 1) {
642 0         0 print $out " $name length: $section_length\n";
643 0 0       0 print $out " Program No: $program_number\n" if $pid;
644 0 0       0 printf $out " Stream ID: 0x%x\n", $program_number if not $pid;
645 0         0 print $out " Section No: $section_number\n";
646 0         0 print $out " Last Sect.: $last_section_number\n";
647             }
648 2         4 my $end = $pos + $section_length + 3 - 4; # (don't read 4-byte CRC)
649 2         3 $pos += 8;
650 2 100       5 if ($pid == 0) {
651             # decode PAT (Program Association Table)
652 1         3 while ($pos <= $end - 4) {
653 2         5 my $program_number = Get16u(\$buf2, $pos);
654 2         3 my $program_map_PID = Get16u(\$buf2, $pos + 2) & 0x1fff;
655 2         5 $pmt{$program_map_PID} = $program_number; # save our PMT PID's
656 2         15 my $str = "Program $program_number Map";
657 2         3 $pidName{$program_map_PID} = $str;
658 2 50       6 $needPID{$program_map_PID} = 1 unless $didPID{$program_map_PID};
659 2 50       4 $verbose and printf $out " PID(0x%.4x) --> $str\n", $program_map_PID;
660 2         6 $pos += 4;
661             }
662             } else {
663             # decode PMT (Program Map Table)
664 1 50       3 $pos + 4 > $slen and $et->Warn('Truncated PMT'), last;
665 1         3 my $pcr_pid = Get16u(\$buf2, $pos) & 0x1fff;
666 1         4 my $program_info_length = Get16u(\$buf2, $pos + 2) & 0x0fff;
667 1         3 my $str = "Program $program_number Clock Reference";
668 1         3 $pidName{$pcr_pid} = $str;
669 1 50       2 $verbose and printf $out " PID(0x%.4x) --> $str\n", $pcr_pid;
670 1         3 $pos += 4;
671 1 50       3 $pos + $program_info_length > $slen and $et->Warn('Truncated program info'), last;
672             # dump program information descriptors if verbose
673 1 50       3 if ($verbose > 1) { for ($j=0; $j<$program_info_length-2; ) {
  0         0  
674 0         0 my $descriptor_tag = Get8u(\$buf2, $pos + $j);
675 0         0 my $descriptor_length = Get8u(\$buf2, $pos + $j + 1);
676 0         0 $j += 2;
677 0 0       0 last if $j + $descriptor_length > $program_info_length;
678 0         0 my $desc = substr($buf2, $pos+$j, $descriptor_length);
679 0         0 $j += $descriptor_length;
680 0         0 $desc =~ s/([\x00-\x1f\x80-\xff])/sprintf("\\x%.2x",ord $1)/eg;
  0         0  
681 0         0 printf $out " Program Descriptor: Type=0x%.2x \"$desc\"\n", $descriptor_tag;
682             }}
683 1         2 $pos += $program_info_length; # skip descriptors (for now)
684 1         10 while ($pos <= $end - 5) {
685 2         6 my $stream_type = Get8u(\$buf2, $pos);
686 2         5 my $elementary_pid = Get16u(\$buf2, $pos + 1) & 0x1fff;
687 2         7 my $es_info_length = Get16u(\$buf2, $pos + 3) & 0x0fff;
688 2         5 my $str = $streamType{$stream_type};
689 2 0       11 $str or $str = ($stream_type < 0x7f ? 'Reserved' : 'Private');
    50          
690 2         11 $str = sprintf('%s (0x%.2x)', $str, $stream_type);
691 2         5 $str = "Program $program_number $str";
692 2 50       5 $verbose and printf $out " PID(0x%.4x) --> $str\n", $elementary_pid;
693 2 50       17 if ($str =~ /(Audio|Video)/) {
694 2 50       12 unless ($pidName{$elementary_pid}) {
695 2         11 $et->HandleTag($tagTablePtr, $1 . 'StreamType', $stream_type)
696             }
697             # we want to parse all Audio and Video streams
698 2 50       5 $needPID{$elementary_pid} = 1 unless $didPID{$elementary_pid};
699             }
700             # save PID type and name string
701 2         5 $pidName{$elementary_pid} = $str;
702 2         4 $pidType{$elementary_pid} = $stream_type;
703 2         3 $pos += 5;
704 2 50       5 $pos + $es_info_length > $slen and $et->Warn('Truncated ES info'), $pos = $end, last;
705             # parse elementary stream descriptors
706 2         6 for ($j=0; $j<$es_info_length-2; ) {
707 3         8 my $descriptor_tag = Get8u(\$buf2, $pos + $j);
708 3         739 my $descriptor_length = Get8u(\$buf2, $pos + $j + 1);
709 3         5 $j += 2;
710 3 50       7 last if $j + $descriptor_length > $es_info_length;
711 3         7 my $desc = substr($buf2, $pos+$j, $descriptor_length);
712 3         3 $j += $descriptor_length;
713 3 50       6 if ($verbose > 1) {
714 0         0 my $dstr = $desc;
715 0         0 $dstr =~ s/([\x00-\x1f\x80-\xff])/sprintf("\\x%.2x",ord $1)/eg;
  0         0  
716 0         0 printf $out " ES Descriptor: Type=0x%.2x \"$dstr\"\n", $descriptor_tag;
717             }
718             # parse type-specific descriptor information (once)
719 3 50       6 unless ($didPID{$pid}) {
720 3 100       8 if ($descriptor_tag == 0x81) { # AC-3
721 1         4 ParseAC3Descriptor($et, \$desc);
722             }
723             }
724             }
725 2         6 $pos += $es_info_length;
726             }
727             }
728             # $pos = $end + 4; # skip CRC
729              
730             } elsif (not defined $didPID{$pid}) {
731              
732             # save data from the start of each elementary stream
733 3 100       6 if ($payload_unit_start_indicator) {
734 2 50       4 if (defined $data{$pid}) {
735             # we must have a whole section, so parse now
736 0         0 my $more = ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
737             # start fresh even if we couldn't process this PID yet
738 0         0 delete $data{$pid};
739 0 0       0 unless ($more) {
740 0         0 delete $needPID{$pid};
741 0         0 $didPID{$pid} = 1;
742 0         0 next;
743             }
744             # set flag indicating we found this PID but we still want more
745 0         0 $needPID{$pid} = -1;
746             }
747             # check for a PES header
748 2 50       5 next if $pos + 6 > $pEnd;
749 2         6 my $start_code = Get32u(\$buff, $pos);
750 2 50       5 next unless ($start_code & 0xffffff00) == 0x00000100;
751 2         3 my $stream_id = $start_code & 0xff;
752 2 50       3 if ($verbose > 1) {
753 0         0 my $pes_packet_length = Get16u(\$buff, $pos + 4);
754 0         0 printf $out " Stream ID: 0x%.2x\n", $stream_id;
755 0         0 print $out " Packet Len: $pes_packet_length\n";
756             }
757 2         3 $pos += 6;
758 2 50       5 unless ($noSyntax{$stream_id}) {
759 2 50       5 next if $pos + 3 > $pEnd;
760             # validate PES syntax
761 2         4 my $syntax = Get8u(\$buff, $pos) & 0xc0;
762 2 50       4 $syntax == 0x80 or $et->Warn('Bad PES syntax'), next;
763             # skip PES header
764 2         5 my $pes_header_data_length = Get8u(\$buff, $pos + 2);
765 2         3 $pos += 3 + $pes_header_data_length;
766 2 50       5 next if $pos >= $pEnd;
767             }
768 2         7 $data{$pid} = substr($buff, $pos, $pEnd-$pos);
769             } else {
770 1 50       3 unless (defined $data{$pid}) {
771             # (vsys a6l dashcam GPS record doesn't have a start indicator)
772 0 0       0 next unless $gpsPID{$pid};
773 0         0 $data{$pid} = '';
774             }
775             # accumulate data for each elementary stream
776 1         4 $data{$pid} .= substr($buff, $pos, $pEnd-$pos);
777             }
778             # save only the first 256 bytes of most streams, except for
779             # unknown or H.264 streams where we save 1 kB
780 3 100 66     11 my $saveLen = (not $pidType{$pid} or $pidType{$pid} == 0x1b) ? 1024 : 256;
781 3 50       7 if (length($data{$pid}) >= $saveLen) {
782 0         0 my $more = ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
783 0 0       0 next if $more < 0; # wait for program map table (hopefully not too long)
784 0         0 delete $data{$pid};
785 0 0       0 $more and $needPID{$pid} = -1, next; # parse more of these
786 0         0 delete $needPID{$pid};
787 0         0 $didPID{$pid} = 1;
788             }
789 3         4 next;
790             }
791 2 50       5 if ($needPID{$pid}) {
792             # we found and parsed a section with this PID, so
793             # delete from the lookup of PID's we still need to parse
794 2         4 delete $needPID{$pid};
795 2         4 $didPID{$pid} = 1;
796             }
797             }
798              
799             # calculate Duration if available
800 1 50       3 $endTime = $fwdTime unless defined $endTime;
801 1 50 33     6 if (defined $startTime and defined $endTime) {
802 1 50       2 $endTime += 0x80000000 * 1200 if $startTime > $endTime; # handle 33-bit wrap
803 1         4 $et->HandleTag($tagTablePtr, 'Duration', $endTime - $startTime);
804             }
805              
806 1 50       5 if ($verbose) {
807 0         0 my @need;
808 0         0 foreach (keys %needPID) {
809 0 0       0 push @need, sprintf('0x%.2x',$_) if $needPID{$_} > 0;
810             }
811 0 0       0 if (@need) {
812 0         0 @need = sort @need;
813 0         0 print $out "End of file. Missing PID(s): @need\n";
814             } else {
815 0 0       0 my $what = $eof ? 'of file' : 'scan';
816 0         0 print $out "End $what. All PID's parsed.\n";
817             }
818             }
819              
820             # parse any remaining partial PID streams
821 1         2 my $pid;
822 1         5 foreach $pid (sort keys %data) {
823 2         8 ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
824 2         6 delete $data{$pid};
825             }
826 1         7 return 1;
827             }
828              
829             1; # end
830              
831             __END__