File Coverage

blib/lib/Image/ExifTool/M2TS.pm
Criterion Covered Total %
statement 213 468 45.5
branch 91 302 30.1
condition 17 80 21.2
subroutine 7 7 100.0
pod 0 4 0.0
total 328 861 38.1


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             # 9) https://en.wikipedia.org/wiki/Program-specific_information
17             #
18             # Notes: Variable names containing underlines are the same as in ref 1.
19             #
20             # Glossary: PES = Packetized Elementary Stream
21             # PAT = Program Association Table
22             # PMT = Program Map Table
23             # PCR = Program Clock Reference
24             # PID = Packet Identifier
25             #
26             # To Do: - parse PCR to obtain average bitrates?
27             #------------------------------------------------------------------------------
28              
29             package Image::ExifTool::M2TS;
30              
31 1     1   12802 use strict;
  1         18  
  1         122  
32 1     1   9 use vars qw($VERSION);
  1         6  
  1         114  
33 1     1   10 use Image::ExifTool qw(:DataAccess :Utils);
  1         2  
  1         10619  
34              
35             $VERSION = '1.31';
36              
37             # program map table "stream_type" lookup (ref 6/1/9)
38             my %streamType = (
39             0x00 => 'Reserved',
40             0x01 => 'MPEG-1 Video',
41             0x02 => 'MPEG-2 Video',
42             0x03 => 'MPEG-1 Audio',
43             0x04 => 'MPEG-2 Audio',
44             0x05 => 'ISO 13818-1 private sections',
45             0x06 => 'ISO 13818-1 PES private data',
46             0x07 => 'ISO 13522 MHEG',
47             0x08 => 'ISO 13818-1 DSM-CC',
48             0x09 => 'ISO 13818-1 auxiliary',
49             0x0A => 'ISO 13818-6 multi-protocol encap',
50             0x0B => 'ISO 13818-6 DSM-CC U-N msgs',
51             0x0C => 'ISO 13818-6 stream descriptors',
52             0x0D => 'ISO 13818-6 sections',
53             0x0E => 'ISO 13818-1 auxiliary',
54             0x0F => 'MPEG-2 AAC Audio',
55             0x10 => 'MPEG-4 Video',
56             0x11 => 'MPEG-4 LATM AAC Audio',
57             0x12 => 'MPEG-4 generic',
58             0x13 => 'ISO 14496-1 SL-packetized',
59             0x14 => 'ISO 13818-6 Synchronized Download Protocol',
60             0x15 => 'Packetized metadata',
61             0x16 => 'Sectioned metadata',
62             0x17 => 'ISO/IEC 13818-6 DSM CC Data Carousel metadata',
63             0x18 => 'ISO/IEC 13818-6 DSM CC Object Carousel metadata',
64             0x19 => 'ISO/IEC 13818-6 Synchronized Download Protocol metadata',
65             0x1a => 'ISO/IEC 13818-11 IPMP',
66             0x1b => 'H.264 (AVC) Video',
67             0x1c => 'ISO/IEC 14496-3 (MPEG-4 raw audio)',
68             0x1d => 'ISO/IEC 14496-17 (MPEG-4 text)',
69             0x1e => 'ISO/IEC 23002-3 (MPEG-4 auxiliary video)',
70             0x1f => 'ISO/IEC 14496-10 SVC (MPEG-4 AVC sub-bitstream)',
71             0x20 => 'ISO/IEC 14496-10 MVC (MPEG-4 AVC sub-bitstream)',
72             0x21 => 'ITU-T Rec. T.800 and ISO/IEC 15444 (JPEG 2000 video)',
73             0x24 => 'H.265 (HEVC) Video', #PH
74             0x42 => 'Chinese Video Standard',
75             0x7f => 'ISO/IEC 13818-11 IPMP (DRM)',
76             0x80 => 'DigiCipher II Video',
77             0x81 => 'A52/AC-3 Audio',
78             0x82 => 'HDMV DTS Audio',
79             0x83 => 'LPCM Audio',
80             0x84 => 'SDDS Audio',
81             0x85 => 'ATSC Program ID',
82             0x86 => 'DTS-HD Audio',
83             0x87 => 'E-AC-3 Audio',
84             0x8a => 'DTS Audio',
85             0x90 => 'Presentation Graphic Stream (subtitle)', #https://en.wikipedia.org/wiki/Program-specific_information
86             0x91 => 'A52b/AC-3 Audio',
87             0x92 => 'DVD_SPU vls Subtitle',
88             0x94 => 'SDDS Audio',
89             0xa0 => 'MSCODEC Video',
90             0xea => 'Private ES (VC-1)',
91             # 0x80-0xFF => 'User Private',
92             );
93              
94             # "table_id" values (ref 5)
95             my %tableID = (
96             0x00 => 'Program Association',
97             0x01 => 'Conditional Access',
98             0x02 => 'Program Map',
99             0x03 => 'Transport Stream Description',
100             0x40 => 'Actual Network Information',
101             0x41 => 'Other Network Information',
102             0x42 => 'Actual Service Description',
103             0x46 => 'Other Service Description',
104             0x4a => 'Bouquet Association',
105             0x4e => 'Actual Event Information - Present/Following',
106             0x4f => 'Other Event Information - Present/Following',
107             0x50 => 'Actual Event Information - Schedule', #(also 0x51-0x5f)
108             0x60 => 'Other Event Information - Schedule', # (also 0x61-0x6f)
109             0x70 => 'Time/Date',
110             0x71 => 'Running Status',
111             0x72 => 'Stuffing',
112             0x73 => 'Time Offset',
113             0x7e => 'Discontinuity Information',
114             0x7f => 'Selection Information',
115             # 0x80-0xfe => 'User Defined',
116             );
117              
118             # PES stream ID's for which a syntax field does not exist
119             my %noSyntax = (
120             0xbc => 1, # program_stream_map
121             0xbe => 1, # padding_stream
122             0xbf => 1, # private_stream_2
123             0xf0 => 1, # ECM_stream
124             0xf1 => 1, # EMM_stream
125             0xf2 => 1, # DSMCC_stream
126             0xf8 => 1, # ITU-T Rec. H.222.1 type E stream
127             0xff => 1, # program_stream_directory
128             );
129              
130             my $knotsToKph = 1.852; # knots --> km/h
131              
132             # information extracted from the MPEG-2 transport stream
133             %Image::ExifTool::M2TS::Main = (
134             GROUPS => { 2 => 'Video' },
135             VARS => { ID_FMT => 'none' },
136             NOTES => q{
137             The MPEG-2 transport stream is used as a container for many different
138             audio/video formats (including AVCHD). This table lists information
139             extracted from M2TS files.
140             },
141             VideoStreamType => {
142             PrintHex => 1,
143             PrintConv => \%streamType,
144             SeparateTable => 'StreamType',
145             },
146             AudioStreamType => {
147             PrintHex => 1,
148             PrintConv => \%streamType,
149             SeparateTable => 'StreamType',
150             },
151             Duration => {
152             Notes => q{
153             the -fast option may be used to avoid scanning to the end of file to
154             calculate the Duration
155             },
156             ValueConv => '$val / 27000000', # (clock is 27MHz)
157             PrintConv => 'ConvertDuration($val)',
158             },
159             # the following tags are for documentation purposes only
160             _AC3 => { SubDirectory => { TagTable => 'Image::ExifTool::M2TS::AC3' } },
161             _H264 => { SubDirectory => { TagTable => 'Image::ExifTool::H264::Main' } },
162             _MISB => { SubDirectory => { TagTable => 'Image::ExifTool::MISB::Main' } },
163             );
164              
165             # information extracted from AC-3 audio streams
166             %Image::ExifTool::M2TS::AC3 = (
167             GROUPS => { 1 => 'AC3', 2 => 'Audio' },
168             VARS => { ID_FMT => 'none' },
169             NOTES => 'Tags extracted from AC-3 audio streams.',
170             AudioSampleRate => {
171             PrintConv => {
172             0 => '48000',
173             1 => '44100',
174             2 => '32000',
175             },
176             },
177             AudioBitrate => {
178             PrintConvColumns => 2,
179             ValueConv => {
180             0 => 32000,
181             1 => 40000,
182             2 => 48000,
183             3 => 56000,
184             4 => 64000,
185             5 => 80000,
186             6 => 96000,
187             7 => 112000,
188             8 => 128000,
189             9 => 160000,
190             10 => 192000,
191             11 => 224000,
192             12 => 256000,
193             13 => 320000,
194             14 => 384000,
195             15 => 448000,
196             16 => 512000,
197             17 => 576000,
198             18 => 640000,
199             32 => '32000 max',
200             33 => '40000 max',
201             34 => '48000 max',
202             35 => '56000 max',
203             36 => '64000 max',
204             37 => '80000 max',
205             38 => '96000 max',
206             39 => '112000 max',
207             40 => '128000 max',
208             41 => '160000 max',
209             42 => '192000 max',
210             43 => '224000 max',
211             44 => '256000 max',
212             45 => '320000 max',
213             46 => '384000 max',
214             47 => '448000 max',
215             48 => '512000 max',
216             49 => '576000 max',
217             50 => '640000 max',
218             },
219             PrintConv => 'ConvertBitrate($val)',
220             },
221             SurroundMode => {
222             PrintConv => {
223             0 => 'Not indicated',
224             1 => 'Not Dolby surround',
225             2 => 'Dolby surround',
226             },
227             },
228             AudioChannels => {
229             PrintConvColumns => 2,
230             PrintConv => {
231             0 => '1 + 1',
232             1 => 1,
233             2 => 2,
234             3 => 3,
235             4 => '2/1',
236             5 => '3/1',
237             6 => '2/2',
238             7 => '3/2',
239             8 => 1,
240             9 => '2 max',
241             10 => '3 max',
242             11 => '4 max',
243             12 => '5 max',
244             13 => '6 max',
245             },
246             },
247             );
248              
249             #------------------------------------------------------------------------------
250             # Extract information from AC-3 audio stream
251             # Inputs: 0) ExifTool ref, 1) data ref
252             # Reference: http://www.atsc.org/standards/a_52b.pdf
253             sub ParseAC3Audio($$)
254             {
255 1     1 0 3 my ($et, $dataPt) = @_;
256 1 50       10 if ($$dataPt =~ /\x0b\x77..(.)/sg) {
257 1         4 my $sampleRate = ord($1) >> 6;
258 1         4 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::AC3');
259 1         4 $et->HandleTag($tagTablePtr, AudioSampleRate => $sampleRate);
260             }
261             }
262              
263             #------------------------------------------------------------------------------
264             # Extract information from AC-3 stream descriptor
265             # Inputs: 0) ExifTool ref, 1) data ref
266             # Reference: http://www.atsc.org/standards/a_52b.pdf
267             # Note: This information is duplicated in the Audio stream, but it
268             # is somewhat easier to extract it from the descriptor instead
269             sub ParseAC3Descriptor($$)
270             {
271 1     1 0 4 my ($et, $dataPt) = @_;
272 1 50       6 return if length $$dataPt < 3;
273 1         21 my @v = unpack('C3', $$dataPt);
274 1         6 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::AC3');
275             # $et->HandleTag($tagTablePtr, 'AudioSampleRate', $v[0] >> 5);
276 1         10 $et->HandleTag($tagTablePtr, 'AudioBitrate', $v[1] >> 2);
277 1         7 $et->HandleTag($tagTablePtr, 'SurroundMode', $v[1] & 0x03);
278 1         7 $et->HandleTag($tagTablePtr, 'AudioChannels', ($v[2] >> 1) & 0x0f);
279             # don't (yet) decode any more (language codes, etc)
280             }
281              
282             #------------------------------------------------------------------------------
283             # Parse PID stream data
284             # Inputs: 0) ExifTool ref, 1) PID number, 2) PID type, 3) PID name, 4) data ref
285             # Returns: 0=stream parsed OK,
286             # 1=stream parsed but we want to parse more of these,
287             # -1=can't parse yet because we don't know the type
288             sub ParsePID($$$$$)
289             {
290 2     2 0 10 my ($et, $pid, $type, $pidName, $dataPt) = @_;
291             # can't parse until we know the type (Program Map Table may be later in the stream)
292 2 50       8 return -1 unless defined $type;
293 2         14 my $verbose = $et->Options('Verbose');
294 2 50       9 if ($verbose > 1) {
295 0         0 my $out = $et->Options('TextOut');
296 0         0 printf $out "Parsing stream 0x%.4x (%s) %d bytes\n", $pid, $pidName, length($$dataPt);
297 0         0 $et->VerboseDump($dataPt);
298             }
299 2         4 my $more = 0;
300 2 50 33     39 if ($type == 0x01 or $type == 0x02) {
    50 33        
    50 33        
    100 33        
    50 33        
    0          
    0          
301             # MPEG-1/MPEG-2 Video
302 0         0 require Image::ExifTool::MPEG;
303 0         0 Image::ExifTool::MPEG::ParseMPEGAudioVideo($et, $dataPt);
304             } elsif ($type == 0x03 or $type == 0x04) {
305             # MPEG-1/MPEG-2 Audio
306 0         0 require Image::ExifTool::MPEG;
307 0         0 Image::ExifTool::MPEG::ParseMPEGAudio($et, $dataPt);
308             } elsif ($type == 6 and $pid == 0x0300) {
309             # LIGOGPSINFO from unknown dashcam (../testpics/gps_video/Wrong Way pass.ts)
310 0 0       0 if ($$dataPt =~ /^LIGOGPSINFO/s) {
311 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
312 0         0 my %dirInfo = ( DataPt => $dataPt, DirName => 'Ligo0x0300' );
313 0         0 Image::ExifTool::LigoGPS::ProcessLigoGPS($et, \%dirInfo, $tbl, 1);
314 0         0 $$et{FoundGoodGPS} = 1;
315 0         0 $more = 1;
316             }
317             } elsif ($type == 0x1b) {
318             # H.264 Video
319 1         3588 require Image::ExifTool::H264;
320 1         12 $more = Image::ExifTool::H264::ParseH264Video($et, $dataPt);
321             # force parsing additional H264 frames with ExtractEmbedded option
322 1 50       10 if ($$et{OPTIONS}{ExtractEmbedded}) {
    50          
323 0         0 $more = 1;
324             } elsif (not $$et{OPTIONS}{Validate}) {
325 1         9 $et->Warn('The ExtractEmbedded option may find more tags in the video data',7);
326             }
327             } elsif ($type == 0x81 or $type == 0x87 or $type == 0x91) {
328             # AC-3 audio
329 1         4 ParseAC3Audio($et, $dataPt);
330             } elsif ($type == 0x15) {
331             # packetized metadata (look for MISB code starting after 5-byte header)
332 0 0       0 if ($$dataPt =~ /^.{5}\x06\x0e\x2b\x34/s) {
333 0         0 $more = Image::ExifTool::MISB::ParseMISB($et, $dataPt, GetTagTable('Image::ExifTool::MISB::Main'));
334 0 0       0 if (not $$et{OPTIONS}{ExtractEmbedded}) {
    0          
335 0         0 $more = 0; # extract from only the first packet unless ExtractEmbedded is used
336             } elsif ($$et{OPTIONS}{ExtractEmbedded} > 2) {
337 0         0 $more = 1; # read past unknown 0x15 packets if ExtractEmbedded > 2
338             }
339             }
340             # still have a lot of questions about how to decode this...
341             # (see https://exiftool.org/forum/index.php?topic=16486 and ../testpics/gps_video/forum16486.ts)
342             # } elsif ($type == 6) {
343             # my @a = unpack('x17x2NNx2nx2nx2nx2Cx2a4x2a5x2Nx2Nx2nx2Nx2Nx2Nx2nx2nx2Nx2nx2n', $$dataPt . " ");
344             # my $hi = shift @a;
345             # $a[0] = Image::ExifTool::ConvertUnixTime(($a[0] + $hi * 4294967296) * 1e-6, undef, 6);
346             # print "@a\n";
347             # $more = 1;
348             } elsif ($type < 0) {
349 0 0 0     0 if ($$dataPt =~ /^(.{164})?(.{24})A[NS][EW]/s) {
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
350             # (Blueskysea B4K, Novatek NT96670)
351             # 0000: 01 00 ff 00 30 31 32 33 34 35 37 38 61 62 63 64 [....01234578abcd]
352             # 0010: 65 66 67 0a 00 00 00 00 00 00 00 00 00 00 00 00 [efg.............]
353             # 0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
354             # 0030: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
355             # 0040: 00 00 00 00 30 31 32 33 34 35 37 38 71 77 65 72 [....01234578qwer]
356             # 0050: 74 79 75 69 6f 70 0a 00 00 00 00 00 00 00 00 00 [tyuiop..........]
357             # 0060: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
358             # 0070: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
359             # 0080: 00 00 00 00 63 38 61 61 32 35 63 66 34 35 65 65 [....c8aa25cf45ee]
360             # 0090: 61 39 65 32 34 34 32 66 61 65 62 35 65 30 39 39 [a9e2442faeb5e099]
361             # 00a0: 30 37 64 34 15 00 00 00 10 00 00 00 1b 00 00 00 [07d4............]
362             # 00b0: 15 00 00 00 01 00 00 00 09 00 00 00 41 4e 57 00 [............ANW.]
363             # 00c0: 82 9a 57 45 98 b2 00 46 66 66 e4 41 d7 e3 14 43 [..WE...Fff.A...C]
364             # 00d0: 01 00 02 00 03 00 04 00 05 00 06 00 [............]
365             # (Viofo A119V3)
366             # 0000: 08 00 00 00 07 00 00 00 18 00 00 00 15 00 00 00 [................]
367             # 0010: 03 00 00 00 0b 00 00 00 41 4e 45 00 01 f2 ac 45 [........ANE....E]
368             # 0020: 2d 7f 6e 45 b8 1e 97 41 d7 23 46 43 00 00 00 00 [-.nE...A.#FC....]
369             # pad with dummy header and parse with existing FreeGPS code (minimum 92 bytes)
370 0   0     0 my $dat = ("\0" x 16) . substr($$dataPt, length($1 || '')) . ("\0" x 20);
371 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
372 0         0 Image::ExifTool::QuickTime::ProcessFreeGPS($et, { DataPt => \$dat }, $tbl);
373 0         0 $more = 1;
374             } elsif ($$dataPt =~ /^(V00|A([NS])([EW]))\0/s) {
375             # INNOVV TS video (same format as INNOVV MP4)
376 0         0 SetByteOrder('II');
377 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
378 0         0 while ($$dataPt =~ /((V00|A[NS][EW])\0.{28})/g) {
379 0         0 my $dat = $1;
380 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
381 0 0       0 if ($2 ne 'V00') {
382 0         0 my $lat = abs(GetFloat(\$dat, 4)); # (abs just to be safe)
383 0         0 my $lon = abs(GetFloat(\$dat, 8)); # (abs just to be safe)
384 0         0 my $spd = GetFloat(\$dat, 12) * $knotsToKph;
385 0         0 my $trk = GetFloat(\$dat, 16);
386 0         0 Image::ExifTool::QuickTime::ConvertLatLon($lat, $lon);
387 0 0       0 $et->HandleTag($tagTbl, GPSLatitude => abs($lat) * (substr($dat,1,1) eq 'S' ? -1 : 1));
388 0 0       0 $et->HandleTag($tagTbl, GPSLongitude => abs($lon) * (substr($dat,2,1) eq 'W' ? -1 : 1));
389 0         0 $et->HandleTag($tagTbl, GPSSpeed => $spd);
390 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
391 0         0 $et->HandleTag($tagTbl, GPSTrack => $trk);
392 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
393             }
394 0         0 my @acc = unpack('x20V3', $dat);
395 0 0       0 map { $_ = $_ - 4294967296 if $_ >= 0x80000000 } @acc;
  0         0  
396 0         0 $et->HandleTag($tagTbl, Accelerometer => "@acc");
397             }
398 0         0 SetByteOrder('MM');
399 0         0 $$et{FoundGoodGPS} = 1; # (necessary to skip over empty/unknown INNOV records)
400 0         0 $more = 1;
401             } elsif ($$dataPt =~ /^\$(GPSINFO|GSNRINFO),/) {
402             # $GPSINFO,0x0004,2021.08.09 13:27:36,2341.54561,12031.70135,8.0,51,153,0,0,\x0d
403             # $GSNRINFO,0.01,0.04,0.25\0
404 0         0 $$dataPt =~ tr/\x0d/\x0a/;
405 0         0 $$dataPt =~ tr/\0//d;
406 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
407 0         0 my @lines = split /\x0a/, $$dataPt;
408 0         0 my ($line, $lastTime);
409 0         0 foreach $line (@lines) {
410 0 0       0 if ($line =~ /^\$GPSINFO/) {
    0          
411 0         0 my @a = split /,/, $lines[0];
412 0 0       0 next unless @a > 7;
413             # ignore duplicate fixes
414 0 0 0     0 next if $lastTime and $a[2] eq $lastTime;
415 0         0 $lastTime = $a[2];
416 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
417 0         0 $a[2] =~ tr/./:/;
418             # (untested, and probably doesn't work for S/W hemispheres)
419 0         0 my ($lat, $lon) = @a[3,4];
420 0         0 Image::ExifTool::QuickTime::ConvertLatLon($lat, $lon);
421             # $a[0] - flags? values: '0x0001','0x0004','0x0008','0x0010'
422 0         0 $et->HandleTag($tagTbl, GPSDateTime => $a[2]);
423 0         0 $et->HandleTag($tagTbl, GPSLatitude => $lat);
424 0         0 $et->HandleTag($tagTbl, GPSLongitude => $lon);
425 0         0 $et->HandleTag($tagTbl, GPSSpeed => $a[5]);
426 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
427             # $a[6] - values: 48-60
428 0         0 $et->HandleTag($tagTbl, GPSTrack => $a[7]);
429 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
430             # #a[8,9] - always 0
431             } elsif ($line =~ /^\$GSNRINFO/) {
432 0         0 my @a = split /,/, $line;
433 0         0 shift @a;
434 0         0 $et->HandleTag($tagTbl, Accelerometer => "@a");
435             }
436             }
437 0         0 $more = 1;
438             } elsif ($$dataPt =~ /\$GPRMC,/) {
439             # Jomise T860S-GM dashcam
440             # $GPRMC,hhmmss.ss,A,ddmm.mmmmm,N,dddmm.mmmmm,W,spd-kts,dir-dg,DDMMYY,,M*cs - lat,lon,spd from video
441             # $GPRMC,172255.00,A,:985.95194,N,17170.14674,W,029.678,170.68,240822,,,D*7B - N47.70428,W122.15338,35mph
442             # $GPRMC,192643.00,A,:987.94979,N,17171.07268,W,010.059,079.61,111122,,,A*73 - N47.71862,W122.16437,12mph
443             # $GPRMC,192743.00,A,:988.72110,N,17171.04873,W,017.477,001.03,111122,,,A*78 - N47.72421,W122.16408,20mph
444             # $GPRMC,192844.00,A,:989.43771,N,17171.03538,W,016.889,001.20,111122,,,A*7B - N47.72932,W122.16393,19mph
445             # $GPRMC,005241.00,A,:987.70873,N,17171.81293,W,000.284,354.78,141122,,,A*7F - N47.71687,W122.17318,0mph
446             # $GPRMC,005341.00,A,:987.90851,N,17171.85380,W,000.080,349.36,141122,,,A*7C - N47.71832,W122.17367,0mph
447             # $GPRMC,005441.00,A,:987.94538,N,17171.21783,W,029.686,091.09,141122,,,A*7A - N47.71859,W122.16630,35mph
448             # $GPRMC,002816.00,A,6820.67273,N,13424.26599,W,000.045,000.00,261122,,,A*79 - N29.52096,W95.55953,0mph (seattle)
449             # $GPRMC,035136.00,A,:981.47322,N,17170.14105,W,024.594,180.50,291122,,,D*79 - N47.67180,W122.15328,28mph
450 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
451 0   0     0 while ($$dataPt =~ /\$[A-Z]{2}RMC,(\d{2})(\d{2})(\d+(\.\d*)?),A?,(.{2})(\d{2}\.\d+),([NS]),(.{3})(\d{2}\.\d+),([EW]),(\d*\.?\d*),(\d*\.?\d*),(\d{2})(\d{2})(\d+)/g and
      0        
      0        
452             # do some basic sanity checks on the date
453             $13 <= 31 and $14 <= 12 and $15 <= 99)
454             {
455 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
456 0 0       0 my $year = $15 + ($15 >= 70 ? 1900 : 2000);
457 0         0 $et->HandleTag($tagTbl, GPSDateTime => sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2dZ', $year, $14, $13, $1, $2, $3));
458             #(not this simple)
459             #$et->HandleTag($tagTbl, GPSLatitude => (($5 || 0) + $6/60) * ($7 eq 'N' ? 1 : -1));
460             #$et->HandleTag($tagTbl, GPSLongitude => (($8 || 0) + $9/60) * ($10 eq 'E' ? 1 : -1));
461 0 0       0 $et->HandleTag($tagTbl, GPSSpeed => $11 * $knotsToKph) if length $11;
462 0 0       0 $et->HandleTag($tagTbl, GPSTrack => $12) if length $12;
463             # it looks like maybe the degrees are xor-ed with something,
464             # and the minutes have some scaling factor and offset?
465             # (the code below is approximately correct for my only sample)
466 0         0 my @chars = unpack('C*', $5 . $8);
467 0         0 my @xor = (0x0e,0x0e,0x00,0x05,0x03); # (empirical based on 1 sample; may be completely off base)
468 0         0 my $bad;
469 0         0 foreach (@chars) {
470 0         0 $_ ^= shift(@xor);
471 0 0 0     0 $bad = 1 if $_ < 0x30 or $_ > 0x39;
472             }
473 0 0       0 if ($bad) {
474 0         0 $et->Warn('Error decrypting GPS degrees');
475             } else {
476 0         0 my $la = pack('C*', @chars[0,1]);
477 0         0 my $lo = pack('C*', @chars[2,3,4]);
478 0         0 $et->Warn('Decryption of this GPS is highly experimental. More testing samples are required');
479 0 0 0     0 $et->HandleTag($tagTbl, GPSLatitude => (($la || 0) + (($6-85.95194)/2.43051724137931+42.2568)/60) * ($7 eq 'N' ? 1 : -1));
480 0 0 0     0 $et->HandleTag($tagTbl, GPSLongitude => (($lo || 0) + (($9-70.14674)/1.460987654320988+9.2028)/60) * ($10 eq 'E' ? 1 : -1));
481             }
482             }
483             } elsif ($$dataPt =~ /\$GSENSORD,\s*(\d+),\s*(\d+),\s*(\d+),/) {
484             # Jomise T860S-GM dashcam
485 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
486 0         0 $$et{DOC_NUM} = $$et{DOC_COUNT};
487 0         0 $et->HandleTag($tagTbl, Accelerometer => "$1 $2 $3"); # (NC - values range from 0 to 6)
488             } elsif ($$dataPt =~ /^.{44}A\0{3}.{4}([NS])\0{3}.{4}([EW])\0{3}/s and length($$dataPt) >= 84) {
489             #forum11320
490 0         0 SetByteOrder('II');
491 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
492 0         0 my $lat = abs(GetFloat($dataPt, 48)); # (abs just to be safe)
493 0         0 my $lon = abs(GetFloat($dataPt, 56)); # (abs just to be safe)
494 0         0 my $spd = GetFloat($dataPt, 64);
495 0         0 my $trk = GetFloat($dataPt, 68);
496 0         0 $et->Warn('GPSLatitude/Longitude encryption is not yet known, so these will be wrong');
497 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
498 0         0 my @date = unpack('x32V3x28V3', $$dataPt);
499 0         0 $date[3] += 2000;
500 0         0 $et->HandleTag($tagTbl, GPSDateTime => sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2d', @date[3..5,0..2]));
501 0 0       0 $et->HandleTag($tagTbl, GPSLatitude => abs($lat) * ($1 eq 'S' ? -1 : 1));
502 0 0       0 $et->HandleTag($tagTbl, GPSLongitude => abs($lon) * ($2 eq 'W' ? -1 : 1));
503 0         0 $et->HandleTag($tagTbl, GPSSpeed => $spd);
504 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
505 0         0 $et->HandleTag($tagTbl, GPSTrack => $trk);
506 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
507 0         0 SetByteOrder('MM');
508 0         0 $more = 1;
509             } elsif (length($$dataPt) >= 64 and substr($$dataPt, 32, 2) eq '$S') {
510             # DOD_LS600W.TS
511 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
512             # find the earliest sample time in the cyclical list
513 0         0 my ($n, $last) = (32, "\0");
514 0         0 for (my $i=32; $i
515 0 0       0 last unless substr($$dataPt, $n, 2) eq '$S';
516 0         0 my $dateTime = substr($$dataPt, $i+6, 8);
517 0 0       0 $last gt $dateTime and $n = $i, last; # earliest sample if time goes backwards
518 0         0 $last = $dateTime;
519             }
520 0         0 for (my $i=32; $i
521 0 0       0 $n = 32 if $n > length($$dataPt)-32;
522 0 0       0 last unless substr($$dataPt, $n, 2) eq '$S';
523 0         0 my @a = unpack("x${n}nnnnCCCCnCNNC", $$dataPt);
524 0         0 $a[8] /= 10; # 1/10 sec
525 0 0       0 $a[2] += (36000 - 65536) if $a[2] & 0x8000; # convert signed integer into range 0-36000
526 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
527 0         0 $et->HandleTag($tagTbl, GPSDateTime => sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%04.1fZ', @a[3..8]));
528 0         0 $et->HandleTag($tagTbl, GPSLatitude => $a[10] * 1e-7);
529 0         0 $et->HandleTag($tagTbl, GPSLongitude => $a[11] * 1e-7);
530 0         0 $et->HandleTag($tagTbl, GPSSpeed => $a[1] * 0.036); # convert from metres per 100 s
531 0         0 $et->HandleTag($tagTbl, GPSTrack => $a[2] / 100);
532             }
533             # Note: 10 bytes after last GPS record look like a single 3-axis accelerometer reading:
534             # eg. fd ff 00 00 ff ff 00 00 01 00
535 0         0 $$et{FoundGoodGPS} = 1; # so we skip over unrecognized packets
536 0         0 $more = 1;
537             } elsif ($$dataPt =~ /^skip.{4}LIGOGPSINFO\0/s) {
538             # (this record contains 2 copies of the same 'skip' atom in my sample --
539             # only extract data from the first one)
540 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
541 0         0 my %dirInfo = ( DataPt => $dataPt, DirStart => 8, DirName => sprintf('Ligo0x%.4x',$pid));
542 0         0 Image::ExifTool::LigoGPS::ProcessLigoGPS($et, \%dirInfo, $tbl, 1);
543 0         0 $$et{FoundGoodGPS} = 1;
544             } elsif ($$et{FoundGoodGPS}) {
545 0         0 $more = 1;
546             }
547 0         0 delete $$et{DOC_NUM};
548             }
549 2         4 return $more;
550             }
551              
552             #------------------------------------------------------------------------------
553             # Extract information from a M2TS file
554             # Inputs: 0) ExifTool object reference, 1) DirInfo reference
555             # Returns: 1 on success, 0 if this wasn't a valid M2TS file
556             sub ProcessM2TS($$)
557             {
558 1     1 0 3 my ($et, $dirInfo) = @_;
559 1         5 my $raf = $$dirInfo{RAF};
560 1         6 my ($buff, $j, $eof, $pLen, $readSize);
561 1         0 my (%pmt, %pidType, %data, %sectLen, %packLen, %fromStart);
562 1         0 my ($startTime, $endTime, $fwdTime, $backScan, $maxBack);
563 1         8 my $verbose = $et->Options('Verbose');
564 1         6 my $out = $et->Options('TextOut');
565              
566             # read enough to guarantee 2 sync bytes
567 1 50       9 return 0 unless $raf->Read($buff, 383) == 383;
568             # test for magic number (sync byte is the only thing we can safely check)
569 1 50       12 return 0 unless $buff =~ /^(.{0,190}?)\x47(.{187}|.{191})\x47/s;
570 1         9 my $tcLen = length($2) - 187; # (length of timecode = 0 or 4 bytes)
571 1         5 my $start = length($1) - $tcLen;
572             # we may need to try the validation twice to handle the edge case
573             # where the first byte of a timecode is 0x47 and we were fooled
574             # into thinking there was no timecode
575 1         2 Try: for (;;) {
576 1 50       5 $start += 192 if $start < 0; # (if all or part of first timecode was missing)
577 1         3 $pLen = 188 + $tcLen;
578 1         3 $readSize = 64 * $pLen; # size of our read buffer
579 1         7 $raf->Seek($start, 0); # rewind to start
580 1 50       4 $raf->Read($buff, $readSize) >= $pLen * 4 or return 0; # require at least 4 packets
581             # validate the sync byte in the next 3 packets
582 1         16 for ($j=1; $j<4; ++$j) {
583 3 50       19 next if substr($buff, $tcLen + $pLen * $j, 1) eq 'G'; # (0x47)
584 0 0       0 return 0 if $tcLen;
585 0         0 $tcLen = 4;
586 0         0 $start -= 4;
587 0         0 next Try;
588             }
589 1         2 last; # success!
590             }
591             # (use M2T instead of M2TS just as an indicator that there is no timecode)
592 1 50       13 $et->SetFileType($tcLen ? 'M2TS' : 'M2T');
593 1 50       4 $et->Warn("File doesn't begin with the start of a packet") if $start;
594 1         7 SetByteOrder('MM');
595 1         23 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::Main');
596              
597             # PID lookup strings (will add to this with entries from program map table)
598 1         8 my %pidName = (
599             0 => 'Program Association Table',
600             1 => 'Conditional Access Table',
601             2 => 'Transport Stream Description Table',
602             0x1fff => 'Null Packet',
603             );
604 1         5 my %didPID = ( 1 => 0, 2 => 0, 0x1fff => 0 );
605 1         5 my %needPID = ( 0 => 1 ); # lookup for stream PID's that we still need to parse
606             # PID's that may contain GPS info
607 1         7 my %gpsPID = (
608             0x0300 => 1, # Novatek INNOVV, DOD_LS600W
609             0x01e4 => 1, # vsys a6l dashcam
610             0x0e1b => 1, # Jomise T860S-GM dashcam GPS
611             0x0e1a => 1, # Jomise T860S-GM dashcam accelerometer
612             );
613 1         2 my $pEnd = 0;
614              
615             # scan entire file for GPS programs if ExtractEmbedded option is 3 or higher
616             # (some dashcams write these programs but don't include it in the PMT)
617 1 50 50     6 if (($et->Options('ExtractEmbedded') || 0) > 2) {
618 0         0 foreach (keys %gpsPID) {
619 0         0 $needPID{$_} = 1;
620 0         0 $pidType{$_} = -1;
621 0         0 $pidName{$_} ='unregistered dashcam GPS';
622             }
623             }
624              
625             # parse packets from MPEG-2 Transport Stream
626 1         2 for (;;) {
627              
628 8 50       21 unless (%needPID) {
629 0 0       0 last unless defined $startTime;
630             # reconfigure to seek backwards for last PCR
631 0 0       0 unless (defined $backScan) {
632 0         0 my $saveTime = $endTime;
633 0         0 undef $endTime;
634 0 0       0 last if $et->Options('FastScan');
635 0 0       0 $verbose and print $out "[Starting backscan for last PCR]\n";
636             # remember how far we got when reading forward through the file
637 0         0 my $fwdPos = $raf->Tell() - length($buff) + $pEnd;
638             # determine the position of the last packet relative to the EOF
639 0 0       0 $raf->Seek(0, 2) or last;
640 0         0 my $fsize = $raf->Tell();
641 0         0 $backScan = int($fsize / $pLen) * $pLen - $fsize;
642             # set limit on how far back we will go
643 0         0 $maxBack = $fwdPos - $fsize;
644             # scan back a maximum of 512k (have seen last PCR at -276k)
645 0         0 my $nMax = int(512000 / $pLen); # max packets to backscan
646 0 0       0 if ($nMax < int(-$maxBack / $pLen)) {
647 0         0 $maxBack = $backScan - $nMax * $pLen;
648             } else {
649             # use this time if none found in all remaining packets
650 0         0 $fwdTime = $saveTime;
651             }
652 0         0 $pEnd = 0;
653             }
654             }
655 8         14 my $pos;
656             # read more if necessary
657 8 50       19 if (defined $backScan) {
658 0 0       0 last if defined $endTime;
659 0         0 $pos = $pEnd = $pEnd - 2 * $pLen; # step back to previous packet
660 0 0       0 if ($pos < 0) {
661             # read another buffer from end of file
662 0 0       0 last if $backScan <= $maxBack;
663 0         0 my $buffLen = $backScan - $maxBack;
664 0 0       0 $buffLen = $readSize if $buffLen > $readSize;
665 0         0 $backScan -= $buffLen;
666 0 0       0 $raf->Seek($backScan, 2) or last;
667 0 0       0 $raf->Read($buff, $buffLen) == $buffLen or last;
668 0         0 $pos = $pEnd = $buffLen - $pLen;
669             }
670             } else {
671 8         14 $pos = $pEnd;
672 8 100       24 if ($pos + $pLen > length $buff) {
673 1 50       12 $raf->Read($buff, $readSize) >= $pLen or $eof = 1, last;
674 0         0 $pos = $pEnd = 0;
675             }
676             }
677 7         13 $pEnd += $pLen;
678             # decode the packet prefix
679 7         12 $pos += $tcLen;
680 7         26 my $prefix = unpack("x${pos}N", $buff); # (use unpack instead of Get32u for speed)
681             # validate sync byte
682 7 50       21 unless (($prefix & 0xff000000) == 0x47000000) {
683 0 0       0 $et->Warn('M2TS synchronization error') unless defined $backScan;
684 0         0 last;
685             }
686             # my $transport_error_indicator = $prefix & 0x00800000;
687 7         13 my $payload_unit_start_indicator = $prefix & 0x00400000;
688             # my $transport_priority = $prefix & 0x00200000;
689 7         15 my $pid =($prefix & 0x001fff00) >> 8; # packet ID
690             # my $transport_scrambling_control = $prefix & 0x000000c0;
691 7         14 my $adaptation_field_exists = $prefix & 0x00000020;
692 7         10 my $payload_data_exists = $prefix & 0x00000010;
693             # my $continuity_counter = $prefix & 0x0000000f;
694 7 50       32 if ($verbose > 1) {
695 0         0 my $i = ($raf->Tell() - length($buff) + $pEnd) / $pLen - 1;
696 0         0 print $out "Transport packet $i:\n";
697 0         0 $et->VerboseDump(\$buff, Len => $pLen, Addr => $i * $pLen, Start => $pos - $tcLen);
698 0 0       0 my $str = $pidName{$pid} ? " ($pidName{$pid})" : ' ';
699 0 0       0 printf $out " Timecode: 0x%.4x\n", Get32u(\$buff, $pos - $tcLen) if $pLen == 192;
700 0         0 printf $out " Packet ID: 0x%.4x$str\n", $pid;
701 0 0       0 printf $out " Start Flag: %s\n", $payload_unit_start_indicator ? 'Yes' : 'No';
702             }
703              
704 7         12 $pos += 4;
705             # handle adaptation field
706 7 100       16 if ($adaptation_field_exists) {
707 1         6 my $len = Get8u(\$buff, $pos++);
708 1 50       9 $pos + $len > $pEnd and $et->Warn('Invalid adaptation field length'), last;
709             # read PCR value for calculation of Duration
710 1 50       5 if ($len > 6) {
711 1         39 my $flags = Get8u(\$buff, $pos);
712 1 50       5 if ($flags & 0x10) { # PCR_flag
713             # combine 33-bit program_clock_reference_base and 9-bit extension
714 1         8 my $pcrBase = Get32u(\$buff, $pos + 1);
715 1         17 my $pcrExt = Get16u(\$buff, $pos + 5);
716             # ignore separate programs (PID's) and store just the
717             # first and last timestamps found in the file (is this OK?)
718 1         7 $endTime = 300 * (2 * $pcrBase + ($pcrExt >> 15)) + ($pcrExt & 0x01ff);
719 1 50       4 $startTime = $endTime unless defined $startTime;
720             }
721             }
722 1         3 $pos += $len;
723             }
724              
725             # all done with this packet unless it carries a payload
726             # or if we are just looking for the last timestamp
727 7 100 66     30 next unless $payload_data_exists and not defined $backScan;
728              
729             # decode payload data
730 6 100 100     39 if ($pid == 0 or # program association table
    50          
731             defined $pmt{$pid}) # program map table(s)
732             {
733             # must interpret pointer field if payload_unit_start_indicator is set
734 3         5 my $buf2;
735 3 50       8 if ($payload_unit_start_indicator) {
736             # skip to start of section
737 3         13 my $pointer_field = Get8u(\$buff, $pos);
738 3         11 $pos += 1 + $pointer_field;
739 3 50       18 $pos >= $pEnd and $et->Warn('Bad pointer field'), last;
740 3         13 $buf2 = substr($buff, $pEnd-$pLen, $pLen);
741 3         34 $pos -= $pEnd - $pLen;
742             } else {
743             # not the start of a section
744 0 0       0 next unless $sectLen{$pid};
745 0         0 my $more = $sectLen{$pid} - length($data{$pid});
746 0         0 my $size = $pLen - $pos;
747 0 0       0 $size = $more if $size > $more;
748 0         0 $data{$pid} .= substr($buff, $pos, $size);
749 0 0       0 next unless $size == $more;
750             # we have the complete section now, so put into $buf2 for parsing
751 0         0 $buf2 = $data{$pid};
752 0         0 $pos = 0;
753 0         0 delete $data{$pid};
754 0         0 delete $fromStart{$pid};
755 0         0 delete $sectLen{$pid};
756             }
757 3         7 my $slen = length($buf2); # section length
758 3 50       12 $pos + 8 > $slen and $et->Warn('Truncated payload'), last;
759             # validate table ID
760 3         10 my $table_id = Get8u(\$buf2, $pos);
761 3   33     18 my $name = ($tableID{$table_id} || sprintf('Unknown (0x%x)',$table_id)) . ' Table';
762 3 100       9 my $expectedID = $pid ? 0x02 : 0x00;
763 3 100       10 unless ($table_id == $expectedID) {
764 1 50       9 $verbose > 1 and print $out " (skipping $name)\n";
765 1         5 delete $needPID{$pid};
766 1         3 $didPID{$pid} = 1;
767 1         5 next;
768             }
769             # validate section syntax indicator for parsed tables (PAT, PMT)
770 2         12 my $section_syntax_indicator = Get8u(\$buf2, $pos + 1) & 0xc0;
771 2 50       8 $section_syntax_indicator == 0x80 or $et->Warn("Bad $name"), last;
772 2         7 my $section_length = Get16u(\$buf2, $pos + 1) & 0x0fff;
773 2 50       7 $section_length > 1021 and $et->Warn("Invalid $name length"), last;
774 2 50       40 if ($slen < $section_length + 3) { # (3 bytes for table_id + section_length)
775             # must wait until we have the full section
776 0         0 $data{$pid} = substr($buf2, $pos);
777 0         0 $sectLen{$pid} = $section_length + 3;
778 0         0 next;
779             }
780 2         9 my $program_number = Get16u(\$buf2, $pos + 3);
781 2         8 my $section_number = Get8u(\$buf2, $pos + 6);
782 2         6 my $last_section_number = Get8u(\$buf2, $pos + 7);
783 2 50       7 if ($verbose > 1) {
784 0         0 print $out " $name length: $section_length\n";
785 0 0       0 print $out " Program No: $program_number\n" if $pid;
786 0 0       0 printf $out " Stream ID: 0x%x\n", $program_number if not $pid;
787 0         0 print $out " Section No: $section_number\n";
788 0         0 print $out " Last Sect.: $last_section_number\n";
789             }
790 2         5 my $end = $pos + $section_length + 3 - 4; # (don't read 4-byte CRC)
791 2         6 $pos += 8;
792 2 100       7 if ($pid == 0) {
793             # decode PAT (Program Association Table)
794 1         5 while ($pos <= $end - 4) {
795 2         5 my $program_number = Get16u(\$buf2, $pos);
796 2         5 my $program_map_PID = Get16u(\$buf2, $pos + 2) & 0x1fff;
797 2         8 $pmt{$program_map_PID} = $program_number; # save our PMT PID's
798 2         5 my $str = "Program $program_number Map";
799 2         5 $pidName{$program_map_PID} = $str;
800 2 50       9 $needPID{$program_map_PID} = 1 unless $didPID{$program_map_PID};
801 2 50       18 $verbose and printf $out " PID(0x%.4x) --> $str\n", $program_map_PID;
802 2         10 $pos += 4;
803             }
804             } else {
805             # decode PMT (Program Map Table)
806 1 50       26 $pos + 4 > $slen and $et->Warn('Truncated PMT'), last;
807 1         4 my $pcr_pid = Get16u(\$buf2, $pos) & 0x1fff;
808 1         5 my $program_info_length = Get16u(\$buf2, $pos + 2) & 0x0fff;
809 1         4 my $str = "Program $program_number Clock Reference";
810 1         4 $pidName{$pcr_pid} = $str;
811 1 50       6 $verbose and printf $out " PID(0x%.4x) --> $str\n", $pcr_pid;
812 1         2 $pos += 4;
813 1 50       5 $pos + $program_info_length > $slen and $et->Warn('Truncated program info'), last;
814             # dump program information descriptors if verbose
815 1 50       6 if ($verbose > 1) { for ($j=0; $j<$program_info_length-2; ) {
  0         0  
816 0         0 my $descriptor_tag = Get8u(\$buf2, $pos + $j);
817 0         0 my $descriptor_length = Get8u(\$buf2, $pos + $j + 1);
818 0         0 $j += 2;
819 0 0       0 last if $j + $descriptor_length > $program_info_length;
820 0         0 my $desc = substr($buf2, $pos+$j, $descriptor_length);
821 0         0 $j += $descriptor_length;
822 0         0 $desc =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%.2x",ord $1)/eg;
  0         0  
823 0         0 printf $out " Program Descriptor: Type=0x%.2x \"$desc\"\n", $descriptor_tag;
824             }}
825 1         2 $pos += $program_info_length; # skip descriptors (for now)
826 1         4 while ($pos <= $end - 5) {
827 2         8 my $stream_type = Get8u(\$buf2, $pos);
828 2         7 my $elementary_pid = Get16u(\$buf2, $pos + 1) & 0x1fff;
829 2         8 my $es_info_length = Get16u(\$buf2, $pos + 3) & 0x0fff;
830 2         9 my $str = $streamType{$stream_type};
831 2 0       8 $str or $str = ($stream_type < 0x7f ? 'Reserved' : 'Private');
    50          
832 2         18 $str = sprintf('%s (0x%.2x)', $str, $stream_type);
833 2         8 $str = "Program $program_number $str";
834 2 50       7 $verbose and printf $out " PID(0x%.4x) --> $str\n", $elementary_pid;
835 2 50       38 if ($str =~ /(Audio|Video)/) {
836 2 50       9 unless ($pidName{$elementary_pid}) {
837 2         21 $et->HandleTag($tagTablePtr, $1 . 'StreamType', $stream_type)
838             }
839             # we want to parse all Audio and Video streams
840 2 50       14 $needPID{$elementary_pid} = 1 unless $didPID{$elementary_pid};
841             }
842             # save PID type and name string
843 2         8 $pidName{$elementary_pid} = $str;
844 2         5 $pidType{$elementary_pid} = $stream_type;
845 2         4 $pos += 5;
846 2 50       9 $pos + $es_info_length > $slen and $et->Warn('Truncated ES info'), $pos = $end, last;
847             # parse elementary stream descriptors
848 2         9 for ($j=0; $j<$es_info_length-2; ) {
849 3         10 my $descriptor_tag = Get8u(\$buf2, $pos + $j);
850 3         10 my $descriptor_length = Get8u(\$buf2, $pos + $j + 1);
851 3         6 $j += 2;
852 3 50       30 last if $j + $descriptor_length > $es_info_length;
853 3         9 my $desc = substr($buf2, $pos+$j, $descriptor_length);
854 3         7 $j += $descriptor_length;
855 3 50       9 if ($verbose > 1) {
856 0         0 my $dstr = $desc;
857 0         0 $dstr =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%.2x",ord $1)/eg;
  0         0  
858 0         0 printf $out " ES Descriptor: Type=0x%.2x \"$dstr\"\n", $descriptor_tag;
859             }
860             # parse type-specific descriptor information (once)
861 3 50       10 unless ($didPID{$pid}) {
862 3 100       14 if ($descriptor_tag == 0x81) { # AC-3
863 1         8 ParseAC3Descriptor($et, \$desc);
864             }
865             }
866             }
867 2         10 $pos += $es_info_length;
868             }
869             }
870             # $pos = $end + 4; # skip CRC
871              
872             } elsif (not defined $didPID{$pid}) {
873              
874             # save data from the start of each elementary stream
875 3 100       11 if ($payload_unit_start_indicator) {
876 2 50       9 if (defined $data{$pid}) {
877             # we must have a whole section, so parse now
878 0         0 my $more = ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
879             # start fresh even if we couldn't process this PID yet
880 0         0 delete $data{$pid};
881 0         0 delete $fromStart{$pid};
882 0 0       0 unless ($more) {
883 0         0 delete $needPID{$pid};
884 0         0 $didPID{$pid} = 1;
885 0         0 next;
886             }
887             # set flag indicating we found this PID but we still want more
888 0         0 $needPID{$pid} = -1;
889             }
890             # check for a PES header
891 2 50       10 next if $pos + 6 > $pEnd;
892 2         8 my $start_code = Get32u(\$buff, $pos);
893 2 50       7 next unless ($start_code & 0xffffff00) == 0x00000100;
894 2         5 my $stream_id = $start_code & 0xff;
895 2         9 my $pes_packet_length = Get16u(\$buff, $pos + 4);
896 2 50       7 if ($verbose > 1) {
897 0         0 printf $out " Stream ID: 0x%.2x\n", $stream_id;
898 0         0 print $out " Packet Len: $pes_packet_length\n";
899             }
900 2         6 $pos += 6;
901 2 50       13 unless ($noSyntax{$stream_id}) {
902 2 50       7 next if $pos + 3 > $pEnd;
903             # validate PES syntax
904 2         7 my $syntax = Get8u(\$buff, $pos) & 0xc0;
905 2 50       7 $syntax == 0x80 or $et->Warn('Bad PES syntax'), next;
906             # skip PES header
907 2         9 my $pes_header_data_length = Get8u(\$buff, $pos + 2);
908 2         6 $pos += 3 + $pes_header_data_length;
909 2 50       8 next if $pos >= $pEnd;
910             }
911 2         13 $data{$pid} = substr($buff, $pos, $pEnd-$pos);
912             # set flag that we read this payload from the start
913 2         6 $fromStart{$pid} = 1;
914             # save the packet length
915 2 100       20 if ($pes_packet_length > 8) {
916 1         3 $packLen{$pid} = $pes_packet_length - 8; # (where are the 8 extra bytes? - PH)
917             } else {
918 1         4 delete $packLen{$pid};
919             }
920             } else {
921 1 50       5 unless (defined $data{$pid}) {
922             # (vsys a6l dashcam GPS record doesn't have a start indicator)
923 0 0       0 next unless $gpsPID{$pid};
924 0         0 $data{$pid} = '';
925             }
926             # accumulate data for each elementary stream
927 1         8 $data{$pid} .= substr($buff, $pos, $pEnd-$pos);
928             }
929             # save only the first 256 bytes of most streams, except for
930             # unknown, H.264 or metadata streams where we save up to 1 kB
931 3         8 my $saveLen;
932 3 100 66     22 if (not $pidType{$pid} or $pidType{$pid} == 0x1b) {
    50          
933 2         7 $saveLen = 1024;
934             } elsif ($pidType{$pid} == 0x15) {
935             # use 1024 or actual size of metadata packet if smaller
936 0         0 $saveLen = 1024;
937 0 0 0     0 $saveLen = $packLen{$pid} if defined $packLen{$pid} and $saveLen > $packLen{$pid};
938             } else {
939 1         2 $saveLen = 256;
940             }
941 3 50       10 if (length($data{$pid}) >= $saveLen) {
942 0         0 my $more = ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
943 0 0       0 next if $more < 0; # wait for program map table (hopefully not too long)
944             # don't stop parsing if we weren't successful and may have missed the start
945 0 0 0     0 $more = 1 if not $more and not $fromStart{$pid};
946 0         0 delete $data{$pid};
947 0         0 delete $fromStart{$pid};
948 0 0       0 $more and $needPID{$pid} = -1, next; # parse more of these
949 0         0 delete $needPID{$pid};
950 0         0 $didPID{$pid} = 1;
951             }
952 3         7 next;
953             }
954 2 50       13 if ($needPID{$pid}) {
955             # we found and parsed a section with this PID, so
956             # delete from the lookup of PID's we still need to parse
957 2         6 delete $needPID{$pid};
958 2         9 $didPID{$pid} = 1;
959             }
960             }
961              
962             # calculate Duration if available
963 1 50       5 $endTime = $fwdTime unless defined $endTime;
964 1 50 33     11 if (defined $startTime and defined $endTime) {
965 1 50       6 $endTime += 0x80000000 * 1200 if $startTime > $endTime; # handle 33-bit wrap
966 1         8 $et->HandleTag($tagTablePtr, 'Duration', $endTime - $startTime);
967             }
968              
969 1 50       5 if ($verbose) {
970 0         0 my @need;
971 0         0 foreach (keys %needPID) {
972 0 0       0 push @need, sprintf('0x%.2x',$_) if $needPID{$_} > 0;
973             }
974 0 0       0 if (@need) {
975 0         0 @need = sort @need;
976 0         0 print $out "End of file. Missing PID(s): @need\n";
977             } else {
978 0 0       0 my $what = $eof ? 'of file' : 'scan';
979 0         0 print $out "End $what. All PID's parsed.\n";
980             }
981             }
982              
983             # parse any remaining partial PID streams
984 1         17 my $pid;
985 1         12 foreach $pid (sort keys %data) {
986 2         15 ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
987 2         9 delete $data{$pid};
988             }
989              
990             # look for LIGOGPSINFO trailer
991 1 0 33     4 if ($et->Options('ExtractEmbedded') and
      33        
      0        
992             $raf->Seek(-8, 2) and $raf->Read($buff, 8) == 8 and
993             $buff =~ /^&&&&/)
994             {
995 0         0 my $len = unpack('x4N', $buff);
996 0 0 0     0 if ($len < $raf->Tell() and $raf->Seek(-$len, 2) and $raf->Read($buff,$len) == $len) {
      0        
997 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
998 0         0 my %dirInfo = ( DataPt => \$buff, DirStart => 8, DirName => 'LigoTrailer' );
999 0         0 Image::ExifTool::LigoGPS::ProcessLigoGPS($et, \%dirInfo, $tbl);
1000             }
1001             }
1002              
1003 1         16 return 1;
1004             }
1005              
1006             1; # end
1007              
1008             __END__