bin/lib/Image/ExifTool/GM.pm
#------------------------------------------------------------------------------
# File: GM.pm
#
# Description: Read GM PDR metadata from automobile videos
#
# Revisions: 2024-04-01 - P. Harvey Created
#
# References: 1) https://exiftool.org/forum/index.php?topic=11335
#------------------------------------------------------------------------------
package Image::ExifTool::GM;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
use Image::ExifTool::GPS;
$VERSION = '1.01';
sub Process_marl($$$);
sub Process_mrld($$$);
sub Process_mrlv($$$);
sub PrintCSV($;$);
# rename some units strings
my %convertUnits = (
"\xc2\xb0" => 'deg',
"\xc2\xb0C" => 'C',
"\xc2\xb0/sec" => 'deg/sec',
ltr => 'L',
);
my $pi = 3.141592653589793;
# offsets and scaling factors to convert to reasonable units
my %changeOffset = (
C => -273.15, # K to C
);
my %changeScale = (
G => 1 / 9.80665, # m/s2 to G
kph => 3.6, # m/s to km/h
deg => 180 / $pi, # radians to degrees
'deg/sec' => 180 / $pi, # rad/s to deg/s
'%' => 100, # decimal to %
kPa => 1/1000, # Pa to kPa
rpm => 10, # ? (arbitrary factor of 10)
km => 1/1000, # m to km
L => 1000, # m3 to L
mm => 1000, # m to mm
);
# default print conversions for various types of units
my %printConv = (
rpm => 'sprintf("%.2f rpm", $val)',
'%' => 'sprintf("%.2f %%", $val)',
kPa => 'sprintf("%.2f kPa", $val)',
G => 'sprintf("%.3f G", $val)',
km => 'sprintf("%.3f km", $val)',
kph => 'sprintf("%.2f km/h", $val)',
deg => 'sprintf("%.2f deg", $val)',
'deg/sec' => 'sprintf("%.2f deg/sec", $val)',
);
# channel parameters extracted from marl dictionary
my @channel = qw(
ID Type Num Units Flags Interval Min Max DispMin DispMax Multiplier Offset
Name Description
);
my %channelStruct = (
STRUCT_NAME => 'GM Channel',
NOTES => 'Information stored for each channel in the Marlin dictionary.',
SORT_ORDER => \@channel,
ID => { Writable => 0, Notes => 'channel ID number' },
Type => { Writable => 0, Notes => 'measurement type' },
Num => { Writable => 0, Notes => 'units ID number' },
Units => { Writable => 0, Notes => 'units string' },
Flags => { Writable => 0, Notes => 'channel flags' },
Interval=> { Writable => 0, Notes => 'measurement interval', ValueConv => '$val / 1e7', PrintConv => '"$val s"' },
Min => { Writable => 0, Notes => 'raw value minimum' },
Max => { Writable => 0, Notes => 'raw value maximum' },
DispMin => { Writable => 0, Notes => 'displayed value minimum' },
DispMax => { Writable => 0, Notes => 'displayed value maximum' },
Multiplier=>{Writable => 0, Notes => 'multiplier for raw value' },
Offset => { Writable => 0, Notes => 'offset for scaled value' },
Name => { Writable => 0, Notes => 'channel name' },
Description=>{Writable=> 0, Notes => 'channel description' },
);
# tags found in the 'mrlh' (marl header) atom
%Image::ExifTool::GM::mrlh = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
NOTES => 'The Marlin PDR header.',
0 => { Name => 'MarlinDataVersion', Format => 'int16u[2]', PrintConv => '$val =~ tr/ /./; $val' },
);
# tags found in the 'mrlv' (Marlin values) atom
%Image::ExifTool::GM::mrlv = (
PROCESS_PROC => \&Process_mrlv,
FORMAT => 'string',
NOTES => q{Tags found in the 'mrlv' (Marlin values) box.},
'time'=> { Name => 'Time1', Groups => { 2 => 'Time' }, ValueConv => '$val =~ tr/-/:/; $val' },
date => { Name => 'Date1', Groups => { 2 => 'Time' }, ValueConv => '$val =~ tr/-/:/; $val' },
ltim => { Name => 'Time2', Groups => { 2 => 'Time' }, ValueConv => '$val =~ tr/-/:/; $val' },
ldat => { Name => 'Date2', Groups => { 2 => 'Time' }, ValueConv => '$val =~ tr/-/:/; $val' },
tstm => {
Name => 'StartTime',
Groups => { 2 => 'Time' },
Format => 'int64u',
RawConv => '$$self{GMStartTime} = $val / 1e7',
ValueConv => 'ConvertUnixTime($val, undef, 6)', # (likely UTC, but not sure so don't add time zone)
PrintConv => '$self->ConvertDateTime($val)',
},
zone => { Name => 'TimeZone', Groups => { 2 => 'Time' } },
lang => 'Language',
unit => { Name => 'Units', PrintConv => { usim => 'U.S. Imperial' } },
swvs => 'SoftwareVersion',
# id ? ""
# cntr ? ""
# flap ? ""
);
# tags found in the 'mrld' (Marlin dictionary) atom
%Image::ExifTool::GM::mrld = (
PROCESS_PROC => \&Process_mrld,
VARS => { ADD_FLATTENED => 1 },
WRITABLE => 0,
NOTES => q{
The Marlin dictionary. Only one channel is listed but all available
channels are extracted. Use the -struct (L<API Struct|../ExifTool.html#Struct>) option to extract the
channel information as structures.
},
Channel01 => { Struct => \%channelStruct },
);
# tags found in 'marl' ctbx timed metadata
%Image::ExifTool::GM::marl = (
PROCESS_PROC => \&Process_marl,
GROUPS => { 2 => 'Other' },
VARS => { NO_ID => 1, NO_LOOKUP => 1 },
NOTES => q{
Tags extracted from the 'ctbx' 'marl' (Marlin) box of timed PDR metadata
from GM cars. Use the -ee (L<API ExtractEmbedded|../ExifTool.html#ExtractEmbedded>) option to extract this
information, or the L<API PrintCSV|../ExifTool.html#PrintCSV> option to output in CSV format.
},
TimeStamp => { # (the marl timestamp)
Groups => { 2 => 'Time' },
Notes => q{
the numerical value is seconds since start of video, but the print
conversion adds StartTime to provide a date/time value. Extracted as
GPSDateTime if requested
},
ValueConv => '$val / 1e7',
PrintConv => q{
return "$val s" unless $$self{GMStartTime};
return $self->ConvertDateTime(ConvertUnixTime($val+$$self{GMStartTime},undef,6));
},
},
GPSDateTime => { # (alternative for TimeStamp)
Groups => { 2 => 'Time' },
Notes => 'generated from the TimeStamp only if specifically requested',
RawConv => '$$self{GMStartTime} ? $val : undef',
ValueConv => 'ConvertUnixTime($val / 1e7 + $$self{GMStartTime}) . "Z"',
PrintConv => '$self->ConvertDateTime($val,undef,6)',
},
Latitude => {
Name => 'GPSLatitude',
Description => 'GPS Latitude', # (need description so we don't set it from the mrld)
Groups => { 2 => 'Location' },
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")',
},
Longitude => {
Name => 'GPSLongitude',
Description => 'GPS Longitude',
Groups => { 2 => 'Location' },
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")',
},
Altitude => {
Name => 'GPSAltitude',
Description => 'GPS Altitude',
Groups => { 2 => 'Location' },
},
Heading => {
Name => 'GPSTrack',
Description => 'GPS Track',
Groups => { 2 => 'Location' },
PrintConv => '$val > 360 ? "n/a" : sprintf("%.2f",$val)', # (seen 655.35)
},
ABSActive => { },
AccelPos => { },
BatteryVoltage => { },
Beacon => { },
BoostPressureInd => { },
BrakePos => { },
ClutchPos => { },
CoolantTemp => { },
CornerExitSetting => { },
CPUFree => { },
CPUIO => { },
CPUIRQ => { },
CPUSystem => { },
CPUUser => { },
DiskReadOperations => { },
DiskReadRate => { },
DiskReadTime => { },
DiskWriteOperations => { },
DiskWriteRate => { },
DiskWriteTime => { },
Distance => { },
DriverPerformanceMode => { },
EngineSpeedRequest => { },
EngineTorqureReq => { },
FuelCapacity => { },
FuelLevel => { },
Gear => {
Notes => q{
in the PrintCSV output, the value for Neutral is set to -1, and Reverse to
-100 for compatibility with RaceRender
},
CSVConv => { 13 => -1, 14 => -100 },
PrintConv => { 1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 13=>'N', 14=>'R' }
},
GPSFix => { },
InfotainOpMode => { },
IntakeAirTemperature => { },
IntakeBoostPressure => { },
LateralAcceleration => { },
LFTyrePressure => { },
LFTyreTemp => { },
LongitudinalAcceleration => { },
LRTyrePressure => { },
LRTyreTemp => { },
OilPressure => { },
OilTemp => { },
OutsideAirTemperature => { },
RecordingEventOdometer => { },
RFTyrePressure => { },
RFTyreTemp => { },
RPM => { },
RRTyrePressure => { },
RRTyreTemp => { },
Speed => { Groups => { 2 => 'Location' } },
SpeedControlResponse => { },
SpeedRequestIntervention => { },
Steering1Switch => { },
Steering2Switch => { },
SteeringAngle => { },
SuspensionDisplacementLeftFront => { },
SuspensionDisplacementLeftRear => { },
SuspensionDisplacementRightFront => { },
SuspensionDisplacementRightRear => { },
SystemBackupPowerEnabled => { },
SystemBackupPowerMode => { },
SystemPowerMode => { },
TractionControlActive => { },
TransOilTemp => { },
TransportStorageMode => { },
ValetMode => { },
VehicleStabilityActive => { },
VerticalAcceleration => { },
WheelspeedLeftDriven => { },
'WheelspeedLeftNon-Driven' => { },
WheelspeedRightDriven => { },
'WheelspeedRightNon-Driven' => { },
YawRate => { },
);
#------------------------------------------------------------------------------
# Print a CSV row
# Inputs: 0) ExifTool ref, 1) time stamp
sub PrintCSV($;$)
{
my ($et, $ts) = @_;
my $csv = $$et{GMCsv} or return; # get the list of channels with measurements
@$csv or return;
my $vals = $$et{GMVals};
my $gmDict = $$et{GMDictionary};
my @items = ('') x scalar(@$gmDict);
$items[0] = ($ts || $$et{GMMaxTS}) / 1e7;
# fill in scaled measurements for this TimeStamp
foreach (@$csv) {
my $gmChan = $$gmDict[$_];
$items[$_] = $$vals[$_] * $$gmChan{Mult} + $$gmChan{Off};
# apply CSV conversion if applicable (ie. Gear)
next unless $$gmChan{Conv} and defined $$gmChan{Conv}{$items[$_]};
$items[$_] = $$gmChan{Conv}{$items[$_]};
}
my $out = $$et{OPTIONS}{TextOut};
print $out join(',',@items),"\n";
@$csv = (); # clear the channel list
}
#------------------------------------------------------------------------------
# Process GM Marlin values ('mrlv' box)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub Process_mrlv($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $dirLen = length $$dataPt;
my $pos = 0;
# data lengths for known formats
my %fmtLen = (
strs => 64, lang => 64, strl => 256, 'time' => 32, date => 32,
tmzn => 32, tstm => 8, focc => 4, "kvp\0" => 64+256,
);
$et->VerboseDir('mrlv', undef, $dirLen);
while ($pos + 8 <= $dirLen) {
my $tag = substr($$dataPt, $pos, 4);
my $fmt = substr($$dataPt, $pos + 4, 4);
my $len = $fmtLen{$fmt};
unless ($len) {
($tag, $fmt) = (PrintableTagID($tag), PrintableTagID($fmt));
$et->Warn("Unknown format ($fmt) for tag $tag");
last;
}
$pos + 8 + $len > $dirLen and $et->Warn('Truncated mrlv data'), last;
$et->HandleTag($tagTablePtr, $tag, undef,
DataPt => $dataPt,
DataPos => $dataPos,
Start => $pos + 8,
Size => $len,
);
$pos += 8 + $len;
}
return 1;
}
#------------------------------------------------------------------------------
# Process GM Marlin dictionary ('mrld' box)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
sub Process_mrld($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos};
my $dirLen = length $$dataPt;
my $struct = $et->Options('Struct') || 0;
my $gmDict = $$et{GMDictionary} = [ ];
my $marl = GetTagTable('Image::ExifTool::GM::marl');
my ($pos, $item, $csv);
$et->VerboseDir('mrld', undef, $dirLen);
require 'Image/ExifTool/XMPStruct.pl';
Image::ExifTool::XMP::AddFlattenedTags($tagTablePtr);
$csv = [ ] if $et->Options('PrintCSV');
for ($pos=0; $pos+448<=$dirLen; $pos+=448) {
# unpack 448-byte records:
# 0. int32u - channel number
# 1. int32u - measurement type
# 2. int32u - units number
# 3. string[64] - units string
# 4. int32u - flags (0.visible, 1.linear conversion, 2.interpolation OK)
# 5. int64u - interval
# 6. int32s - min reading
# 7. int32s - max reading
# 8. double - disp min
# 9. double - disp max
# 10. double - multiplier
# 11. double - offset
# 12. string[64] - channel name
# 13. string[64] - channel description
my @a = unpack("x${pos}NNNZ64Na8N2a8a8a8a8Z64Z64", $$dataPt);
my $units = $convertUnits{$a[3]} || $a[3];
$a[3] = $et->Decode($a[3], 'UTF8'); # convert from UTF8
$_ & 0x8000000 and $_ -= 4294967296 foreach @a[6,7]; # convert signed ints
map { $_ = GetDouble(\$_,0) } @a[8,9,10,11]; # convert doubles
$a[5] = Get64u(\$a[5],0); # convert 64-bit int
my $chan = $a[0];
my $tag = sprintf('Channel%.2d', $chan);
my $tagInfo = $$tagTablePtr{$tag};
my $hash = { map { $channel[$_] => $a[$_] } 1..$#a };
unless ($tagInfo) {
$tagInfo = AddTagToTable($tagTablePtr, $tag, { Name => $tag, Struct => \%channelStruct });
Image::ExifTool::XMP::AddFlattenedTags($tagTablePtr, $tag);
}
# extract channel structure if specified
if ($struct) {
$$hash{_ordered_keys_} = [ @channel[1..$#channel] ];
$et->FoundTag($tagInfo, $hash);
}
# extract flattened channel elements
if ($struct == 0 or $struct == 2) {
$et->HandleTag($tagTablePtr, "$tag$channel[$_]", $a[$_]) foreach 1..$#a;
}
# add corresponding tag to marl table
my $name = Image::ExifTool::MakeTagName($a[12]);
$tagInfo = $$marl{$name};
unless ($tagInfo) {
$et->VPrint(0, $$et{INDENT}, "[adding $name]\n");
$tagInfo = AddTagToTable($marl, $name, { });
}
$$tagInfo{Description} = $a[13] unless $$tagInfo{Description};
unless ($$tagInfo{PrintConv}) {
# add a default print conversion
$units =~ tr/"\\//d; # (just to be safe, probably never happen)
$$tagInfo{PrintConv} = $printConv{$units} || qq("\$val $units");
}
# adjust multiplier/offset as necessary to scale to more appropriate units
# (ie. to the units actually specified in this dictionary -- d'oh)
my $mult = $a[10] * ($changeScale{$units} || 1);
my $off = $a[11] * ($changeScale{$units} || 1) + ($changeOffset{$units} || 0);
my $init = int(($a[6] + $a[7]) / 2); # initial value for difference readings
# save information about this channel necessary for processing the marl data
$$gmDict[$chan] = { Name => $name, Mult => $mult, Off => $off, Init => $init };
$$gmDict[$chan]{Conv} = $$tagInfo{CSVConv};
$csv and $$csv[$chan] = $a[12] . ($a[3] ? " ($a[3])" : '');
}
# channel 0 must not be defined because we use it for the TimeStamp
if (defined $$gmDict[0]) {
$et->Warn('Internal error: PDR channel 0 is used');
delete $$et{GMDictionary};
} elsif ($csv) {
$$csv[0] = 'Time (s)';
defined $_ or $_ = '' foreach @$csv;
my $out = $$et{OPTIONS}{TextOut};
print $out join(',',@$csv),"\n";
$$et{GMCsv} = [ ];
}
$et->AddCleanup(\&PrintCSV); # print last CSV line when we are done
# initialize variables for processing marl box
$$et{GMVals} = [ ];
$$et{GMMaxTS} = 0;
$$et{GMBadChan} = 0;
return 1;
}
#------------------------------------------------------------------------------
# Process GM 'marl' ctbx data (ref PH)
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
# Returns: 1 on success
# (see https://exiftool.org/forum/index.php?topic=11335.msg61393#msg61393)
sub Process_marl($$$)
{
my ($et, $dirInfo, $tagTablePtr) = @_;
my $dataPt = $$dirInfo{DataPt};
my $dataPos = $$dirInfo{DataPos} + $$dirInfo{Base};
my $dataLen = length $$dataPt;
my $vals = $$et{GMVals}; # running values for each channel (0=TimeStamp)
my $chan = $$et{GMChan}; # running channel number
my $gmDict = $$et{GMDictionary};
my $csv = $$et{GMCsv};
my $maxTS = $$et{GMMaxTS};
my $reqGPSDateTime = $$et{REQ_TAG_LOOKUP}{gpsdatetime};
my $reqTimeStamp = $reqGPSDateTime ? $$et{REQ_TAG_LOOKUP}{timestamp} : 1;
my ($pos, $verbose2);
$et->VerboseDir('marl', undef, $dataLen);
$gmDict or $et->Warn('Missing marl dictionary'), return 0;
my $maxChan = $#$gmDict;
$verbose2 = 1 if $et->Options('Verbose') > 1;
$$vals[0] = -1 unless defined $$vals[0]; # (we use the 0th channel for the TimeStamp)
my $ts = $$vals[0];
for ($pos=0; $pos + 8 <= $dataLen; $pos += 8) {
my @a = unpack("x${pos}NN", $$dataPt);
my $ah = $a[0] >> 24;
my $a2 = $ah & 0xc0;
my ($val, $chanDiff, $valDiff, @ts, $gmChan);
if ($a2 == 0xc0) { # 16-byte full record?
last if $ah == 0xff; # exit at first empty record
$chan = $a[0] & 0x0fffffff;
$gmChan = $$gmDict[$chan] or next; # (shouldn't happen)
$val = $a[1] - ($a[1] & 0x80000000 ? 4294967296 : 0);
$$vals[$chan] = $val;
last if $pos + 16 > $dataLen; # (shouldn't happen)
$pos += 8; # point at time stamp
@ts = unpack("x${pos}NN", $$dataPt);
$ts = $ts[0] * 4294967296 + $ts[1];
} elsif ($a2 == 0x40) { # 8-byte difference record?
next unless defined $chan; # (shouldn't happen)
$ts += $a[1]; # increment time stamp
$chanDiff = ($ah & 0x3f) - ($ah & 0x20 ? 0x40 : 0);
$chan += $chanDiff; # increment the running channel number
$gmChan = $$gmDict[$chan] or next; # (shouldn't happen)
defined $$vals[$chan] or $$vals[$chan] = $$gmChan{Init}; # init if necessary
$valDiff = ($a[0] & 0x00ffffff) - ($a[0] & 0x00800000 ? 0x01000000 : 0);
$val = ($$vals[$chan] += $valDiff); # increment the running value for this channel
} else {
next; # (shouldn't happen)
}
# ensure that the timestamps are monotonically increasing
# (have seen backward steps up to 0.033 sec, so fudge these)
if ($ts > $maxTS) {
if ($csv) {
PrintCSV($et, $maxTS);
} else {
$$et{DOC_NUM} = ++$$et{DOC_COUNT};
$et->HandleTag($tagTablePtr, TimeStamp => $ts) if $reqTimeStamp;
$et->HandleTag($tagTablePtr, GPSDateTime => $ts) if $reqGPSDateTime;
}
$maxTS = $ts;
}
$csv and push(@$csv, $chan), next;
my $scaled = $val * $$gmChan{Mult} + $$gmChan{Off};
$et->HandleTag($tagTablePtr, $$gmChan{Name}, $scaled);
if ($verbose2) {
my $str = " * $$gmChan{Mult} + $$gmChan{Off} = $scaled";
my $p0 = $dataPos + $pos - ($a2 == 0xc0 ? 8 : 0);
my ($cd,$vd) = @ts ? ('','') : (sprintf('%+d',$chanDiff),sprintf('%+d',$valDiff));
printf "| %8.4x: %.8x %.8x chan$cd=%.2d $$gmChan{Name}$vd = $val$str\n", $p0, @a, $chan;
printf("| %8.4x: %.8x %.8x TimeStamp = %.6f sec\n", $dataPos + $pos, @ts, $ts / 1e7) if @ts;
}
}
$$vals[0] = $ts; # save last timestamp
$$et{GMChan} = $chan; # save last channel number
$$et{GMMaxTS} = $ts;
delete $$et{DOC_NUM};
return 1;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::GM - Read GM PDR Data from automobile videos
=head1 SYNOPSIS
This module is loaded automatically by Image::ExifTool when required.
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read PDR
metadata from videos written by some GM models such as Corvette and Camero.
=head1 AUTHOR
Copyright 2003-2024, Phil Harvey (philharvey66 at gmail.com)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 REFERENCES
=over 4
=item L<https://exiftool.org/forum/index.php?topic=11335>
=back
=head1 SEE ALSO
L<Image::ExifTool::TagNames/GM Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut