exiftool_vendored 11.99.0 → 12.06.0
Sign up to get free protection for your applications and to get access to all the features.
Potentially problematic release.
This version of exiftool_vendored might be problematic. Click here for more details.
- checksums.yaml +4 -4
- data/bin/Changes +119 -2
- data/bin/MANIFEST +5 -0
- data/bin/META.json +1 -1
- data/bin/META.yml +1 -1
- data/bin/README +32 -32
- data/bin/exiftool +55 -50
- data/bin/lib/Image/ExifTool.pm +155 -109
- data/bin/lib/Image/ExifTool.pod +103 -77
- data/bin/lib/Image/ExifTool/AIFF.pm +2 -2
- data/bin/lib/Image/ExifTool/APE.pm +2 -2
- data/bin/lib/Image/ExifTool/BuildTagLookup.pm +11 -6
- data/bin/lib/Image/ExifTool/Canon.pm +2 -1
- data/bin/lib/Image/ExifTool/CanonCustom.pm +82 -16
- data/bin/lib/Image/ExifTool/DPX.pm +56 -2
- data/bin/lib/Image/ExifTool/DarwinCore.pm +16 -3
- data/bin/lib/Image/ExifTool/Exif.pm +15 -6
- data/bin/lib/Image/ExifTool/Font.pm +9 -2
- data/bin/lib/Image/ExifTool/GIF.pm +5 -0
- data/bin/lib/Image/ExifTool/GeoTiff.pm +2 -0
- data/bin/lib/Image/ExifTool/GoPro.pm +10 -1
- data/bin/lib/Image/ExifTool/H264.pm +1 -1
- data/bin/lib/Image/ExifTool/ID3.pm +86 -12
- data/bin/lib/Image/ExifTool/Lang/de.pm +3 -1
- data/bin/lib/Image/ExifTool/Lang/es.pm +1 -1
- data/bin/lib/Image/ExifTool/M2TS.pm +1 -1
- data/bin/lib/Image/ExifTool/MacOS.pm +1 -1
- data/bin/lib/Image/ExifTool/Minolta.pm +3 -2
- data/bin/lib/Image/ExifTool/Nikon.pm +134 -15
- data/bin/lib/Image/ExifTool/Olympus.pm +34 -17
- data/bin/lib/Image/ExifTool/PNG.pm +14 -3
- data/bin/lib/Image/ExifTool/PPM.pm +5 -5
- data/bin/lib/Image/ExifTool/Panasonic.pm +147 -13
- data/bin/lib/Image/ExifTool/PanasonicRaw.pm +33 -0
- data/bin/lib/Image/ExifTool/Parrot.pm +2 -1
- data/bin/lib/Image/ExifTool/Pentax.pm +2 -1
- data/bin/lib/Image/ExifTool/Photoshop.pm +2 -1
- data/bin/lib/Image/ExifTool/QuickTime.pm +204 -27
- data/bin/lib/Image/ExifTool/QuickTimeStream.pl +355 -19
- data/bin/lib/Image/ExifTool/README +20 -19
- data/bin/lib/Image/ExifTool/Ricoh.pm +19 -1
- data/bin/lib/Image/ExifTool/Shift.pl +1 -0
- data/bin/lib/Image/ExifTool/SigmaRaw.pm +40 -33
- data/bin/lib/Image/ExifTool/Sony.pm +376 -11
- data/bin/lib/Image/ExifTool/TagLookup.pm +1949 -1872
- data/bin/lib/Image/ExifTool/TagNames.pod +329 -53
- data/bin/lib/Image/ExifTool/Validate.pm +4 -4
- data/bin/lib/Image/ExifTool/WriteExif.pl +1 -0
- data/bin/lib/Image/ExifTool/WriteQuickTime.pl +23 -15
- data/bin/lib/Image/ExifTool/Writer.pl +44 -21
- data/bin/lib/Image/ExifTool/XMP.pm +41 -4
- data/bin/lib/Image/ExifTool/XMPStruct.pl +3 -1
- data/bin/lib/Image/ExifTool/ZISRAW.pm +123 -0
- data/bin/perl-Image-ExifTool.spec +31 -31
- data/lib/exiftool_vendored/version.rb +1 -1
- metadata +4 -3
@@ -17,7 +17,7 @@ package Image::ExifTool::Validate;
|
|
17
17
|
use strict;
|
18
18
|
use vars qw($VERSION %exifSpec);
|
19
19
|
|
20
|
-
$VERSION = '1.
|
20
|
+
$VERSION = '1.18';
|
21
21
|
|
22
22
|
use Image::ExifTool qw(:Utils);
|
23
23
|
use Image::ExifTool::Exif;
|
@@ -214,11 +214,11 @@ my %validValue = (
|
|
214
214
|
IFD0 => {
|
215
215
|
0x100 => 'defined $val', # ImageWidth
|
216
216
|
0x101 => 'defined $val', # ImageLength
|
217
|
-
0x102 => 'defined $val', # BitsPerSample
|
217
|
+
# (default is 1) 0x102 => 'defined $val', # BitsPerSample
|
218
218
|
0x103 => q{
|
219
219
|
not defined $val or $val =~ /^(1|5|6|32773)$/ or
|
220
220
|
($val == 2 and (not defined $val{0x102} or $val{0x102} == 1));
|
221
|
-
},
|
221
|
+
}, # Compression
|
222
222
|
0x106 => '$val =~ /^[0123]$/', # PhotometricInterpretation
|
223
223
|
0x111 => 'defined $val', # StripOffsets
|
224
224
|
# SamplesPerPixel
|
@@ -237,7 +237,7 @@ my %validValue = (
|
|
237
237
|
0x117 => 'defined $val', # StripByteCounts
|
238
238
|
0x11a => 'defined $val', # XResolution
|
239
239
|
0x11b => 'defined $val', # YResolution
|
240
|
-
0x128 => '$val =~ /^[123]$/', # ResolutionUnit
|
240
|
+
0x128 => 'not defined $val or $val =~ /^[123]$/', # ResolutionUnit
|
241
241
|
# ColorMap (must be palette image with correct number of colors)
|
242
242
|
0x140 => q{
|
243
243
|
return '' if defined $val{0x106} and $val{0x106} == 3 xor defined $val;
|
@@ -1832,6 +1832,7 @@ NoOverwrite: next if $isNew > 0;
|
|
1832
1832
|
warn "Internal error writing offsets for $$newInfo{Name}\n";
|
1833
1833
|
return undef;
|
1834
1834
|
}
|
1835
|
+
$newValuePt = \$newValue;
|
1835
1836
|
}
|
1836
1837
|
$offsetInfo or $offsetInfo = $offsetInfo[$ifd] = { };
|
1837
1838
|
# save location of valuePtr in new directory
|
@@ -300,15 +300,19 @@ sub CheckQTValue($$$)
|
|
300
300
|
|
301
301
|
#------------------------------------------------------------------------------
|
302
302
|
# Format QuickTime value for writing
|
303
|
-
# Inputs: 0) ExifTool ref, 1) value ref, 2) Format (or undef)
|
303
|
+
# Inputs: 0) ExifTool ref, 1) value ref, 2) Format (or undef), 3) Writable (or undef)
|
304
304
|
# Returns: Flags for QT data type, and reformats value as required
|
305
|
-
sub FormatQTValue(
|
305
|
+
sub FormatQTValue($$;$$)
|
306
306
|
{
|
307
|
-
my ($et, $valPt, $format) = @_;
|
307
|
+
my ($et, $valPt, $format, $writable) = @_;
|
308
308
|
my $flags;
|
309
309
|
if ($format and $format ne 'string') {
|
310
310
|
$$valPt = WriteValue($$valPt, $format);
|
311
|
-
$
|
311
|
+
if ($writable and $qtFormat{$writable}) {
|
312
|
+
$flags = $qtFormat{$writable};
|
313
|
+
} else {
|
314
|
+
$flags = $qtFormat{$format} || 0;
|
315
|
+
}
|
312
316
|
} elsif ($$valPt =~ /^\xff\xd8\xff/) {
|
313
317
|
$flags = 0x0d; # JPG
|
314
318
|
} elsif ($$valPt =~ /^(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n/) {
|
@@ -1122,9 +1126,9 @@ sub WriteQuickTime($$$)
|
|
1122
1126
|
my $newVal = $et->GetNewValue($nvHash);
|
1123
1127
|
next unless defined $newVal;
|
1124
1128
|
my $prVal = $newVal;
|
1125
|
-
my $flags = FormatQTValue($et, \$newVal, $format);
|
1129
|
+
my $flags = FormatQTValue($et, \$newVal, $format, $$tagInfo{Writable});
|
1126
1130
|
next unless defined $newVal;
|
1127
|
-
my ($ctry, $lang) = (0,
|
1131
|
+
my ($ctry, $lang) = (0, 0);
|
1128
1132
|
if ($$ti{LangCode}) {
|
1129
1133
|
unless ($$ti{LangCode} =~ /^([A-Z]{3})?[-_]?([A-Z]{2})?$/i) {
|
1130
1134
|
$et->Warn("Invalid language code for $$ti{Name}");
|
@@ -1180,7 +1184,11 @@ sub WriteQuickTime($$$)
|
|
1180
1184
|
} else {
|
1181
1185
|
if ($format) {
|
1182
1186
|
# update flags for the format we are writing
|
1183
|
-
|
1187
|
+
if ($$tagInfo{Writable} and $qtFormat{$$tagInfo{Writable}}) {
|
1188
|
+
$flags = $qtFormat{$$tagInfo{Writable}};
|
1189
|
+
} elsif ($qtFormat{$format}) {
|
1190
|
+
$flags = $qtFormat{$format};
|
1191
|
+
}
|
1184
1192
|
} else {
|
1185
1193
|
$format = QuickTimeFormat($flags, $len);
|
1186
1194
|
}
|
@@ -1199,12 +1207,13 @@ sub WriteQuickTime($$$)
|
|
1199
1207
|
}
|
1200
1208
|
my $prVal = $newVal;
|
1201
1209
|
# format new value for writing (and get new flags)
|
1202
|
-
$flags = FormatQTValue($et, \$newVal, $format);
|
1210
|
+
$flags = FormatQTValue($et, \$newVal, $format, $$tagInfo{Writable});
|
1203
1211
|
my $grp = $et->GetGroup($langInfo, 1);
|
1204
1212
|
$et->VerboseValue("- $grp:$$langInfo{Name}", $val);
|
1205
1213
|
$et->VerboseValue("+ $grp:$$langInfo{Name}", $prVal);
|
1206
1214
|
$newData = substr($buff, 0, $pos-16) unless defined $newData;
|
1207
|
-
$
|
1215
|
+
my $wLang = $lang eq $undLang ? 0 : $lang;
|
1216
|
+
$newData .= pack('Na4Nnn', length($newVal)+16, $type, $flags, $ctry, $wLang);
|
1208
1217
|
$newData .= $newVal;
|
1209
1218
|
++$$et{CHANGED};
|
1210
1219
|
} elsif (defined $newData) {
|
@@ -1268,10 +1277,11 @@ sub WriteQuickTime($$$)
|
|
1268
1277
|
# add back necessary header and encode as necessary
|
1269
1278
|
if (defined $lang) {
|
1270
1279
|
$newData = $et->Encode($newData, $lang < 0x400 ? $charsetQuickTime : 'UTF8');
|
1280
|
+
my $wLang = $lang eq $undLang ? 0 : $lang;
|
1271
1281
|
if ($$tagInfo{IText} and $$tagInfo{IText} == 6) {
|
1272
|
-
$newData = pack('Nn', 0, $
|
1282
|
+
$newData = pack('Nn', 0, $wLang) . $newData . "\0";
|
1273
1283
|
} else {
|
1274
|
-
$newData = pack('nn', length($newData), $
|
1284
|
+
$newData = pack('nn', length($newData), $wLang) . $newData;
|
1275
1285
|
}
|
1276
1286
|
} elsif (not $format or $format =~ /^string/ and
|
1277
1287
|
not $$tagInfo{Binary} and not $$tagInfo{ValueConv})
|
@@ -1406,9 +1416,9 @@ sub WriteQuickTime($$$)
|
|
1406
1416
|
my $newVal = $et->GetNewValue($nvHash);
|
1407
1417
|
next unless defined $newVal;
|
1408
1418
|
my $prVal = $newVal;
|
1409
|
-
my $flags = FormatQTValue($et, \$newVal, $$tagInfo{Format});
|
1419
|
+
my $flags = FormatQTValue($et, \$newVal, $$tagInfo{Format}, $$tagInfo{Writable});
|
1410
1420
|
next unless defined $newVal;
|
1411
|
-
my ($ctry, $lang) = (0,0);
|
1421
|
+
my ($ctry, $lang) = (0, 0);
|
1412
1422
|
# handle alternate languages
|
1413
1423
|
if ($$tagInfo{LangCode}) {
|
1414
1424
|
$tag = substr($tag, 0, 4); # strip language code from tag ID
|
@@ -1424,10 +1434,8 @@ sub WriteQuickTime($$$)
|
|
1424
1434
|
}
|
1425
1435
|
if ($$dirInfo{HasData}) {
|
1426
1436
|
# add 'data' header
|
1427
|
-
$lang or $lang = $undLang;
|
1428
1437
|
$newVal = pack('Na4Nnn',16+length($newVal),'data',$flags,$ctry,$lang).$newVal;
|
1429
1438
|
} elsif ($tag =~ /^\xa9/ or $$tagInfo{IText}) {
|
1430
|
-
$lang or $lang = $undLang;
|
1431
1439
|
if ($ctry) {
|
1432
1440
|
my $grp = $et->GetGroup($tagInfo,1);
|
1433
1441
|
$et->Warn("Can't use country code for $grp:$$tagInfo{Name}");
|
@@ -359,21 +359,25 @@ sub SetNewValue($;$$%)
|
|
359
359
|
my $convType = $options{Type} || ($$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv');
|
360
360
|
|
361
361
|
# filter value if necessary
|
362
|
-
$self->Filter($$self{OPTIONS}{FilterW}, \$value) if $convType eq 'PrintConv';
|
362
|
+
$self->Filter($$self{OPTIONS}{FilterW}, \$value) or return 0 if $convType eq 'PrintConv';
|
363
363
|
|
364
364
|
my (@wantGroup, $family2);
|
365
365
|
my $wantGroup = $options{Group};
|
366
366
|
if ($wantGroup) {
|
367
367
|
foreach (split /:/, $wantGroup) {
|
368
368
|
next unless length($_) and /^(\d+)?(.*)/; # separate family number and group name
|
369
|
-
my ($f, $g) = ($1,
|
369
|
+
my ($f, $g) = ($1, $2);
|
370
|
+
my $lcg = lc $g;
|
370
371
|
# save group/family unless '*' or 'all'
|
371
|
-
push @wantGroup, [ $f, $
|
372
|
-
if (
|
373
|
-
|
374
|
-
$
|
372
|
+
push @wantGroup, [ $f, $lcg ] unless $lcg eq '*' or $lcg eq 'all';
|
373
|
+
if ($g =~ s/^ID-//i) { # family 7 is a tag ID
|
374
|
+
return 0 if defined $f and $f ne 7;
|
375
|
+
$wantGroup[-1] = [ 7, $g ]; # group name with 'ID-' removed and case preserved
|
376
|
+
} elsif (defined $f) {
|
377
|
+
$f > 2 and return 0; # only allow family 0, 1 or 2
|
378
|
+
$family2 = 1 if $f == 2; # set flag indicating family 2 was used
|
375
379
|
} else {
|
376
|
-
$family2 = 1 if $family2groups{$
|
380
|
+
$family2 = 1 if $family2groups{$lcg};
|
377
381
|
}
|
378
382
|
}
|
379
383
|
undef $wantGroup unless @wantGroup;
|
@@ -622,6 +626,8 @@ TAG: foreach $tagInfo (@matchingTags) {
|
|
622
626
|
next;
|
623
627
|
}
|
624
628
|
next if $lcWant eq lc $grp[2];
|
629
|
+
} elsif ($fam == 7) {
|
630
|
+
next if IsSameID($$tagInfo{TagID}, $lcWant);
|
625
631
|
} elsif ($fam != 1 and not $$tagInfo{AllowGroup}) {
|
626
632
|
next if $lcWant eq lc $grp[$fam];
|
627
633
|
if ($wgAll and not $fam and $allFam0{$lcWant}) {
|
@@ -1258,6 +1264,7 @@ sub SetNewValuesFromFile($$;@)
|
|
1258
1264
|
Filter => $$options{Filter},
|
1259
1265
|
FixBase => $$options{FixBase},
|
1260
1266
|
GlobalTimeShift => $$options{GlobalTimeShift},
|
1267
|
+
HexTagIDs => $$options{HexTagIDs},
|
1261
1268
|
IgnoreMinorErrors=>$$options{IgnoreMinorErrors},
|
1262
1269
|
Lang => $$options{Lang},
|
1263
1270
|
LargeFileSupport=> $$options{LargeFileSupport},
|
@@ -1409,7 +1416,9 @@ sub SetNewValuesFromFile($$;@)
|
|
1409
1416
|
foreach (split /:/, $grp) {
|
1410
1417
|
# save family/groups in list (ignoring 'all' and '*')
|
1411
1418
|
next unless length($_) and /^(\d+)?(.*)/;
|
1412
|
-
|
1419
|
+
my ($f, $g) = ($1, $2);
|
1420
|
+
$f = 7 if $g =~ s/^ID-//i;
|
1421
|
+
push @fg, [ $f, $g ] unless $g eq '*' or $g eq 'all';
|
1413
1422
|
}
|
1414
1423
|
}
|
1415
1424
|
# allow ValueConv to be specified by a '#' on the tag name
|
@@ -1475,10 +1484,12 @@ SET: foreach $set (@setList) {
|
|
1475
1484
|
}
|
1476
1485
|
foreach (@{$$set[0]}) {
|
1477
1486
|
my ($f, $g) = @$_;
|
1478
|
-
if (defined $f) {
|
1479
|
-
next SET unless defined $grp[$f] and $g eq $grp[$f];
|
1480
|
-
} else {
|
1487
|
+
if (not defined $f) {
|
1481
1488
|
next SET unless $grp{$g};
|
1489
|
+
} elsif ($f == 7) {
|
1490
|
+
next SET unless IsSameID($srcExifTool->GetTagID($tag), $g);
|
1491
|
+
} else {
|
1492
|
+
next SET unless defined $grp[$f] and $g eq $grp[$f];
|
1482
1493
|
}
|
1483
1494
|
}
|
1484
1495
|
}
|
@@ -1598,21 +1609,25 @@ sub GetNewValue($$;$)
|
|
1598
1609
|
$nvHash = $self->GetNewValueHash($tagInfo);
|
1599
1610
|
} else {
|
1600
1611
|
# separate group from tag name
|
1601
|
-
|
1612
|
+
my @groups;
|
1613
|
+
@groups = split ':', $1 if $tag =~ s/(.*)://;
|
1602
1614
|
my @tagInfoList = FindTagInfo($tag);
|
1603
1615
|
# decide which tag we want
|
1604
1616
|
GNV_TagInfo: foreach $tagInfo (@tagInfoList) {
|
1605
1617
|
my $nvh = $self->GetNewValueHash($tagInfo) or next;
|
1606
|
-
# select tag in specified group if necessary
|
1607
|
-
|
1618
|
+
# select tag in specified group(s) if necessary
|
1619
|
+
foreach (@groups) {
|
1620
|
+
next if $_ eq $$nvh{WriteGroup};
|
1608
1621
|
my @grps = $self->GetGroup($tagInfo);
|
1609
1622
|
if ($grps[0] eq $$nvh{WriteGroup}) {
|
1610
1623
|
# check family 1 group only if WriteGroup is not specific
|
1611
|
-
|
1624
|
+
next if $_ eq $grps[1];
|
1612
1625
|
} else {
|
1613
1626
|
# otherwise check family 0 group
|
1614
|
-
|
1627
|
+
next if $_ eq $grps[0];
|
1615
1628
|
}
|
1629
|
+
# also check family 7
|
1630
|
+
next if /^ID-(.*)/i and IsSameID($$tagInfo{TagID}, $1);
|
1616
1631
|
# step to next entry in list
|
1617
1632
|
$nvh = $$nvh{Next} or next GNV_TagInfo;
|
1618
1633
|
}
|
@@ -2007,7 +2022,7 @@ sub SetFileName($$;$$$)
|
|
2007
2022
|
|
2008
2023
|
#------------------------------------------------------------------------------
|
2009
2024
|
# Set file permissions, group/user id and various MDItem tags from new tag values
|
2010
|
-
# Inputs: 0)
|
2025
|
+
# Inputs: 0) ExifTool ref, 1) file name or glob (must be a name for MDItem tags)
|
2011
2026
|
# Returns: 1=something was set OK, 0=didn't try, -1=error (and warning set)
|
2012
2027
|
# Notes: There may be errors even if 1 is returned
|
2013
2028
|
sub SetSystemTags($$)
|
@@ -3269,7 +3284,7 @@ sub IsSameFile($$$)
|
|
3269
3284
|
|
3270
3285
|
#------------------------------------------------------------------------------
|
3271
3286
|
# Is this a raw file type?
|
3272
|
-
# Inputs: 0)
|
3287
|
+
# Inputs: 0) ExifTool ref
|
3273
3288
|
# Returns: true if FileType is a type of RAW image
|
3274
3289
|
sub IsRawType($)
|
3275
3290
|
{
|
@@ -5525,7 +5540,11 @@ sub WriteJPEG($$)
|
|
5525
5540
|
my $buff = $self->WriteDirectory(\%dirInfo, $tagTablePtr, \&WriteTIFF);
|
5526
5541
|
if (defined $buff and length $buff) {
|
5527
5542
|
if (length($buff) + length($exifAPP1hdr) > $maxSegmentLen) {
|
5528
|
-
$self->
|
5543
|
+
if ($self->Options('NoMultiExif')) {
|
5544
|
+
$self->Error('EXIF is too large for JPEG segment');
|
5545
|
+
} else {
|
5546
|
+
$self->Warn('Creating multi-segment EXIF',1);
|
5547
|
+
}
|
5529
5548
|
}
|
5530
5549
|
# switch to buffered output if required
|
5531
5550
|
if (($$self{PREVIEW_INFO} or $$self{LeicaTrailer}) and not $oldOutfile) {
|
@@ -5997,7 +6016,11 @@ sub WriteJPEG($$)
|
|
5997
6016
|
# delete segment if IFD contains no entries
|
5998
6017
|
length $$segDataPt or $del = 1, last;
|
5999
6018
|
if (length($$segDataPt) + length($exifAPP1hdr) > $maxSegmentLen) {
|
6000
|
-
$self->
|
6019
|
+
if ($self->Options('NoMultiExif')) {
|
6020
|
+
$self->Error('EXIF is too large for JPEG segment');
|
6021
|
+
} else {
|
6022
|
+
$self->Warn('Writing multi-segment EXIF',1);
|
6023
|
+
}
|
6001
6024
|
}
|
6002
6025
|
# switch to buffered output if required
|
6003
6026
|
if (($$self{PREVIEW_INFO} or $$self{LeicaTrailer}) and not $oldOutfile) {
|
@@ -6779,7 +6802,7 @@ sub WriteBinaryData($$$)
|
|
6779
6802
|
my $val = ReadValue($dataPt, $entry, $format, $count, $dirLen-$entry);
|
6780
6803
|
next unless defined $val;
|
6781
6804
|
my $nvHash = $self->GetNewValueHash($tagInfo, $$self{CUR_WRITE_GROUP});
|
6782
|
-
next unless $self->IsOverwriting($nvHash, $val);
|
6805
|
+
next unless $self->IsOverwriting($nvHash, $val) > 0;
|
6783
6806
|
my $newVal = $self->GetNewValue($nvHash);
|
6784
6807
|
next unless defined $newVal; # can't delete from a binary table
|
6785
6808
|
# update DataMember with new value if necessary
|
@@ -49,7 +49,7 @@ use Image::ExifTool::Exif;
|
|
49
49
|
use Image::ExifTool::GPS;
|
50
50
|
require Exporter;
|
51
51
|
|
52
|
-
$VERSION = '3.
|
52
|
+
$VERSION = '3.35';
|
53
53
|
@ISA = qw(Exporter);
|
54
54
|
@EXPORT_OK = qw(EscapeXML UnescapeXML);
|
55
55
|
|
@@ -889,6 +889,7 @@ my %sRetouchArea = (
|
|
889
889
|
ModifyDate => { Groups => { 2 => 'Time' }, %dateTimeInfo, Priority => 0 },
|
890
890
|
Nickname => { },
|
891
891
|
Rating => { Writable => 'real', Notes => 'a value from 0 to 5, or -1 for "rejected"' },
|
892
|
+
RatingPercent=>{ Writable => 'real', Avoid => 1, Notes => 'non-standard' },
|
892
893
|
Thumbnails => {
|
893
894
|
FlatName => 'Thumbnail',
|
894
895
|
Struct => \%sThumbnail,
|
@@ -1483,8 +1484,35 @@ my %sPantryItem = (
|
|
1483
1484
|
STRUCT_NAME => 'Look',
|
1484
1485
|
NAMESPACE => 'crs',
|
1485
1486
|
Name => { },
|
1487
|
+
Amount => { },
|
1488
|
+
Cluster=> { },
|
1489
|
+
UUID => { },
|
1490
|
+
SupportsMonochrome => { },
|
1486
1491
|
}
|
1487
1492
|
},
|
1493
|
+
# more again (ref forum11258)
|
1494
|
+
GrainSeed => { },
|
1495
|
+
ClipboardOrientation => { Writable => 'integer' },
|
1496
|
+
ClipboardAspectRatio => { Writable => 'integer' },
|
1497
|
+
PresetType => { },
|
1498
|
+
Cluster => { },
|
1499
|
+
UUID => { Avoid => 1 },
|
1500
|
+
SupportsAmount => { Writable => 'boolean' },
|
1501
|
+
SupportsColor => { Writable => 'boolean' },
|
1502
|
+
SupportsMonochrome => { Writable => 'boolean' },
|
1503
|
+
SupportsHighDynamicRange=> { Writable => 'boolean' },
|
1504
|
+
SupportsNormalDynamicRange=> { Writable => 'boolean' },
|
1505
|
+
SupportsSceneReferred => { Writable => 'boolean' },
|
1506
|
+
SupportsOutputReferred => { Writable => 'boolean' },
|
1507
|
+
CameraModelRestriction => { },
|
1508
|
+
Copyright => { Avoid => 1 },
|
1509
|
+
ContactInfo => { },
|
1510
|
+
GrainSeed => { Writable => 'integer' },
|
1511
|
+
Name => { Writable => 'lang-alt', Avoid => 1 },
|
1512
|
+
ShortName => { Writable => 'lang-alt' },
|
1513
|
+
SortName => { Writable => 'lang-alt' },
|
1514
|
+
Group => { Writable => 'lang-alt', Avoid => 1 },
|
1515
|
+
Description => { Writable => 'lang-alt', Avoid => 1 },
|
1488
1516
|
);
|
1489
1517
|
|
1490
1518
|
# Tiff namespace properties (tiff)
|
@@ -2935,13 +2963,15 @@ sub PrintLensID(@)
|
|
2935
2963
|
# for Pentax, CS4 stores an int16u, but we use 2 x int8u
|
2936
2964
|
$id = join(' ', unpack('C*', pack('n', $id)));
|
2937
2965
|
}
|
2938
|
-
my $str = $$printConv{$id} || "Unknown ($id)";
|
2939
2966
|
# Nikon is a special case because Adobe doesn't store the full LensID
|
2967
|
+
# (Apple Photos does, but we have to convert back to hex)
|
2940
2968
|
if ($mk eq 'Nikon') {
|
2941
|
-
|
2969
|
+
$id = sprintf('%X', $id);
|
2970
|
+
$id = "0$id" if length($id) & 0x01; # pad with leading 0 if necessary
|
2971
|
+
$id =~ s/(..)/$1 /g and $id =~ s/ $//; # put spaces between bytes
|
2942
2972
|
my (%newConv, %used);
|
2943
2973
|
my $i = 0;
|
2944
|
-
foreach (grep /^$
|
2974
|
+
foreach (grep /^$id/, keys %$printConv) {
|
2945
2975
|
my $lens = $$printConv{$_};
|
2946
2976
|
next if $used{$lens}; # avoid duplicates
|
2947
2977
|
$used{$lens} = 1;
|
@@ -2950,6 +2980,7 @@ sub PrintLensID(@)
|
|
2950
2980
|
}
|
2951
2981
|
$printConv = \%newConv;
|
2952
2982
|
}
|
2983
|
+
my $str = $$printConv{$id} || "Unknown ($id)";
|
2953
2984
|
return Image::ExifTool::Exif::PrintLensID($et, $str, $printConv,
|
2954
2985
|
undef, $id, $focalLength, $sa, $maxAv, $sf, $lf, $lensModel);
|
2955
2986
|
}
|
@@ -3187,6 +3218,7 @@ NoLoop:
|
|
3187
3218
|
#} elsif (grep / /, @$props) {
|
3188
3219
|
# $$tagInfo{List} = 1;
|
3189
3220
|
}
|
3221
|
+
#PHIL why flat tag added here???? (try a.xmp)
|
3190
3222
|
AddTagToTable($tagTablePtr, $tagID, $tagInfo);
|
3191
3223
|
$added = 1;
|
3192
3224
|
last;
|
@@ -3531,6 +3563,11 @@ sub ParseXMPElement($$$;$$$$)
|
|
3531
3563
|
# add svg namespace prefix if missing to ignore these entries in the tag name
|
3532
3564
|
$$propList[-1] = "svg:$prop";
|
3533
3565
|
}
|
3566
|
+
} elsif ($$et{XmpIgnoreProps}) { # ignore specified properties for tag name
|
3567
|
+
foreach (@{$$et{XmpIgnoreProps}}) {
|
3568
|
+
last unless @$propList;
|
3569
|
+
pop @$propList if $_ eq $$propList[0];
|
3570
|
+
}
|
3534
3571
|
}
|
3535
3572
|
|
3536
3573
|
# handle properties inside element attributes (RDF shorthand format):
|
@@ -519,6 +519,7 @@ sub AddNewStruct($$$$$$)
|
|
519
519
|
next unless $$fieldInfo{List};
|
520
520
|
my $i = 0;
|
521
521
|
my ($item, $p);
|
522
|
+
my $level = scalar(() = ($propPath =~ / \d+/g));
|
522
523
|
# loop through all list items (note: can't yet write multi-dimensional lists)
|
523
524
|
foreach $item (@{$val}) {
|
524
525
|
if ($i) {
|
@@ -533,7 +534,8 @@ sub AddNewStruct($$$$$$)
|
|
533
534
|
if (ref $item eq 'HASH') {
|
534
535
|
my $subStruct = $$fieldInfo{Struct} or next;
|
535
536
|
AddNewStruct($et, $tagInfo, $capture, $p, $item, $subStruct) or next;
|
536
|
-
|
537
|
+
# don't write empty items in upper-level list
|
538
|
+
} elsif (length $item or (defined $item and $level == 1)) {
|
537
539
|
AddNewTag($et, $fieldInfo, $capture, $p, \$item, \%langIdx);
|
538
540
|
$addedTag = 1;
|
539
541
|
}
|
@@ -0,0 +1,123 @@
|
|
1
|
+
#------------------------------------------------------------------------------
|
2
|
+
# File: ZISRAW.pm
|
3
|
+
#
|
4
|
+
# Description: Read ZISRAW (CZI) meta information
|
5
|
+
#
|
6
|
+
# Revisions: 2020-08-07 - P. Harvey Created
|
7
|
+
#
|
8
|
+
# References: 1) https://www.zeiss.com/microscopy/us/products/microscope-software/zen/czi.html
|
9
|
+
#------------------------------------------------------------------------------
|
10
|
+
|
11
|
+
package Image::ExifTool::ZISRAW;
|
12
|
+
|
13
|
+
use strict;
|
14
|
+
use vars qw($VERSION);
|
15
|
+
use Image::ExifTool qw(:DataAccess :Utils);
|
16
|
+
|
17
|
+
$VERSION = '1.00';
|
18
|
+
|
19
|
+
%Image::ExifTool::ZISRAW::Main = (
|
20
|
+
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
|
21
|
+
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
|
22
|
+
NOTES => q{
|
23
|
+
As well as the header information listed below, ExifTool also extracts the
|
24
|
+
top-level XML-based metadata from Zeiss Integrated Software RAW (ZISRAW) CZI
|
25
|
+
files.
|
26
|
+
},
|
27
|
+
0x20 => {
|
28
|
+
Name => 'ZISRAWVersion',
|
29
|
+
Format => 'int32u[2]',
|
30
|
+
PrintConv => '$val =~ tr/ /./; $val',
|
31
|
+
},
|
32
|
+
0x30 => {
|
33
|
+
Name => 'PrimaryFileGUID',
|
34
|
+
Format => 'undef[16]',
|
35
|
+
ValueConv => 'unpack("H*",$val)',
|
36
|
+
},
|
37
|
+
0x40 => {
|
38
|
+
Name => 'FileGUID',
|
39
|
+
Format => 'undef[16]',
|
40
|
+
ValueConv => 'unpack("H*",$val)',
|
41
|
+
},
|
42
|
+
);
|
43
|
+
|
44
|
+
#------------------------------------------------------------------------------
|
45
|
+
# Extract metadata from a ZISRAW (CZI) image
|
46
|
+
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
47
|
+
# Returns: 1 on success, 0 if this wasn't a valid CZI file
|
48
|
+
sub ProcessCZI($$)
|
49
|
+
{
|
50
|
+
my ($et, $dirInfo) = @_;
|
51
|
+
my $raf = $$dirInfo{RAF};
|
52
|
+
my ($buff, $tagTablePtr);
|
53
|
+
|
54
|
+
# verify this is a valid CZI file
|
55
|
+
return 0 unless $raf->Read($buff, 100) == 100;
|
56
|
+
return 0 unless $buff =~ /^ZISRAWFILE\0{6}/;
|
57
|
+
$et->SetFileType();
|
58
|
+
SetByteOrder('II');
|
59
|
+
my %dirInfo = (
|
60
|
+
DataPt => \$buff,
|
61
|
+
DirStart => 0,
|
62
|
+
DirLen => length($buff),
|
63
|
+
);
|
64
|
+
$tagTablePtr = GetTagTable('Image::ExifTool::ZISRAW::Main');
|
65
|
+
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
66
|
+
|
67
|
+
# read the metadata section
|
68
|
+
my $pos = Get64u(\$buff, 92) or return 1;
|
69
|
+
$raf->Seek($pos, 0) or $et->Warn('Error seeking to metadata'), return 0;
|
70
|
+
$raf->Read($buff, 288) == 288 or $et->Warn('Error reading metadata header'), return 0;
|
71
|
+
$buff =~ /^ZISRAWMETADATA\0\0/ or $et->Warn('Invalid metadata header'), return 0;
|
72
|
+
my $len = Get32u(\$buff, 32);
|
73
|
+
$len < 200000000 or $et->Warn('Metadata section too large. Ignoring'), return 0;
|
74
|
+
$raf->Read($buff, $len) or $et->Warn('Error reading XML metadata'), return 0;
|
75
|
+
$et->FoundTag('XML', $buff); # extract as a block
|
76
|
+
$tagTablePtr = GetTagTable('Image::ExifTool::XMP::XML');
|
77
|
+
$dirInfo{DirLen} = length $buff;
|
78
|
+
# shorten tag names somewhat by removing 'ImageDocumentMetadata' prefix from all
|
79
|
+
$$et{XmpIgnoreProps} = [ 'ImageDocument', 'Metadata' ];
|
80
|
+
$et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
81
|
+
|
82
|
+
return 1;
|
83
|
+
}
|
84
|
+
|
85
|
+
1; # end
|
86
|
+
|
87
|
+
__END__
|
88
|
+
|
89
|
+
=head1 NAME
|
90
|
+
|
91
|
+
Image::ExifTool::ZISRAW - Read ZISRAW (CZI) meta information
|
92
|
+
|
93
|
+
=head1 SYNOPSIS
|
94
|
+
|
95
|
+
This module is used by Image::ExifTool
|
96
|
+
|
97
|
+
=head1 DESCRIPTION
|
98
|
+
|
99
|
+
This module contains definitions required by Image::ExifTool to read
|
100
|
+
metadata from Zeiss Integrated Software RAW (ZISRAW) CZI files.
|
101
|
+
|
102
|
+
=head1 AUTHOR
|
103
|
+
|
104
|
+
Copyright 2003-2020, Phil Harvey (philharvey66 at gmail.com)
|
105
|
+
|
106
|
+
This library is free software; you can redistribute it and/or modify it
|
107
|
+
under the same terms as Perl itself.
|
108
|
+
|
109
|
+
=head1 REFERENCES
|
110
|
+
|
111
|
+
=over 4
|
112
|
+
|
113
|
+
=item L<https://www.zeiss.com/microscopy/us/products/microscope-software/zen/czi.html>
|
114
|
+
|
115
|
+
=back
|
116
|
+
|
117
|
+
=head1 SEE ALSO
|
118
|
+
|
119
|
+
L<Image::ExifTool::TagNames/ZISRAW Tags>,
|
120
|
+
L<Image::ExifTool(3pm)|Image::ExifTool>
|
121
|
+
|
122
|
+
=cut
|
123
|
+
|