$VERSION
=
'1.43'
;
sub
ProcessJpeg2000Box($$$);
sub
ProcessJUMD($$$);
my
%resolutionUnit
= (
-3
=>
'km'
,
-2
=>
'100 m'
,
-1
=>
'10 m'
,
0
=>
'm'
,
1
=>
'10 cm'
,
2
=>
'cm'
,
3
=>
'mm'
,
4
=>
'0.1 mm'
,
5
=>
'0.01 mm'
,
6
=>
'um'
,
);
my
%isImageData
= (
jp2c
=>1,
jbrd
=>1,
jxlp
=>1,
jxlc
=>1 );
my
%jp2Map
= (
IPTC
=>
'UUID-IPTC'
,
IFD0
=>
'UUID-EXIF'
,
XMP
=>
'UUID-XMP'
,
'UUID-IPTC'
=>
'JP2'
,
'UUID-EXIF'
=>
'JP2'
,
'UUID-XMP'
=>
'JP2'
,
jp2h
=>
'JP2'
,
colr
=>
'jp2h'
,
ICC_Profile
=>
'colr'
,
IFD1
=>
'IFD0'
,
EXIF
=>
'IFD0'
,
ExifIFD
=>
'IFD0'
,
GPS
=>
'IFD0'
,
SubIFD
=>
'IFD0'
,
GlobParamIFD
=>
'IFD0'
,
PrintIM
=>
'IFD0'
,
InteropIFD
=>
'ExifIFD'
,
MakerNotes
=>
'ExifIFD'
,
);
my
%jxlMap
= (
IFD0
=>
'Exif'
,
XMP
=>
'xml '
,
'Exif'
=>
'JP2'
,
IFD1
=>
'IFD0'
,
EXIF
=>
'IFD0'
,
ExifIFD
=>
'IFD0'
,
GPS
=>
'IFD0'
,
SubIFD
=>
'IFD0'
,
GlobParamIFD
=>
'IFD0'
,
PrintIM
=>
'IFD0'
,
InteropIFD
=>
'ExifIFD'
,
MakerNotes
=>
'ExifIFD'
,
);
my
%uuid
= (
'UUID-EXIF'
=>
'JpgTiffExif->JP2'
,
'UUID-EXIF2'
=>
''
,
'UUID-EXIF_bad'
=>
'0'
,
'UUID-IPTC'
=>
"\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38"
,
'UUID-XMP'
=>
"\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac"
,
);
my
%j2cMarker
= (
0x4f
=>
'SOC'
,
0x51
=>
'SIZ'
,
0x52
=>
'COD'
,
0x53
=>
'COC'
,
0x55
=>
'TLM'
,
0x57
=>
'PLM'
,
0x58
=>
'PLT'
,
0x5c
=>
'QCD'
,
0x5d
=>
'QCC'
,
0x5e
=>
'RGN'
,
0x5f
=>
'POD'
,
0x60
=>
'PPM'
,
0x61
=>
'PPT'
,
0x63
=>
'CRG'
,
0x64
=>
'CME'
,
0x90
=>
'SOT'
,
0x91
=>
'SOP'
,
0x92
=>
'EPH'
,
0x93
=>
'SOD'
,
0x70
=>
'DCO'
,
0x71
=>
'VMS'
,
0x72
=>
'DFS'
,
0x73
=>
'ADS'
,
0x78
=>
'CBD'
,
0x74
=>
'MCT'
,
0x75
=>
'MCC'
,
0x77
=>
'MIC'
,
0x76
=>
'NLT'
,
);
%Image::ExifTool::Jpeg2000::Main
= (
GROUPS
=> {
2
=>
'Image'
},
PROCESS_PROC
=> \
&ProcessJpeg2000Box
,
WRITE_PROC
=> \
&ProcessJpeg2000Box
,
PREFERRED
=> 1,
NOTES
=>
q{
The tags below are found in JPEG 2000 images and the C2PA CAI JUMBF metadata
in various file types (see below). Note that ExifTool currently writes only
EXIF, IPTC and XMP tags in Jpeg2000 images, and EXIF and XMP in JXL images.
ExifTool will read/write Brotli-compressed EXIF and XMP in JXL images, but
the API L<Compress|../ExifTool.html#Compress> option must be set to create new EXIF and XMP in compressed
format.
C2PA (Coalition for Content Provenance and Authenticity) CAI (Content
Authenticity Initiative) JUMBF (JPEG Universal Metadata Box Format) metdata
is currently extracted from JPEG, PNG, TIFF-based (eg. TIFF, DNG),
QuickTime-based (eg. MP4, MOV, HEIF, AVIF), RIFF-based (eg. WAV, AVI, WebP),
PDF, SVG and GIF files, and ID3v2 metadata. The suggested ExifTool
command-line arguments for reading C2PA metadata are C<-jumbf:all -G3 -b -j
-u -struct>. This metadata may be deleted from writable JPEG, PNG, WebP,
TIFF-based, and QuickTime-based files by deleting the JUMBF group with
C<-jumbf:all=>. The C2PA JUMBF metadata may be extracted as a block via the
specification.
}
,
'jP '
=>
'JP2Signature'
,
"jP\x1a\x1a"
=>
'JP2Signature'
,
prfl
=>
'Profile'
,
ftyp
=> {
Name
=>
'FileType'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::FileType'
},
},
rreq
=>
'ReaderRequirements'
,
jp2h
=> {
Name
=>
'JP2Header'
,
SubDirectory
=> { },
},
ihdr
=> {
Name
=>
'ImageHeader'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::ImageHeader'
,
},
},
bpcc
=>
'BitsPerComponent'
,
colr
=> {
Name
=>
'ColorSpecification'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::ColorSpec'
,
},
},
pclr
=>
'Palette'
,
cdef
=>
'ComponentDefinition'
,
'res '
=> {
Name
=>
'Resolution'
,
SubDirectory
=> { },
},
resc
=> {
Name
=>
'CaptureResolution'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::CaptureResolution'
,
},
},
resd
=> {
Name
=>
'DisplayResolution'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::DisplayResolution'
,
},
},
jpch
=> {
Name
=>
'CodestreamHeader'
,
SubDirectory
=> { },
},
'lbl '
=> {
Name
=>
'Label'
,
Format
=>
'string'
,
},
cmap
=>
'ComponentMapping'
,
roid
=>
'ROIDescription'
,
jplh
=> {
Name
=>
'CompositingLayerHeader'
,
SubDirectory
=> { },
},
cgrp
=>
'ColorGroup'
,
opct
=>
'Opacity'
,
creg
=>
'CodestreamRegistration'
,
dtbl
=>
'DataReference'
,
ftbl
=> {
Name
=>
'FragmentTable'
,
Subdirectory
=> { },
},
flst
=>
'FragmentList'
,
cref
=>
'Cross-Reference'
,
mdat
=>
'MediaData'
,
comp
=>
'Composition'
,
copt
=>
'CompositionOptions'
,
inst
=>
'InstructionSet'
,
asoc
=> {
Name
=>
'Association'
,
SubDirectory
=> { },
},
nlst
=>
'NumberList'
,
bfil
=>
'BinaryFilter'
,
drep
=>
'DesiredReproductions'
,
gtso
=>
'GraphicsTechnologyStandardOutput'
,
chck
=>
'DigitalSignature'
,
mp7b
=>
'MPEG7Binary'
,
free
=>
'Free'
,
jp2c
=> [{
Name
=>
'ContiguousCodestream'
,
Condition
=>
'not $$self{jumd_level}'
,
},{
Name
=>
'PreviewImage'
,
Groups
=> {
2
=>
'Preview'
},
Format
=>
'undef'
,
Binary
=> 1,
}],
jp2i
=> {
Name
=>
'IntellectualProperty'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::XMP::Main'
},
},
'xml '
=> [{
Name
=>
'XML'
,
Condition
=>
'not $$self{IsJXL}'
,
Writable
=>
'undef'
,
Flags
=> [
'Binary'
,
'Protected'
,
'BlockExtract'
],
List
=> 1,
Notes
=>
q{
by default, the XML data in this tag is parsed using the ExifTool XMP module
to to allow individual tags to be accessed when reading, but it may also be
extracted as a block via the "XML" tag, which is also how this tag is
written and copied. It may also be extracted as a block by setting the API
BlockExtract option. This is a List-type tag because multiple XML blocks
may exist
}
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::XMP::XML'
},
},{
Name
=>
'XMP'
,
Notes
=>
'used for XMP in JPEG XL files'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::XMP::Main'
},
}],
uuid
=> [
{
Name
=>
'UUID-EXIF'
,
Condition
=>
'$$valPt=~/^JpgTiffExif->JP2(?!Exif\0\0)/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Exif::Main'
,
ProcessProc
=> \
&Image::ExifTool::ProcessTIFF
,
WriteProc
=> \
&Image::ExifTool::WriteTIFF
,
DirName
=>
'EXIF'
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-EXIF2'
,
Condition
=>
'$$valPt=~/^\x05\x37\xcd\xab\x9d\x0c\x44\x31\xa7\x2a\xfa\x56\x1f\x2a\x11\x3e/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Exif::Main'
,
ProcessProc
=> \
&Image::ExifTool::ProcessTIFF
,
WriteProc
=> \
&Image::ExifTool::WriteTIFF
,
DirName
=>
'EXIF'
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-EXIF_bad'
,
Condition
=>
'$$valPt=~/^JpgTiffExif->JP2/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Exif::Main'
,
ProcessProc
=> \
&Image::ExifTool::ProcessTIFF
,
WriteProc
=> \
&Image::ExifTool::WriteTIFF
,
DirName
=>
'EXIF'
,
Start
=>
'$valuePtr + 22'
,
},
},
{
Name
=>
'UUID-IPTC'
,
Condition
=>
'$$valPt=~/^\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::IPTC::Main'
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-IPTC2'
,
Condition
=>
'$$valPt=~/^\x09\xa1\x4e\x97\xc0\xb4\x42\xe0\xbe\xbf\x36\xdf\x6f\x0c\xe3\x6f/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::IPTC::Main'
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-XMP'
,
Condition
=>
'$$valPt=~/^\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::XMP::Main'
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-GeoJP2'
,
Condition
=>
'$$valPt=~/^\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Exif::Main'
,
ProcessProc
=> \
&Image::ExifTool::ProcessTIFF
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-Photoshop'
,
Condition
=>
'$$valPt=~/^\x2c\x4c\x01\x00\x85\x04\x40\xb9\xa0\x3e\x56\x21\x48\xd6\xdf\xeb/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Photoshop::Main'
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-C2PAClaimSignature'
,
Condition
=>
'$$valPt=~/^c2cs\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::CBOR::Main'
,
Start
=>
'$valuePtr + 16'
,
},
},
{
Name
=>
'UUID-Signature'
,
Condition
=>
'$$valPt=~/^casg\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/'
,
Format
=>
'undef'
,
ValueConv
=>
'substr($val,16)'
,
},
{
Name
=>
'UUID-Unknown'
,
},
],
uinf
=> {
Name
=>
'UUIDInfo'
,
SubDirectory
=> { },
},
ulst
=>
'UUIDList'
,
'url '
=> {
Name
=>
'URL'
,
Format
=>
'string'
,
},
jumd
=> {
Name
=>
'JUMBFDescr'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::JUMD'
},
},
jumb
=> {
Name
=>
'JUMBFBox'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::Main'
,
ProcessProc
=> \
&ProcessJUMB
,
},
},
json
=> {
Name
=>
'JSONData'
,
Flags
=> [
'Binary'
,
'Protected'
,
'BlockExtract'
],
Notes
=>
q{
by default, data in this tag is parsed using the ExifTool JSON module to to
allow individual tags to be accessed when reading, but it may also be
extracted as a block via the "JSONData" tag or by setting the API
BlockExtract option
}
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::JSON::Main'
},
},
cbor
=> {
Name
=>
'CBORData'
,
Flags
=> [
'Binary'
,
'Protected'
],
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::CBOR::Main'
},
},
bfdb
=> {
Name
=>
'BinaryDataType'
,
Notes
=>
'JUMBF, MIME type and optional file name'
,
Format
=>
'undef'
,
ValueConv
=>
'$_=substr($val,1); s/\0+$//; s/\0/, /; $_'
,
JUMBF_Suffix
=>
'Type'
,
},
bidb
=> {
Name
=>
'BinaryData'
,
Notes
=>
'JUMBF'
,
Groups
=> {
2
=>
'Preview'
},
Format
=>
'undef'
,
Binary
=> 1,
JUMBF_Suffix
=>
'Data'
,
},
c2sh
=> {
Name
=>
'C2PASaltHash'
,
Format
=>
'undef'
,
ValueConv
=>
'unpack("H*",$val)'
,
JUMBF_Suffix
=>
'Salt'
,
},
jxlc
=> {
Name
=>
'JXLCodestream'
,
Format
=>
'undef'
,
Notes
=>
q{
Codestream in JPEG XL image. Currently processed only to determine
ImageSize
}
,
RawConv
=>
'Image::ExifTool::Jpeg2000::ProcessJXLCodestream($self,\$val); undef'
,
},
jxlp
=> {
Name
=>
'PartialJXLCodestream'
,
Format
=>
'undef'
,
Notes
=>
q{
Partial codestreams in JPEG XL image. Currently processed only to determine
ImageSize
}
,
RawConv
=>
'Image::ExifTool::Jpeg2000::ProcessJXLCodestream($self,\$val); undef'
,
},
Exif
=> {
Name
=>
'EXIF'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Exif::Main'
,
ProcessProc
=> \
&Image::ExifTool::ProcessTIFF
,
WriteProc
=> \
&Image::ExifTool::WriteTIFF
,
DirName
=>
'EXIF'
,
Start
=>
'$valuePtr + 4 + (length($$dataPt)-$valuePtr > 4 ? unpack("N", $$dataPt) : 0)'
,
},
},
hrgm
=> {
Name
=>
'GainMapImage'
,
Groups
=> {
2
=>
'Preview'
},
Format
=>
'undef'
,
Binary
=> 1,
},
brob
=> [{
Name
=>
'BrotliXMP'
,
Condition
=>
'$$valPt =~ /^xml /i'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::XMP::Main'
,
ProcessProc
=> \
&ProcessBrotli
,
WriteProc
=> \
&ProcessBrotli
,
},
},{
Name
=>
'BrotliEXIF'
,
Condition
=>
'$$valPt =~ /^exif/i'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Exif::Main'
,
ProcessProc
=> \
&ProcessBrotli
,
WriteProc
=> \
&ProcessBrotli
,
},
},{
Name
=>
'BrotliJUMB'
,
Condition
=>
'$$valPt =~ /^jumb/i'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::Jpeg2000::Main'
,
ProcessProc
=> \
&ProcessBrotli
,
},
}],
);
%Image::ExifTool::Jpeg2000::ImageHeader
= (
PROCESS_PROC
=> \
&Image::ExifTool::ProcessBinaryData
,
GROUPS
=> {
2
=>
'Image'
},
0
=> {
Name
=>
'ImageHeight'
,
Format
=>
'int32u'
,
},
4
=> {
Name
=>
'ImageWidth'
,
Format
=>
'int32u'
,
},
8
=> {
Name
=>
'NumberOfComponents'
,
Format
=>
'int16u'
,
},
10
=> {
Name
=>
'BitsPerComponent'
,
PrintConv
=>
q{
$val == 0xff and return 'Variable';
my $sign = ($val & 0x80) ? 'Signed' : 'Unsigned';
return (($val & 0x7f) + 1) . " Bits, $sign";
}
,
},
11
=> {
Name
=>
'Compression'
,
PrintConv
=> {
0
=>
'Uncompressed'
,
1
=>
'Modified Huffman'
,
2
=>
'Modified READ'
,
3
=>
'Modified Modified READ'
,
4
=>
'JBIG'
,
5
=>
'JPEG'
,
6
=>
'JPEG-LS'
,
7
=>
'JPEG 2000'
,
8
=>
'JBIG2'
,
},
},
);
%Image::ExifTool::Jpeg2000::FileType
= (
PROCESS_PROC
=> \
&Image::ExifTool::ProcessBinaryData
,
GROUPS
=> {
2
=>
'Video'
},
FORMAT
=>
'int32u'
,
0
=> {
Name
=>
'MajorBrand'
,
Format
=>
'undef[4]'
,
PrintConv
=> {
'jp2 '
=>
'JPEG 2000 Image (.JP2)'
,
'jpm '
=>
'JPEG 2000 Compound Image (.JPM)'
,
'jpx '
=>
'JPEG 2000 with extensions (.JPX)'
,
'jxl '
=>
'JPEG XL Image (.JXL)'
,
'jph '
=>
'High-throughput JPEG 2000 (.JPH)'
,
},
},
1
=> {
Name
=>
'MinorVersion'
,
Format
=>
'undef[4]'
,
ValueConv
=>
'sprintf("%x.%x.%x", unpack("nCC", $val))'
,
},
2
=> {
Name
=>
'CompatibleBrands'
,
Format
=>
'undef[$size-8]'
,
List
=> 1,
ValueConv
=>
'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a'
,
},
);
%Image::ExifTool::Jpeg2000::CaptureResolution
= (
PROCESS_PROC
=> \
&Image::ExifTool::ProcessBinaryData
,
GROUPS
=> {
2
=>
'Image'
},
FORMAT
=>
'int8s'
,
0
=> {
Name
=>
'CaptureYResolution'
,
Format
=>
'rational32u'
,
},
4
=> {
Name
=>
'CaptureXResolution'
,
Format
=>
'rational32u'
,
},
8
=> {
Name
=>
'CaptureYResolutionUnit'
,
SeparateTable
=>
'ResolutionUnit'
,
PrintConv
=> \
%resolutionUnit
,
},
9
=> {
Name
=>
'CaptureXResolutionUnit'
,
SeparateTable
=>
'ResolutionUnit'
,
PrintConv
=> \
%resolutionUnit
,
},
);
%Image::ExifTool::Jpeg2000::DisplayResolution
= (
PROCESS_PROC
=> \
&Image::ExifTool::ProcessBinaryData
,
GROUPS
=> {
2
=>
'Image'
},
FORMAT
=>
'int8s'
,
0
=> {
Name
=>
'DisplayYResolution'
,
Format
=>
'rational32u'
,
},
4
=> {
Name
=>
'DisplayXResolution'
,
Format
=>
'rational32u'
,
},
8
=> {
Name
=>
'DisplayYResolutionUnit'
,
SeparateTable
=>
'ResolutionUnit'
,
PrintConv
=> \
%resolutionUnit
,
},
9
=> {
Name
=>
'DisplayXResolutionUnit'
,
SeparateTable
=>
'ResolutionUnit'
,
PrintConv
=> \
%resolutionUnit
,
},
);
%Image::ExifTool::Jpeg2000::ColorSpec
= (
PROCESS_PROC
=> \
&Image::ExifTool::ProcessBinaryData
,
WRITE_PROC
=> \
&Image::ExifTool::WriteBinaryData
,
CHECK_PROC
=> \
&Image::ExifTool::CheckBinaryData
,
GROUPS
=> {
2
=>
'Image'
},
FORMAT
=>
'int8s'
,
WRITABLE
=> 1,
WRITE_GROUP
=>
'colr'
,
DATAMEMBER
=> [ 0 ],
IS_SUBDIR
=> [ 3 ],
NOTES
=>
q{
The table below contains tags in the color specification (colr) box. This
box may be rewritten by writing either ICC_Profile, ColorSpace or
ColorSpecData. When writing, any existing colr boxes are replaced with the
newly created colr box.
B<NOTE>: Care must be taken when writing this color specification because
writing a specification that is incompatible with the image data may make
the image undisplayable.
}
,
0
=> {
Name
=>
'ColorSpecMethod'
,
RawConv
=>
'$$self{ColorSpecMethod} = $val'
,
Protected
=> 1,
Notes
=>
q{
default for writing is 2 when writing ICC_Profile, 1 when writing
ColorSpace, or 4 when writing ColorSpecData
}
,
PrintConv
=> {
1
=>
'Enumerated'
,
2
=>
'Restricted ICC'
,
3
=>
'Any ICC'
,
4
=>
'Vendor Color'
,
},
},
1
=> {
Name
=>
'ColorSpecPrecedence'
,
Notes
=>
'default for writing is 0'
,
Protected
=> 1,
},
2
=> {
Name
=>
'ColorSpecApproximation'
,
Notes
=>
'default for writing is 0'
,
Protected
=> 1,
PrintConv
=> {
0
=>
'Not Specified'
,
1
=>
'Accurate'
,
2
=>
'Exceptional Quality'
,
3
=>
'Reasonable Quality'
,
4
=>
'Poor Quality'
,
},
},
3
=> [
{
Name
=>
'ICC_Profile'
,
Condition
=>
q{
$$self{ColorSpecMethod}
== 2 or
$$self
{ColorSpecMethod} == 3
},
Format
=>
'undef[$size-3]'
,
SubDirectory
=> {
TagTable
=>
'Image::ExifTool::ICC_Profile::Main'
,
},
},
{
Name
=>
'ColorSpace'
,
Condition
=>
'$$self{ColorSpecMethod} == 1'
,
Format
=>
'int32u'
,
Protected
=> 1,
PrintConv
=> {
0
=>
'Bi-level'
,
1
=>
'YCbCr(1)'
,
3
=>
'YCbCr(2)'
,
4
=>
'YCbCr(3)'
,
9
=>
'PhotoYCC'
,
11
=>
'CMY'
,
12
=>
'CMYK'
,
13
=>
'YCCK'
,
14
=>
'CIELab'
,
15
=>
'Bi-level(2)'
,
16
=>
'sRGB'
,
17
=>
'Grayscale'
,
18
=>
'sYCC'
,
19
=>
'CIEJab'
,
20
=>
'e-sRGB'
,
21
=>
'ROMM-RGB'
,
22
=>
'YPbPr(1125/60)'
,
23
=>
'YPbPr(1250/50)'
,
24
=>
'e-sYCC'
,
},
},
{
Name
=>
'ColorSpecData'
,
Format
=>
'undef[$size-3]'
,
Protected
=> 1,
Binary
=> 1,
},
],
);
%Image::ExifTool::Jpeg2000::JUMD
= (
PROCESS_PROC
=> \
&ProcessJUMD
,
GROUPS
=> {
0
=>
'JUMBF'
,
1
=>
'JUMBF'
,
2
=>
'Image'
},
NOTES
=>
'Information extracted from the JUMBF description box.'
,
'type'
=> {
Name
=>
'JUMDType'
,
ValueConv
=>
'unpack "H*", $val'
,
PrintConv
=>
q{
my @a = $val =~ /^(\w{8}
)(\w{4})(\w{4})(\w{16})$/;
return
$val
unless
@a
;
my
$ascii
=
pack
'H*'
,
$a
[0];
$a
[0] =
"($ascii)"
if
$ascii
=~ /^[a-zA-Z0-9]{4}$/;
return
join
'-'
,
@a
;
},
},
'label'
=> {
Name
=>
'JUMDLabel'
},
'toggles'
=> {
Name
=>
'JUMDToggles'
,
Unknown
=> 1,
PrintConv
=> {
BITMASK
=> {
0
=>
'Requestable'
,
1
=>
'Label'
,
2
=>
'ID'
,
3
=>
'Signature'
,
}},
},
'id'
=> {
Name
=>
'JUMDID'
,
Description
=>
'JUMD ID'
},
'sig'
=> {
Name
=>
'JUMDSignature'
,
PrintConv
=>
'unpack "H*", $val'
},
);
sub
ProcessJUMB($$$)
{
my
(
$et
,
$dirInfo
,
$tagTablePtr
) =
@_
;
if
(
$$et
{jumd_level}) {
++
$$et
{jumd_level}[-1];
}
else
{
$$et
{jumd_level} = [ ++
$$et
{DOC_COUNT} ];
$$et
{SET_GROUP0} =
'JUMBF'
;
}
$$et
{DOC_NUM} =
join
'-'
, @{
$$et
{jumd_level}};
push
@{
$$et
{jumd_level}}, 0;
ProcessJpeg2000Box(
$et
,
$dirInfo
,
$tagTablePtr
);
delete
$$et
{DOC_NUM};
delete
$$et
{JUMBFLabel};
pop
@{
$$et
{jumd_level}};
if
(@{
$$et
{jumd_level}} < 2) {
delete
$$et
{jumd_level};
delete
$$et
{SET_GROUP0};
}
return
1;
}
sub
ProcessJUMD($$$)
{
my
(
$et
,
$dirInfo
,
$tagTablePtr
) =
@_
;
my
$dataPt
=
$$dirInfo
{DataPt};
my
$pos
=
$$dirInfo
{DirStart};
my
$end
=
$pos
+
$$dirInfo
{DirLen};
$et
->VerboseDir(
'JUMD'
, 0,
$end
-
$pos
);
delete
$$et
{JUMBFLabel};
$$dirInfo
{DirLen} < 17 and
$et
->Warn(
'Truncated JUMD directory'
),
return
0;
my
$type
=
substr
(
$$dataPt
,
$pos
, 4);
$et
->HandleTag(
$tagTablePtr
,
'type'
,
substr
(
$$dataPt
,
$pos
, 16));
$pos
+= 16;
my
$flags
= Get8u(
$dataPt
,
$pos
++);
$et
->HandleTag(
$tagTablePtr
,
'toggles'
,
$flags
);
if
(
$flags
& 0x02) {
pos
(
$$dataPt
) =
$pos
;
$$dataPt
=~ /\0/g or
$et
->Warn(
'Missing JUMD label terminator'
),
return
0;
my
$len
=
pos
(
$$dataPt
) -
$pos
;
my
$name
=
substr
(
$$dataPt
,
$pos
,
$len
);
$et
->HandleTag(
$tagTablePtr
,
'label'
,
$name
);
$pos
+=
$len
;
if
(
$len
) {
$name
=~ s/[^-_a-zA-Z0-9]([a-z])/\U$1/g;
$name
=~
tr
/-_a-zA-Z0-9//dc;
$name
=~ s/__/_/;
$name
=
ucfirst
$name
;
$name
=~ s/C2pa/C2PA/;
$name
=
"Tag$name"
if
length
(
$name
) < 2;
$$et
{JUMBFLabel} =
$name
;
}
}
if
(
$flags
& 0x04) {
$pos
+ 4 >
$end
and
$et
->Warn(
'Missing JUMD ID'
),
return
0;
$et
->HandleTag(
$tagTablePtr
,
'id'
, Get32u(
$dataPt
,
$pos
));
$pos
+= 4;
}
if
(
$flags
& 0x08) {
$pos
+ 32 >
$end
and
$et
->Warn(
'Missing JUMD signature'
),
return
0;
$et
->HandleTag(
$tagTablePtr
,
'sig'
,
substr
(
$$dataPt
,
$pos
, 32));
$pos
+= 32;
}
my
$more
=
$end
-
$pos
;
if
(
$more
) {
if
(
$more
>= 8) {
my
%dirInfo
= (
DataPt
=>
$dataPt
,
DataLen
=>
$$dirInfo
{DataLen},
DirStart
=>
$pos
,
DirLen
=>
$more
,
DirName
=>
'JUMDPrivate'
,
);
$et
->ProcessDirectory(\
%dirInfo
, GetTagTable(
'Image::ExifTool::Jpeg2000::Main'
));
}
else
{
$et
->Warn(
"Extra data in JUMD box $more bytes)"
, 1);
}
}
return
1;
}
sub
BrotliWarn($$;$)
{
my
(
$et
,
$type
,
$uncompress
) =
@_
;
my
(
$enc
,
$mod
) =
$uncompress
?
qw(decoding Uncompress)
:
qw(encoding Compress)
;
$et
->Warn(
"Error $enc '${type}' brob box"
);
$et
->Warn(
"Try updating to IO::${mod}::Brotli 0.004 or later"
);
}
sub
CreateNewBoxes($$)
{
my
(
$et
,
$outfile
) =
@_
;
my
$addTags
=
$$et
{AddJp2Tags};
my
$addDirs
=
$$et
{AddJp2Dirs};
delete
$$et
{AddJp2Tags};
delete
$$et
{AddJp2Dirs};
my
(
$tag
,
$dirName
);
foreach
$tag
(
sort
keys
%$addTags
) {
my
$tagInfo
=
$$addTags
{
$tag
};
my
$nvHash
=
$et
->GetNewValueHash(
$tagInfo
);
next
unless
$$tagInfo
{List} or
$et
->IsOverwriting(
$nvHash
) > 0;
next
if
$$nvHash
{EditOnly};
my
@vals
=
$et
->GetNewValue(
$nvHash
);
my
$val
;
foreach
$val
(
@vals
) {
my
$boxhdr
=
pack
(
'N'
,
length
(
$val
) + 8) .
$$tagInfo
{TagID};
Write(
$outfile
,
$boxhdr
,
$val
) or
return
0;
++
$$et
{CHANGED};
$et
->VerboseValue(
"+ Jpeg2000:$$tagInfo{Name}"
,
$val
);
}
}
foreach
$dirName
(
sort
keys
%$addDirs
) {
if
(
$dirName
eq
'xml '
or
$dirName
eq
'Exif'
) {
my
(
$tag
,
$dir
) =
$dirName
eq
'xml '
? (
'xml '
,
'XMP'
) : (
'Exif'
,
'EXIF'
);
my
$tagInfo
=
$Image::ExifTool::Jpeg2000::Main
{
$tag
};
$tagInfo
=
$$tagInfo
[1]
if
ref
$tagInfo
eq
'ARRAY'
;
my
$subdir
=
$$tagInfo
{SubDirectory};
my
$tagTable
= GetTagTable(
$$subdir
{TagTable});
$tagTable
= GetTagTable(
'Image::ExifTool::XMP::Main'
)
if
$dir
eq
'XMP'
;
my
%dirInfo
= (
DirName
=>
$dir
,
Parent
=>
$tag
,
);
my
$compress
=
$et
->Options(
'Compress'
);
$dirInfo
{Compact} = 1
if
$$et
{IsJXL} and
$compress
;
my
$newdir
=
$et
->WriteDirectory(\
%dirInfo
,
$tagTable
,
$$subdir
{WriteProc});
if
(
defined
$newdir
and
length
$newdir
) {
my
$pad
=
$dirName
eq
'Exif'
?
"\0\0\0\0"
:
''
;
if
(
$$et
{IsJXL} and
$compress
) {
my
$compressed
;
eval
{
$compressed
= IO::Compress::Brotli::bro(
$pad
.
$newdir
) };
if
($@ or not
$compressed
) {
BrotliWarn(
$et
,
$dirName
);
}
else
{
$et
->VPrint(0,
" Writing Brotli-compressed $dir\n"
);
$newdir
=
$compressed
;
$pad
=
$tag
;
$tag
=
'brob'
;
}
}
else
{
$et
->Warn(
'Install IO::Compress::Brotli to create Brotli-compressed metadata'
);
}
}
my
$boxhdr
=
pack
(
'N'
,
length
(
$newdir
) +
length
(
$pad
) + 8) .
$tag
;
Write(
$outfile
,
$boxhdr
,
$pad
,
$newdir
) or
return
0;
next
;
}
}
next
unless
$uuid
{
$dirName
};
my
$tagInfo
;
foreach
$tagInfo
(@{
$Image::ExifTool::Jpeg2000::Main
{uuid}}) {
next
unless
$$tagInfo
{Name} eq
$dirName
;
my
$subdir
=
$$tagInfo
{SubDirectory};
my
$tagTable
= GetTagTable(
$$subdir
{TagTable});
my
%dirInfo
= (
DirName
=>
$$subdir
{DirName} ||
$dirName
,
Parent
=>
'JP2'
,
);
$dirInfo
{DirName} =~ s/^UUID-//;
my
$newdir
=
$et
->WriteDirectory(\
%dirInfo
,
$tagTable
,
$$subdir
{WriteProc});
if
(
defined
$newdir
and
length
$newdir
) {
my
$boxhdr
=
pack
(
'N'
,
length
(
$newdir
) + 24) .
'uuid'
.
$uuid
{
$dirName
};
Write(
$outfile
,
$boxhdr
,
$newdir
) or
return
0;
last
;
}
}
}
return
1;
}
sub
CreateColorSpec($$)
{
my
(
$et
,
$outfile
) =
@_
;
my
$meth
=
$et
->GetNewValue(
'Jpeg2000:ColorSpecMethod'
);
my
$prec
=
$et
->GetNewValue(
'Jpeg2000:ColorSpecPrecedence'
) || 0;
my
$approx
=
$et
->GetNewValue(
'Jpeg2000:ColorSpecApproximation'
) || 0;
my
$icc
=
$et
->GetNewValue(
'ICC_Profile'
);
my
$space
=
$et
->GetNewValue(
'Jpeg2000:ColorSpace'
);
my
$cdata
=
$et
->GetNewValue(
'Jpeg2000:ColorSpecData'
);
unless
(
$meth
) {
if
(
$icc
) {
$meth
= 2;
}
elsif
(
defined
$space
) {
$meth
= 1;
}
elsif
(
defined
$cdata
) {
$meth
= 4;
}
else
{
$et
->Warn(
'Color space not defined'
),
return
0;
}
}
if
(
$meth
eq
'1'
) {
defined
$space
or
$et
->Warn(
'Must specify ColorSpace'
),
return
0;
$cdata
=
pack
(
'N'
,
$space
);
}
elsif
(
$meth
eq
'2'
or
$meth
eq
'3'
) {
defined
$icc
or
$et
->Warn(
'Must specify ICC_Profile'
),
return
0;
$cdata
=
$icc
;
}
elsif
(
$meth
eq
'4'
) {
defined
$cdata
or
$et
->Warn(
'Must specify ColorSpecData'
),
return
0;
}
else
{
$et
->Warn(
'Unknown ColorSpecMethod'
),
return
0;
}
my
$boxhdr
=
pack
(
'N'
,
length
(
$cdata
) + 11) .
'colr'
;
Write(
$outfile
,
$boxhdr
,
pack
(
'CCC'
,
$meth
,
$prec
,
$approx
),
$cdata
) or
return
0;
++
$$et
{CHANGED};
$et
->VPrint(1,
" + Jpeg2000:ColorSpec\n"
);
return
1;
}
sub
ProcessJpeg2000Box($$$)
{
my
(
$et
,
$dirInfo
,
$tagTablePtr
) =
@_
;
my
$dataPt
=
$$dirInfo
{DataPt};
my
$dataLen
=
$$dirInfo
{DataLen};
my
$dataPos
=
$$dirInfo
{DataPos} || 0;
my
$dirLen
=
$$dirInfo
{DirLen} || 0;
my
$dirStart
=
$$dirInfo
{DirStart} || 0;
my
$base
=
$$dirInfo
{Base} || 0;
my
$outfile
=
$$dirInfo
{OutFile};
my
$dirName
=
$$dirInfo
{DirName} ||
''
;
my
$dirEnd
=
$dirStart
+
$dirLen
;
my
(
$err
,
$outBuff
,
$verbose
,
$doColour
,
$hash
,
$raf
);
if
(
$dataPt
) {
if
(
$dirName
eq
'JUMBF'
and
$$et
{REQ_TAG_LOOKUP}{jumbf} and not
$$dirInfo
{NoBlockSave}) {
if
(
$dirStart
or
$dirLen
ne
length
(
$$dataPt
)) {
my
$dat
=
substr
(
$$dataPt
,
$dirStart
,
$dirLen
);
$et
->FoundTag(
JUMBF
=> \
$dat
);
}
else
{
$et
->FoundTag(
JUMBF
=>
$dataPt
);
}
}
}
else
{
$raf
=
$$dirInfo
{RAF};
}
if
(
$outfile
) {
unless
(
$raf
) {
$outBuff
=
''
;
$outfile
= \
$outBuff
;
}
if
(
$dirName
eq
'JP2Header'
) {
$doColour
= 2
if
defined
$et
->GetNewValue(
'ColorSpecMethod'
) or
$et
->GetNewValue(
'ICC_Profile'
) or
defined
$et
->GetNewValue(
'ColorSpecPrecedence'
) or
defined
$et
->GetNewValue(
'ColorSpace'
) or
defined
$et
->GetNewValue(
'ColorSpecApproximation'
) or
defined
$et
->GetNewValue(
'ColorSpecData'
);
}
}
else
{
$verbose
=
$$et
{OPTIONS}{Verbose};
$et
->VerboseDir(
$dirName
)
if
$verbose
;
$hash
=
$$et
{ImageDataHash}
if
$raf
;
}
my
(
$pos
,
$boxLen
,
$lastBox
);
for
(
$pos
=
$dirStart
; ;
$pos
+=
$boxLen
) {
my
(
$boxID
,
$buff
,
$valuePtr
);
my
$hdrLen
= 8;
if
(
$raf
) {
$dataPos
=
$raf
->Tell() -
$base
;
my
$n
=
$raf
->Read(
$buff
,
$hdrLen
);
unless
(
$n
==
$hdrLen
) {
$n
and
$err
=
''
,
last
;
CreateNewBoxes(
$et
,
$outfile
) or
$err
= 1
if
$outfile
;
last
;
}
$dataPt
= \
$buff
;
$dirLen
=
$dirEnd
=
$hdrLen
;
$pos
= 0;
}
elsif
(
$pos
>=
$dirEnd
-
$hdrLen
) {
$err
=
''
unless
$pos
==
$dirEnd
;
last
;
}
$boxLen
=
unpack
(
"x$pos N"
,
$$dataPt
);
$boxID
=
substr
(
$$dataPt
,
$pos
+4, 4);
if
(
$outfile
and
$boxID
eq
'ftbl'
) {
$et
->Error(
"Can't yet handle fragmented JPX files"
);
return
-1;
}
if
(
$doColour
and
$boxID
eq
'colr'
) {
if
(
$doColour
== 1) {
$et
->VPrint(1,
" - Jpeg2000:ColorSpec\n"
);
++
$$et
{CHANGED};
next
;
}
$et
->Warn(
'Out-of-order colr box encountered'
);
undef
$doColour
;
}
$lastBox
=
$boxID
;
$pos
+=
$hdrLen
;
if
(
$boxLen
== 1) {
$hdrLen
+= 8;
if
(
$raf
) {
my
$buf2
;
if
(
$raf
->Read(
$buf2
,8) == 8) {
$buff
.=
$buf2
;
$dirLen
=
$dirEnd
=
$hdrLen
;
}
}
$pos
>
$dirEnd
- 8 and
$err
=
''
,
last
;
my
(
$hi
,
$lo
) =
unpack
(
"x$pos N2"
,
$$dataPt
);
$hi
and
$err
=
"Can't currently handle JPEG 2000 boxes > 4 GB"
,
last
;
$pos
+= 8;
$boxLen
=
$lo
-
$hdrLen
;
}
elsif
(
$boxLen
== 0) {
if
(
$raf
) {
if
(
$outfile
) {
CreateNewBoxes(
$et
,
$outfile
) or
$err
= 1;
Write(
$outfile
,
$$dataPt
) or
$err
= 1;
while
(
$raf
->Read(
$buff
, 65536)) {
Write(
$outfile
,
$buff
) or
$err
= 1;
}
}
else
{
if
(
$verbose
) {
my
$msg
=
sprintf
(
"offset 0x%.4x to end of file"
,
$dataPos
+
$base
+
$pos
);
$et
->VPrint(0,
"$$et{INDENT}- Tag '${boxID}' ($msg)\n"
);
}
if
(
$hash
and
$isImageData
{
$boxID
}) {
$et
->ImageDataHash(
$raf
,
undef
,
$boxID
);
}
}
last
;
}
$boxLen
=
$dirEnd
-
$pos
;
}
else
{
$boxLen
-=
$hdrLen
;
}
$boxLen
< 0 and
$err
=
'Invalid JPEG 2000 box length'
,
last
;
my
$tagInfo
=
$et
->GetTagInfo(
$tagTablePtr
,
$boxID
);
unless
(
defined
$tagInfo
or
$verbose
) {
if
(
$raf
) {
if
(
$outfile
) {
Write(
$outfile
,
$$dataPt
) or
$err
= 1;
$raf
->Read(
$buff
,
$boxLen
) ==
$boxLen
or
$err
=
''
,
last
;
Write(
$outfile
,
$buff
) or
$err
= 1;
}
elsif
(
$hash
and
$isImageData
{
$boxID
}) {
$et
->ImageDataHash(
$raf
,
$boxLen
,
$boxID
);
}
else
{
$raf
->Seek(
$boxLen
, 1) or
$err
=
'Seek error'
,
last
;
}
}
elsif
(
$outfile
) {
Write(
$outfile
,
substr
(
$$dataPt
,
$pos
-
$hdrLen
,
$boxLen
+
$hdrLen
)) or
$err
=
''
,
last
;
}
next
;
}
if
(
$raf
) {
$dataPos
=
$raf
->Tell() -
$base
;
$raf
->Read(
$buff
,
$boxLen
) ==
$boxLen
or
$err
=
''
,
last
;
if
(
$hash
and
$isImageData
{
$boxID
}) {
$hash
->add(
$buff
);
$et
->VPrint(0,
"$$et{INDENT}(ImageDataHash: $boxLen bytes of $boxID data)\n"
);
}
$valuePtr
= 0;
$dataLen
=
$boxLen
;
}
elsif
(
$pos
+
$boxLen
>
$dirEnd
) {
$err
=
''
;
last
;
}
else
{
$valuePtr
=
$pos
;
}
if
(
defined
$tagInfo
and not
$tagInfo
) {
my
$tmpVal
=
substr
(
$$dataPt
,
$valuePtr
,
$boxLen
< 128 ?
$boxLen
: 128);
$tagInfo
=
$et
->GetTagInfo(
$tagTablePtr
,
$boxID
, \
$tmpVal
);
}
if
(
$outfile
and
$tagInfo
) {
if
(
$boxID
eq
'uuid'
and
$$et
{DEL_GROUP}{
'*'
}) {
$et
->VPrint(0,
" Deleting $$tagInfo{Name}\n"
);
++
$$et
{CHANGED};
next
;
}
elsif
(
$$tagInfo
{Writable}) {
my
$isOverwriting
;
if
(
$$et
{DEL_GROUP}{Jpeg2000}) {
$isOverwriting
= 1;
}
else
{
my
$nvHash
=
$et
->GetNewValueHash(
$tagInfo
);
$isOverwriting
=
$et
->IsOverwriting(
$nvHash
);
}
if
(
$isOverwriting
) {
my
$val
=
substr
(
$$dataPt
,
$valuePtr
,
$boxLen
);
$et
->VerboseValue(
"- Jpeg2000:$$tagInfo{Name}"
,
$val
);
++
$$et
{CHANGED};
next
;
}
elsif
(not
$$tagInfo
{List}) {
delete
$$et
{AddJp2Tags}{
$boxID
};
}
}
}
if
(
$tagInfo
and
$$et
{JUMBFLabel} and (not
$$tagInfo
{SubDirectory} or
$$tagInfo
{BlockExtract})) {
$tagInfo
= {
%$tagInfo
,
Name
=>
$$et
{JUMBFLabel} . (
$$tagInfo
{JUMBF_Suffix} ||
''
) };
(
$$tagInfo
{Description} = Image::ExifTool::MakeDescription(
$$tagInfo
{Name})) =~ s/C2 PA/C2PA/;
AddTagToTable(
$tagTablePtr
,
'_JUMBF_'
.
$$et
{JUMBFLabel},
$tagInfo
);
delete
$$tagInfo
{Protected};
$$tagInfo
{TagID} =
$boxID
;
}
if
(
$verbose
) {
$et
->VerboseInfo(
$boxID
,
$tagInfo
,
Table
=>
$tagTablePtr
,
DataPt
=>
$dataPt
,
Size
=>
$boxLen
,
Start
=>
$valuePtr
,
Addr
=>
$valuePtr
+
$dataPos
+
$base
,
);
next
unless
$tagInfo
;
}
if
(
$$tagInfo
{SubDirectory}) {
my
$subdir
=
$$tagInfo
{SubDirectory};
my
$subdirStart
=
$valuePtr
;
my
$subdirLen
=
$boxLen
;
if
(
defined
$$subdir
{Start}) {
$subdirStart
=
eval
(
$$subdir
{Start});
$subdirLen
-=
$subdirStart
-
$valuePtr
;
if
(
$subdirLen
< 0) {
$subdirStart
=
$valuePtr
;
$subdirLen
= 0;
}
}
my
%subdirInfo
= (
Parent
=>
'JP2'
,
DataPt
=>
$dataPt
,
DataPos
=> -
$subdirStart
,
DataLen
=>
$dataLen
,
DirStart
=>
$subdirStart
,
DirLen
=>
$subdirLen
,
DirName
=>
$$subdir
{DirName} ||
$$tagInfo
{Name},
OutFile
=>
$outfile
,
Base
=>
$base
+
$dataPos
+
$subdirStart
,
);
my
$uuid
=
$uuid
{
$$tagInfo
{Name}};
$subdirInfo
{DirName} =~ s/^UUID-//;
my
$subTable
= GetTagTable(
$$subdir
{TagTable}) ||
$tagTablePtr
;
if
(
$outfile
) {
my
$fakeID
=
$boxID
;
if
(
$boxID
eq
'brob'
) {
$fakeID
=
'xml '
if
$$dataPt
=~ /^xml /i;
$fakeID
=
'Exif'
if
$$dataPt
=~ /^Exif/i;
}
my
$newdir
;
if
(
$uuid
or
$fakeID
eq
'Exif'
or (
$fakeID
eq
'xml '
and
$$et
{IsJXL}) or
(
$boxID
eq
'jp2h'
and
$$et
{EDIT_DIRS}{jp2h}))
{
my
$compress
=
$et
->Options(
'Compress'
);
$subdirInfo
{Parent} =
$fakeID
;
$subdirInfo
{Compact} = 1
if
$compress
and
$$et
{IsJXL};
$newdir
=
$et
->WriteDirectory(\
%subdirInfo
,
$subTable
,
$$subdir
{WriteProc});
next
if
defined
$newdir
and not
length
$newdir
;
if
(
defined
$newdir
and
$$et
{IsJXL} and
defined
$compress
and
(
$fakeID
eq
'Exif'
or
$fakeID
eq
'xml '
))
{
if
(
$compress
and
$boxID
ne
'brob'
) {
my
$pad
=
$boxID
eq
'Exif'
?
"\0\0\0\0"
:
''
;
my
$compressed
;
eval
{
$compressed
= IO::Compress::Brotli::bro(
$pad
.
$newdir
) };
if
($@ or not
$compressed
) {
BrotliWarn(
$et
,
$boxID
);
}
else
{
$et
->VPrint(0,
" Writing Brotli-compressed $boxID\n"
);
$newdir
=
$boxID
.
$compressed
;
$boxID
=
'brob'
;
$subdirStart
=
$valuePtr
= 0;
++
$$et
{CHANGED};
}
}
else
{
$et
->Warn(
'Install IO::Compress::Brotli to write Brotli-compressed metadata'
);
}
}
elsif
(not
$compress
and
$boxID
eq
'brob'
) {
$et
->VPrint(0,
" Writing uncompressed $fakeID\n"
);
$boxID
=
$fakeID
;
$subdirStart
=
$valuePtr
= 0;
++
$$et
{CHANGED};
}
}
}
elsif
(
defined
$uuid
) {
$et
->Warn(
"Not editing $$tagInfo{Name} box"
, 1);
}
delete
$$et
{AddJp2Dirs}{
$fakeID
};
if
(
$boxID
eq
'brob'
) {
delete
$$et
{AddJp2Dirs}{{
'xml '
=>
'XMP'
,
'Exif'
=>
'EXIF'
}->{
$fakeID
}};
}
else
{
delete
$$et
{AddJp2Dirs}{
$$tagInfo
{Name}};
}
defined
$newdir
or
$newdir
=
substr
(
$$dataPt
,
$subdirStart
,
$subdirLen
);
my
$prefixLen
=
$subdirStart
-
$valuePtr
;
my
$boxhdr
=
pack
(
'N'
,
length
(
$newdir
) + 8 +
$prefixLen
) .
$boxID
;
$boxhdr
.=
substr
(
$$dataPt
,
$valuePtr
,
$prefixLen
)
if
$prefixLen
;
Write(
$outfile
,
$boxhdr
,
$newdir
) or
$err
= 1;
if
(
$doColour
and
$boxID
eq
'ihdr'
) {
$doColour
=
$doColour
==2 ? CreateColorSpec(
$et
,
$outfile
) : 0;
}
}
else
{
$subdirInfo
{BlockInfo} =
$tagInfo
if
$$tagInfo
{BlockExtract};
$et
->Warn(
"Reading non-standard $$tagInfo{Name} box"
)
if
defined
$uuid
and
$uuid
eq
'0'
;
unless
(
$et
->ProcessDirectory(\
%subdirInfo
,
$subTable
,
$$subdir
{ProcessProc})) {
if
(
$subTable
eq
$tagTablePtr
) {
$err
=
'JPEG 2000 format error'
;
last
;
}
$et
->Warn(
"Unrecognized $$tagInfo{Name} box"
);
}
}
}
elsif
(
$$tagInfo
{Format} and not
$outfile
) {
my
$rational
;
my
$val
= ReadValue(
$dataPt
,
$valuePtr
,
$$tagInfo
{Format},
undef
,
$boxLen
, \
$rational
);
if
(
defined
$val
) {
my
$key
=
$et
->FoundTag(
$tagInfo
,
$val
);
$$et
{TAG_EXTRA}{
$key
}{Rational} =
$rational
if
defined
$rational
and
defined
$key
;
}
}
elsif
(
$outfile
) {
my
$boxhdr
=
pack
(
'N'
,
$boxLen
+ 8) .
$boxID
;
Write(
$outfile
,
$boxhdr
,
substr
(
$$dataPt
,
$valuePtr
,
$boxLen
)) or
$err
= 1;
}
}
if
(
defined
$err
) {
$err
or
$err
=
'Truncated JPEG 2000 box'
;
if
(
$outfile
) {
$et
->Error(
$err
)
unless
$err
eq
'1'
;
return
$raf
? -1 :
undef
;
}
$et
->Warn(
$err
);
}
return
$outBuff
if
$outfile
and not
$raf
;
return
1;
}
sub
GetBits($$)
{
my
(
$a
,
$n
) =
@_
;
my
$v
= 0;
my
$bit
= 1;
my
$i
;
while
(
$n
--) {
for
(
$i
=0;
$i
<
@$a
; ++
$i
) {
my
$set
=
$$a
[
$i
] & 1;
$$a
[
$i
] >>= 1;
if
(
$i
) {
$$a
[
$i
-1] |= 0x80
if
$set
;
}
else
{
$v
|=
$bit
if
$set
;
$bit
<<= 1;
}
}
}
return
$v
;
}
sub
ProcessBrotli($$$)
{
my
(
$et
,
$dirInfo
,
$tagTablePtr
) =
@_
;
my
$dataPt
=
$$dirInfo
{DataPt};
return
0
unless
length
(
$$dataPt
) > 4;
my
$isWriting
=
$$dirInfo
{IsWriting};
my
$type
=
substr
(
$$dataPt
, 0, 4);
$et
->VerboseDir(
"Decrypted Brotli '${type}'"
)
unless
$isWriting
;
my
%knownType
= (
exif
=>
'Exif'
,
'xml '
=>
'xml '
,
jumb
=>
'jumb'
);
my
$stdType
=
$knownType
{
lc
$type
};
unless
(
$stdType
) {
$et
->Warn(
'Unknown Brotli box type'
, 1);
return
1;
}
if
(
$type
ne
$stdType
) {
$et
->Warn(
"Incorrect case for Brotli '${type}' data (should be '${stdType}')"
);
$type
=
$stdType
;
}
$et
->Warn(
'Install IO::Compress::Brotli to write Brotli-compressed metadata'
);
return
undef
;
}
my
$compress
=
$et
->Options(
'Compress'
);
my
$verbose
=
$isWriting
? 0 :
$et
->Options(
'Verbose'
);
my
$dat
=
substr
(
$$dataPt
, 4);
eval
{
$dat
= IO::Uncompress::Brotli::unbro(
$dat
, 100000000) };
$@ and BrotliWarn(
$et
,
$type
, 1),
return
1;
$verbose
> 2 and
$et
->VerboseDump(\
$dat
,
Prefix
=>
$$et
{INDENT} .
' '
);
my
%dirInfo
= (
DataPt
=> \
$dat
);
if
(
$type
eq
'xml '
) {
$dirInfo
{DirName} =
'XMP'
;
if
(
$isWriting
) {
$dirInfo
{Compact} = 1
if
$compress
;
$dat
=
$et
->WriteDirectory(\
%dirInfo
,
$tagTablePtr
);
}
else
{
Image::ExifTool::XMP::ProcessXMP(
$et
, \
%dirInfo
,
$tagTablePtr
);
}
}
elsif
(
$type
eq
'Exif'
) {
$dirInfo
{DirName} =
'EXIF'
;
$dirInfo
{DirStart} = 4 + (
length
(
$dat
) > 4 ?
unpack
(
"N"
,
$dat
) : 0);
if
(
$dirInfo
{DirStart} >
length
$dat
) {
$et
->Warn(
"Corrupted Brotli '${type}' data"
);
}
elsif
(
$isWriting
) {
$dat
=
$et
->WriteDirectory(\
%dirInfo
,
$tagTablePtr
, \
&Image::ExifTool::WriteTIFF
);
$dat
=
"\0\0\0\0"
.
$dat
if
defined
$dat
and
length
$dat
;
}
else
{
$et
->ProcessTIFF(\
%dirInfo
,
$tagTablePtr
);
}
}
elsif
(
$type
eq
'jumb'
) {
return
undef
if
$isWriting
;
Image::ExifTool::Jpeg2000::ProcessJUMB(
$et
, \
%dirInfo
,
$tagTablePtr
);
}
if
(
$isWriting
) {
return
undef
unless
defined
$dat
;
return
$dat
if
defined
$compress
and not
$compress
;
eval
{
$dat
= IO::Compress::Brotli::bro(
$dat
) };
$@ and BrotliWarn(
$et
,
$type
),
return
undef
;
$et
->VPrint(0,
" Writing Brotli-compressed $type\n"
);
return
$type
.
$dat
;
}
}
else
{
$et
->Warn(
'Install IO::Uncompress::Brotli to decode Brotli-compressed metadata'
);
return
undef
if
$isWriting
;
}
return
1;
}
sub
ProcessJXLCodestream($$)
{
my
(
$et
,
$dataPt
) =
@_
;
return
0
unless
$$dataPt
=~ /^(\0\0\0\0)?\xff\x0a/;
return
0
if
$$et
{ProcessedJXLCodestream};
$$et
{ProcessedJXLCodestream} = 1;
my
$dat
;
if
(
length
$$dataPt
> 64) {
$dat
=
substr
(
$$dataPt
, 0, 64);
}
elsif
(
length
$$dataPt
< 18) {
$dat
=
$$dataPt
. (
"\0"
x 18);
}
else
{
$dat
=
$$dataPt
;
}
$dat
=~ s/^\0\0\0\0//;
my
@a
=
unpack
'x2C12'
,
$dat
;
my
(
$x
,
$y
);
my
$small
= GetBits(\
@a
, 1);
if
(
$small
) {
$y
= (GetBits(\
@a
, 5) + 1) * 8;
}
else
{
$y
= GetBits(\
@a
, [9, 13, 18, 30]->[GetBits(\
@a
, 2)]) + 1;
}
my
$ratio
= GetBits(\
@a
, 3);
if
(
$ratio
== 0) {
if
(
$small
) {
$x
= (GetBits(\
@a
, 5) + 1) * 8;;
}
else
{
$x
= GetBits(\
@a
, [9, 13, 18, 30]->[GetBits(\
@a
, 2)]) + 1;
}
}
else
{
my
$r
= [[1,1],[12,10],[4,3],[3,2],[16,9],[5,4],[2,1]]->[
$ratio
-1];
$x
=
int
(
$y
*
$$r
[0] /
$$r
[1]);
}
$et
->FoundTag(
ImageWidth
=>
$x
);
$et
->FoundTag(
ImageHeight
=>
$y
);
return
1;
}
sub
ProcessJUMBF($$)
{
my
(
$et
,
$dirInfo
) =
@_
;
my
$raf
=
$$dirInfo
{RAF};
my
$hdr
;
return
0
unless
$raf
->Read(
$hdr
,20) == 20 and
$raf
->Seek(0,0);
return
0
unless
$hdr
=~ /^.{4}jumb\0.{3}jumd(.{4})/;
$et
->SetFileType($1 eq
'c2pa'
?
'C2PA'
:
'JUMBF'
);
my
%dirInfo
= (
RAF
=>
$raf
,
DirName
=>
'JUMBF'
,
);
my
$tagTablePtr
= GetTagTable(
'Image::ExifTool::Jpeg2000::Main'
);
return
$et
->ProcessDirectory(\
%dirInfo
,
$tagTablePtr
);
}
sub
ProcessJP2($$)
{
local
$_
;
my
(
$et
,
$dirInfo
) =
@_
;
my
$raf
=
$$dirInfo
{RAF};
my
$outfile
=
$$dirInfo
{OutFile};
my
$hdr
;
return
0
unless
$raf
->Read(
$hdr
,12) == 12;
unless
(
$hdr
eq
"\0\0\0\x0cjP \x0d\x0a\x87\x0a"
or
$hdr
eq
"\0\0\0\x0cjP\x1a\x1a\x0d\x0a\x87\x0a"
or
$$et
{IsJXL})
{
return
0
unless
$hdr
=~ /^\xff\x4f\xff\x51\0/;
if
(
$outfile
) {
$et
->Error(
'Writing of J2C files is not yet supported'
);
return
0
}
unless
(
$Image::ExifTool::jpegMarker
{0x4f}) {
$Image::ExifTool::jpegMarker
{
$_
} =
$j2cMarker
{
$_
}
foreach
keys
%j2cMarker
;
}
$et
->SetFileType(
'J2C'
);
$raf
->Seek(0,0);
return
$et
->ProcessJPEG(
$dirInfo
);
}
if
(
$outfile
) {
Write(
$outfile
,
$hdr
) or
return
-1;
if
(
$$et
{IsJXL}) {
$et
->InitWriteDirs(\
%jxlMap
);
$$et
{AddJp2Tags} = { };
}
else
{
$et
->InitWriteDirs(\
%jp2Map
);
$$et
{AddJp2Tags} =
$et
->GetNewTagInfoHash(\
%Image::ExifTool::Jpeg2000::Main
);
}
my
%addDirs
= %{
$$et
{ADD_DIRS}};
$$et
{AddJp2Dirs} = \
%addDirs
;
}
else
{
my
(
$buff
,
$fileType
);
if
(
$raf
->Read(
$buff
, 12) == 12 and
$buff
=~ /^.{4}ftyp(.{4})/s) {
$fileType
=
'JPX'
if
$1 eq
'jpx '
;
$fileType
=
'JPM'
if
$1 eq
'jpm '
;
$fileType
=
'JXL'
if
$1 eq
'jxl '
;
$fileType
=
'JPH'
if
$1 eq
'jph '
;
}
$raf
->Seek(-
length
(
$buff
), 1)
if
defined
$buff
;
$et
->SetFileType(
$fileType
);
}
SetByteOrder(
'MM'
);
my
%dirInfo
= (
RAF
=>
$raf
,
DirName
=>
'JP2'
,
OutFile
=>
$$dirInfo
{OutFile},
);
my
$tagTablePtr
= GetTagTable(
'Image::ExifTool::Jpeg2000::Main'
);
return
$et
->ProcessDirectory(\
%dirInfo
,
$tagTablePtr
);
}
sub
ProcessJXL($$)
{
my
(
$et
,
$dirInfo
) =
@_
;
my
$raf
=
$$dirInfo
{RAF};
my
$outfile
=
$$dirInfo
{OutFile};
my
(
$hdr
,
$buff
);
return
0
unless
$raf
->Read(
$hdr
,12) == 12;
if
(
$hdr
eq
"\0\0\0\x0cJXL \x0d\x0a\x87\x0a"
) {
$$et
{IsJXL} = 1;
}
elsif
(
$hdr
=~ /^\xff\x0a/) {
if
(
$outfile
) {
if
(
$$et
{OPTIONS}{IgnoreMinorErrors}) {
$et
->Warn(
'Wrapped JXL codestream in ISO BMFF container'
);
}
else
{
$et
->Error(
'Will wrap JXL codestream in ISO BMFF container for writing'
,1);
return
0;
}
$$et
{IsJXL} = 2;
my
$buff
=
"\0\0\0\x0cJXL \x0d\x0a\x87\x0a\0\0\0\x14ftypjxl \0\0\0\0jxl "
;
$$dirInfo
{RAF} = File::RandomAccess->new(\
$buff
);
}
else
{
$et
->SetFileType(
'JXL Codestream'
,
'image/jxl'
,
'jxl'
);
if
(
$$et
{ImageDataHash} and
$raf
->Seek(0,0)) {
$et
->ImageDataHash(
$raf
,
undef
,
'JXL'
);
}
return
ProcessJXLCodestream(
$et
, \
$hdr
);
}
}
else
{
return
0;
}
$raf
->Seek(0,0) or
$et
->Error(
'Seek error'
),
return
0;
my
$success
= ProcessJP2(
$et
,
$dirInfo
);
if
(
$outfile
and
$success
> 0 and
$$et
{IsJXL} == 2) {
$raf
->Seek(0,2) or
return
-1;
my
$size
=
$raf
->Tell();
$raf
->Seek(0,0) or
return
-1;
SetByteOrder(
'MM'
);
Write(
$outfile
, Set32u(
$size
+ 8),
'jxlc'
) or
return
-1;
while
(
$raf
->Read(
$buff
, 65536)) {
Write(
$outfile
,
$buff
) or
return
-1;
}
}
return
$success
;
}
1;