424 lines
18 KiB
Perl
424 lines
18 KiB
Perl
#------------------------------------------------------------------------------
|
|
# File: LigoGPS.pm
|
|
#
|
|
# Description: Read LIGOGPSINFO timed GPS records
|
|
#
|
|
# Revisions: 2024-12-30 - P. Harvey Created
|
|
#------------------------------------------------------------------------------
|
|
package Image::ExifTool::LigoGPS;
|
|
|
|
use strict;
|
|
use vars qw($VERSION);
|
|
use Image::ExifTool;
|
|
|
|
$VERSION = '1.04';
|
|
|
|
sub ProcessLigoGPS($$$;$);
|
|
sub ProcessLigoJSON($$$);
|
|
sub OrderCipherDigits($$$;$);
|
|
|
|
my $knotsToKph = 1.852; # knots --> km/h
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Clean up cipher variables and print warning if deciphering was unsuccessful
|
|
# Inputs: 0) ExifTool ref
|
|
sub CleanupCipher($)
|
|
{
|
|
my $et = shift;
|
|
if ($$et{LigoCipher} and $$et{LigoCipher}{'next'}) {
|
|
$et->Warn('Not enough GPS points to determine cipher for decoding LIGOGPSINFO');
|
|
}
|
|
delete $$et{LigoCipher};
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Un-do LIGOGPS fuzzing
|
|
# Inputs: 0) fuzzed latitude, 1) fuzzed longitude, 2) scale factor
|
|
# Returns: 0) latitude, 1) longitude
|
|
sub UnfuzzLigoGPS($$$)
|
|
{
|
|
my ($lat, $lon, $scl) = @_;
|
|
my $lat2 = int($lat / 10) * 10;
|
|
my $lon2 = int($lon / 10) * 10;
|
|
return($lat2 + ($lon - $lon2) * $scl, $lon2 + ($lat - $lat2) * $scl);
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Decrypt LIGOGPSINFO record (starting with "####")
|
|
# Inputs: 0) encrypted GPS record incuding 8-byte header
|
|
# Returns: decrypted record including 4-byte uint32 header, or undef on error
|
|
sub DecryptLigoGPS($)
|
|
{
|
|
my $str = shift;
|
|
my $num = unpack('x4V',$str);
|
|
return undef if $num < 4;
|
|
$num = 0x84 if $num > 0x84; # (be safe)
|
|
my @in = unpack("x8C$num",$str);
|
|
my @out;
|
|
while (@in) {
|
|
my $b = shift @in; # get next byte in data
|
|
# upper 3 bits steer the decryption for this round
|
|
my $steeringBits = $b & 0xe0;
|
|
if ($steeringBits >= 0xc0) {
|
|
return undef if @in < 4; # next 4 bytes are encrypted data
|
|
push @out, (shift(@in) | $b & 0x01) ^ 0x20,
|
|
(shift(@in) | $b & 0x02) ^ 0x20,
|
|
(shift(@in) | $b & 0x0c) ^ 0x20,
|
|
shift(@in) ^ 0x20 | $b & 0x30;
|
|
} elsif ($steeringBits >= 0x40) {
|
|
return undef if @in < 3; # next 3 bytes are encrypted data
|
|
if ($steeringBits == 0x40) {
|
|
push @out, 0x20,
|
|
(shift(@in) | $b & 0x01) ^ 0x20,
|
|
(shift(@in) | $b & 0x06) ^ 0x20,
|
|
(shift(@in) | $b & 0x18) ^ 0x20;
|
|
} elsif ($steeringBits == 0x60) {
|
|
push @out, (shift(@in) | $b & 0x03) ^ 0x20,
|
|
0x20,
|
|
(shift(@in) | $b & 0x04) ^ 0x20,
|
|
(shift(@in) | $b & 0x18) ^ 0x20;
|
|
} elsif ($steeringBits == 0x80) {
|
|
push @out, (shift(@in) | $b & 0x03) ^ 0x20,
|
|
(shift(@in) | $b & 0x0c) ^ 0x20,
|
|
0x20,
|
|
(shift(@in) | $b & 0x10) ^ 0x20;
|
|
} else {
|
|
push @out, (shift(@in) | $b & 0x01) ^ 0x20,
|
|
(shift(@in) | $b & 0x06) ^ 0x20,
|
|
(shift(@in) | $b & 0x18) ^ 0x20,
|
|
0x20;
|
|
}
|
|
} elsif ($steeringBits == 0x00) {
|
|
return undef if @in < 1; # next byte is encrypted data
|
|
push @out, shift(@in) | $b & 0x13;
|
|
} else {
|
|
return undef; # (shouldn't happen)
|
|
}
|
|
}
|
|
return pack 'C*', @out;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Determine correct ordering of enciphered digits (unit digits of seconds)
|
|
# Inputs: 0) starting character code, 1) lookup for next character(s) in sequence
|
|
# 2) i/o list of ordered characters, 3) hash of used characters
|
|
# Returns: true if a consistent ordering was found
|
|
# - loops through all possible orders based on $next sequence until a complete
|
|
# cycle is established
|
|
# - this complexity is necessary because GPS may skip some seconds
|
|
sub OrderCipherDigits($$$;$)
|
|
{
|
|
my ($ch, $next, $order, $did) = @_;
|
|
$did or $did = { };
|
|
while ($$next{$ch}) {
|
|
if (@$order < 10) {
|
|
last if $$did{$ch};
|
|
} else {
|
|
# success if we have cycled through all 10 digits and back to the first
|
|
return 1 if @$order == 10 and $ch eq $$order[0];
|
|
last;
|
|
}
|
|
push @$order, $ch;
|
|
$$did{$ch} = 1;
|
|
# continue with next character if there is only one possibility
|
|
@{$$next{$ch}} == 1 and $ch = $$next{$ch}[0], next;
|
|
# otherwise, test all possibilities
|
|
my $n = $#$order;
|
|
foreach (@{$$next{$ch}}) {
|
|
my %did = %$did; # make a copy of the used-character lookup
|
|
return 1 if OrderCipherDigits($_, $next, $order, \%did);
|
|
$#$order = $n; # restore order and try next possibility
|
|
}
|
|
last;
|
|
}
|
|
return 0; # failure
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Decipher and parse LIGOGPSINFO record (starting with "####")
|
|
# Inputs: 0) ExifTool ref, 1) enciphered string, 2) tag table ref
|
|
# 3) true if GPS coordinates don't need de-fuzzing
|
|
# Returns: true if this looked like an enciphered string
|
|
# Notes: handles contained tags, but may defer handling until full cipher is known
|
|
sub DecipherLigoGPS($$$;$)
|
|
{
|
|
my ($et, $str, $tagTbl, $noFuzz) = @_;
|
|
|
|
# (enciphered characters must be in the range 0x30-0x5f ('0' - '_'))
|
|
$str =~ m[^####.{4}([0-_])[0-_]{3}/[0-_]{2}/[0-_]{2} ..([0-_])..([0-_]).([0-_]) ]s or return undef;
|
|
return undef unless $2 eq $3; # (colons in time string must be the same)
|
|
|
|
my $cipherInfo = $$et{LigoCipher};
|
|
unless ($cipherInfo) {
|
|
$cipherInfo = $$et{LigoCipher} = { cache => [ ], 'next' => { } };
|
|
$et->AddCleanup(\&CleanupCipher);
|
|
};
|
|
my $decipher = $$cipherInfo{decipher};
|
|
my $cache = $$cipherInfo{cache};
|
|
|
|
# determine the cipher code table based on the advancing 1's digit of seconds
|
|
unless ($decipher) {
|
|
push @$cache, $str; # cache records until we can decipher them
|
|
my $next = $$cipherInfo{next};
|
|
my ($millennium, $colon, $ch2) = ($1, $2, $4);
|
|
# determine the cipher lookup table
|
|
# (only characters in range 0x30-0x5f are encrypted)
|
|
my $ch1 = $$cipherInfo{ch1};
|
|
$$cipherInfo{ch1} = $ch2;
|
|
return 1 if not defined $ch1 or $ch1 eq $ch2; # ignore duplicate sequential digits
|
|
if ($$next{$ch1}) {
|
|
return 1 if grep /\Q$ch2\E/, @{$$next{$ch1}}; # don't add twice
|
|
push @{$$next{$ch1}}, $ch2;
|
|
} else {
|
|
$$next{$ch1} = [ $ch2 ];
|
|
}
|
|
# must wait until the lookup contains all 10 digits
|
|
scalar(keys %$next) < 10 and return 1;
|
|
# protect against trying to decipher bad data
|
|
scalar(keys %$next) > 10 and $$cipherInfo{'next'} = { }, return 1;
|
|
my (@order, $two);
|
|
return 1 unless OrderCipherDigits($ch1, $next, \@order);
|
|
# get index of enciphered "2" in ordered array
|
|
$order[$_] eq $millennium and $two = $_, last foreach 0..9;
|
|
defined $two or $et->Warn('Problem deciphering LIGOGPSINFO'), return 1;
|
|
delete $$cipherInfo{'next'}; # all done with 'next' lookup
|
|
my %decipher = ( $colon => ':' ); # (':' is the time separator)
|
|
foreach (0..9) {
|
|
my $ch = $order[($_ + $two - 2 + 10) % 10];
|
|
$decipher{$ch} = chr($_ + 0x30);
|
|
}
|
|
# may also know the lat/lon quadrant from the signs of the coordinates
|
|
if ($str =~ / ([0-_])$colon(-?).*? ([0-_])$colon(-?)/) {
|
|
@decipher{$1,$3} = ($2 ? 'S' : 'N', $4 ? 'W' : 'E');
|
|
unless ($2 or $4) {
|
|
my ($ns, $ew) = ($1, $3);
|
|
if ($$et{OPTIONS}{GPSQuadrant} and $$et{OPTIONS}{GPSQuadrant} =~ /^([NS])([EW])$/i) {
|
|
@decipher{$ns,$ew} = (uc($1), uc($2));
|
|
} else {
|
|
$et->Warn('May need to set API GPSQuadrant option (eg. "NW")');
|
|
}
|
|
}
|
|
}
|
|
# fill in unknown entries with '?' (only chars 0x30-0x5f are enciphered)
|
|
defined $decipher{$_} or $decipher{$_} = '?' foreach map(chr, 0x30..0x5f);
|
|
$decipher = $$cipherInfo{decipher} = \%decipher;
|
|
$str = shift @$cache; # start deciphering at oldest cache entry
|
|
}
|
|
|
|
# apply reverse cipher and extract GPS information
|
|
do {
|
|
my $pre = substr($str, 4, 4); # save second 4 bytes of header
|
|
($str = substr($str,8)) =~ s/\0+$//; # remove 8-byte header and null padding
|
|
$str =~ s/([0-_])/$$decipher{$1}/g; # decipher
|
|
if ($$et{OPTIONS}{Verbose} > 1) {
|
|
$et->VPrint(1, "$$et{INDENT}\(Deciphered: ".unpack('H8',$pre)." $str)\n");
|
|
}
|
|
# add back leading 4 bytes (int16u counter plus 2 unknown bytes), and parse
|
|
ParseLigoGPS($et, "$pre$str", $tagTbl, $noFuzz);
|
|
} while $str = shift @$cache;
|
|
|
|
return 1;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Parse decrypted/deciphered (but not defuzzed) LIGOGPSINFO record
|
|
# (record starts with 4-byte int32u counter followed by date/time, etc)
|
|
# Inputs: 0) ExifTool ref, 1) GPS string, 2) tag table ref, 3) not fuzzed
|
|
# Returns: nothing
|
|
sub ParseLigoGPS($$$;$)
|
|
{
|
|
my ($et, $str, $tagTbl, $noFuzz) = @_;
|
|
|
|
# example string input
|
|
# "....2022/09/19 12:45:24 N:31.285065 W:124.759483 46.93 km/h x:-0.000 y:-0.000 z:-0.000"
|
|
unless ($str=~ /^.{4}(\S+ \S+)\s+([NS?]):(-?)([.\d]+)\s+([EW?]):(-?)([\.\d]+)\s+([.\d]+)/s) {
|
|
$et->Warn('LIGOGPSINFO format error');
|
|
return;
|
|
}
|
|
my ($time,$latRef,$latNeg,$lat,$lonRef,$lonNeg,$lon,$spd) = ($1,$2,$3,$4,$5,$6,$7,$8);
|
|
my %gpsScl = ( 1 => 1.524855137, 2 => 1.456027985, 3 => 1.15368 );
|
|
my $spdScl = $noFuzz ? $knotsToKph : 1.85407333;
|
|
$$et{DOC_NUM} = ++$$et{DOC_COUNT};
|
|
$time =~ tr(/)(:);
|
|
# convert from DDMM.MMMMMM to DD.DDDDDD if necessary
|
|
# (speed wasn't scaled in my 1 sample with this format)
|
|
$lat =~ /^\d{3}/ and Image::ExifTool::QuickTime::ConvertLatLon($lat,$lon), $spdScl = 1;
|
|
unless ($noFuzz) { # unfuzz the coordinates if necessary
|
|
my $scl = $$et{OPTIONS}{LigoGPSScale} || $$et{LigoGPSScale} || 1;
|
|
$scl = $gpsScl{$scl} if $gpsScl{$scl};
|
|
($lat, $lon) = UnfuzzLigoGPS($lat, $lon, $scl);
|
|
}
|
|
# a final sanity check
|
|
($lat > 90 or $lon > 180) and $et->Warn('LIGOGPSINFO coordinates out of range'), return;
|
|
$$et{SET_GROUP1} = 'LIGO';
|
|
$et->HandleTag($tagTbl, 'GPSDateTime', $time);
|
|
# (ignore N/S/E/W if coordinate is signed)
|
|
$et->HandleTag($tagTbl, 'GPSLatitude', $lat * (($latNeg or $latRef eq 'S') ? -1 : 1));
|
|
$et->HandleTag($tagTbl, 'GPSLongitude', $lon * (($lonNeg or $lonRef eq 'W') ? -1 : 1));
|
|
$et->HandleTag($tagTbl, 'GPSSpeed', $spd * $spdScl);
|
|
$et->HandleTag($tagTbl, 'GPSTrack', $1) if $str =~ /\bA:(\S+)/;
|
|
$et->HandleTag($tagTbl, 'GPSAltitude', $1) if $str =~ /\bH:(\S+)/;
|
|
$et->HandleTag($tagTbl, 'MagneticVariation', $1) if $str =~ /\bM:(\S+)/;
|
|
# (have a sample where tab is used to separate acc components)
|
|
$et->HandleTag($tagTbl, 'Accelerometer',"$1 $2 $3") if $str =~ /x:(\S+)\sy:(\S+)\sz:(\S+)/;
|
|
delete $$et{SET_GROUP1};
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Process GKU dashcam trailer containing JSON-format LigoGPS
|
|
# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
|
|
# Returns: 1 on success
|
|
sub ProcessGKU($$$;$)
|
|
{
|
|
my ($et, $dirInfo, $tagTbl) = @_;
|
|
my $dataPt = $$dirInfo{DataPt};
|
|
my $pos = unpack('V', $$dataPt);
|
|
return 0 if $pos + 13 > length $$dataPt or substr($$dataPt, $pos, 13) ne 'LIGOGPSINFO {';
|
|
pos($$dataPt) = $pos;
|
|
return ProcessLigoJSON($et, $dirInfo, $tagTbl);
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Process LIGOGPSINFO data (non-JSON format)
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
|
# 3) 1=LIGOGPS lat/lon/spd weren't fuzzed
|
|
# Returns: 1 on success
|
|
# Notes: The directory data should start with the string "LIGOGPSINFO\0"
|
|
sub ProcessLigoGPS($$$;$)
|
|
{
|
|
my ($et, $dirInfo, $tagTbl, $noFuzz) = @_;
|
|
my $dataPt = $$dirInfo{DataPt};
|
|
my $pos = ($$dirInfo{DirStart} || 0) + 0x14;
|
|
return undef if $pos > length $$dataPt;
|
|
my $cipherInfo = $$et{LigoCipher};
|
|
my $dirName = $$dirInfo{DirName} || 'LigoGPS';
|
|
push @{$$et{PATH}}, $dirName unless $$dirInfo{DirID};
|
|
# not fuzzed if header =~ /LIGOGPSINFO\0\0\0\0[\x01\x14]/ (\x01=BlueSkySeaDV688)
|
|
$noFuzz = 1 if substr($$dataPt, $pos-8, 4) =~ /^\0\0\0[\x01\x14]/;
|
|
$et->VerboseDir($dirName);
|
|
for (; $pos + 0x84 <= length($$dataPt); $pos+=0x84) {
|
|
my $dat = substr($$dataPt, $pos, 0x84);
|
|
$dat =~ /^####/ or next; # (have seen blank records filled with zeros, so keep trying)
|
|
# decipher if we already know the encryption
|
|
$cipherInfo and $$cipherInfo{decipher} and DecipherLigoGPS($et, $dat, $tagTbl, $noFuzz) and next;
|
|
my $str = DecryptLigoGPS($dat);
|
|
defined $str or DecipherLigoGPS($et, $dat, $tagTbl, $noFuzz), next; # try to decipher
|
|
$et->VPrint(1, "$$et{INDENT}\(Decrypted: ",unpack('V',$str),' ',substr($str,4),")\n") if $$et{OPTIONS}{Verbose} > 1;
|
|
ParseLigoGPS($et, $str, $tagTbl, $noFuzz);
|
|
}
|
|
pop @{$$et{PATH}} unless $$dirInfo{DirID};
|
|
delete $$et{DOC_NUM};
|
|
return 1;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Process LIGOGPSINFO JSON-format GPS (Yada RoadCam Pro 4K BT58189)
|
|
# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
|
|
# Returns: 1 on success
|
|
# Sample data (chained 512-byte records starting like this):
|
|
# 0000: 4c 49 47 4f 47 50 53 49 4e 46 4f 20 7b 22 48 6f [LIGOGPSINFO {"Ho]
|
|
# 0010: 75 72 22 3a 20 22 32 33 22 2c 20 22 4d 69 6e 75 [ur": "23", "Minu]
|
|
# 0020: 74 65 22 3a 20 22 31 30 22 2c 20 22 53 65 63 6f [te": "10", "Seco]
|
|
# 0030: 6e 64 22 3a 20 22 32 32 22 2c 20 22 59 65 61 72 [nd": "22", "Year]
|
|
# 0040: 22 3a 20 22 32 30 32 33 22 2c 20 22 4d 6f 6e 74 [": "2023", "Mont]
|
|
# 0050: 68 22 3a 20 22 31 32 22 2c 20 22 44 61 79 22 3a [h": "12", "Day":]
|
|
# 0060: 20 22 32 38 22 2c 20 22 73 74 61 74 75 73 22 3a [ "28", "status":]
|
|
sub ProcessLigoJSON($$$)
|
|
{
|
|
my ($et, $dirInfo, $tagTbl) = @_;
|
|
my $dataPt = $$dirInfo{DataPt};
|
|
my $dirLen = $$dirInfo{DirLen};
|
|
require Image::ExifTool::Import;
|
|
$et->VerboseDir('LIGO_JSON', undef, length($$dataPt) - pos($$dataPt));
|
|
$$et{SET_GROUP1} = 'LIGO';
|
|
while ($$dataPt =~ /LIGOGPSINFO (\{.*?\})/g) {
|
|
my $json = $1;
|
|
my %dbase;
|
|
Image::ExifTool::Import::ReadJSON(\$json, \%dbase);
|
|
my $info = $dbase{'*'} or next;
|
|
# my sample contains the following JSON fields (in this order):
|
|
# Hour Minute Second Year Month Day (GPS UTC time)
|
|
# status NS EW Latitude Longitude Speed (speed in knots)
|
|
# GsensorX GsensorY GsensorZ (units? - only seen "000" for all)
|
|
# MHour MMinute MSecond MYear MMonth MDay (local dashcam clock time)
|
|
# OLatitude OLongitude (? same values as Latitude/Longitude)
|
|
next unless defined $$info{status} and $$info{status} eq 'A'; # only read if GPS is active
|
|
$$et{DOC_NUM} = ++$$et{DOC_COUNT};
|
|
my $num = 0;
|
|
defined $$info{$_} and ++$num foreach qw(Year Month Day Hour Minute Second);
|
|
if ($num == 6) {
|
|
# this is the GPS time in UTC
|
|
my $time = sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2dZ',@$info{qw{Year Month Day Hour Minute Second}});
|
|
$et->HandleTag($tagTbl, GPSDateTime => $time);
|
|
}
|
|
if ($$info{Latitude} and $$info{Longitude}) {
|
|
my $lat = $$info{Latitude};
|
|
$lat = -$lat if $$info{NS} and $$info{NS} eq 'S';
|
|
my $lon = $$info{Longitude};
|
|
$lon = -$lon if $$info{EW} and $$info{EW} eq 'W';
|
|
$et->HandleTag($tagTbl, GPSLatitude => $lat);
|
|
$et->HandleTag($tagTbl, GPSLongitude => $lon);
|
|
}
|
|
$et->HandleTag($tagTbl, GPSSpeed => $$info{Speed} * $knotsToKph) if defined $$info{Speed};
|
|
if (defined $$info{GsensorX} and defined $$info{GsensorY} and defined $$info{GsensorZ}) {
|
|
# (don't know conversion factor for accel data, so leave it raw for now)
|
|
$et->HandleTag($tagTbl, Accelerometer => "$$info{GsensorX} $$info{GsensorY} $$info{GsensorZ}");
|
|
}
|
|
$num = 0;
|
|
defined $$info{$_} and ++$num foreach qw(MYear MMonth MDay MHour MMinute MSecond);
|
|
if ($num == 6) {
|
|
# this is the dashcam clock time (local time zone)
|
|
my $time = sprintf('%.4d:%.2d:%.2d %.2d:%.2d:%.2d',@$info{qw{MYear MMonth MDay MHour MMinute MSecond}});
|
|
$et->HandleTag($tagTbl, DateTimeOriginal => $time);
|
|
}
|
|
if (defined $$info{OLatitude} and defined $$info{OLongitude}) {
|
|
my $lat = $$info{OLatitude};
|
|
$lat = -$lat if $$info{NS} and $$info{NS} eq 'S';
|
|
my $lon = $$info{OLongitude};
|
|
$lon = -$lon if $$info{EW} and $$info{EW} eq 'W';
|
|
$et->HandleTag($tagTbl, GPSLatitude2 => $lat);
|
|
$et->HandleTag($tagTbl, GPSLongitude2 => $lon);
|
|
}
|
|
unless ($et->Options('ExtractEmbedded')) {
|
|
$et->Warn('Use the ExtractEmbedded option to extract all timed GPS',3);
|
|
last;
|
|
}
|
|
}
|
|
delete $$et{DOC_NUM};
|
|
delete $$et{SET_GROUP1};
|
|
return 1;
|
|
}
|
|
|
|
1; #end
|
|
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Image::ExifTool::LigoGPS - Read LIGOGPSINFO timed GPS records
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
This module is loaded automatically by Image::ExifTool when required.
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module decrypts, deciphers and decodes timed GPS metadata from
|
|
LIGOGPSINFO records found in various locations of MP4 and M2TS videos from a
|
|
variety of dashcam makes and models.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Copyright 2003-2025, 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 SEE ALSO
|
|
|
|
L<Image::ExifTool::TagNames/QuickTime Stream Tags>,
|
|
L<Image::ExifTool(3pm)|Image::ExifTool>
|
|
|
|
=cut
|