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.
@@ -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.11';
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 AMFM font files.
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 DFONT files. These tags support localized languages by
221
- adding a hyphen followed by a language code to the end of the tag name (eg.
222
- "Copyright-fr" or "License-en-US"). Tags with no language code use the
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
- if ($verbose) {
408
- $tag =~ s/([\0-\x1f\x7f-\xff])/sprintf('\x%.2x',ord $1)/ge;
409
- my $str = sprintf("%s%d) Tag '%s' (offset 0x%.4x, %d bytes)\n",
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
- my $type = $1 eq 'wOFF' ? 'woff' : 'woff2';
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.09'; # (this is the module version number, not the database version)
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; # earth radius in km
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: List of matching city information, empty if none found.
463
- # Each element in the list is an array with 0=index of city in database,
464
- # 1=distance in km (or undef if no distance), 2=compass bearing (or undef)
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.82';
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) {