1696 lines
64 KiB
Perl
1696 lines
64 KiB
Perl
#------------------------------------------------------------------------------
|
|
# File: Jpeg2000.pm
|
|
#
|
|
# Description: Read JPEG 2000 meta information
|
|
#
|
|
# Revisions: 02/11/2005 - P. Harvey Created
|
|
# 06/22/2007 - PH Added write support (EXIF, IPTC and XMP only)
|
|
#
|
|
# References: 1) http://www.jpeg.org/public/fcd15444-2.pdf
|
|
# 2) ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf
|
|
#------------------------------------------------------------------------------
|
|
|
|
package Image::ExifTool::Jpeg2000;
|
|
|
|
use strict;
|
|
use vars qw($VERSION);
|
|
use Image::ExifTool qw(:DataAccess :Utils);
|
|
|
|
$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',
|
|
);
|
|
|
|
# top-level boxes containing image data
|
|
my %isImageData = ( jp2c=>1, jbrd=>1, jxlp=>1, jxlc=>1 );
|
|
|
|
# map of where information is written in JPEG2000 image
|
|
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', # to write EXIF as a block
|
|
ExifIFD => 'IFD0',
|
|
GPS => 'IFD0',
|
|
SubIFD => 'IFD0',
|
|
GlobParamIFD => 'IFD0',
|
|
PrintIM => 'IFD0',
|
|
InteropIFD => 'ExifIFD',
|
|
MakerNotes => 'ExifIFD',
|
|
);
|
|
|
|
# map of where information is written in a JXL image
|
|
my %jxlMap = (
|
|
IFD0 => 'Exif',
|
|
XMP => 'xml ',
|
|
'Exif' => 'JP2',
|
|
IFD1 => 'IFD0',
|
|
EXIF => 'IFD0', # to write EXIF as a block
|
|
ExifIFD => 'IFD0',
|
|
GPS => 'IFD0',
|
|
SubIFD => 'IFD0',
|
|
GlobParamIFD => 'IFD0',
|
|
PrintIM => 'IFD0',
|
|
InteropIFD => 'ExifIFD',
|
|
MakerNotes => 'ExifIFD',
|
|
);
|
|
|
|
# UUID's for writable UUID directories (by tag name)
|
|
my %uuid = (
|
|
'UUID-EXIF' => 'JpgTiffExif->JP2',
|
|
'UUID-EXIF2' => '', # (flags a warning when writing)
|
|
'UUID-EXIF_bad' => '0', # (flags a warning when reading and writing)
|
|
'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",
|
|
# (can't yet write GeoJP2 information)
|
|
# 'UUID-GeoJP2' => "\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03",
|
|
);
|
|
|
|
# JPEG2000 codestream markers (ref ISO/IEC FCD15444-1/2)
|
|
my %j2cMarker = (
|
|
0x4f => 'SOC', # start of codestream
|
|
# 0x50 - seen in JPH codestream
|
|
0x51 => 'SIZ', # image and tile size
|
|
0x52 => 'COD', # coding style default
|
|
0x53 => 'COC', # coding style component
|
|
0x55 => 'TLM', # tile-part lengths
|
|
0x57 => 'PLM', # packet length, main header
|
|
0x58 => 'PLT', # packet length, tile-part header
|
|
# 0x59 - seen in JPH codestream
|
|
0x5c => 'QCD', # quantization default
|
|
0x5d => 'QCC', # quantization component
|
|
0x5e => 'RGN', # region of interest
|
|
0x5f => 'POD', # progression order default
|
|
0x60 => 'PPM', # packed packet headers, main
|
|
0x61 => 'PPT', # packed packet headers, tile-part
|
|
0x63 => 'CRG', # component registration
|
|
0x64 => 'CME', # comment and extension
|
|
0x90 => 'SOT', # start of tile-part
|
|
0x91 => 'SOP', # start of packet
|
|
0x92 => 'EPH', # end of packet header
|
|
0x93 => 'SOD', # start of data
|
|
# extensions (ref ISO/IEC FCD15444-2)
|
|
0x70 => 'DCO', # variable DC offset
|
|
0x71 => 'VMS', # visual masking
|
|
0x72 => 'DFS', # downsampling factor style
|
|
0x73 => 'ADS', # arbitrary decomposition style
|
|
# 0x72 => 'ATK', # arbitrary transformation kernels ?
|
|
0x78 => 'CBD', # component bit depth
|
|
0x74 => 'MCT', # multiple component transformation definition
|
|
0x75 => 'MCC', # multiple component collection
|
|
0x77 => 'MIC', # multiple component intermediate collection
|
|
0x76 => 'NLT', # non-linearity point transformation
|
|
);
|
|
|
|
# JPEG 2000 "box" (ie. atom) names
|
|
# Note: only tags with a defined "Format" are extracted
|
|
%Image::ExifTool::Jpeg2000::Main = (
|
|
GROUPS => { 2 => 'Image' },
|
|
PROCESS_PROC => \&ProcessJpeg2000Box,
|
|
WRITE_PROC => \&ProcessJpeg2000Box,
|
|
PREFERRED => 1, # always add these tags when writing
|
|
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
|
|
JUMBF tag. See L<https://c2pa.org/specifications/> for the C2PA
|
|
specification.
|
|
},
|
|
#
|
|
# NOTE: ONLY TAGS WITH "Format" DEFINED ARE EXTRACTED!
|
|
#
|
|
'jP ' => 'JP2Signature', # (ref 1)
|
|
"jP\x1a\x1a" => 'JP2Signature', # (ref 2)
|
|
prfl => 'Profile',
|
|
ftyp => {
|
|
Name => 'FileType',
|
|
SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::FileType' },
|
|
},
|
|
rreq => 'ReaderRequirements',
|
|
jp2h => {
|
|
Name => 'JP2Header',
|
|
SubDirectory => { },
|
|
},
|
|
# JP2Header sub boxes...
|
|
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 => { },
|
|
},
|
|
# Resolution sub boxes...
|
|
resc => {
|
|
Name => 'CaptureResolution',
|
|
SubDirectory => {
|
|
TagTable => 'Image::ExifTool::Jpeg2000::CaptureResolution',
|
|
},
|
|
},
|
|
resd => {
|
|
Name => 'DisplayResolution',
|
|
SubDirectory => {
|
|
TagTable => 'Image::ExifTool::Jpeg2000::DisplayResolution',
|
|
},
|
|
},
|
|
jpch => {
|
|
Name => 'CodestreamHeader',
|
|
SubDirectory => { },
|
|
},
|
|
# CodestreamHeader sub boxes...
|
|
'lbl '=> {
|
|
Name => 'Label',
|
|
Format => 'string',
|
|
},
|
|
cmap => 'ComponentMapping',
|
|
roid => 'ROIDescription',
|
|
jplh => {
|
|
Name => 'CompositingLayerHeader',
|
|
SubDirectory => { },
|
|
},
|
|
# CompositingLayerHeader sub boxes...
|
|
cgrp => 'ColorGroup',
|
|
opct => 'Opacity',
|
|
creg => 'CodestreamRegistration',
|
|
dtbl => 'DataReference',
|
|
ftbl => {
|
|
Name => 'FragmentTable',
|
|
Subdirectory => { },
|
|
},
|
|
# FragmentTable sub boxes...
|
|
flst => 'FragmentList',
|
|
cref => 'Cross-Reference',
|
|
mdat => 'MediaData',
|
|
comp => 'Composition',
|
|
copt => 'CompositionOptions',
|
|
inst => 'InstructionSet',
|
|
asoc => {
|
|
Name => 'Association',
|
|
SubDirectory => { },
|
|
},
|
|
# (Association box may contain any other sub-box)
|
|
nlst => 'NumberList',
|
|
bfil => 'BinaryFilter',
|
|
drep => 'DesiredReproductions',
|
|
# DesiredReproductions sub boxes...
|
|
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
|
|
},
|
|
# (note: extracting as a block was broken in 11.04, and finally fixed in 12.14)
|
|
SubDirectory => { TagTable => 'Image::ExifTool::XMP::XML' },
|
|
},{
|
|
Name => 'XMP',
|
|
Notes => 'used for XMP in JPEG XL files',
|
|
# NOTE: the hacked code relies on this being at index 1 of the tagInfo list!
|
|
SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
|
|
}],
|
|
uuid => [
|
|
{
|
|
Name => 'UUID-EXIF',
|
|
# (this is the EXIF that we create in JP2)
|
|
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',
|
|
# written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
|
|
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',
|
|
# written by Digikam
|
|
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',
|
|
# (this is the IPTC that we create in JP2)
|
|
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',
|
|
# written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
|
|
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',
|
|
# ref http://www.adobe.com/products/xmp/pdfs/xmpspec.pdf
|
|
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',
|
|
# ref http://www.remotesensing.org/jpeg2000/
|
|
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',
|
|
# written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
|
|
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', # (seen in incorrectly-formatted JUMB data of JPEG images)
|
|
# (may be able to remove this when JUMBF specification is finalized)
|
|
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', # (seen in JUMB data of JPEG images)
|
|
# (may be able to remove this when JUMBF specification is finalized)
|
|
Condition => '$$valPt=~/^casg\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/',
|
|
Format => 'undef',
|
|
ValueConv => 'substr($val,16)',
|
|
},
|
|
{
|
|
Name => 'UUID-Unknown',
|
|
},
|
|
# also written by Adobe JPEG2000 plugin v1.5:
|
|
# 3a 0d 02 18 0a e9 41 15 b3 76 4b ca 41 ce 0e 71 - 1 byte (01)
|
|
# 47 c9 2c cc d1 a1 45 81 b9 04 38 bb 54 67 71 3b - 1 byte (01)
|
|
# bc 45 a7 74 dd 50 4e c6 a9 f6 f3 a1 37 f4 7e 90 - 4 bytes (00 00 00 32)
|
|
# d7 c8 c5 ef 95 1f 43 b2 87 57 04 25 00 f5 38 e8 - 4 bytes (00 00 00 32)
|
|
],
|
|
uinf => {
|
|
Name => 'UUIDInfo',
|
|
SubDirectory => { },
|
|
},
|
|
# UUIDInfo sub boxes...
|
|
ulst => 'UUIDList',
|
|
'url '=> {
|
|
Name => 'URL',
|
|
Format => 'string',
|
|
},
|
|
# JUMBF boxes (ref https://github.com/thorfdbg/codestream-parser)
|
|
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 => { # used in JUMBF
|
|
Name => 'BinaryDataType',
|
|
Notes => 'JUMBF, MIME type and optional file name',
|
|
Format => 'undef',
|
|
# (ignore "toggles" byte and just extract MIME type and file name)
|
|
ValueConv => '$_=substr($val,1); s/\0+$//; s/\0/, /; $_',
|
|
JUMBF_Suffix => 'Type', # (used when tag is renamed according to JUMDLabel)
|
|
},
|
|
bidb => { # used in JUMBF
|
|
Name => 'BinaryData',
|
|
Notes => 'JUMBF',
|
|
Groups => { 2 => 'Preview' },
|
|
Format => 'undef',
|
|
Binary => 1,
|
|
JUMBF_Suffix => 'Data', # (used when tag is renamed according to JUMDLabel)
|
|
},
|
|
c2sh => { # used in JUMBF
|
|
Name => 'C2PASaltHash',
|
|
Format => 'undef',
|
|
ValueConv => 'unpack("H*",$val)',
|
|
JUMBF_Suffix => 'Salt', # (used when tag is renamed according to JUMDLabel)
|
|
},
|
|
#
|
|
# stuff seen in JPEG XL images:
|
|
#
|
|
# jbrd - JPEG Bitstream Reconstruction Data (allows lossless conversion back to original JPG)
|
|
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 => [{ # Brotli-encoded metadata (see https://libjxl.readthedocs.io/en/latest/api_decoder.html)
|
|
Name => 'BrotliXMP',
|
|
Condition => '$$valPt =~ /^xml /i',
|
|
SubDirectory => {
|
|
TagTable => 'Image::ExifTool::XMP::Main',
|
|
ProcessProc => \&ProcessBrotli,
|
|
WriteProc => \&ProcessBrotli,
|
|
# (don't set DirName to 'XMP' because this would enable a block write of raw XMP)
|
|
},
|
|
},{
|
|
Name => 'BrotliEXIF',
|
|
Condition => '$$valPt =~ /^exif/i',
|
|
SubDirectory => {
|
|
TagTable => 'Image::ExifTool::Exif::Main',
|
|
ProcessProc => \&ProcessBrotli,
|
|
WriteProc => \&ProcessBrotli,
|
|
# (don't set DirName to 'EXIF' because this would enable a block write of raw EXIF)
|
|
},
|
|
},{
|
|
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',
|
|
},
|
|
},
|
|
);
|
|
|
|
# (ref fcd15444-1/2/6.pdf)
|
|
# (also see http://developer.apple.com/mac/library/documentation/QuickTime/QTFF/QTFFChap1/qtff1.html)
|
|
%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)', # image/jp2
|
|
'jpm ' => 'JPEG 2000 Compound Image (.JPM)', # image/jpm
|
|
'jpx ' => 'JPEG 2000 with extensions (.JPX)', # image/jpx
|
|
'jxl ' => 'JPEG XL Image (.JXL)', # image/jxl
|
|
'jph ' => 'High-throughput JPEG 2000 (.JPH)', # image/jph
|
|
},
|
|
},
|
|
1 => {
|
|
Name => 'MinorVersion',
|
|
Format => 'undef[4]',
|
|
ValueConv => 'sprintf("%x.%x.%x", unpack("nCC", $val))',
|
|
},
|
|
2 => {
|
|
Name => 'CompatibleBrands',
|
|
Format => 'undef[$size-8]',
|
|
List => 1, # (for documentation only)
|
|
# ignore any entry with a null, and return others as a list
|
|
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, # (we don't actually call this)
|
|
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
|
|
GROUPS => { 2 => 'Image' },
|
|
FORMAT => 'int8s',
|
|
WRITABLE => 1,
|
|
# (Note: 'colr' is not a real group, but is used as a hack to write the
|
|
# necessary colr box. This hack necessitated another hack in TagInfoXML.pm
|
|
# to avoid reporting this fake group in the XML output)
|
|
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 => { # ref 15444-2 2002-05-15
|
|
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)', # (incorrectly listed as 18 in 15444-2 2000-12-07)
|
|
16 => 'sRGB',
|
|
17 => 'Grayscale',
|
|
18 => 'sYCC',
|
|
19 => 'CIEJab',
|
|
20 => 'e-sRGB',
|
|
21 => 'ROMM-RGB',
|
|
# incorrect in 15444-2 2000-12-07
|
|
#22 => 'sRGB based YCbCr',
|
|
#23 => 'YPbPr(1125/60)',
|
|
#24 => 'YPbPr(1250/50)',
|
|
22 => 'YPbPr(1125/60)',
|
|
23 => 'YPbPr(1250/50)',
|
|
24 => 'e-sYCC',
|
|
},
|
|
},
|
|
{
|
|
Name => 'ColorSpecData',
|
|
Format => 'undef[$size-3]',
|
|
Protected => 1,
|
|
Binary => 1,
|
|
},
|
|
],
|
|
);
|
|
|
|
# JUMBF description box
|
|
%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;
|
|
},
|
|
# seen:
|
|
# cacb/cast/caas/cacl/casg/json-00110010800000aa00389b71
|
|
# (also brob- but not yet tested)
|
|
# 6579d6fbdba2446bb2ac1b82feeb89d1 - JPEG image
|
|
},
|
|
'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' },
|
|
);
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Read JUMBF box to keep track of sub-document numbers
|
|
# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
|
|
# Returns: 1 on success
|
|
sub ProcessJUMB($$$)
|
|
{
|
|
my ($et, $dirInfo, $tagTablePtr) = @_;
|
|
if ($$et{jumd_level}) {
|
|
++$$et{jumd_level}[-1]; # increment current sub-document number
|
|
} else {
|
|
$$et{jumd_level} = [ ++$$et{DOC_COUNT} ]; # new top-level sub-document
|
|
$$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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Read JUMBF description box (ref https://github.com/thorfdbg/codestream-parser)
|
|
# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
|
|
# Returns: 1 on success
|
|
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) { # label exists?
|
|
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; # capitalize characters after illegal characters
|
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove other illegal characters
|
|
$name =~ s/__/_/; # collapse double underlines
|
|
$name = ucfirst $name; # capitalize first letter
|
|
$name =~ s/C2pa/C2PA/; # capitalize C2PA
|
|
$name = "Tag$name" if length($name) < 2; # must at least 2 characters long
|
|
$$et{JUMBFLabel} = $name;
|
|
}
|
|
}
|
|
if ($flags & 0x04) { # ID exists?
|
|
$pos + 4 > $end and $et->Warn('Missing JUMD ID'), return 0;
|
|
$et->HandleTag($tagTablePtr, 'id', Get32u($dataPt, $pos));
|
|
$pos += 4;
|
|
}
|
|
if ($flags & 0x08) { # signature exists?
|
|
$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) {
|
|
# (may find c2sh box hiding after JUMD record)
|
|
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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Warn about error in Brotli compression/decompression
|
|
# Inputs: 0) ExifTool ref, 1) box type, 2) true for decoding (Uncompress)
|
|
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");
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Create new JPEG 2000 boxes when writing
|
|
# (Currently only supports adding top-level Writable JPEG2000 tags and certain UUID boxes)
|
|
# Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
|
|
# Returns: 1 on success
|
|
sub CreateNewBoxes($$)
|
|
{
|
|
my ($et, $outfile) = @_;
|
|
my $addTags = $$et{AddJp2Tags};
|
|
my $addDirs = $$et{AddJp2Dirs};
|
|
delete $$et{AddJp2Tags};
|
|
delete $$et{AddJp2Dirs};
|
|
my ($tag, $dirName);
|
|
# add JPEG2000 tags
|
|
foreach $tag (sort keys %$addTags) {
|
|
my $tagInfo = $$addTags{$tag};
|
|
my $nvHash = $et->GetNewValueHash($tagInfo);
|
|
# (native JPEG2000 information is always preferred, so don't check IsCreating)
|
|
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);
|
|
}
|
|
}
|
|
# add UUID boxes (and/or JXL Exif/XML boxes)
|
|
foreach $dirName (sort keys %$addDirs) {
|
|
# handle JPEG XL XMP and EXIF
|
|
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'; # (hack for stupid JXL XMP)
|
|
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) {
|
|
# not sure why, but EXIF box is padded with leading 0's in my sample
|
|
my $pad = $dirName eq 'Exif' ? "\0\0\0\0" : '';
|
|
if ($$et{IsJXL} and $compress) {
|
|
# create as Brotli-compressed metadata
|
|
if (eval { require IO::Compress::Brotli }) {
|
|
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',
|
|
);
|
|
# remove "UUID-" from start of directory name to allow appropriate
|
|
# directories to be written as a block
|
|
$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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Create Color Specification Box
|
|
# Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
|
|
# Returns: 1 on success
|
|
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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Process JPEG 2000 box
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table
|
|
# Returns: 1 on success when reading, or -1 on write error
|
|
# (or JP2 box or undef when writing from buffer)
|
|
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) {
|
|
# save C2PA JUMBF as a block if requested
|
|
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}; # read from RAF
|
|
}
|
|
|
|
if ($outfile) {
|
|
unless ($raf) {
|
|
# buffer output to be used for return value
|
|
$outBuff = '';
|
|
$outfile = \$outBuff;
|
|
}
|
|
# determine if we will be writing colr box
|
|
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 {
|
|
# (must not set verbose flag when writing!)
|
|
$verbose = $$et{OPTIONS}{Verbose};
|
|
$et->VerboseDir($dirName) if $verbose;
|
|
# do hash if requested, but only for top-level image data
|
|
$hash = $$et{ImageDataHash} if $raf;
|
|
}
|
|
# loop through all contained boxes
|
|
my ($pos, $boxLen, $lastBox);
|
|
for ($pos=$dirStart; ; $pos+=$boxLen) {
|
|
my ($boxID, $buff, $valuePtr);
|
|
my $hdrLen = 8; # the box header length
|
|
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); # (length includes header and data)
|
|
$boxID = substr($$dataPt, $pos+4, 4);
|
|
# (ftbl box contains flst boxes with absolute file offsets, not currently handled)
|
|
if ($outfile and $boxID eq 'ftbl') {
|
|
$et->Error("Can't yet handle fragmented JPX files");
|
|
return -1;
|
|
}
|
|
# remove old colr boxes if necessary
|
|
if ($doColour and $boxID eq 'colr') {
|
|
if ($doColour == 1) { # did we successfully write the new colr box?
|
|
$et->VPrint(1," - Jpeg2000:ColorSpec\n");
|
|
++$$et{CHANGED};
|
|
next;
|
|
}
|
|
$et->Warn('Out-of-order colr box encountered');
|
|
undef $doColour;
|
|
}
|
|
$lastBox = $boxID;
|
|
$pos += $hdrLen; # move to end of box header
|
|
if ($boxLen == 1) {
|
|
# box header contains an additional 8-byte integer for length
|
|
$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; # move to end of extended-length box header
|
|
$boxLen = $lo - $hdrLen; # length of remaining box data
|
|
} elsif ($boxLen == 0) {
|
|
if ($raf) {
|
|
if ($outfile) {
|
|
CreateNewBoxes($et, $outfile) or $err = 1;
|
|
# copy over the rest of the file
|
|
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; # (ignore the rest of the file when reading)
|
|
}
|
|
$boxLen = $dirEnd - $pos; # data runs to end of file
|
|
} else {
|
|
$boxLen -= $hdrLen; # length of remaining box data
|
|
}
|
|
$boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
|
|
my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
|
|
unless (defined $tagInfo or $verbose) {
|
|
# no need to process this box
|
|
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) {
|
|
# read the box data
|
|
$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) {
|
|
# GetTagInfo() required the value for a Condition
|
|
my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128);
|
|
$tagInfo = $et->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
|
|
}
|
|
# delete all UUID boxes and any writable box if deleting all information
|
|
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};
|
|
}
|
|
}
|
|
}
|
|
# create new tag for JUMBF data values with name corresponding to JUMBFLabel
|
|
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}; # (must do this so -j -b returns JUMBF binary data)
|
|
$$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}) {
|
|
#### eval Start ($valuePtr, $dataPt)
|
|
$subdirStart = eval($$subdir{Start});
|
|
$subdirLen -= $subdirStart - $valuePtr;
|
|
if ($subdirLen < 0) {
|
|
$subdirStart = $valuePtr;
|
|
$subdirLen = 0;
|
|
}
|
|
}
|
|
my %subdirInfo = (
|
|
Parent => 'JP2',
|
|
DataPt => $dataPt,
|
|
DataPos => -$subdirStart, # (relative to Base)
|
|
DataLen => $dataLen,
|
|
DirStart => $subdirStart,
|
|
DirLen => $subdirLen,
|
|
DirName => $$subdir{DirName} || $$tagInfo{Name},
|
|
OutFile => $outfile,
|
|
Base => $base + $dataPos + $subdirStart,
|
|
);
|
|
my $uuid = $uuid{$$tagInfo{Name}};
|
|
# remove "UUID-" prefix to allow appropriate directories to be written as a block
|
|
$subdirInfo{DirName} =~ s/^UUID-//;
|
|
my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
|
|
if ($outfile) {
|
|
# (special case for brob box, which may be EXIF or XMP)
|
|
my $fakeID = $boxID;
|
|
if ($boxID eq 'brob') {
|
|
# I have seen 'brob' ID's with funny cases, so standardize these
|
|
$fakeID = 'xml ' if $$dataPt =~ /^xml /i;
|
|
$fakeID = 'Exif' if $$dataPt =~ /^Exif/i;
|
|
}
|
|
my $newdir;
|
|
# only edit writable UUID, Exif and jp2h boxes
|
|
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; # next if deleting the box
|
|
# compress JXL EXIF or XMP metadata if requested
|
|
if (defined $newdir and $$et{IsJXL} and defined $compress and
|
|
($fakeID eq 'Exif' or $fakeID eq 'xml '))
|
|
{
|
|
if ($compress and $boxID ne 'brob') {
|
|
# rewrite as a Brotli-compressed 'brob' box
|
|
if (eval { require IO::Compress::Brotli }) {
|
|
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') {
|
|
# (in this case, ProcessBrotli has returned uncompressed data,
|
|
# so change to the uncompressed 'xml ' or 'Exif' box type)
|
|
$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);
|
|
}
|
|
# remove this directory from our create list
|
|
delete $$et{AddJp2Dirs}{$fakeID}; # (eg. 'Exif' or 'xml ')
|
|
if ($boxID eq 'brob') {
|
|
# (can't make tag Name 'XMP' or 'Exif' for Brotli-compressed tags because it
|
|
# would break the logic in WriteDirectory(), so we do a lookup here instead)
|
|
delete $$et{AddJp2Dirs}{{'xml '=>'XMP','Exif'=>'EXIF'}->{$fakeID}};
|
|
} else {
|
|
delete $$et{AddJp2Dirs}{$$tagInfo{Name}}; # (eg. 'EXIF' or 'XMP')
|
|
}
|
|
# use old box data if not changed
|
|
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;
|
|
# write new colr box immediately after ihdr
|
|
if ($doColour and $boxID eq 'ihdr') {
|
|
# (shouldn't be multiple ihdr boxes, but just in case, write only 1)
|
|
$doColour = $doColour==2 ? CreateColorSpec($et, $outfile) : 0;
|
|
}
|
|
} else {
|
|
# extract as a block if specified
|
|
$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) {
|
|
# only save tag values if Format was specified
|
|
my $rational;
|
|
my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen, \$rational);
|
|
if (defined $val) {
|
|
my $key = $et->FoundTag($tagInfo, $val);
|
|
# save Rational value
|
|
$$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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Return bits from a bitstream object
|
|
# Inputs: 0) array ref, 1) number of bits
|
|
# Returns: specified number of bits as an integer, and shifts input bitstream
|
|
sub GetBits($$)
|
|
{
|
|
my ($a, $n) = @_;
|
|
my $v = 0;
|
|
my $bit = 1;
|
|
my $i;
|
|
while ($n--) {
|
|
for ($i=0; $i<@$a; ++$i) {
|
|
# consume bits LSB first
|
|
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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Read/write Brotli-encoded metadata
|
|
# Inputs: 0) ExifTool ref, 1) dirInfoRef, 2) tag table ref
|
|
# Returns: 1 on success when reading, or new data when writing (undef if unchanged)
|
|
# (ref https://libjxl.readthedocs.io/en/latest/api_decoder.html)
|
|
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;
|
|
}
|
|
if (eval { require IO::Uncompress::Brotli }) {
|
|
if ($isWriting and not eval { require IO::Compress::Brotli }) {
|
|
$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'; # (necessary for block read/write)
|
|
require Image::ExifTool::XMP;
|
|
if ($isWriting) {
|
|
$dirInfo{Compact} = 1 if $compress; # (no need to add padding if writing compressed)
|
|
$dat = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
|
|
} else {
|
|
Image::ExifTool::XMP::ProcessXMP($et, \%dirInfo, $tagTablePtr);
|
|
}
|
|
} elsif ($type eq 'Exif') {
|
|
$dirInfo{DirName} = 'EXIF'; # (necessary for block read/write)
|
|
$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);
|
|
# add back header word
|
|
$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; # (can't yet write JUMBF)
|
|
Image::ExifTool::Jpeg2000::ProcessJUMB($et, \%dirInfo, $tagTablePtr); # (untested)
|
|
}
|
|
if ($isWriting) {
|
|
return undef unless defined $dat;
|
|
# rewrite as uncompressed if Compress option is set to 0 (or '')
|
|
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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Extract parameters from JPEG XL codestream [unverified!]
|
|
# Inputs: 0) ExifTool ref, 1) codestream ref
|
|
# Returns: 1 on success
|
|
sub ProcessJXLCodestream($$)
|
|
{
|
|
my ($et, $dataPt) = @_;
|
|
|
|
return 0 unless $$dataPt =~ /^(\0\0\0\0)?\xff\x0a/; # validate codestream
|
|
# ignore if already extracted (ie. subsequent jxlp boxes)
|
|
return 0 if $$et{ProcessedJXLCodestream};
|
|
$$et{ProcessedJXLCodestream} = 1;
|
|
# work with first 64 bytes of codestream data
|
|
# (and add padding if necessary to avoid unpacking past end of data)
|
|
my $dat;
|
|
if (length $$dataPt > 64) {
|
|
$dat = substr($$dataPt, 0, 64);
|
|
} elsif (length $$dataPt < 18) {
|
|
$dat = $$dataPt . ("\0" x 18); # (so we'll have a minimum 14 bytes to work with)
|
|
} else {
|
|
$dat = $$dataPt;
|
|
}
|
|
$dat =~ s/^\0\0\0\0//; # remove jxlp header word
|
|
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;
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Read/write meta information from a C2PA/JUMBF file
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
|
# Returns: 1 on success, 0 if this wasn't a valid JUMBF file
|
|
sub ProcessJUMBF($$)
|
|
{
|
|
my ($et, $dirInfo) = @_;
|
|
my $raf = $$dirInfo{RAF};
|
|
my $hdr;
|
|
|
|
# check to be sure this is a valid JPG2000 file
|
|
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);
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Read/write meta information from a JPEG 2000 image
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG 2000 file, or -1 on write error
|
|
sub ProcessJP2($$)
|
|
{
|
|
local $_;
|
|
my ($et, $dirInfo) = @_;
|
|
my $raf = $$dirInfo{RAF};
|
|
my $outfile = $$dirInfo{OutFile};
|
|
my $hdr;
|
|
|
|
# check to be sure this is a valid JPG2000 file
|
|
return 0 unless $raf->Read($hdr,12) == 12;
|
|
unless ($hdr eq "\0\0\0\x0cjP \x0d\x0a\x87\x0a" or # (ref 1)
|
|
$hdr eq "\0\0\0\x0cjP\x1a\x1a\x0d\x0a\x87\x0a" or # (ref 2)
|
|
$$et{IsJXL})
|
|
{
|
|
return 0 unless $hdr =~ /^\xff\x4f\xff\x51\0/; # check for JP2 codestream format
|
|
if ($outfile) {
|
|
$et->Error('Writing of J2C files is not yet supported');
|
|
return 0
|
|
}
|
|
# add J2C markers if not done already
|
|
unless ($Image::ExifTool::jpegMarker{0x4f}) {
|
|
$Image::ExifTool::jpegMarker{$_} = $j2cMarker{$_} foreach keys %j2cMarker;
|
|
}
|
|
$et->SetFileType('J2C');
|
|
$raf->Seek(0,0);
|
|
return $et->ProcessJPEG($dirInfo); # decode with JPEG processor
|
|
}
|
|
if ($outfile) {
|
|
Write($outfile, $hdr) or return -1;
|
|
if ($$et{IsJXL}) {
|
|
$et->InitWriteDirs(\%jxlMap);
|
|
$$et{AddJp2Tags} = { }; # (don't add JP2 tags in JXL files)
|
|
} else {
|
|
$et->InitWriteDirs(\%jp2Map);
|
|
$$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main);
|
|
}
|
|
# save list of directories to create
|
|
my %addDirs = %{$$et{ADD_DIRS}}; # (make a copy)
|
|
$$et{AddJp2Dirs} = \%addDirs;
|
|
} else {
|
|
my ($buff, $fileType);
|
|
# recognize JPX and JPM as unique types of JP2
|
|
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'); # JPEG 2000 files are big-endian
|
|
my %dirInfo = (
|
|
RAF => $raf,
|
|
DirName => 'JP2',
|
|
OutFile => $$dirInfo{OutFile},
|
|
);
|
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
|
|
return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# Read/write meta information in a JPEG XL image
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG XL file, -1 on write error
|
|
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") {
|
|
# JPEG XL in ISO BMFF container
|
|
$$et{IsJXL} = 1;
|
|
} elsif ($hdr =~ /^\xff\x0a/) {
|
|
# JPEG XL codestream
|
|
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 ";
|
|
# add metadata to empty ISO BMFF container
|
|
$$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) {
|
|
# attach the JXL codestream box to the ISO BMFF file
|
|
$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; # end
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Image::ExifTool::Jpeg2000 - Read JPEG 2000 meta information
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
This module is used by Image::ExifTool
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module contains routines required by Image::ExifTool to read JPEG 2000
|
|
files.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Copyright 2003-2025, Phil Harvey (philharvey66 at gmail.com)
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the same terms as Perl itself.
|
|
|
|
=head1 REFERENCES
|
|
|
|
=over 4
|
|
|
|
=item L<http://www.jpeg.org/public/fcd15444-2.pdf>
|
|
|
|
=item L<ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf>
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Image::ExifTool::TagNames/Jpeg2000 Tags>,
|
|
L<Image::ExifTool(3pm)|Image::ExifTool>
|
|
|
|
=cut
|
|
|