exiftool_vendored 13.38.0 → 13.40.0
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- checksums.yaml +4 -4
- data/bin/Changes +23 -0
- data/bin/MANIFEST +3 -0
- data/bin/META.json +1 -1
- data/bin/META.yml +1 -1
- data/bin/README +49 -47
- data/bin/config_files/local_time.config +55 -0
- data/bin/exiftool +65 -54
- data/bin/lib/Image/ExifTool/DJI.pm +256 -20
- data/bin/lib/Image/ExifTool/Font.pm +386 -118
- data/bin/lib/Image/ExifTool/Geolocation.pm +10 -7
- data/bin/lib/Image/ExifTool/Geotag.pm +18 -1
- data/bin/lib/Image/ExifTool/LNK.pm +63 -2
- data/bin/lib/Image/ExifTool/OOXML.pm +3 -2
- data/bin/lib/Image/ExifTool/Olympus.pm +3 -1
- data/bin/lib/Image/ExifTool/Pentax.pm +7 -2
- data/bin/lib/Image/ExifTool/QuickTime.pm +3 -3
- data/bin/lib/Image/ExifTool/QuickTimeStream.pl +42 -35
- data/bin/lib/Image/ExifTool/Sony.pm +14 -9
- data/bin/lib/Image/ExifTool/TagLookup.pm +27 -0
- data/bin/lib/Image/ExifTool/TagNames.pod +151 -21
- data/bin/lib/Image/ExifTool/XMP2.pl +11 -5
- data/bin/lib/Image/ExifTool.pm +9 -4
- data/bin/lib/Image/ExifTool.pod +52 -45
- data/bin/perl-Image-ExifTool.spec +47 -46
- data/lib/exiftool_vendored/version.rb +1 -1
- metadata +2 -1
|
@@ -11,6 +11,8 @@
|
|
|
11
11
|
# 4) http://partners.adobe.com/public/developer/en/font/5178.PFM.pdf
|
|
12
12
|
# 5) http://opensource.adobe.com/svn/opensource/flex/sdk/trunk/modules/compiler/src/java/flex2/compiler/util/MimeMappings.java
|
|
13
13
|
# 6) http://www.adobe.com/devnet/font/pdfs/5004.AFM_Spec.pdf
|
|
14
|
+
# 7) https://www.w3.org/TR/WOFF/
|
|
15
|
+
# 8) https://www.w3.org/TR/WOFF2/
|
|
14
16
|
#------------------------------------------------------------------------------
|
|
15
17
|
|
|
16
18
|
package Image::ExifTool::Font;
|
|
@@ -18,11 +20,15 @@ package Image::ExifTool::Font;
|
|
|
18
20
|
use strict;
|
|
19
21
|
use vars qw($VERSION %ttLang);
|
|
20
22
|
use Image::ExifTool qw(:DataAccess :Utils);
|
|
23
|
+
use Image::ExifTool::XMP;
|
|
21
24
|
|
|
22
|
-
$VERSION = '1.
|
|
25
|
+
$VERSION = '1.12';
|
|
23
26
|
|
|
24
27
|
sub ProcessOTF($$);
|
|
25
28
|
|
|
29
|
+
# OTF tags to process (skip all others)
|
|
30
|
+
my %processTag = ( name => 1, C2PA => 1 );
|
|
31
|
+
|
|
26
32
|
# TrueType 'name' platform codes
|
|
27
33
|
my %ttPlatform = (
|
|
28
34
|
0 => 'Unicode',
|
|
@@ -178,13 +184,24 @@ my %ttCharset = (
|
|
|
178
184
|
Custom => { },
|
|
179
185
|
);
|
|
180
186
|
|
|
187
|
+
# codes for the 63 known WOFF2 tags
|
|
188
|
+
my @knownTags = (
|
|
189
|
+
'cmap', 'head', 'hhea', 'hmtx', 'maxp', 'name', 'OS/2', 'post', 'cvt',
|
|
190
|
+
'fpgm', 'glyf', 'loca', 'prep', 'CFF', 'VORG', 'EBDT', 'EBLC', 'gasp',
|
|
191
|
+
'hdmx', 'kern', 'LTSH', 'PCLT', 'VDMX', 'vhea', 'vmtx', 'BASE', 'GDEF',
|
|
192
|
+
'GPOS', 'GSUB', 'EBSC', 'JSTF', 'MATH', 'CBDT', 'CBLC', 'COLR', 'CPAL',
|
|
193
|
+
'SVG', 'sbix', 'acnt', 'avar', 'bdat', 'bloc', 'bsln', 'cvar', 'fdsc',
|
|
194
|
+
'feat', 'fmtx', 'fvar', 'gvar', 'hsty', 'just', 'lcar', 'mort', 'morx',
|
|
195
|
+
'opbd', 'prop', 'trak', 'Zapf', 'Silf', 'Glat', 'Gloc', 'Feat', 'Sill',
|
|
196
|
+
);
|
|
197
|
+
|
|
181
198
|
# eclectic table of tags for various format font files
|
|
182
199
|
%Image::ExifTool::Font::Main = (
|
|
183
200
|
GROUPS => { 2 => 'Document' },
|
|
184
201
|
NOTES => q{
|
|
185
202
|
This table contains a collection of tags found in font files of various
|
|
186
203
|
formats. ExifTool current recognizes OTF, TTF, TTC, DFONT, PFA, PFB, PFM,
|
|
187
|
-
AFM, ACFM and
|
|
204
|
+
AFM, ACFM, AMFM, WOFF and WOFF2 font files.
|
|
188
205
|
},
|
|
189
206
|
name => {
|
|
190
207
|
SubDirectory => { TagTable => 'Image::ExifTool::Font::Name' },
|
|
@@ -210,6 +227,14 @@ my %ttCharset = (
|
|
|
210
227
|
Name => 'PostScriptFontName',
|
|
211
228
|
Description => 'PostScript Font Name',
|
|
212
229
|
},
|
|
230
|
+
# for WOFF files
|
|
231
|
+
WOFFVersion => { },
|
|
232
|
+
XML => {
|
|
233
|
+
SubDirectory => {
|
|
234
|
+
TagTable => 'Image::ExifTool::Font::XML',
|
|
235
|
+
IgnoreProp => { metadata => 1 },
|
|
236
|
+
},
|
|
237
|
+
},
|
|
213
238
|
);
|
|
214
239
|
|
|
215
240
|
# TrueType name tags (ref 1/2)
|
|
@@ -217,10 +242,10 @@ my %ttCharset = (
|
|
|
217
242
|
GROUPS => { 2 => 'Document' },
|
|
218
243
|
NOTES => q{
|
|
219
244
|
The following tags are extracted from the TrueType font "name" table found
|
|
220
|
-
in OTF, TTF, TTC and
|
|
221
|
-
adding a hyphen followed by a language code to the end of the
|
|
222
|
-
"Copyright-fr" or "License-en-US"). Tags with no language
|
|
223
|
-
default language of "en".
|
|
245
|
+
in OTF, TTF, TTC, DFONT, WOFF and WOFF2 files. These tags support localized
|
|
246
|
+
languages by adding a hyphen followed by a language code to the end of the
|
|
247
|
+
tag name (eg. "Copyright-fr" or "License-en-US"). Tags with no language
|
|
248
|
+
code use the default language of "en".
|
|
224
249
|
},
|
|
225
250
|
0 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
|
|
226
251
|
1 => 'FontFamily',
|
|
@@ -332,6 +357,39 @@ my %ttCharset = (
|
|
|
332
357
|
Descender => { },
|
|
333
358
|
);
|
|
334
359
|
|
|
360
|
+
# WOFF XML
|
|
361
|
+
%Image::ExifTool::Font::XML = (
|
|
362
|
+
GROUPS => { 1 => 'XML', 2 => 'Document' },
|
|
363
|
+
PROCESS_PROC => \&Image::ExifTool::XMP::ProcessXMP,
|
|
364
|
+
NOTES => 'Tags found in WOFF and WOFF2 XML metadata.',
|
|
365
|
+
version => { },
|
|
366
|
+
uniqueidId => { Name => 'UniqueID' },
|
|
367
|
+
vendorName => { },
|
|
368
|
+
vendorUrl => { Name => 'VendorURL' },
|
|
369
|
+
vendorDir => { },
|
|
370
|
+
vendorClass => { },
|
|
371
|
+
creditsCreditName => { Name => 'CreditName' },
|
|
372
|
+
creditsCreditUrl => { Name => 'CreditURL' },
|
|
373
|
+
creditsCreditRole => { Name => 'CreditRole' },
|
|
374
|
+
creditsCreditDir => { Name => 'CreditDir' },
|
|
375
|
+
creditsCreditClass => { Name => 'CreditClass' },
|
|
376
|
+
descriptionUrl => { },
|
|
377
|
+
descriptionText => { Name => 'Description' },
|
|
378
|
+
licenseUrl => { Name => 'LicenseURL' },
|
|
379
|
+
licenseId => { Name => 'LicenseID' },
|
|
380
|
+
licenseText => { Name => 'License' },
|
|
381
|
+
copyrightText => { Name => 'Copyright', Groups => { 2 => 'Author' } },
|
|
382
|
+
trademarkText => { Name => 'Trademark' },
|
|
383
|
+
licenseeDir => { },
|
|
384
|
+
licenseeName => { },
|
|
385
|
+
licenseeClass => { },
|
|
386
|
+
extensionId => { Name => 'ExtensionID' },
|
|
387
|
+
extensionName => { },
|
|
388
|
+
extensionItemId => { Name => 'ExtensionItemID' },
|
|
389
|
+
extensionItemName => { },
|
|
390
|
+
extensionItemValue => { },
|
|
391
|
+
);
|
|
392
|
+
|
|
335
393
|
#------------------------------------------------------------------------------
|
|
336
394
|
# Read information from a TrueType font collection (TTC) (refs 2,3)
|
|
337
395
|
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
|
@@ -365,6 +423,122 @@ sub ProcessTTC($$)
|
|
|
365
423
|
return 1;
|
|
366
424
|
}
|
|
367
425
|
|
|
426
|
+
#------------------------------------------------------------------------------
|
|
427
|
+
# Process an OTF tag table entry (refs 1,2)
|
|
428
|
+
# Inputs: 0) ExifTool ref, 1) entry index, 2) tag, 3) data ref,
|
|
429
|
+
# 4) offset if uncompressed, 5) true to skip because data is transformed
|
|
430
|
+
# Returns: undef on success, 0 to stop processing table, or error string otherwise
|
|
431
|
+
sub ProcessTableEntry($$$$;$$)
|
|
432
|
+
{
|
|
433
|
+
my ($et, $idx, $tag, $dataPt, $offset, $transformed) = @_;
|
|
434
|
+
my $verbose = $et->Options('Verbose');
|
|
435
|
+
my $size = length $$dataPt;
|
|
436
|
+
|
|
437
|
+
$offset or $offset = 0;
|
|
438
|
+
if ($verbose) {
|
|
439
|
+
$tag =~ s/([\0-\x1f\x7f-\xff])/sprintf('\x%.2x',ord $1)/ge;
|
|
440
|
+
my $str = sprintf("%s%d) Tag '%s' (offset 0x%.4x, %d bytes)\n",
|
|
441
|
+
$$et{INDENT}, $idx, $tag, $offset, $size);
|
|
442
|
+
$et->VPrint(0, $str);
|
|
443
|
+
$et->VerboseDump($dataPt, Addr => $offset) if $verbose > 2;
|
|
444
|
+
return undef unless $processTag{$tag};
|
|
445
|
+
}
|
|
446
|
+
return undef if $transformed or $size < 8;
|
|
447
|
+
unless ($tag eq 'name') {
|
|
448
|
+
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Main');
|
|
449
|
+
$et->HandleTag($tagTablePtr, $tag, undef, DataPt => $dataPt, Size => length($$dataPt));
|
|
450
|
+
return undef;
|
|
451
|
+
}
|
|
452
|
+
# process the 'name' tag
|
|
453
|
+
my $entries = Get16u($dataPt, 2);
|
|
454
|
+
my $recEnd = 6 + $entries * 12;
|
|
455
|
+
if ($recEnd > $size) {
|
|
456
|
+
$et->Warn('Truncated name record');
|
|
457
|
+
return 0;
|
|
458
|
+
}
|
|
459
|
+
my $strStart = Get16u($dataPt, 4);
|
|
460
|
+
if ($strStart < $recEnd or $strStart > $size) {
|
|
461
|
+
$et->Warn('Invalid string offset');
|
|
462
|
+
return 0;
|
|
463
|
+
}
|
|
464
|
+
# parse language-tag record (in format 1 Naming table only) (ref 2)
|
|
465
|
+
my ($i, %langTag);
|
|
466
|
+
if (Get16u($dataPt, 0) == 1 and $recEnd + 2 <= $size) {
|
|
467
|
+
my $langTags = Get16u($dataPt, $recEnd);
|
|
468
|
+
if ($langTags and $recEnd + 2 + $langTags * 4 < $size) {
|
|
469
|
+
for ($i=0; $i<$langTags; ++$i) {
|
|
470
|
+
my $pt = $recEnd + 2 + $i * 4;
|
|
471
|
+
my $langLen = Get16u($dataPt, $pt);
|
|
472
|
+
# make sure the language string length is reasonable (UTF-16BE)
|
|
473
|
+
last if $langLen == 0 or $langLen & 0x01 or $langLen > 40;
|
|
474
|
+
my $langPt = Get16u($dataPt, $pt + 2) + $strStart;
|
|
475
|
+
last if $langPt + $langLen > $size;
|
|
476
|
+
my $lang = substr($$dataPt, $langPt, $langLen);
|
|
477
|
+
$lang = $et->Decode($lang,'UCS2','MM','UTF8');
|
|
478
|
+
$lang =~ tr/-_a-zA-Z0-9//dc; # remove naughty characters
|
|
479
|
+
$langTag{$i + 0x8000} = $lang;
|
|
480
|
+
}
|
|
481
|
+
}
|
|
482
|
+
}
|
|
483
|
+
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Name');
|
|
484
|
+
my $oldIndent = $$et{INDENT};
|
|
485
|
+
$$et{INDENT} .= '| ';
|
|
486
|
+
$et->VerboseDir('Name', $entries) if $verbose;
|
|
487
|
+
for ($i=0; $i<$entries; ++$i) {
|
|
488
|
+
my $pt = 6 + $i * 12;
|
|
489
|
+
my $platform = Get16u($dataPt, $pt);
|
|
490
|
+
my $encoding = Get16u($dataPt, $pt + 2);
|
|
491
|
+
my $langID = Get16u($dataPt, $pt + 4);
|
|
492
|
+
my $nameID = Get16u($dataPt, $pt + 6);
|
|
493
|
+
my $strLen = Get16u($dataPt, $pt + 8);
|
|
494
|
+
my $strPt = Get16u($dataPt, $pt + 10) + $strStart;
|
|
495
|
+
if ($strPt + $strLen <= $size) {
|
|
496
|
+
my $val = substr($$dataPt, $strPt, $strLen);
|
|
497
|
+
my ($lang, $charset, $extra);
|
|
498
|
+
my $sys = $ttPlatform{$platform};
|
|
499
|
+
# translate from specified encoding
|
|
500
|
+
if ($sys) {
|
|
501
|
+
$lang = $ttLang{$sys}{$langID} || $langTag{$langID};
|
|
502
|
+
$charset = $ttCharset{$sys}{$encoding};
|
|
503
|
+
if (not $charset) {
|
|
504
|
+
if (not defined $charset and not $$et{FontWarn}) {
|
|
505
|
+
$et->Warn("Unknown $sys character set ($encoding)");
|
|
506
|
+
$$et{FontWarn} = 1;
|
|
507
|
+
}
|
|
508
|
+
} else {
|
|
509
|
+
# translate to ExifTool character set
|
|
510
|
+
$val = $et->Decode($val, $charset);
|
|
511
|
+
}
|
|
512
|
+
} else {
|
|
513
|
+
$et->Warn("Unknown platform ($platform) for name $nameID");
|
|
514
|
+
}
|
|
515
|
+
# get the tagInfo for our specific language (use 'en' for default)
|
|
516
|
+
my $tagInfo = $et->GetTagInfo($tagTablePtr, $nameID);
|
|
517
|
+
if ($tagInfo and $lang and $lang ne 'en') {
|
|
518
|
+
my $langInfo = Image::ExifTool::GetLangInfo($tagInfo, $lang);
|
|
519
|
+
$tagInfo = $langInfo if $langInfo;
|
|
520
|
+
}
|
|
521
|
+
if ($verbose) {
|
|
522
|
+
$langID > 0x400 and $langID = sprintf('0x%x', $langID);
|
|
523
|
+
$extra = ", Plat=$platform/" . ($sys || 'Unknown') . ', ' .
|
|
524
|
+
"Enc=$encoding/" . ($charset || 'Unknown') . ', ' .
|
|
525
|
+
"Lang=$langID/" . ($lang || 'Unknown');
|
|
526
|
+
}
|
|
527
|
+
$et->HandleTag($tagTablePtr, $nameID, $val,
|
|
528
|
+
TagInfo => $tagInfo,
|
|
529
|
+
DataPt => $dataPt,
|
|
530
|
+
DataPos => $offset,
|
|
531
|
+
Start => $strPt,
|
|
532
|
+
Size => $strLen,
|
|
533
|
+
Index => $i,
|
|
534
|
+
Extra => $extra,
|
|
535
|
+
);
|
|
536
|
+
}
|
|
537
|
+
}
|
|
538
|
+
$$et{INDENT} = $oldIndent;
|
|
539
|
+
return $verbose ? undef : 0;
|
|
540
|
+
}
|
|
541
|
+
|
|
368
542
|
#------------------------------------------------------------------------------
|
|
369
543
|
# Read information from a TrueType font file (OTF or TTF) (refs 1,2)
|
|
370
544
|
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
|
@@ -388,13 +562,8 @@ sub ProcessOTF($$)
|
|
|
388
562
|
return 0 unless $raf->Read($tbl, $len) == $len;
|
|
389
563
|
|
|
390
564
|
my $verbose = $et->Options('Verbose');
|
|
391
|
-
my $oldIndent = $$et{INDENT};
|
|
392
|
-
$$et{INDENT} .= '| ';
|
|
393
|
-
$et->VerboseDir('TrueType', $numTables) if $verbose;
|
|
394
|
-
|
|
395
|
-
my %processTag = ( name => 1, C2PA => 1 ); # tags to process (skip all others)
|
|
396
565
|
|
|
397
|
-
for ($pos=0; $pos<$len; $pos+=16) {
|
|
566
|
+
for ($pos=0, $i=0; $pos<$len; $pos+=16, ++$i) {
|
|
398
567
|
# look for tags to process
|
|
399
568
|
my $tag = substr($tbl, $pos, 4);
|
|
400
569
|
next unless $processTag{$tag} or $verbose;
|
|
@@ -404,109 +573,10 @@ sub ProcessOTF($$)
|
|
|
404
573
|
$et->Warn("Error reading '${tag}' data");
|
|
405
574
|
next;
|
|
406
575
|
}
|
|
407
|
-
|
|
408
|
-
|
|
409
|
-
|
|
410
|
-
$$et{INDENT}, $pos/16, $tag, $offset, $size);
|
|
411
|
-
$et->VPrint(0, $str);
|
|
412
|
-
$et->VerboseDump(\$buff, Addr => $offset) if $verbose > 2;
|
|
413
|
-
next unless $processTag{$tag};
|
|
414
|
-
}
|
|
415
|
-
next unless $size >= 8;
|
|
416
|
-
unless ($tag eq 'name') {
|
|
417
|
-
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Main');
|
|
418
|
-
$et->HandleTag($tagTablePtr, $tag, undef, DataPt => \$buff, Size => length($buff));
|
|
419
|
-
next;
|
|
420
|
-
}
|
|
421
|
-
# process the 'name' tag
|
|
422
|
-
my $entries = Get16u(\$buff, 2);
|
|
423
|
-
my $recEnd = 6 + $entries * 12;
|
|
424
|
-
if ($recEnd > $size) {
|
|
425
|
-
$et->Warn('Truncated name record');
|
|
426
|
-
last;
|
|
427
|
-
}
|
|
428
|
-
my $strStart = Get16u(\$buff, 4);
|
|
429
|
-
if ($strStart < $recEnd or $strStart > $size) {
|
|
430
|
-
$et->Warn('Invalid string offset');
|
|
431
|
-
last;
|
|
432
|
-
}
|
|
433
|
-
# parse language-tag record (in format 1 Naming table only) (ref 2)
|
|
434
|
-
my %langTag;
|
|
435
|
-
if (Get16u(\$buff, 0) == 1 and $recEnd + 2 <= $size) {
|
|
436
|
-
my $langTags = Get16u(\$buff, $recEnd);
|
|
437
|
-
if ($langTags and $recEnd + 2 + $langTags * 4 < $size) {
|
|
438
|
-
for ($i=0; $i<$langTags; ++$i) {
|
|
439
|
-
my $pt = $recEnd + 2 + $i * 4;
|
|
440
|
-
my $langLen = Get16u(\$buff, $pt);
|
|
441
|
-
# make sure the language string length is reasonable (UTF-16BE)
|
|
442
|
-
last if $langLen == 0 or $langLen & 0x01 or $langLen > 40;
|
|
443
|
-
my $langPt = Get16u(\$buff, $pt + 2) + $strStart;
|
|
444
|
-
last if $langPt + $langLen > $size;
|
|
445
|
-
my $lang = substr($buff, $langPt, $langLen);
|
|
446
|
-
$lang = $et->Decode($lang,'UCS2','MM','UTF8');
|
|
447
|
-
$lang =~ tr/-_a-zA-Z0-9//dc; # remove naughty characters
|
|
448
|
-
$langTag{$i + 0x8000} = $lang;
|
|
449
|
-
}
|
|
450
|
-
}
|
|
451
|
-
}
|
|
452
|
-
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Name');
|
|
453
|
-
$$et{INDENT} .= '| ';
|
|
454
|
-
$et->VerboseDir('Name', $entries) if $verbose;
|
|
455
|
-
for ($i=0; $i<$entries; ++$i) {
|
|
456
|
-
my $pt = 6 + $i * 12;
|
|
457
|
-
my $platform = Get16u(\$buff, $pt);
|
|
458
|
-
my $encoding = Get16u(\$buff, $pt + 2);
|
|
459
|
-
my $langID = Get16u(\$buff, $pt + 4);
|
|
460
|
-
my $nameID = Get16u(\$buff, $pt + 6);
|
|
461
|
-
my $strLen = Get16u(\$buff, $pt + 8);
|
|
462
|
-
my $strPt = Get16u(\$buff, $pt + 10) + $strStart;
|
|
463
|
-
if ($strPt + $strLen <= $size) {
|
|
464
|
-
my $val = substr($buff, $strPt, $strLen);
|
|
465
|
-
my ($lang, $charset, $extra);
|
|
466
|
-
my $sys = $ttPlatform{$platform};
|
|
467
|
-
# translate from specified encoding
|
|
468
|
-
if ($sys) {
|
|
469
|
-
$lang = $ttLang{$sys}{$langID} || $langTag{$langID};
|
|
470
|
-
$charset = $ttCharset{$sys}{$encoding};
|
|
471
|
-
if (not $charset) {
|
|
472
|
-
if (not defined $charset and not $$et{FontWarn}) {
|
|
473
|
-
$et->Warn("Unknown $sys character set ($encoding)");
|
|
474
|
-
$$et{FontWarn} = 1;
|
|
475
|
-
}
|
|
476
|
-
} else {
|
|
477
|
-
# translate to ExifTool character set
|
|
478
|
-
$val = $et->Decode($val, $charset);
|
|
479
|
-
}
|
|
480
|
-
} else {
|
|
481
|
-
$et->Warn("Unknown platform ($platform) for name $nameID");
|
|
482
|
-
}
|
|
483
|
-
# get the tagInfo for our specific language (use 'en' for default)
|
|
484
|
-
my $tagInfo = $et->GetTagInfo($tagTablePtr, $nameID);
|
|
485
|
-
if ($tagInfo and $lang and $lang ne 'en') {
|
|
486
|
-
my $langInfo = Image::ExifTool::GetLangInfo($tagInfo, $lang);
|
|
487
|
-
$tagInfo = $langInfo if $langInfo;
|
|
488
|
-
}
|
|
489
|
-
if ($verbose) {
|
|
490
|
-
$langID > 0x400 and $langID = sprintf('0x%x', $langID);
|
|
491
|
-
$extra = ", Plat=$platform/" . ($sys || 'Unknown') . ', ' .
|
|
492
|
-
"Enc=$encoding/" . ($charset || 'Unknown') . ', ' .
|
|
493
|
-
"Lang=$langID/" . ($lang || 'Unknown');
|
|
494
|
-
}
|
|
495
|
-
$et->HandleTag($tagTablePtr, $nameID, $val,
|
|
496
|
-
TagInfo => $tagInfo,
|
|
497
|
-
DataPt => \$buff,
|
|
498
|
-
DataPos => $offset,
|
|
499
|
-
Start => $strPt,
|
|
500
|
-
Size => $strLen,
|
|
501
|
-
Index => $i,
|
|
502
|
-
Extra => $extra,
|
|
503
|
-
);
|
|
504
|
-
}
|
|
505
|
-
}
|
|
506
|
-
$$et{INDENT} = $oldIndent . '| ';
|
|
507
|
-
last unless $verbose;
|
|
576
|
+
my $err = ProcessTableEntry($et, $i, $tag, \$buff, $offset);
|
|
577
|
+
$err and $et->Warn($err), last;
|
|
578
|
+
last if defined $err;
|
|
508
579
|
}
|
|
509
|
-
$$et{INDENT} = $oldIndent;
|
|
510
580
|
return 1;
|
|
511
581
|
}
|
|
512
582
|
|
|
@@ -554,6 +624,203 @@ sub ProcessAFM($$)
|
|
|
554
624
|
return 1;
|
|
555
625
|
}
|
|
556
626
|
|
|
627
|
+
#------------------------------------------------------------------------------
|
|
628
|
+
# Read WOFF2 255UInt16 integer (ref 8)
|
|
629
|
+
# Inputs: 0) raf ref
|
|
630
|
+
# Returns: value, or undef on error
|
|
631
|
+
sub Read255UInt16($)
|
|
632
|
+
{
|
|
633
|
+
my $raf = shift;
|
|
634
|
+
my $buff;
|
|
635
|
+
return undef unless $raf->Read($buff, 1);
|
|
636
|
+
my $val = unpack('C', $buff);
|
|
637
|
+
if ($val == 253) {
|
|
638
|
+
return undef unless $raf->Read($buff, 2) == 2;
|
|
639
|
+
$val = unpack('n', $buff);
|
|
640
|
+
} elsif ($val == 254) {
|
|
641
|
+
return undef unless $raf->Read($buff, 1);
|
|
642
|
+
$val = unpack('C', $buff) + 253 * 2;
|
|
643
|
+
} elsif ($val == 255) {
|
|
644
|
+
return undef unless $raf->Read($buff, 1);
|
|
645
|
+
$val = unpack('C', $buff) + 253;
|
|
646
|
+
}
|
|
647
|
+
return $val;
|
|
648
|
+
}
|
|
649
|
+
|
|
650
|
+
#------------------------------------------------------------------------------
|
|
651
|
+
# Read WOFF2 UIntBase128 integer (ref 8)
|
|
652
|
+
# Inputs: 0) raf ref
|
|
653
|
+
# Returns: value, or undef on error
|
|
654
|
+
sub ReadUIntBase128($)
|
|
655
|
+
{
|
|
656
|
+
my $raf = shift;
|
|
657
|
+
my $buff;
|
|
658
|
+
my $val = 0;
|
|
659
|
+
foreach (0..4) {
|
|
660
|
+
return undef unless $raf->Read($buff, 1);
|
|
661
|
+
my $byte = unpack('C', $buff);
|
|
662
|
+
return undef if not $_ and $byte == 0x80;
|
|
663
|
+
return undef if $val & 0xfe000000;
|
|
664
|
+
$val = ($val << 7) | ($byte & 0x7f);
|
|
665
|
+
return $val unless $byte & 0x80;
|
|
666
|
+
}
|
|
667
|
+
return undef; # can't be longer than 5 bytes
|
|
668
|
+
}
|
|
669
|
+
|
|
670
|
+
#------------------------------------------------------------------------------
|
|
671
|
+
# Uncompress data
|
|
672
|
+
# Inputs: 0) ExifTool ref, 1) data ref
|
|
673
|
+
# Returns: true on success
|
|
674
|
+
sub Uncompress($$)
|
|
675
|
+
{
|
|
676
|
+
my ($et, $dataPt) = @_;
|
|
677
|
+
my $stat;
|
|
678
|
+
unless (eval { require Compress::Zlib }) {
|
|
679
|
+
$et->Warn('Install Compress::Zlib to read compressed metadata');
|
|
680
|
+
return 0;
|
|
681
|
+
}
|
|
682
|
+
my $inflate = Compress::Zlib::inflateInit();
|
|
683
|
+
$inflate and ($$dataPt, $stat) = $inflate->inflate($$dataPt);
|
|
684
|
+
unless ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
|
|
685
|
+
$et->Warn('Error uncompressing metadata');
|
|
686
|
+
return 0;
|
|
687
|
+
}
|
|
688
|
+
return 1;
|
|
689
|
+
}
|
|
690
|
+
|
|
691
|
+
#------------------------------------------------------------------------------
|
|
692
|
+
# Brotli uncompress data
|
|
693
|
+
# Inputs: 0) ExifTool ref, 1) data ref
|
|
694
|
+
# Returns: true on success
|
|
695
|
+
sub Unbrotli($$)
|
|
696
|
+
{
|
|
697
|
+
my ($et, $dataPt) = @_;
|
|
698
|
+
unless (eval { require IO::Uncompress::Brotli }) {
|
|
699
|
+
$et->Warn('Install IO::Compress::Brotli to decode Brotli-compressed metadata');
|
|
700
|
+
return 0;
|
|
701
|
+
}
|
|
702
|
+
eval { $$dataPt = IO::Uncompress::Brotli::unbro($$dataPt, 100000000) };
|
|
703
|
+
if ($@) {
|
|
704
|
+
$et->Warn('Error decoding metadata');
|
|
705
|
+
$et->Warn('Try updating to IO::Uncompress::Brotli 0.004 or later');
|
|
706
|
+
return 0;
|
|
707
|
+
}
|
|
708
|
+
return 1;
|
|
709
|
+
}
|
|
710
|
+
|
|
711
|
+
#------------------------------------------------------------------------------
|
|
712
|
+
# Read information from WOFF/WOFF2 font files
|
|
713
|
+
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
|
714
|
+
# Returns: 1 on success, 0 if this wasn't a recognized WOFF file
|
|
715
|
+
sub ProcessWOFF($$)
|
|
716
|
+
{
|
|
717
|
+
my ($et, $dirInfo) = @_;
|
|
718
|
+
my $raf = $$dirInfo{RAF};
|
|
719
|
+
my ($buff, $tbl, $i);
|
|
720
|
+
$raf->Seek(0,0) and $raf->Read($buff,48) == 48 or return 0;
|
|
721
|
+
$buff =~ /^(wOF[F2])/ or return 0;
|
|
722
|
+
my ($type, $off) = $1 eq 'wOFF' ? ('woff' , 20) : ('woff2', 24);
|
|
723
|
+
$et->SetFileType(uc($type), "font/$type");
|
|
724
|
+
SetByteOrder('MM');
|
|
725
|
+
my $flavor = substr($buff, 4, 4);
|
|
726
|
+
my $numTables = Get16u(\$buff, 12);
|
|
727
|
+
my ($vh, $vl, $metaPos, $metaLen) = unpack("x${off}nnNN", $buff);
|
|
728
|
+
my $verbose = $et->Options('Verbose');
|
|
729
|
+
my $tagTablePtr = GetTagTable('Image::ExifTool::Font::Main');
|
|
730
|
+
$et->HandleTag($tagTablePtr, WOFFVersion => "$vh.$vl");
|
|
731
|
+
#
|
|
732
|
+
# read font table
|
|
733
|
+
#
|
|
734
|
+
if ($type eq 'woff') {
|
|
735
|
+
unless ($raf->Seek($off+24,0) and $raf->Read($tbl,$numTables*20)==$numTables*20) {
|
|
736
|
+
$et->Warn('Error reading font table');
|
|
737
|
+
return 1;
|
|
738
|
+
}
|
|
739
|
+
for ($i=0; $i<$numTables; ++$i) {
|
|
740
|
+
my $pt = $i * 20;
|
|
741
|
+
my ($tag, $pos, $compLen, $len) = unpack("x${pt}a4N3", $tbl);
|
|
742
|
+
next unless $processTag{$tag} or $verbose;
|
|
743
|
+
$raf->Seek($pos,0) and $raf->Read($buff,$compLen)==$compLen or $et->Warn('Bad font table entry'), return 1;
|
|
744
|
+
my $dataPos;
|
|
745
|
+
if ($compLen eq $len) {
|
|
746
|
+
$dataPos = $pos;
|
|
747
|
+
} else {
|
|
748
|
+
next unless Uncompress($et, \$buff);
|
|
749
|
+
}
|
|
750
|
+
my $err = ProcessTableEntry($et, $i, $tag, \$buff, $dataPos);
|
|
751
|
+
$err and $et->Warn($err), return 1;
|
|
752
|
+
last if defined $err;
|
|
753
|
+
}
|
|
754
|
+
} else { # WOFF2
|
|
755
|
+
my $compSize = Get32u(\$buff, 20);
|
|
756
|
+
my ($err, @entry, $entry);
|
|
757
|
+
$raf->Seek($off+24,0) or $et->Warn('Error seeking to font table'), return 1;
|
|
758
|
+
for ($i=0; $i<$numTables; ++$i) {
|
|
759
|
+
$raf->Read($buff, 1) or $err = 1, last;
|
|
760
|
+
my $flags = unpack('C', $buff);
|
|
761
|
+
my $tag = $knownTags[$flags & 0x3f];
|
|
762
|
+
$tag or $raf->Read($tag, 4) == 4 or $err = 1, last;
|
|
763
|
+
my $len = ReadUIntBase128($raf);
|
|
764
|
+
defined $len or $err = 1, last;
|
|
765
|
+
my $transformed;
|
|
766
|
+
if (($tag eq 'glyf' or $tag eq 'loca') xor $flags & 0xc0) {
|
|
767
|
+
# a non-null transform was used
|
|
768
|
+
$len = ReadUIntBase128($raf);
|
|
769
|
+
$transformed = 1;
|
|
770
|
+
}
|
|
771
|
+
# save information about this entry for later
|
|
772
|
+
push @entry, [ $i, $tag, $len, $transformed ];
|
|
773
|
+
}
|
|
774
|
+
$err and $et->Warn('Error reading font table'), return 1;
|
|
775
|
+
# skip the collection table if necessary
|
|
776
|
+
if ($flavor eq 'ttcf') {
|
|
777
|
+
$raf->Seek(4, 1) or $et->Warn('Seek error'), return 1;
|
|
778
|
+
my $n = Read255UInt16($raf);
|
|
779
|
+
defined $n and $raf->Seek(4,1) or $et->Warn('Error reading collection table'), return 1;
|
|
780
|
+
$raf->Seek(4, 1) or $err = 1, last;
|
|
781
|
+
for ($i=0; $i<$n; ++$i) {
|
|
782
|
+
defined Read255UInt16($raf) or $err = 1, last;
|
|
783
|
+
}
|
|
784
|
+
$err and $et->Warn('Error reading collection directory'), return 1;
|
|
785
|
+
}
|
|
786
|
+
$raf->Read($buff,$compSize) == $compSize or $et->Warn('Error reading font data'), return 1;
|
|
787
|
+
return 1 unless Unbrotli($et, \$buff);
|
|
788
|
+
# after all that exhausting and frankly unnecessary work (poor file design),
|
|
789
|
+
# we finally have the uncompressed font data so we can process the table entries
|
|
790
|
+
my $pos = 0;
|
|
791
|
+
foreach $entry (@entry) {
|
|
792
|
+
my ($i, $tag, $len, $transformed) = @$entry;
|
|
793
|
+
if ($processTag{$tag} or $verbose) {
|
|
794
|
+
my $dat = substr($buff, $pos, $len);
|
|
795
|
+
my $err = ProcessTableEntry($et, $i, $tag, \$dat, undef, $transformed);
|
|
796
|
+
$err and $et->Warn($err), return 1;
|
|
797
|
+
last if defined $err;
|
|
798
|
+
}
|
|
799
|
+
$pos += $len;
|
|
800
|
+
}
|
|
801
|
+
}
|
|
802
|
+
#
|
|
803
|
+
# read compressed XML-format metadata (NC)
|
|
804
|
+
#
|
|
805
|
+
if ($metaLen) {
|
|
806
|
+
unless ($raf->Seek($metaPos,0) and $raf->Read($buff,$metaLen)==$metaLen) {
|
|
807
|
+
$et->Warn('Error reading metadata');
|
|
808
|
+
return 1;
|
|
809
|
+
}
|
|
810
|
+
if ($type eq 'woff') {
|
|
811
|
+
return 1 unless Uncompress($et, \$buff);
|
|
812
|
+
} else { # WOFF2
|
|
813
|
+
return 1 unless Unbrotli($et, \$buff);
|
|
814
|
+
}
|
|
815
|
+
# (we don't properly support XML structures)
|
|
816
|
+
my $oldStruct = $et->Options('Struct');
|
|
817
|
+
$et->Options(Struct => 0);
|
|
818
|
+
$et->HandleTag($tagTablePtr, 'XML', $buff);
|
|
819
|
+
$et->Options(Struct => $oldStruct);
|
|
820
|
+
}
|
|
821
|
+
return 1;
|
|
822
|
+
}
|
|
823
|
+
|
|
557
824
|
#------------------------------------------------------------------------------
|
|
558
825
|
# Read information from various format font files
|
|
559
826
|
# Inputs: 0) ExifTool ref, 1) dirInfo ref
|
|
@@ -601,10 +868,7 @@ sub ProcessFont($$)
|
|
|
601
868
|
}
|
|
602
869
|
$rtnVal = 1;
|
|
603
870
|
} elsif ($buff =~ /^(wOF[F2])/) {
|
|
604
|
-
|
|
605
|
-
$et->SetFileType(uc($type), "font/$type");
|
|
606
|
-
# (don't yet extract metadata from these files)
|
|
607
|
-
$rtnVal = 1;
|
|
871
|
+
$rtnVal = ProcessWOFF($et, $dirInfo);
|
|
608
872
|
} else {
|
|
609
873
|
$rtnVal = 0;
|
|
610
874
|
}
|
|
@@ -654,6 +918,10 @@ under the same terms as Perl itself.
|
|
|
654
918
|
|
|
655
919
|
=item L<http://www.adobe.com/devnet/font/pdfs/5004.AFM_Spec.pdf>
|
|
656
920
|
|
|
921
|
+
=item L<https://www.w3.org/TR/WOFF/>
|
|
922
|
+
|
|
923
|
+
=item L<https://www.w3.org/TR/WOFF2/>
|
|
924
|
+
|
|
657
925
|
=back
|
|
658
926
|
|
|
659
927
|
=head1 SEE ALSO
|
|
@@ -71,7 +71,7 @@ package Image::ExifTool::Geolocation;
|
|
|
71
71
|
use strict;
|
|
72
72
|
use vars qw($VERSION $geoDir $altDir $dbInfo);
|
|
73
73
|
|
|
74
|
-
$VERSION = '1.
|
|
74
|
+
$VERSION = '1.10'; # (this is the module version number, not the database version)
|
|
75
75
|
|
|
76
76
|
my $debug; # set to output processing time for testing
|
|
77
77
|
|
|
@@ -85,10 +85,10 @@ my (@cityList, @countryList, @regionList, @subregionList, @timezoneList);
|
|
|
85
85
|
my (%countryNum, %regionNum, %subregionNum, %timezoneNum); # reverse lookups
|
|
86
86
|
my (@sortOrder, @altNames, %langLookup, $nCity, %featureCodes, %featureTypes);
|
|
87
87
|
my ($lastArgs, %lastFound, @lastByPop, @lastByLat); # cached city matches
|
|
88
|
-
my $dbVer = '1.03';
|
|
88
|
+
my $dbVer = '1.03'; # database version number
|
|
89
89
|
my $sortedBy = 'Latitude';
|
|
90
90
|
my $pi = 3.1415926536;
|
|
91
|
-
my $earthRadius = 6371;
|
|
91
|
+
my $earthRadius = 6371; # earth radius in km
|
|
92
92
|
# hard-coded feature codes for v1.02 database
|
|
93
93
|
my @featureCodes = qw(Other PPL PPLA PPLA2 PPLA3 PPLA4 PPLA5 PPLC
|
|
94
94
|
PPLCH PPLF PPLG PPLL PPLR PPLS STLMT PPLX);
|
|
@@ -459,9 +459,9 @@ sub GetAltNames($;$)
|
|
|
459
459
|
# 1) options hash reference (or undef for no options)
|
|
460
460
|
# Options: GeolocMinPop, GeolocMaxDist, GeolocMulti, GeolocFeature, GeolocAltNames,
|
|
461
461
|
# GeolocNearby
|
|
462
|
-
# Returns:
|
|
463
|
-
#
|
|
464
|
-
#
|
|
462
|
+
# Returns: 0) Reference to list of indices for matching cities, or undef for no matches
|
|
463
|
+
# 1) Reference to list of distance/bearing pairs, or undef if no GPS
|
|
464
|
+
# In scalar context returns list of indices only
|
|
465
465
|
sub Geolocate($;$)
|
|
466
466
|
{
|
|
467
467
|
my ($arg, $opts) = @_;
|
|
@@ -712,7 +712,7 @@ Entry: for (; $i<@cityList; ++$i) {
|
|
|
712
712
|
push @dist, [ $km, $be ];
|
|
713
713
|
last if $num <= 1;
|
|
714
714
|
}
|
|
715
|
-
return(\@rtnList, \@dist);
|
|
715
|
+
return wantarray ? (\@rtnList, \@dist) : \@rtnList;
|
|
716
716
|
}
|
|
717
717
|
|
|
718
718
|
1; #end
|
|
@@ -969,6 +969,9 @@ if no matches were found.
|
|
|
969
969
|
1) Reference to list of distance/bearing pairs for each matching city, or
|
|
970
970
|
undef if the search didn't provide GPS coordinates.
|
|
971
971
|
|
|
972
|
+
In scalar context, only the reference to the list of database entry numbers
|
|
973
|
+
is returned.
|
|
974
|
+
|
|
972
975
|
=back
|
|
973
976
|
|
|
974
977
|
=head1 ALTERNATE DATABASES
|
|
@@ -35,7 +35,7 @@ use vars qw($VERSION);
|
|
|
35
35
|
use Image::ExifTool qw(:Public);
|
|
36
36
|
use Image::ExifTool::GPS;
|
|
37
37
|
|
|
38
|
-
$VERSION = '1.
|
|
38
|
+
$VERSION = '1.83';
|
|
39
39
|
|
|
40
40
|
sub JITTER() { return 2 } # maximum time jitter
|
|
41
41
|
|
|
@@ -1345,6 +1345,23 @@ Category: foreach $category (qw{pos track alt orient atemp err dop}) {
|
|
|
1345
1345
|
if (defined $dop) {
|
|
1346
1346
|
$et->SetNewValue(GPSMeasureMode => $mm, %opts);
|
|
1347
1347
|
$et->SetNewValue(GPSDOP => $dop, %opts);
|
|
1348
|
+
# also set GPSHPositioningError if specified
|
|
1349
|
+
my $hposErr = $$et{OPTIONS}{GeoHPosErr};
|
|
1350
|
+
if ($hposErr) {
|
|
1351
|
+
$hposErr =~ s/gpsdop/GPSDOP/i;
|
|
1352
|
+
my $GPSDOP = $dop;
|
|
1353
|
+
local $SIG{'__WARN__'} = \&Image::ExifTool::SetWarning;
|
|
1354
|
+
undef $Image::ExifTool::evalWarning;
|
|
1355
|
+
#### eval GeoHPosErr ($GPSDOP)
|
|
1356
|
+
$hposErr = eval $hposErr;
|
|
1357
|
+
my $err = Image::ExifTool::GetWarning() || $@;
|
|
1358
|
+
if ($err) {
|
|
1359
|
+
$err = Image::ExifTool::CleanWarning($err);
|
|
1360
|
+
$et->Warn("Error calculating GPSHPositioningError: $err", 1);
|
|
1361
|
+
} else {
|
|
1362
|
+
$et->SetNewValue(GPSHPositioningError => $hposErr, %opts);
|
|
1363
|
+
}
|
|
1364
|
+
}
|
|
1348
1365
|
}
|
|
1349
1366
|
}
|
|
1350
1367
|
unless ($xmp) {
|