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   4317 use strict;
  1         2  
  1         31  
32 1     1   3 use vars qw($VERSION);
  1         1  
  1         34  
33 1     1   3 use Image::ExifTool qw(:DataAccess :Utils);
  1         1  
  1         5482  
34              
35             $VERSION = '1.33';
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 2 my ($et, $dataPt) = @_;
256 1 50       6 if ($$dataPt =~ /\x0b\x77..(.)/sg) {
257 1         3 my $sampleRate = ord($1) >> 6;
258 1         2 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::AC3');
259 1         3 $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 3 my ($et, $dataPt) = @_;
272 1 50       2 return if length $$dataPt < 3;
273 1         3 my @v = unpack('C3', $$dataPt);
274 1         2 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::AC3');
275             # $et->HandleTag($tagTablePtr, 'AudioSampleRate', $v[0] >> 5);
276 1         5 $et->HandleTag($tagTablePtr, 'AudioBitrate', $v[1] >> 2);
277 1         3 $et->HandleTag($tagTablePtr, 'SurroundMode', $v[1] & 0x03);
278 1         3 $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 5 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       4 return -1 unless defined $type;
293 2         5 my $verbose = $et->Options('Verbose');
294 2 50       5 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         2 my $more = 0;
300 2 50 33     26 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
310             # unknown dashcam (../testpics/gps_video/Wrong Way pass.ts, 160 bytes, not fuzzed)
311             # Pruveeo D90 dashcam (../testpics/gps_video/20260216_101326F.ts, 200 bytes, fuzzed)
312 0 0       0 if ($$dataPt =~ /^LIGOGPSINFO/s) {
313 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
314 0         0 my %dirInfo = ( DataPt => $dataPt, DirName => 'Ligo0x0300' );
315 0         0 Image::ExifTool::LigoGPS::ProcessLigoGPS($et, \%dirInfo, $tbl, length($$dataPt)!=200);
316 0         0 $$et{FoundGoodGPS} = 1;
317 0         0 $more = 1;
318             }
319             } elsif ($type == 0x1b) {
320             # H.264 Video
321 1         738 require Image::ExifTool::H264;
322 1         4 $more = Image::ExifTool::H264::ParseH264Video($et, $dataPt);
323             # force parsing additional H264 frames with ExtractEmbedded option
324 1 50       5 if ($$et{OPTIONS}{ExtractEmbedded}) {
    50          
325 0         0 $more = 1;
326             } elsif (not $$et{OPTIONS}{Validate}) {
327 1         5 $et->Warn('The ExtractEmbedded option may find more tags in the video data',7);
328             }
329             } elsif ($type == 0x81 or $type == 0x87 or $type == 0x91) {
330             # AC-3 audio
331 1         3 ParseAC3Audio($et, $dataPt);
332             } elsif ($type == 0x15) {
333             # packetized metadata (look for MISB code starting after 5-byte header)
334 0 0       0 if ($$dataPt =~ /^.{5}\x06\x0e\x2b\x34/s) {
335 0         0 $more = Image::ExifTool::MISB::ParseMISB($et, $dataPt, GetTagTable('Image::ExifTool::MISB::Main'));
336 0 0       0 if (not $$et{OPTIONS}{ExtractEmbedded}) {
    0          
337 0         0 $more = 0; # extract from only the first packet unless ExtractEmbedded is used
338             } elsif ($$et{OPTIONS}{ExtractEmbedded} > 2) {
339 0         0 $more = 1; # read past unknown 0x15 packets if ExtractEmbedded > 2
340             }
341             }
342             # still have a lot of questions about how to decode this...
343             # (see https://exiftool.org/forum/index.php?topic=16486 and ../testpics/gps_video/forum16486.ts)
344             # } elsif ($type == 6) {
345             # my @a = unpack('x17x2NNx2nx2nx2nx2Cx2a4x2a5x2Nx2Nx2nx2Nx2Nx2Nx2nx2nx2Nx2nx2n', $$dataPt . " ");
346             # my $hi = shift @a;
347             # $a[0] = Image::ExifTool::ConvertUnixTime(($a[0] + $hi * 4294967296) * 1e-6, undef, 6);
348             # print "@a\n";
349             # $more = 1;
350             } elsif ($type < 0) {
351 0 0 0     0 if ($$dataPt =~ /^(.{164})?(.{24})A[NS][EW]/s) {
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
352             # (Blueskysea B4K, Novatek NT96670)
353             # 0000: 01 00 ff 00 30 31 32 33 34 35 37 38 61 62 63 64 [....01234578abcd]
354             # 0010: 65 66 67 0a 00 00 00 00 00 00 00 00 00 00 00 00 [efg.............]
355             # 0020: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
356             # 0030: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
357             # 0040: 00 00 00 00 30 31 32 33 34 35 37 38 71 77 65 72 [....01234578qwer]
358             # 0050: 74 79 75 69 6f 70 0a 00 00 00 00 00 00 00 00 00 [tyuiop..........]
359             # 0060: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
360             # 0070: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 [................]
361             # 0080: 00 00 00 00 63 38 61 61 32 35 63 66 34 35 65 65 [....c8aa25cf45ee]
362             # 0090: 61 39 65 32 34 34 32 66 61 65 62 35 65 30 39 39 [a9e2442faeb5e099]
363             # 00a0: 30 37 64 34 15 00 00 00 10 00 00 00 1b 00 00 00 [07d4............]
364             # 00b0: 15 00 00 00 01 00 00 00 09 00 00 00 41 4e 57 00 [............ANW.]
365             # 00c0: 82 9a 57 45 98 b2 00 46 66 66 e4 41 d7 e3 14 43 [..WE...Fff.A...C]
366             # 00d0: 01 00 02 00 03 00 04 00 05 00 06 00 [............]
367             # (Viofo A119V3)
368             # 0000: 08 00 00 00 07 00 00 00 18 00 00 00 15 00 00 00 [................]
369             # 0010: 03 00 00 00 0b 00 00 00 41 4e 45 00 01 f2 ac 45 [........ANE....E]
370             # 0020: 2d 7f 6e 45 b8 1e 97 41 d7 23 46 43 00 00 00 00 [-.nE...A.#FC....]
371             # pad with dummy header and parse with existing FreeGPS code (minimum 92 bytes)
372 0   0     0 my $dat = ("\0" x 16) . substr($$dataPt, length($1 || '')) . ("\0" x 20);
373 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
374 0         0 Image::ExifTool::QuickTime::ProcessFreeGPS($et, { DataPt => \$dat }, $tbl);
375 0         0 $more = 1;
376             } elsif ($$dataPt =~ /^(V00|A([NS])([EW]))\0/s) {
377             # INNOVV TS video (same format as INNOVV MP4)
378 0         0 SetByteOrder('II');
379 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
380 0         0 while ($$dataPt =~ /((V00|A[NS][EW])\0.{28})/g) {
381 0         0 my $dat = $1;
382 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
383 0 0       0 if ($2 ne 'V00') {
384 0         0 my $lat = abs(GetFloat(\$dat, 4)); # (abs just to be safe)
385 0         0 my $lon = abs(GetFloat(\$dat, 8)); # (abs just to be safe)
386 0         0 my $spd = GetFloat(\$dat, 12) * $knotsToKph;
387 0         0 my $trk = GetFloat(\$dat, 16);
388 0         0 Image::ExifTool::QuickTime::ConvertLatLon($lat, $lon);
389 0 0       0 $et->HandleTag($tagTbl, GPSLatitude => abs($lat) * (substr($dat,1,1) eq 'S' ? -1 : 1));
390 0 0       0 $et->HandleTag($tagTbl, GPSLongitude => abs($lon) * (substr($dat,2,1) eq 'W' ? -1 : 1));
391 0         0 $et->HandleTag($tagTbl, GPSSpeed => $spd);
392 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
393 0         0 $et->HandleTag($tagTbl, GPSTrack => $trk);
394 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
395             }
396 0         0 my @acc = unpack('x20V3', $dat);
397 0 0       0 map { $_ = $_ - 4294967296 if $_ >= 0x80000000 } @acc;
  0         0  
398 0         0 $et->HandleTag($tagTbl, Accelerometer => "@acc");
399             }
400 0         0 SetByteOrder('MM');
401 0         0 $$et{FoundGoodGPS} = 1; # (necessary to skip over empty/unknown INNOV records)
402 0         0 $more = 1;
403             } elsif ($$dataPt =~ /^\$(GPSINFO|GSNRINFO),/) {
404             # $GPSINFO,0x0004,2021.08.09 13:27:36,2341.54561,12031.70135,8.0,51,153,0,0,\x0d
405             # $GSNRINFO,0.01,0.04,0.25\0
406 0         0 $$dataPt =~ tr/\x0d/\x0a/;
407 0         0 $$dataPt =~ tr/\0//d;
408 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
409 0         0 my @lines = split /\x0a/, $$dataPt;
410 0         0 my ($line, $lastTime);
411 0         0 foreach $line (@lines) {
412 0 0       0 if ($line =~ /^\$GPSINFO/) {
    0          
413 0         0 my @a = split /,/, $lines[0];
414 0 0       0 next unless @a > 7;
415             # ignore duplicate fixes
416 0 0 0     0 next if $lastTime and $a[2] eq $lastTime;
417 0         0 $lastTime = $a[2];
418 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
419 0         0 $a[2] =~ tr/./:/;
420             # (untested, and probably doesn't work for S/W hemispheres)
421 0         0 my ($lat, $lon) = @a[3,4];
422 0         0 Image::ExifTool::QuickTime::ConvertLatLon($lat, $lon);
423             # $a[0] - flags? values: '0x0001','0x0004','0x0008','0x0010'
424 0         0 $et->HandleTag($tagTbl, GPSDateTime => $a[2]);
425 0         0 $et->HandleTag($tagTbl, GPSLatitude => $lat);
426 0         0 $et->HandleTag($tagTbl, GPSLongitude => $lon);
427 0         0 $et->HandleTag($tagTbl, GPSSpeed => $a[5]);
428 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
429             # $a[6] - values: 48-60
430 0         0 $et->HandleTag($tagTbl, GPSTrack => $a[7]);
431 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
432             # #a[8,9] - always 0
433             } elsif ($line =~ /^\$GSNRINFO/) {
434 0         0 my @a = split /,/, $line;
435 0         0 shift @a;
436 0         0 $et->HandleTag($tagTbl, Accelerometer => "@a");
437             }
438             }
439 0         0 $more = 1;
440             } elsif ($$dataPt =~ /\$GPRMC,/) {
441             # Jomise T860S-GM dashcam
442             # $GPRMC,hhmmss.ss,A,ddmm.mmmmm,N,dddmm.mmmmm,W,spd-kts,dir-dg,DDMMYY,,M*cs - lat,lon,spd from video
443             # $GPRMC,172255.00,A,:985.95194,N,17170.14674,W,029.678,170.68,240822,,,D*7B - N47.70428,W122.15338,35mph
444             # $GPRMC,192643.00,A,:987.94979,N,17171.07268,W,010.059,079.61,111122,,,A*73 - N47.71862,W122.16437,12mph
445             # $GPRMC,192743.00,A,:988.72110,N,17171.04873,W,017.477,001.03,111122,,,A*78 - N47.72421,W122.16408,20mph
446             # $GPRMC,192844.00,A,:989.43771,N,17171.03538,W,016.889,001.20,111122,,,A*7B - N47.72932,W122.16393,19mph
447             # $GPRMC,005241.00,A,:987.70873,N,17171.81293,W,000.284,354.78,141122,,,A*7F - N47.71687,W122.17318,0mph
448             # $GPRMC,005341.00,A,:987.90851,N,17171.85380,W,000.080,349.36,141122,,,A*7C - N47.71832,W122.17367,0mph
449             # $GPRMC,005441.00,A,:987.94538,N,17171.21783,W,029.686,091.09,141122,,,A*7A - N47.71859,W122.16630,35mph
450             # $GPRMC,002816.00,A,6820.67273,N,13424.26599,W,000.045,000.00,261122,,,A*79 - N29.52096,W95.55953,0mph (seattle)
451             # $GPRMC,035136.00,A,:981.47322,N,17170.14105,W,024.594,180.50,291122,,,D*79 - N47.67180,W122.15328,28mph
452 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
453 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        
454             # do some basic sanity checks on the date
455             $13 <= 31 and $14 <= 12 and $15 <= 99)
456             {
457 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
458 0 0       0 my $year = $15 + ($15 >= 70 ? 1900 : 2000);
459 0         0 $et->HandleTag($tagTbl, GPSDateTime => sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2dZ', $year, $14, $13, $1, $2, $3));
460             #(not this simple)
461             #$et->HandleTag($tagTbl, GPSLatitude => (($5 || 0) + $6/60) * ($7 eq 'N' ? 1 : -1));
462             #$et->HandleTag($tagTbl, GPSLongitude => (($8 || 0) + $9/60) * ($10 eq 'E' ? 1 : -1));
463 0 0       0 $et->HandleTag($tagTbl, GPSSpeed => $11 * $knotsToKph) if length $11;
464 0 0       0 $et->HandleTag($tagTbl, GPSTrack => $12) if length $12;
465             # it looks like maybe the degrees are xor-ed with something,
466             # and the minutes have some scaling factor and offset?
467             # (the code below is approximately correct for my only sample)
468 0         0 my @chars = unpack('C*', $5 . $8);
469 0         0 my @xor = (0x0e,0x0e,0x00,0x05,0x03); # (empirical based on 1 sample; may be completely off base)
470 0         0 my $bad;
471 0         0 foreach (@chars) {
472 0         0 $_ ^= shift(@xor);
473 0 0 0     0 $bad = 1 if $_ < 0x30 or $_ > 0x39;
474             }
475 0 0       0 if ($bad) {
476 0         0 $et->Warn('Error decrypting GPS degrees');
477             } else {
478 0         0 my $la = pack('C*', @chars[0,1]);
479 0         0 my $lo = pack('C*', @chars[2,3,4]);
480 0         0 $et->Warn('Decryption of this GPS is highly experimental. More testing samples are required');
481 0 0 0     0 $et->HandleTag($tagTbl, GPSLatitude => (($la || 0) + (($6-85.95194)/2.43051724137931+42.2568)/60) * ($7 eq 'N' ? 1 : -1));
482 0 0 0     0 $et->HandleTag($tagTbl, GPSLongitude => (($lo || 0) + (($9-70.14674)/1.460987654320988+9.2028)/60) * ($10 eq 'E' ? 1 : -1));
483             }
484             }
485             } elsif ($$dataPt =~ /\$GSENSORD,\s*(\d+),\s*(\d+),\s*(\d+),/) {
486             # Jomise T860S-GM dashcam
487 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
488 0         0 $$et{DOC_NUM} = $$et{DOC_COUNT};
489 0         0 $et->HandleTag($tagTbl, Accelerometer => "$1 $2 $3"); # (NC - values range from 0 to 6)
490             } elsif ($$dataPt =~ /^.{44}A\0{3}.{4}([NS])\0{3}.{4}([EW])\0{3}/s and length($$dataPt) >= 84) {
491             #forum11320
492 0         0 SetByteOrder('II');
493 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
494 0         0 my $lat = abs(GetFloat($dataPt, 48)); # (abs just to be safe)
495 0         0 my $lon = abs(GetFloat($dataPt, 56)); # (abs just to be safe)
496 0         0 my $spd = GetFloat($dataPt, 64);
497 0         0 my $trk = GetFloat($dataPt, 68);
498 0         0 $et->Warn('GPSLatitude/Longitude encryption is not yet known, so these will be wrong');
499 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
500 0         0 my @date = unpack('x32V3x28V3', $$dataPt);
501 0         0 $date[3] += 2000;
502 0         0 $et->HandleTag($tagTbl, GPSDateTime => sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2d', @date[3..5,0..2]));
503 0 0       0 $et->HandleTag($tagTbl, GPSLatitude => abs($lat) * ($1 eq 'S' ? -1 : 1));
504 0 0       0 $et->HandleTag($tagTbl, GPSLongitude => abs($lon) * ($2 eq 'W' ? -1 : 1));
505 0         0 $et->HandleTag($tagTbl, GPSSpeed => $spd);
506 0         0 $et->HandleTag($tagTbl, GPSSpeedRef => 'K');
507 0         0 $et->HandleTag($tagTbl, GPSTrack => $trk);
508 0         0 $et->HandleTag($tagTbl, GPSTrackRef => 'T');
509 0         0 SetByteOrder('MM');
510 0         0 $more = 1;
511             } elsif (length($$dataPt) >= 64 and substr($$dataPt, 32, 2) eq '$S') {
512             # DOD_LS600W.TS
513 0         0 my $tagTbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
514             # find the earliest sample time in the cyclical list
515 0         0 my ($n, $last) = (32, "\0");
516 0         0 for (my $i=32; $i
517 0 0       0 last unless substr($$dataPt, $n, 2) eq '$S';
518 0         0 my $dateTime = substr($$dataPt, $i+6, 8);
519 0 0       0 $last gt $dateTime and $n = $i, last; # earliest sample if time goes backwards
520 0         0 $last = $dateTime;
521             }
522 0         0 for (my $i=32; $i
523 0 0       0 $n = 32 if $n > length($$dataPt)-32;
524 0 0       0 last unless substr($$dataPt, $n, 2) eq '$S';
525 0         0 my @a = unpack("x${n}nnnnCCCCnCNNC", $$dataPt);
526 0         0 $a[8] /= 10; # 1/10 sec
527 0 0       0 $a[2] += (36000 - 65536) if $a[2] & 0x8000; # convert signed integer into range 0-36000
528 0         0 $$et{DOC_NUM} = ++$$et{DOC_COUNT};
529 0         0 $et->HandleTag($tagTbl, GPSDateTime => sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%04.1fZ', @a[3..8]));
530 0         0 $et->HandleTag($tagTbl, GPSLatitude => $a[10] * 1e-7);
531 0         0 $et->HandleTag($tagTbl, GPSLongitude => $a[11] * 1e-7);
532 0         0 $et->HandleTag($tagTbl, GPSSpeed => $a[1] * 0.036); # convert from metres per 100 s
533 0         0 $et->HandleTag($tagTbl, GPSTrack => $a[2] / 100);
534             }
535             # Note: 10 bytes after last GPS record look like a single 3-axis accelerometer reading:
536             # eg. fd ff 00 00 ff ff 00 00 01 00
537 0         0 $$et{FoundGoodGPS} = 1; # so we skip over unrecognized packets
538 0         0 $more = 1;
539             } elsif ($$dataPt =~ /^skip.{4}LIGOGPSINFO\0/s) {
540             # (this record contains 2 copies of the same 'skip' atom in my sample --
541             # only extract data from the first one)
542 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
543 0         0 my %dirInfo = ( DataPt => $dataPt, DirStart => 8, DirName => sprintf('Ligo0x%.4x',$pid));
544 0         0 Image::ExifTool::LigoGPS::ProcessLigoGPS($et, \%dirInfo, $tbl, 1);
545 0         0 $$et{FoundGoodGPS} = 1;
546             } elsif ($$et{FoundGoodGPS}) {
547 0         0 $more = 1;
548             }
549 0         0 delete $$et{DOC_NUM};
550             }
551 2         4 return $more;
552             }
553              
554             #------------------------------------------------------------------------------
555             # Extract information from a M2TS file
556             # Inputs: 0) ExifTool object reference, 1) DirInfo reference
557             # Returns: 1 on success, 0 if this wasn't a valid M2TS file
558             sub ProcessM2TS($$)
559             {
560 1     1 0 2 my ($et, $dirInfo) = @_;
561 1         3 my $raf = $$dirInfo{RAF};
562 1         4 my ($buff, $j, $eof, $pLen, $readSize);
563 1         0 my (%pmt, %pidType, %data, %sectLen, %packLen, %fromStart);
564 1         0 my ($startTime, $endTime, $fwdTime, $backScan, $maxBack);
565 1         3 my $verbose = $et->Options('Verbose');
566 1         3 my $out = $et->Options('TextOut');
567              
568             # read enough to guarantee 2 sync bytes
569 1 50       3 return 0 unless $raf->Read($buff, 383) == 383;
570             # test for magic number (sync byte is the only thing we can safely check)
571 1 50       6 return 0 unless $buff =~ /^(.{0,190}?)\x47(.{187}|.{191})\x47/s;
572 1         3 my $tcLen = length($2) - 187; # (length of timecode = 0 or 4 bytes)
573 1         2 my $start = length($1) - $tcLen;
574             # we may need to try the validation twice to handle the edge case
575             # where the first byte of a timecode is 0x47 and we were fooled
576             # into thinking there was no timecode
577 1         1 Try: for (;;) {
578 1 50       8 $start += 192 if $start < 0; # (if all or part of first timecode was missing)
579 1         1 $pLen = 188 + $tcLen;
580 1         2 $readSize = 64 * $pLen; # size of our read buffer
581 1         2 $raf->Seek($start, 0); # rewind to start
582 1 50       2 $raf->Read($buff, $readSize) >= $pLen * 4 or return 0; # require at least 4 packets
583             # validate the sync byte in the next 3 packets
584 1         4 for ($j=1; $j<4; ++$j) {
585 3 50       8 next if substr($buff, $tcLen + $pLen * $j, 1) eq 'G'; # (0x47)
586 0 0       0 return 0 if $tcLen;
587 0         0 $tcLen = 4;
588 0         0 $start -= 4;
589 0         0 next Try;
590             }
591 1         1 last; # success!
592             }
593             # (use M2T instead of M2TS just as an indicator that there is no timecode)
594 1 50       6 $et->SetFileType($tcLen ? 'M2TS' : 'M2T');
595 1 50       2 $et->Warn("File doesn't begin with the start of a packet") if $start;
596 1         4 SetByteOrder('MM');
597 1         2 my $tagTablePtr = GetTagTable('Image::ExifTool::M2TS::Main');
598              
599             # PID lookup strings (will add to this with entries from program map table)
600 1         5 my %pidName = (
601             0 => 'Program Association Table',
602             1 => 'Conditional Access Table',
603             2 => 'Transport Stream Description Table',
604             0x1fff => 'Null Packet',
605             );
606 1         3 my %didPID = ( 1 => 0, 2 => 0, 0x1fff => 0 );
607 1         3 my %needPID = ( 0 => 1 ); # lookup for stream PID's that we still need to parse
608             # PID's that may contain GPS info
609 1         3 my %gpsPID = (
610             0x0300 => 1, # Novatek INNOVV, DOD_LS600W
611             0x01e4 => 1, # vsys a6l dashcam
612             0x0e1b => 1, # Jomise T860S-GM dashcam GPS
613             0x0e1a => 1, # Jomise T860S-GM dashcam accelerometer
614             );
615 1         2 my $pEnd = 0;
616              
617             # scan entire file for GPS programs if ExtractEmbedded option is 3 or higher
618             # (some dashcams write these programs but don't include it in the PMT)
619 1 50 50     3 if (($et->Options('ExtractEmbedded') || 0) > 2) {
620 0         0 foreach (keys %gpsPID) {
621 0         0 $needPID{$_} = 1;
622 0         0 $pidType{$_} = -1;
623 0         0 $pidName{$_} ='unregistered dashcam GPS';
624             }
625             }
626              
627             # parse packets from MPEG-2 Transport Stream
628 1         2 for (;;) {
629              
630 8 50       24 unless (%needPID) {
631 0 0       0 last unless defined $startTime;
632             # reconfigure to seek backwards for last PCR
633 0 0       0 unless (defined $backScan) {
634 0         0 my $saveTime = $endTime;
635 0         0 undef $endTime;
636 0 0       0 last if $et->Options('FastScan');
637 0 0       0 $verbose and print $out "[Starting backscan for last PCR]\n";
638             # remember how far we got when reading forward through the file
639 0         0 my $fwdPos = $raf->Tell() - length($buff) + $pEnd;
640             # determine the position of the last packet relative to the EOF
641 0 0       0 $raf->Seek(0, 2) or last;
642 0         0 my $fsize = $raf->Tell();
643 0         0 $backScan = int($fsize / $pLen) * $pLen - $fsize;
644             # set limit on how far back we will go
645 0         0 $maxBack = $fwdPos - $fsize;
646             # scan back a maximum of 512k (have seen last PCR at -276k)
647 0         0 my $nMax = int(512000 / $pLen); # max packets to backscan
648 0 0       0 if ($nMax < int(-$maxBack / $pLen)) {
649 0         0 $maxBack = $backScan - $nMax * $pLen;
650             } else {
651             # use this time if none found in all remaining packets
652 0         0 $fwdTime = $saveTime;
653             }
654 0         0 $pEnd = 0;
655             }
656             }
657 8         8 my $pos;
658             # read more if necessary
659 8 50       11 if (defined $backScan) {
660 0 0       0 last if defined $endTime;
661 0         0 $pos = $pEnd = $pEnd - 2 * $pLen; # step back to previous packet
662 0 0       0 if ($pos < 0) {
663             # read another buffer from end of file
664 0 0       0 last if $backScan <= $maxBack;
665 0         0 my $buffLen = $backScan - $maxBack;
666 0 0       0 $buffLen = $readSize if $buffLen > $readSize;
667 0         0 $backScan -= $buffLen;
668 0 0       0 $raf->Seek($backScan, 2) or last;
669 0 0       0 $raf->Read($buff, $buffLen) == $buffLen or last;
670 0         0 $pos = $pEnd = $buffLen - $pLen;
671             }
672             } else {
673 8         8 $pos = $pEnd;
674 8 100       11 if ($pos + $pLen > length $buff) {
675 1 50       4 $raf->Read($buff, $readSize) >= $pLen or $eof = 1, last;
676 0         0 $pos = $pEnd = 0;
677             }
678             }
679 7         7 $pEnd += $pLen;
680             # decode the packet prefix
681 7         6 $pos += $tcLen;
682 7         15 my $prefix = unpack("x${pos}N", $buff); # (use unpack instead of Get32u for speed)
683             # validate sync byte
684 7 50       12 unless (($prefix & 0xff000000) == 0x47000000) {
685 0 0       0 $et->Warn('M2TS synchronization error') unless defined $backScan;
686 0         0 last;
687             }
688             # my $transport_error_indicator = $prefix & 0x00800000;
689 7         6 my $payload_unit_start_indicator = $prefix & 0x00400000;
690             # my $transport_priority = $prefix & 0x00200000;
691 7         8 my $pid =($prefix & 0x001fff00) >> 8; # packet ID
692             # my $transport_scrambling_control = $prefix & 0x000000c0;
693 7         5 my $adaptation_field_exists = $prefix & 0x00000020;
694 7         7 my $payload_data_exists = $prefix & 0x00000010;
695             # my $continuity_counter = $prefix & 0x0000000f;
696 7 50       11 if ($verbose > 1) {
697 0         0 my $i = ($raf->Tell() - length($buff) + $pEnd) / $pLen - 1;
698 0         0 print $out "Transport packet $i:\n";
699 0         0 $et->VerboseDump(\$buff, Len => $pLen, Addr => $i * $pLen, Start => $pos - $tcLen);
700 0 0       0 my $str = $pidName{$pid} ? " ($pidName{$pid})" : ' ';
701 0 0       0 printf $out " Timecode: 0x%.4x\n", Get32u(\$buff, $pos - $tcLen) if $pLen == 192;
702 0         0 printf $out " Packet ID: 0x%.4x$str\n", $pid;
703 0 0       0 printf $out " Start Flag: %s\n", $payload_unit_start_indicator ? 'Yes' : 'No';
704             }
705              
706 7         7 $pos += 4;
707             # handle adaptation field
708 7 100       20 if ($adaptation_field_exists) {
709 1         3 my $len = Get8u(\$buff, $pos++);
710 1 50       3 $pos + $len > $pEnd and $et->Warn('Invalid adaptation field length'), last;
711             # read PCR value for calculation of Duration
712 1 50       2 if ($len > 6) {
713 1         2 my $flags = Get8u(\$buff, $pos);
714 1 50       7 if ($flags & 0x10) { # PCR_flag
715             # combine 33-bit program_clock_reference_base and 9-bit extension
716 1         3 my $pcrBase = Get32u(\$buff, $pos + 1);
717 1         2 my $pcrExt = Get16u(\$buff, $pos + 5);
718             # ignore separate programs (PID's) and store just the
719             # first and last timestamps found in the file (is this OK?)
720 1         3 $endTime = 300 * (2 * $pcrBase + ($pcrExt >> 15)) + ($pcrExt & 0x01ff);
721 1 50       2 $startTime = $endTime unless defined $startTime;
722             }
723             }
724 1         2 $pos += $len;
725             }
726              
727             # all done with this packet unless it carries a payload
728             # or if we are just looking for the last timestamp
729 7 100 66     16 next unless $payload_data_exists and not defined $backScan;
730              
731             # decode payload data
732 6 100 100     19 if ($pid == 0 or # program association table
    50          
733             defined $pmt{$pid}) # program map table(s)
734             {
735             # must interpret pointer field if payload_unit_start_indicator is set
736 3         8 my $buf2;
737 3 50       4 if ($payload_unit_start_indicator) {
738             # skip to start of section
739 3         13 my $pointer_field = Get8u(\$buff, $pos);
740 3         4 $pos += 1 + $pointer_field;
741 3 50       5 $pos >= $pEnd and $et->Warn('Bad pointer field'), last;
742 3         6 $buf2 = substr($buff, $pEnd-$pLen, $pLen);
743 3         4 $pos -= $pEnd - $pLen;
744             } else {
745             # not the start of a section
746 0 0       0 next unless $sectLen{$pid};
747 0         0 my $more = $sectLen{$pid} - length($data{$pid});
748 0         0 my $size = $pLen - $pos;
749 0 0       0 $size = $more if $size > $more;
750 0         0 $data{$pid} .= substr($buff, $pos, $size);
751 0 0       0 next unless $size == $more;
752             # we have the complete section now, so put into $buf2 for parsing
753 0         0 $buf2 = $data{$pid};
754 0         0 $pos = 0;
755 0         0 delete $data{$pid};
756 0         0 delete $fromStart{$pid};
757 0         0 delete $sectLen{$pid};
758             }
759 3         3 my $slen = length($buf2); # section length
760 3 50       5 $pos + 8 > $slen and $et->Warn('Truncated payload'), last;
761             # validate table ID
762 3         8 my $table_id = Get8u(\$buf2, $pos);
763 3   33     9 my $name = ($tableID{$table_id} || sprintf('Unknown (0x%x)',$table_id)) . ' Table';
764 3 100       4 my $expectedID = $pid ? 0x02 : 0x00;
765 3 100       6 unless ($table_id == $expectedID) {
766 1 50       12 $verbose > 1 and print $out " (skipping $name)\n";
767 1         2 delete $needPID{$pid};
768 1         2 $didPID{$pid} = 1;
769 1         2 next;
770             }
771             # validate section syntax indicator for parsed tables (PAT, PMT)
772 2         4 my $section_syntax_indicator = Get8u(\$buf2, $pos + 1) & 0xc0;
773 2 50       7 $section_syntax_indicator == 0x80 or $et->Warn("Bad $name"), last;
774 2         5 my $section_length = Get16u(\$buf2, $pos + 1) & 0x0fff;
775 2 50       4 $section_length > 1021 and $et->Warn("Invalid $name length"), last;
776 2 50       5 if ($slen < $section_length + 3) { # (3 bytes for table_id + section_length)
777             # must wait until we have the full section
778 0         0 $data{$pid} = substr($buf2, $pos);
779 0         0 $sectLen{$pid} = $section_length + 3;
780 0         0 next;
781             }
782 2         3 my $program_number = Get16u(\$buf2, $pos + 3);
783 2         3 my $section_number = Get8u(\$buf2, $pos + 6);
784 2         5 my $last_section_number = Get8u(\$buf2, $pos + 7);
785 2 50       5 if ($verbose > 1) {
786 0         0 print $out " $name length: $section_length\n";
787 0 0       0 print $out " Program No: $program_number\n" if $pid;
788 0 0       0 printf $out " Stream ID: 0x%x\n", $program_number if not $pid;
789 0         0 print $out " Section No: $section_number\n";
790 0         0 print $out " Last Sect.: $last_section_number\n";
791             }
792 2         3 my $end = $pos + $section_length + 3 - 4; # (don't read 4-byte CRC)
793 2         2 $pos += 8;
794 2 100       4 if ($pid == 0) {
795             # decode PAT (Program Association Table)
796 1         2 while ($pos <= $end - 4) {
797 2         4 my $program_number = Get16u(\$buf2, $pos);
798 2         4 my $program_map_PID = Get16u(\$buf2, $pos + 2) & 0x1fff;
799 2         9 $pmt{$program_map_PID} = $program_number; # save our PMT PID's
800 2         2 my $str = "Program $program_number Map";
801 2         4 $pidName{$program_map_PID} = $str;
802 2 50       6 $needPID{$program_map_PID} = 1 unless $didPID{$program_map_PID};
803 2 50       3 $verbose and printf $out " PID(0x%.4x) --> $str\n", $program_map_PID;
804 2         4 $pos += 4;
805             }
806             } else {
807             # decode PMT (Program Map Table)
808 1 50       2 $pos + 4 > $slen and $et->Warn('Truncated PMT'), last;
809 1         2 my $pcr_pid = Get16u(\$buf2, $pos) & 0x1fff;
810 1         2 my $program_info_length = Get16u(\$buf2, $pos + 2) & 0x0fff;
811 1         2 my $str = "Program $program_number Clock Reference";
812 1         1 $pidName{$pcr_pid} = $str;
813 1 50       2 $verbose and printf $out " PID(0x%.4x) --> $str\n", $pcr_pid;
814 1         2 $pos += 4;
815 1 50       2 $pos + $program_info_length > $slen and $et->Warn('Truncated program info'), last;
816             # dump program information descriptors if verbose
817 1 50       3 if ($verbose > 1) { for ($j=0; $j<$program_info_length-2; ) {
  0         0  
818 0         0 my $descriptor_tag = Get8u(\$buf2, $pos + $j);
819 0         0 my $descriptor_length = Get8u(\$buf2, $pos + $j + 1);
820 0         0 $j += 2;
821 0 0       0 last if $j + $descriptor_length > $program_info_length;
822 0         0 my $desc = substr($buf2, $pos+$j, $descriptor_length);
823 0         0 $j += $descriptor_length;
824 0         0 $desc =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%.2x",ord $1)/eg;
  0         0  
825 0         0 printf $out " Program Descriptor: Type=0x%.2x \"$desc\"\n", $descriptor_tag;
826             }}
827 1         2 $pos += $program_info_length; # skip descriptors (for now)
828 1         3 while ($pos <= $end - 5) {
829 2         2 my $stream_type = Get8u(\$buf2, $pos);
830 2         4 my $elementary_pid = Get16u(\$buf2, $pos + 1) & 0x1fff;
831 2         9 my $es_info_length = Get16u(\$buf2, $pos + 3) & 0x0fff;
832 2         4 my $str = $streamType{$stream_type};
833 2 0       4 $str or $str = ($stream_type < 0x7f ? 'Reserved' : 'Private');
    50          
834 2         9 $str = sprintf('%s (0x%.2x)', $str, $stream_type);
835 2         4 $str = "Program $program_number $str";
836 2 50       4 $verbose and printf $out " PID(0x%.4x) --> $str\n", $elementary_pid;
837 2 50       13 if ($str =~ /(Audio|Video)/) {
838 2 50       10 unless ($pidName{$elementary_pid}) {
839 2         9 $et->HandleTag($tagTablePtr, $1 . 'StreamType', $stream_type)
840             }
841             # we want to parse all Audio and Video streams
842 2 50       6 $needPID{$elementary_pid} = 1 unless $didPID{$elementary_pid};
843             }
844             # save PID type and name string
845 2         4 $pidName{$elementary_pid} = $str;
846 2         3 $pidType{$elementary_pid} = $stream_type;
847 2         3 $pos += 5;
848 2 50       3 $pos + $es_info_length > $slen and $et->Warn('Truncated ES info'), $pos = $end, last;
849             # parse elementary stream descriptors
850 2         5 for ($j=0; $j<$es_info_length-2; ) {
851 3         5 my $descriptor_tag = Get8u(\$buf2, $pos + $j);
852 3         6 my $descriptor_length = Get8u(\$buf2, $pos + $j + 1);
853 3         4 $j += 2;
854 3 50       5 last if $j + $descriptor_length > $es_info_length;
855 3         5 my $desc = substr($buf2, $pos+$j, $descriptor_length);
856 3         3 $j += $descriptor_length;
857 3 50       5 if ($verbose > 1) {
858 0         0 my $dstr = $desc;
859 0         0 $dstr =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\x%.2x",ord $1)/eg;
  0         0  
860 0         0 printf $out " ES Descriptor: Type=0x%.2x \"$dstr\"\n", $descriptor_tag;
861             }
862             # parse type-specific descriptor information (once)
863 3 50       6 unless ($didPID{$pid}) {
864 3 100       11 if ($descriptor_tag == 0x81) { # AC-3
865 1         3 ParseAC3Descriptor($et, \$desc);
866             }
867             }
868             }
869 2         6 $pos += $es_info_length;
870             }
871             }
872             # $pos = $end + 4; # skip CRC
873              
874             } elsif (not defined $didPID{$pid}) {
875              
876             # save data from the start of each elementary stream
877 3 100       4 if ($payload_unit_start_indicator) {
878 2 50       4 if (defined $data{$pid}) {
879             # we must have a whole section, so parse now
880 0         0 my $more = ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
881             # start fresh even if we couldn't process this PID yet
882 0         0 delete $data{$pid};
883 0         0 delete $fromStart{$pid};
884 0 0       0 unless ($more) {
885 0         0 delete $needPID{$pid};
886 0         0 $didPID{$pid} = 1;
887 0         0 next;
888             }
889             # set flag indicating we found this PID but we still want more
890 0         0 $needPID{$pid} = -1;
891             }
892             # check for a PES header
893 2 50       4 next if $pos + 6 > $pEnd;
894 2         5 my $start_code = Get32u(\$buff, $pos);
895 2 50       3 next unless ($start_code & 0xffffff00) == 0x00000100;
896 2         3 my $stream_id = $start_code & 0xff;
897 2         4 my $pes_packet_length = Get16u(\$buff, $pos + 4);
898 2 50       3 if ($verbose > 1) {
899 0         0 printf $out " Stream ID: 0x%.2x\n", $stream_id;
900 0         0 print $out " Packet Len: $pes_packet_length\n";
901             }
902 2         3 $pos += 6;
903 2 50       4 unless ($noSyntax{$stream_id}) {
904 2 50       4 next if $pos + 3 > $pEnd;
905             # validate PES syntax
906 2         3 my $syntax = Get8u(\$buff, $pos) & 0xc0;
907 2 50       3 $syntax == 0x80 or $et->Warn('Bad PES syntax'), next;
908             # skip PES header
909 2         25 my $pes_header_data_length = Get8u(\$buff, $pos + 2);
910 2         3 $pos += 3 + $pes_header_data_length;
911 2 50       3 next if $pos >= $pEnd;
912             }
913 2         6 $data{$pid} = substr($buff, $pos, $pEnd-$pos);
914             # set flag that we read this payload from the start
915 2         2 $fromStart{$pid} = 1;
916             # save the packet length
917 2 100       4 if ($pes_packet_length > 8) {
918 1         3 $packLen{$pid} = $pes_packet_length - 8; # (where are the 8 extra bytes? - PH)
919             } else {
920 1         2 delete $packLen{$pid};
921             }
922             } else {
923 1 50       3 unless (defined $data{$pid}) {
924             # (vsys a6l dashcam GPS record doesn't have a start indicator)
925 0 0       0 next unless $gpsPID{$pid};
926 0         0 $data{$pid} = '';
927             }
928             # accumulate data for each elementary stream
929 1         3 $data{$pid} .= substr($buff, $pos, $pEnd-$pos);
930             }
931             # save only the first 256 bytes of most streams, except for
932             # unknown, H.264 or metadata streams where we save up to 1 kB
933 3         3 my $saveLen;
934 3 100 66     10 if (not $pidType{$pid} or $pidType{$pid} == 0x1b) {
    50          
935 2         3 $saveLen = 1024;
936             } elsif ($pidType{$pid} == 0x15) {
937             # use 1024 or actual size of metadata packet if smaller
938 0         0 $saveLen = 1024;
939 0 0 0     0 $saveLen = $packLen{$pid} if defined $packLen{$pid} and $saveLen > $packLen{$pid};
940             } else {
941 1         1 $saveLen = 256;
942             }
943 3 50       5 if (length($data{$pid}) >= $saveLen) {
944 0         0 my $more = ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
945 0 0       0 next if $more < 0; # wait for program map table (hopefully not too long)
946             # don't stop parsing if we weren't successful and may have missed the start
947 0 0 0     0 $more = 1 if not $more and not $fromStart{$pid};
948 0         0 delete $data{$pid};
949 0         0 delete $fromStart{$pid};
950 0 0       0 $more and $needPID{$pid} = -1, next; # parse more of these
951 0         0 delete $needPID{$pid};
952 0         0 $didPID{$pid} = 1;
953             }
954 3         3 next;
955             }
956 2 50       5 if ($needPID{$pid}) {
957             # we found and parsed a section with this PID, so
958             # delete from the lookup of PID's we still need to parse
959 2         4 delete $needPID{$pid};
960 2         3 $didPID{$pid} = 1;
961             }
962             }
963              
964             # calculate Duration if available
965 1 50       2 $endTime = $fwdTime unless defined $endTime;
966 1 50 33     10 if (defined $startTime and defined $endTime) {
967 1 50       3 $endTime += 0x80000000 * 1200 if $startTime > $endTime; # handle 33-bit wrap
968 1         3 $et->HandleTag($tagTablePtr, 'Duration', $endTime - $startTime);
969             }
970              
971 1 50       3 if ($verbose) {
972 0         0 my @need;
973 0         0 foreach (keys %needPID) {
974 0 0       0 push @need, sprintf('0x%.2x',$_) if $needPID{$_} > 0;
975             }
976 0 0       0 if (@need) {
977 0         0 @need = sort @need;
978 0         0 print $out "End of file. Missing PID(s): @need\n";
979             } else {
980 0 0       0 my $what = $eof ? 'of file' : 'scan';
981 0         0 print $out "End $what. All PID's parsed.\n";
982             }
983             }
984              
985             # parse any remaining partial PID streams
986 1         2 my $pid;
987 1         4 foreach $pid (sort keys %data) {
988 2         8 ParsePID($et, $pid, $pidType{$pid}, $pidName{$pid}, \$data{$pid});
989 2         4 delete $data{$pid};
990             }
991              
992             # look for LIGOGPSINFO trailer
993 1 0 33     3 if ($et->Options('ExtractEmbedded') and
      33        
      0        
994             $raf->Seek(-8, 2) and $raf->Read($buff, 8) == 8 and
995             $buff =~ /^&&&&/)
996             {
997 0         0 my $len = unpack('x4N', $buff);
998 0 0 0     0 if ($len < $raf->Tell() and $raf->Seek(-$len, 2) and $raf->Read($buff,$len) == $len) {
      0        
999 0         0 my $tbl = GetTagTable('Image::ExifTool::QuickTime::Stream');
1000 0         0 my %dirInfo = ( DataPt => \$buff, DirStart => 8, DirName => 'LigoTrailer' );
1001 0         0 Image::ExifTool::LigoGPS::ProcessLigoGPS($et, \%dirInfo, $tbl);
1002             }
1003             }
1004              
1005 1         8 return 1;
1006             }
1007              
1008             1; # end
1009              
1010             __END__