File Coverage

blib/lib/Image/ExifTool/Jpeg2000.pm
Criterion Covered Total %
statement 386 548 70.4
branch 187 402 46.5
condition 90 199 45.2
subroutine 13 15 86.6
pod 0 12 0.0
total 676 1176 57.4


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: Jpeg2000.pm
3             #
4             # Description: Read JPEG 2000 meta information
5             #
6             # Revisions: 02/11/2005 - P. Harvey Created
7             # 06/22/2007 - PH Added write support (EXIF, IPTC and XMP only)
8             #
9             # References: 1) http://www.jpeg.org/public/fcd15444-2.pdf
10             # 2) ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf
11             #------------------------------------------------------------------------------
12              
13             package Image::ExifTool::Jpeg2000;
14              
15 12     12   11203 use strict;
  12         25  
  12         451  
16 12     12   50 use vars qw($VERSION);
  12         18  
  12         542  
17 12     12   59 use Image::ExifTool qw(:DataAccess :Utils);
  12         30  
  12         83273  
18              
19             $VERSION = '1.43';
20              
21             sub ProcessJpeg2000Box($$$);
22             sub ProcessJUMD($$$);
23              
24             my %resolutionUnit = (
25             -3 => 'km',
26             -2 => '100 m',
27             -1 => '10 m',
28             0 => 'm',
29             1 => '10 cm',
30             2 => 'cm',
31             3 => 'mm',
32             4 => '0.1 mm',
33             5 => '0.01 mm',
34             6 => 'um',
35             );
36              
37             # top-level boxes containing image data
38             my %isImageData = ( jp2c=>1, jbrd=>1, jxlp=>1, jxlc=>1 );
39              
40             # map of where information is written in JPEG2000 image
41             my %jp2Map = (
42             IPTC => 'UUID-IPTC',
43             IFD0 => 'UUID-EXIF',
44             XMP => 'UUID-XMP',
45             'UUID-IPTC' => 'JP2',
46             'UUID-EXIF' => 'JP2',
47             'UUID-XMP' => 'JP2',
48             jp2h => 'JP2',
49             colr => 'jp2h',
50             ICC_Profile => 'colr',
51             IFD1 => 'IFD0',
52             EXIF => 'IFD0', # to write EXIF as a block
53             ExifIFD => 'IFD0',
54             GPS => 'IFD0',
55             SubIFD => 'IFD0',
56             GlobParamIFD => 'IFD0',
57             PrintIM => 'IFD0',
58             InteropIFD => 'ExifIFD',
59             MakerNotes => 'ExifIFD',
60             );
61              
62             # map of where information is written in a JXL image
63             my %jxlMap = (
64             IFD0 => 'Exif',
65             XMP => 'xml ',
66             'Exif' => 'JP2',
67             IFD1 => 'IFD0',
68             EXIF => 'IFD0', # to write EXIF as a block
69             ExifIFD => 'IFD0',
70             GPS => 'IFD0',
71             SubIFD => 'IFD0',
72             GlobParamIFD => 'IFD0',
73             PrintIM => 'IFD0',
74             InteropIFD => 'ExifIFD',
75             MakerNotes => 'ExifIFD',
76             );
77              
78             # UUID's for writable UUID directories (by tag name)
79             my %uuid = (
80             'UUID-EXIF' => 'JpgTiffExif->JP2',
81             'UUID-EXIF2' => '', # (flags a warning when writing)
82             'UUID-EXIF_bad' => '0', # (flags a warning when reading and writing)
83             'UUID-IPTC' => "\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38",
84             'UUID-XMP' => "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac",
85             # (can't yet write GeoJP2 information)
86             # 'UUID-GeoJP2' => "\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03",
87             );
88              
89             # JPEG2000 codestream markers (ref ISO/IEC FCD15444-1/2)
90             my %j2cMarker = (
91             0x4f => 'SOC', # start of codestream
92             # 0x50 - seen in JPH codestream
93             0x51 => 'SIZ', # image and tile size
94             0x52 => 'COD', # coding style default
95             0x53 => 'COC', # coding style component
96             0x55 => 'TLM', # tile-part lengths
97             0x57 => 'PLM', # packet length, main header
98             0x58 => 'PLT', # packet length, tile-part header
99             # 0x59 - seen in JPH codestream
100             0x5c => 'QCD', # quantization default
101             0x5d => 'QCC', # quantization component
102             0x5e => 'RGN', # region of interest
103             0x5f => 'POD', # progression order default
104             0x60 => 'PPM', # packed packet headers, main
105             0x61 => 'PPT', # packed packet headers, tile-part
106             0x63 => 'CRG', # component registration
107             0x64 => 'CME', # comment and extension
108             0x90 => 'SOT', # start of tile-part
109             0x91 => 'SOP', # start of packet
110             0x92 => 'EPH', # end of packet header
111             0x93 => 'SOD', # start of data
112             # extensions (ref ISO/IEC FCD15444-2)
113             0x70 => 'DCO', # variable DC offset
114             0x71 => 'VMS', # visual masking
115             0x72 => 'DFS', # downsampling factor style
116             0x73 => 'ADS', # arbitrary decomposition style
117             # 0x72 => 'ATK', # arbitrary transformation kernels ?
118             0x78 => 'CBD', # component bit depth
119             0x74 => 'MCT', # multiple component transformation definition
120             0x75 => 'MCC', # multiple component collection
121             0x77 => 'MIC', # multiple component intermediate collection
122             0x76 => 'NLT', # non-linearity point transformation
123             );
124              
125             # JPEG 2000 "box" (ie. atom) names
126             # Note: only tags with a defined "Format" are extracted
127             %Image::ExifTool::Jpeg2000::Main = (
128             GROUPS => { 2 => 'Image' },
129             PROCESS_PROC => \&ProcessJpeg2000Box,
130             WRITE_PROC => \&ProcessJpeg2000Box,
131             PREFERRED => 1, # always add these tags when writing
132             NOTES => q{
133             The tags below are found in JPEG 2000 images and the C2PA CAI JUMBF metadata
134             in various file types (see below). Note that ExifTool currently writes only
135             EXIF, IPTC and XMP tags in Jpeg2000 images, and EXIF and XMP in JXL images.
136             ExifTool will read/write Brotli-compressed EXIF and XMP in JXL images, but
137             the API L option must be set to create new EXIF and XMP in compressed
138             format.
139              
140             C2PA (Coalition for Content Provenance and Authenticity) CAI (Content
141             Authenticity Initiative) JUMBF (JPEG Universal Metadata Box Format) metdata
142             is currently extracted from JPEG, PNG, TIFF-based (eg. TIFF, DNG),
143             QuickTime-based (eg. MP4, MOV, HEIF, AVIF), RIFF-based (eg. WAV, AVI, WebP),
144             PDF, SVG and GIF files, and ID3v2 metadata. The suggested ExifTool
145             command-line arguments for reading C2PA metadata are C<-jumbf:all -G3 -b -j
146             -u -struct>. This metadata may be deleted from writable JPEG, PNG, WebP,
147             TIFF-based, and QuickTime-based files by deleting the JUMBF group with
148             C<-jumbf:all=>. The C2PA JUMBF metadata may be extracted as a block via the
149             JUMBF tag. See L for the C2PA
150             specification.
151             },
152             #
153             # NOTE: ONLY TAGS WITH "Format" DEFINED ARE EXTRACTED!
154             #
155             'jP ' => 'JP2Signature', # (ref 1)
156             "jP\x1a\x1a" => 'JP2Signature', # (ref 2)
157             prfl => 'Profile',
158             ftyp => {
159             Name => 'FileType',
160             SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::FileType' },
161             },
162             rreq => 'ReaderRequirements',
163             jp2h => {
164             Name => 'JP2Header',
165             SubDirectory => { },
166             },
167             # JP2Header sub boxes...
168             ihdr => {
169             Name => 'ImageHeader',
170             SubDirectory => {
171             TagTable => 'Image::ExifTool::Jpeg2000::ImageHeader',
172             },
173             },
174             bpcc => 'BitsPerComponent',
175             colr => {
176             Name => 'ColorSpecification',
177             SubDirectory => {
178             TagTable => 'Image::ExifTool::Jpeg2000::ColorSpec',
179             },
180             },
181             pclr => 'Palette',
182             cdef => 'ComponentDefinition',
183             'res '=> {
184             Name => 'Resolution',
185             SubDirectory => { },
186             },
187             # Resolution sub boxes...
188             resc => {
189             Name => 'CaptureResolution',
190             SubDirectory => {
191             TagTable => 'Image::ExifTool::Jpeg2000::CaptureResolution',
192             },
193             },
194             resd => {
195             Name => 'DisplayResolution',
196             SubDirectory => {
197             TagTable => 'Image::ExifTool::Jpeg2000::DisplayResolution',
198             },
199             },
200             jpch => {
201             Name => 'CodestreamHeader',
202             SubDirectory => { },
203             },
204             # CodestreamHeader sub boxes...
205             'lbl '=> {
206             Name => 'Label',
207             Format => 'string',
208             },
209             cmap => 'ComponentMapping',
210             roid => 'ROIDescription',
211             jplh => {
212             Name => 'CompositingLayerHeader',
213             SubDirectory => { },
214             },
215             # CompositingLayerHeader sub boxes...
216             cgrp => 'ColorGroup',
217             opct => 'Opacity',
218             creg => 'CodestreamRegistration',
219             dtbl => 'DataReference',
220             ftbl => {
221             Name => 'FragmentTable',
222             Subdirectory => { },
223             },
224             # FragmentTable sub boxes...
225             flst => 'FragmentList',
226             cref => 'Cross-Reference',
227             mdat => 'MediaData',
228             comp => 'Composition',
229             copt => 'CompositionOptions',
230             inst => 'InstructionSet',
231             asoc => {
232             Name => 'Association',
233             SubDirectory => { },
234             },
235             # (Association box may contain any other sub-box)
236             nlst => 'NumberList',
237             bfil => 'BinaryFilter',
238             drep => 'DesiredReproductions',
239             # DesiredReproductions sub boxes...
240             gtso => 'GraphicsTechnologyStandardOutput',
241             chck => 'DigitalSignature',
242             mp7b => 'MPEG7Binary',
243             free => 'Free',
244             jp2c => [{
245             Name => 'ContiguousCodestream',
246             Condition => 'not $$self{jumd_level}',
247             },{
248             Name => 'PreviewImage',
249             Groups => { 2 => 'Preview' },
250             Format => 'undef',
251             Binary => 1,
252             }],
253             jp2i => {
254             Name => 'IntellectualProperty',
255             SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
256             },
257             'xml '=> [{
258             Name => 'XML',
259             Condition => 'not $$self{IsJXL}',
260             Writable => 'undef',
261             Flags => [ 'Binary', 'Protected', 'BlockExtract' ],
262             List => 1,
263             Notes => q{
264             by default, the XML data in this tag is parsed using the ExifTool XMP module
265             to to allow individual tags to be accessed when reading, but it may also be
266             extracted as a block via the "XML" tag, which is also how this tag is
267             written and copied. It may also be extracted as a block by setting the API
268             BlockExtract option. This is a List-type tag because multiple XML blocks
269             may exist
270             },
271             # (note: extracting as a block was broken in 11.04, and finally fixed in 12.14)
272             SubDirectory => { TagTable => 'Image::ExifTool::XMP::XML' },
273             },{
274             Name => 'XMP',
275             Notes => 'used for XMP in JPEG XL files',
276             # NOTE: the hacked code relies on this being at index 1 of the tagInfo list!
277             SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
278             }],
279             uuid => [
280             {
281             Name => 'UUID-EXIF',
282             # (this is the EXIF that we create in JP2)
283             Condition => '$$valPt=~/^JpgTiffExif->JP2(?!Exif\0\0)/',
284             SubDirectory => {
285             TagTable => 'Image::ExifTool::Exif::Main',
286             ProcessProc => \&Image::ExifTool::ProcessTIFF,
287             WriteProc => \&Image::ExifTool::WriteTIFF,
288             DirName => 'EXIF',
289             Start => '$valuePtr + 16',
290             },
291             },
292             {
293             Name => 'UUID-EXIF2',
294             # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
295             Condition => '$$valPt=~/^\x05\x37\xcd\xab\x9d\x0c\x44\x31\xa7\x2a\xfa\x56\x1f\x2a\x11\x3e/',
296             SubDirectory => {
297             TagTable => 'Image::ExifTool::Exif::Main',
298             ProcessProc => \&Image::ExifTool::ProcessTIFF,
299             WriteProc => \&Image::ExifTool::WriteTIFF,
300             DirName => 'EXIF',
301             Start => '$valuePtr + 16',
302             },
303             },
304             {
305             Name => 'UUID-EXIF_bad',
306             # written by Digikam
307             Condition => '$$valPt=~/^JpgTiffExif->JP2/',
308             SubDirectory => {
309             TagTable => 'Image::ExifTool::Exif::Main',
310             ProcessProc => \&Image::ExifTool::ProcessTIFF,
311             WriteProc => \&Image::ExifTool::WriteTIFF,
312             DirName => 'EXIF',
313             Start => '$valuePtr + 22',
314             },
315             },
316             {
317             Name => 'UUID-IPTC',
318             # (this is the IPTC that we create in JP2)
319             Condition => '$$valPt=~/^\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38/',
320             SubDirectory => {
321             TagTable => 'Image::ExifTool::IPTC::Main',
322             Start => '$valuePtr + 16',
323             },
324             },
325             {
326             Name => 'UUID-IPTC2',
327             # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
328             Condition => '$$valPt=~/^\x09\xa1\x4e\x97\xc0\xb4\x42\xe0\xbe\xbf\x36\xdf\x6f\x0c\xe3\x6f/',
329             SubDirectory => {
330             TagTable => 'Image::ExifTool::IPTC::Main',
331             Start => '$valuePtr + 16',
332             },
333             },
334             {
335             Name => 'UUID-XMP',
336             # ref http://www.adobe.com/products/xmp/pdfs/xmpspec.pdf
337             Condition => '$$valPt=~/^\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac/',
338             SubDirectory => {
339             TagTable => 'Image::ExifTool::XMP::Main',
340             Start => '$valuePtr + 16',
341             },
342             },
343             {
344             Name => 'UUID-GeoJP2',
345             # ref http://www.remotesensing.org/jpeg2000/
346             Condition => '$$valPt=~/^\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03/',
347             SubDirectory => {
348             TagTable => 'Image::ExifTool::Exif::Main',
349             ProcessProc => \&Image::ExifTool::ProcessTIFF,
350             Start => '$valuePtr + 16',
351             },
352             },
353             {
354             Name => 'UUID-Photoshop',
355             # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
356             Condition => '$$valPt=~/^\x2c\x4c\x01\x00\x85\x04\x40\xb9\xa0\x3e\x56\x21\x48\xd6\xdf\xeb/',
357             SubDirectory => {
358             TagTable => 'Image::ExifTool::Photoshop::Main',
359             Start => '$valuePtr + 16',
360             },
361             },
362             {
363             Name => 'UUID-C2PAClaimSignature', # (seen in incorrectly-formatted JUMB data of JPEG images)
364             # (may be able to remove this when JUMBF specification is finalized)
365             Condition => '$$valPt=~/^c2cs\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/',
366             SubDirectory => {
367             TagTable => 'Image::ExifTool::CBOR::Main',
368             Start => '$valuePtr + 16',
369             },
370             },
371             {
372             Name => 'UUID-Signature', # (seen in JUMB data of JPEG images)
373             # (may be able to remove this when JUMBF specification is finalized)
374             Condition => '$$valPt=~/^casg\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/',
375             Format => 'undef',
376             ValueConv => 'substr($val,16)',
377             },
378             {
379             Name => 'UUID-Unknown',
380             },
381             # also written by Adobe JPEG2000 plugin v1.5:
382             # 3a 0d 02 18 0a e9 41 15 b3 76 4b ca 41 ce 0e 71 - 1 byte (01)
383             # 47 c9 2c cc d1 a1 45 81 b9 04 38 bb 54 67 71 3b - 1 byte (01)
384             # bc 45 a7 74 dd 50 4e c6 a9 f6 f3 a1 37 f4 7e 90 - 4 bytes (00 00 00 32)
385             # d7 c8 c5 ef 95 1f 43 b2 87 57 04 25 00 f5 38 e8 - 4 bytes (00 00 00 32)
386             ],
387             uinf => {
388             Name => 'UUIDInfo',
389             SubDirectory => { },
390             },
391             # UUIDInfo sub boxes...
392             ulst => 'UUIDList',
393             'url '=> {
394             Name => 'URL',
395             Format => 'string',
396             },
397             # JUMBF boxes (ref https://github.com/thorfdbg/codestream-parser)
398             jumd => {
399             Name => 'JUMBFDescr',
400             SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::JUMD' },
401             },
402             jumb => {
403             Name => 'JUMBFBox',
404             SubDirectory => {
405             TagTable => 'Image::ExifTool::Jpeg2000::Main',
406             ProcessProc => \&ProcessJUMB,
407             },
408             },
409             json => {
410             Name => 'JSONData',
411             Flags => [ 'Binary', 'Protected', 'BlockExtract' ],
412             Notes => q{
413             by default, data in this tag is parsed using the ExifTool JSON module to to
414             allow individual tags to be accessed when reading, but it may also be
415             extracted as a block via the "JSONData" tag or by setting the API
416             BlockExtract option
417             },
418             SubDirectory => { TagTable => 'Image::ExifTool::JSON::Main' },
419             },
420             cbor => {
421             Name => 'CBORData',
422             Flags => [ 'Binary', 'Protected' ],
423             SubDirectory => { TagTable => 'Image::ExifTool::CBOR::Main' },
424             },
425             bfdb => { # used in JUMBF
426             Name => 'BinaryDataType',
427             Notes => 'JUMBF, MIME type and optional file name',
428             Format => 'undef',
429             # (ignore "toggles" byte and just extract MIME type and file name)
430             ValueConv => '$_=substr($val,1); s/\0+$//; s/\0/, /; $_',
431             JUMBF_Suffix => 'Type', # (used when tag is renamed according to JUMDLabel)
432             },
433             bidb => { # used in JUMBF
434             Name => 'BinaryData',
435             Notes => 'JUMBF',
436             Groups => { 2 => 'Preview' },
437             Format => 'undef',
438             Binary => 1,
439             JUMBF_Suffix => 'Data', # (used when tag is renamed according to JUMDLabel)
440             },
441             c2sh => { # used in JUMBF
442             Name => 'C2PASaltHash',
443             Format => 'undef',
444             ValueConv => 'unpack("H*",$val)',
445             JUMBF_Suffix => 'Salt', # (used when tag is renamed according to JUMDLabel)
446             },
447             #
448             # stuff seen in JPEG XL images:
449             #
450             # jbrd - JPEG Bitstream Reconstruction Data (allows lossless conversion back to original JPG)
451             jxlc => {
452             Name => 'JXLCodestream',
453             Format => 'undef',
454             Notes => q{
455             Codestream in JPEG XL image. Currently processed only to determine
456             ImageSize
457             },
458             RawConv => 'Image::ExifTool::Jpeg2000::ProcessJXLCodestream($self,\$val); undef',
459             },
460             jxlp => {
461             Name => 'PartialJXLCodestream',
462             Format => 'undef',
463             Notes => q{
464             Partial codestreams in JPEG XL image. Currently processed only to determine
465             ImageSize
466             },
467             RawConv => 'Image::ExifTool::Jpeg2000::ProcessJXLCodestream($self,\$val); undef',
468             },
469             Exif => {
470             Name => 'EXIF',
471             SubDirectory => {
472             TagTable => 'Image::ExifTool::Exif::Main',
473             ProcessProc => \&Image::ExifTool::ProcessTIFF,
474             WriteProc => \&Image::ExifTool::WriteTIFF,
475             DirName => 'EXIF',
476             Start => '$valuePtr + 4 + (length($$dataPt)-$valuePtr > 4 ? unpack("N", $$dataPt) : 0)',
477             },
478             },
479             hrgm => {
480             Name => 'GainMapImage',
481             Groups => { 2 => 'Preview' },
482             Format => 'undef',
483             Binary => 1,
484             },
485             brob => [{ # Brotli-encoded metadata (see https://libjxl.readthedocs.io/en/latest/api_decoder.html)
486             Name => 'BrotliXMP',
487             Condition => '$$valPt =~ /^xml /i',
488             SubDirectory => {
489             TagTable => 'Image::ExifTool::XMP::Main',
490             ProcessProc => \&ProcessBrotli,
491             WriteProc => \&ProcessBrotli,
492             # (don't set DirName to 'XMP' because this would enable a block write of raw XMP)
493             },
494             },{
495             Name => 'BrotliEXIF',
496             Condition => '$$valPt =~ /^exif/i',
497             SubDirectory => {
498             TagTable => 'Image::ExifTool::Exif::Main',
499             ProcessProc => \&ProcessBrotli,
500             WriteProc => \&ProcessBrotli,
501             # (don't set DirName to 'EXIF' because this would enable a block write of raw EXIF)
502             },
503             },{
504             Name => 'BrotliJUMB',
505             Condition => '$$valPt =~ /^jumb/i',
506             SubDirectory => {
507             TagTable => 'Image::ExifTool::Jpeg2000::Main',
508             ProcessProc => \&ProcessBrotli,
509             },
510             }],
511             );
512              
513             %Image::ExifTool::Jpeg2000::ImageHeader = (
514             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
515             GROUPS => { 2 => 'Image' },
516             0 => {
517             Name => 'ImageHeight',
518             Format => 'int32u',
519             },
520             4 => {
521             Name => 'ImageWidth',
522             Format => 'int32u',
523             },
524             8 => {
525             Name => 'NumberOfComponents',
526             Format => 'int16u',
527             },
528             10 => {
529             Name => 'BitsPerComponent',
530             PrintConv => q{
531             $val == 0xff and return 'Variable';
532             my $sign = ($val & 0x80) ? 'Signed' : 'Unsigned';
533             return (($val & 0x7f) + 1) . " Bits, $sign";
534             },
535             },
536             11 => {
537             Name => 'Compression',
538             PrintConv => {
539             0 => 'Uncompressed',
540             1 => 'Modified Huffman',
541             2 => 'Modified READ',
542             3 => 'Modified Modified READ',
543             4 => 'JBIG',
544             5 => 'JPEG',
545             6 => 'JPEG-LS',
546             7 => 'JPEG 2000',
547             8 => 'JBIG2',
548             },
549             },
550             );
551              
552             # (ref fcd15444-1/2/6.pdf)
553             # (also see http://developer.apple.com/mac/library/documentation/QuickTime/QTFF/QTFFChap1/qtff1.html)
554             %Image::ExifTool::Jpeg2000::FileType = (
555             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
556             GROUPS => { 2 => 'Video' },
557             FORMAT => 'int32u',
558             0 => {
559             Name => 'MajorBrand',
560             Format => 'undef[4]',
561             PrintConv => {
562             'jp2 ' => 'JPEG 2000 Image (.JP2)', # image/jp2
563             'jpm ' => 'JPEG 2000 Compound Image (.JPM)', # image/jpm
564             'jpx ' => 'JPEG 2000 with extensions (.JPX)', # image/jpx
565             'jxl ' => 'JPEG XL Image (.JXL)', # image/jxl
566             'jph ' => 'High-throughput JPEG 2000 (.JPH)', # image/jph
567             },
568             },
569             1 => {
570             Name => 'MinorVersion',
571             Format => 'undef[4]',
572             ValueConv => 'sprintf("%x.%x.%x", unpack("nCC", $val))',
573             },
574             2 => {
575             Name => 'CompatibleBrands',
576             Format => 'undef[$size-8]',
577             List => 1, # (for documentation only)
578             # ignore any entry with a null, and return others as a list
579             ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a',
580             },
581             );
582              
583             %Image::ExifTool::Jpeg2000::CaptureResolution = (
584             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
585             GROUPS => { 2 => 'Image' },
586             FORMAT => 'int8s',
587             0 => {
588             Name => 'CaptureYResolution',
589             Format => 'rational32u',
590             },
591             4 => {
592             Name => 'CaptureXResolution',
593             Format => 'rational32u',
594             },
595             8 => {
596             Name => 'CaptureYResolutionUnit',
597             SeparateTable => 'ResolutionUnit',
598             PrintConv => \%resolutionUnit,
599             },
600             9 => {
601             Name => 'CaptureXResolutionUnit',
602             SeparateTable => 'ResolutionUnit',
603             PrintConv => \%resolutionUnit,
604             },
605             );
606              
607             %Image::ExifTool::Jpeg2000::DisplayResolution = (
608             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
609             GROUPS => { 2 => 'Image' },
610             FORMAT => 'int8s',
611             0 => {
612             Name => 'DisplayYResolution',
613             Format => 'rational32u',
614             },
615             4 => {
616             Name => 'DisplayXResolution',
617             Format => 'rational32u',
618             },
619             8 => {
620             Name => 'DisplayYResolutionUnit',
621             SeparateTable => 'ResolutionUnit',
622             PrintConv => \%resolutionUnit,
623             },
624             9 => {
625             Name => 'DisplayXResolutionUnit',
626             SeparateTable => 'ResolutionUnit',
627             PrintConv => \%resolutionUnit,
628             },
629             );
630              
631             %Image::ExifTool::Jpeg2000::ColorSpec = (
632             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
633             WRITE_PROC => \&Image::ExifTool::WriteBinaryData, # (we don't actually call this)
634             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
635             GROUPS => { 2 => 'Image' },
636             FORMAT => 'int8s',
637             WRITABLE => 1,
638             # (Note: 'colr' is not a real group, but is used as a hack to write the
639             # necessary colr box. This hack necessitated another hack in TagInfoXML.pm
640             # to avoid reporting this fake group in the XML output)
641             WRITE_GROUP => 'colr',
642             DATAMEMBER => [ 0 ],
643             IS_SUBDIR => [ 3 ],
644             NOTES => q{
645             The table below contains tags in the color specification (colr) box. This
646             box may be rewritten by writing either ICC_Profile, ColorSpace or
647             ColorSpecData. When writing, any existing colr boxes are replaced with the
648             newly created colr box.
649              
650             B: Care must be taken when writing this color specification because
651             writing a specification that is incompatible with the image data may make
652             the image undisplayable.
653             },
654             0 => {
655             Name => 'ColorSpecMethod',
656             RawConv => '$$self{ColorSpecMethod} = $val',
657             Protected => 1,
658             Notes => q{
659             default for writing is 2 when writing ICC_Profile, 1 when writing
660             ColorSpace, or 4 when writing ColorSpecData
661             },
662             PrintConv => {
663             1 => 'Enumerated',
664             2 => 'Restricted ICC',
665             3 => 'Any ICC',
666             4 => 'Vendor Color',
667             },
668             },
669             1 => {
670             Name => 'ColorSpecPrecedence',
671             Notes => 'default for writing is 0',
672             Protected => 1,
673             },
674             2 => {
675             Name => 'ColorSpecApproximation',
676             Notes => 'default for writing is 0',
677             Protected => 1,
678             PrintConv => {
679             0 => 'Not Specified',
680             1 => 'Accurate',
681             2 => 'Exceptional Quality',
682             3 => 'Reasonable Quality',
683             4 => 'Poor Quality',
684             },
685             },
686             3 => [
687             {
688             Name => 'ICC_Profile',
689             Condition => q{
690             $$self{ColorSpecMethod} == 2 or
691             $$self{ColorSpecMethod} == 3
692             },
693             Format => 'undef[$size-3]',
694             SubDirectory => {
695             TagTable => 'Image::ExifTool::ICC_Profile::Main',
696             },
697             },
698             {
699             Name => 'ColorSpace',
700             Condition => '$$self{ColorSpecMethod} == 1',
701             Format => 'int32u',
702             Protected => 1,
703             PrintConv => { # ref 15444-2 2002-05-15
704             0 => 'Bi-level',
705             1 => 'YCbCr(1)',
706             3 => 'YCbCr(2)',
707             4 => 'YCbCr(3)',
708             9 => 'PhotoYCC',
709             11 => 'CMY',
710             12 => 'CMYK',
711             13 => 'YCCK',
712             14 => 'CIELab',
713             15 => 'Bi-level(2)', # (incorrectly listed as 18 in 15444-2 2000-12-07)
714             16 => 'sRGB',
715             17 => 'Grayscale',
716             18 => 'sYCC',
717             19 => 'CIEJab',
718             20 => 'e-sRGB',
719             21 => 'ROMM-RGB',
720             # incorrect in 15444-2 2000-12-07
721             #22 => 'sRGB based YCbCr',
722             #23 => 'YPbPr(1125/60)',
723             #24 => 'YPbPr(1250/50)',
724             22 => 'YPbPr(1125/60)',
725             23 => 'YPbPr(1250/50)',
726             24 => 'e-sYCC',
727             },
728             },
729             {
730             Name => 'ColorSpecData',
731             Format => 'undef[$size-3]',
732             Protected => 1,
733             Binary => 1,
734             },
735             ],
736             );
737              
738             # JUMBF description box
739             %Image::ExifTool::Jpeg2000::JUMD = (
740             PROCESS_PROC => \&ProcessJUMD,
741             GROUPS => { 0 => 'JUMBF', 1 => 'JUMBF', 2 => 'Image' },
742             NOTES => 'Information extracted from the JUMBF description box.',
743             'type' => {
744             Name => 'JUMDType',
745             ValueConv => 'unpack "H*", $val',
746             PrintConv => q{
747             my @a = $val =~ /^(\w{8})(\w{4})(\w{4})(\w{16})$/;
748             return $val unless @a;
749             my $ascii = pack 'H*', $a[0];
750             $a[0] = "($ascii)" if $ascii =~ /^[a-zA-Z0-9]{4}$/;
751             return join '-', @a;
752             },
753             # seen:
754             # cacb/cast/caas/cacl/casg/json-00110010800000aa00389b71
755             # (also brob- but not yet tested)
756             # 6579d6fbdba2446bb2ac1b82feeb89d1 - JPEG image
757             },
758             'label' => { Name => 'JUMDLabel' },
759             'toggles' => {
760             Name => 'JUMDToggles',
761             Unknown => 1,
762             PrintConv => { BITMASK => {
763             0 => 'Requestable',
764             1 => 'Label',
765             2 => 'ID',
766             3 => 'Signature',
767             }},
768             },
769             'id' => { Name => 'JUMDID', Description => 'JUMD ID' },
770             'sig' => { Name => 'JUMDSignature', PrintConv => 'unpack "H*", $val' },
771             );
772              
773             #------------------------------------------------------------------------------
774             # Read JUMBF box to keep track of sub-document numbers
775             # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
776             # Returns: 1 on success
777             sub ProcessJUMB($$$)
778             {
779 120     120 0 197 my ($et, $dirInfo, $tagTablePtr) = @_;
780 120 100       217 if ($$et{jumd_level}) {
781 100         169 ++$$et{jumd_level}[-1]; # increment current sub-document number
782             } else {
783 20         76 $$et{jumd_level} = [ ++$$et{DOC_COUNT} ]; # new top-level sub-document
784 20         59 $$et{SET_GROUP0} = 'JUMBF';
785             }
786 120         189 $$et{DOC_NUM} = join '-', @{$$et{jumd_level}};
  120         428  
787 120         143 push @{$$et{jumd_level}}, 0;
  120         221  
788 120         506 ProcessJpeg2000Box($et, $dirInfo, $tagTablePtr);
789 120         213 delete $$et{DOC_NUM};
790 120         193 delete $$et{JUMBFLabel};
791 120         155 pop @{$$et{jumd_level}};
  120         195  
792 120 100       158 if (@{$$et{jumd_level}} < 2) {
  120         252  
793 20         53 delete $$et{jumd_level};
794 20         34 delete $$et{SET_GROUP0};
795             }
796 120         220 return 1;
797             }
798              
799             #------------------------------------------------------------------------------
800             # Read JUMBF description box (ref https://github.com/thorfdbg/codestream-parser)
801             # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
802             # Returns: 1 on success
803             sub ProcessJUMD($$$)
804             {
805 120     120 0 231 my ($et, $dirInfo, $tagTablePtr) = @_;
806 120         211 my $dataPt = $$dirInfo{DataPt};
807 120         192 my $pos = $$dirInfo{DirStart};
808 120         187 my $end = $pos + $$dirInfo{DirLen};
809 120         437 $et->VerboseDir('JUMD', 0, $end-$pos);
810 120         199 delete $$et{JUMBFLabel};
811 120 50       238 $$dirInfo{DirLen} < 17 and $et->Warn('Truncated JUMD directory'), return 0;
812 120         218 my $type = substr($$dataPt, $pos, 4);
813 120         444 $et->HandleTag($tagTablePtr, 'type', substr($$dataPt, $pos, 16));
814 120         225 $pos += 16;
815 120         314 my $flags = Get8u($dataPt, $pos++);
816 120         318 $et->HandleTag($tagTablePtr, 'toggles', $flags);
817 120 50       228 if ($flags & 0x02) { # label exists?
818 120         297 pos($$dataPt) = $pos;
819 120 50       424 $$dataPt =~ /\0/g or $et->Warn('Missing JUMD label terminator'), return 0;
820 120         230 my $len = pos($$dataPt) - $pos;
821 120         205 my $name = substr($$dataPt, $pos, $len);
822 120         272 $et->HandleTag($tagTablePtr, 'label', $name);
823 120         174 $pos += $len;
824 120 50       201 if ($len) {
825 120         754 $name =~ s/[^-_a-zA-Z0-9]([a-z])/\U$1/g; # capitalize characters after illegal characters
826 120         248 $name =~ tr/-_a-zA-Z0-9//dc; # remove other illegal characters
827 120         216 $name =~ s/__/_/; # collapse double underlines
828 120         211 $name = ucfirst $name; # capitalize first letter
829 120         197 $name =~ s/C2pa/C2PA/; # capitalize C2PA
830 120 50       227 $name = "Tag$name" if length($name) < 2; # must at least 2 characters long
831 120         316 $$et{JUMBFLabel} = $name;
832             }
833             }
834 120 50       254 if ($flags & 0x04) { # ID exists?
835 0 0       0 $pos + 4 > $end and $et->Warn('Missing JUMD ID'), return 0;
836 0         0 $et->HandleTag($tagTablePtr, 'id', Get32u($dataPt, $pos));
837 0         0 $pos += 4;
838             }
839 120 50       232 if ($flags & 0x08) { # signature exists?
840 0 0       0 $pos + 32 > $end and $et->Warn('Missing JUMD signature'), return 0;
841 0         0 $et->HandleTag($tagTablePtr, 'sig', substr($$dataPt, $pos, 32));
842 0         0 $pos += 32;
843             }
844 120         188 my $more = $end - $pos;
845 120 50       186 if ($more) {
846             # (may find c2sh box hiding after JUMD record)
847 0 0       0 if ($more >= 8) {
848             my %dirInfo = (
849             DataPt => $dataPt,
850             DataLen => $$dirInfo{DataLen},
851 0         0 DirStart => $pos,
852             DirLen => $more,
853             DirName => 'JUMDPrivate',
854             );
855 0         0 $et->ProcessDirectory(\%dirInfo, GetTagTable('Image::ExifTool::Jpeg2000::Main'));
856             } else {
857 0         0 $et->Warn("Extra data in JUMD box $more bytes)", 1);
858             }
859             }
860 120         289 return 1;
861             }
862              
863             #------------------------------------------------------------------------------
864             # Warn about error in Brotli compression/decompression
865             # Inputs: 0) ExifTool ref, 1) box type, 2) true for decoding (Uncompress)
866             sub BrotliWarn($$;$)
867             {
868 0     0 0 0 my ($et, $type, $uncompress) = @_;
869 0 0       0 my ($enc, $mod) = $uncompress ? qw(decoding Uncompress) : qw(encoding Compress);
870 0         0 $et->Warn("Error $enc '${type}' brob box");
871 0         0 $et->Warn("Try updating to IO::${mod}::Brotli 0.004 or later");
872             }
873              
874             #------------------------------------------------------------------------------
875             # Create new JPEG 2000 boxes when writing
876             # (Currently only supports adding top-level Writable JPEG2000 tags and certain UUID boxes)
877             # Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
878             # Returns: 1 on success
879             sub CreateNewBoxes($$)
880             {
881 2     2 0 5 my ($et, $outfile) = @_;
882 2         5 my $addTags = $$et{AddJp2Tags};
883 2         4 my $addDirs = $$et{AddJp2Dirs};
884 2         4 delete $$et{AddJp2Tags};
885 2         9 delete $$et{AddJp2Dirs};
886 2         14 my ($tag, $dirName);
887             # add JPEG2000 tags
888 2         9 foreach $tag (sort keys %$addTags) {
889 1         3 my $tagInfo = $$addTags{$tag};
890 1         4 my $nvHash = $et->GetNewValueHash($tagInfo);
891             # (native JPEG2000 information is always preferred, so don't check IsCreating)
892 1 50 33     5 next unless $$tagInfo{List} or $et->IsOverwriting($nvHash) > 0;
893 1 50       4 next if $$nvHash{EditOnly};
894 1         4 my @vals = $et->GetNewValue($nvHash);
895 1         2 my $val;
896 1         2 foreach $val (@vals) {
897 1         5 my $boxhdr = pack('N', length($val) + 8) . $$tagInfo{TagID};
898 1 50       4 Write($outfile, $boxhdr, $val) or return 0;
899 1         2 ++$$et{CHANGED};
900 1         6 $et->VerboseValue("+ Jpeg2000:$$tagInfo{Name}", $val);
901             }
902             }
903             # add UUID boxes (and/or JXL Exif/XML boxes)
904 2         11 foreach $dirName (sort keys %$addDirs) {
905             # handle JPEG XL XMP and EXIF
906 13 100 100     35 if ($dirName eq 'xml ' or $dirName eq 'Exif') {
907 2 100       8 my ($tag, $dir) = $dirName eq 'xml ' ? ('xml ', 'XMP') : ('Exif', 'EXIF');
908 2         5 my $tagInfo = $Image::ExifTool::Jpeg2000::Main{$tag};
909 2 100       6 $tagInfo = $$tagInfo[1] if ref $tagInfo eq 'ARRAY'; # (hack for stupid JXL XMP)
910 2         3 my $subdir = $$tagInfo{SubDirectory};
911 2         7 my $tagTable = GetTagTable($$subdir{TagTable});
912 2 100       6 $tagTable = GetTagTable('Image::ExifTool::XMP::Main') if $dir eq 'XMP';
913 2         6 my %dirInfo = (
914             DirName => $dir,
915             Parent => $tag,
916             );
917 2         8 my $compress = $et->Options('Compress');
918 2 50 33     9 $dirInfo{Compact} = 1 if $$et{IsJXL} and $compress;
919 2         18 my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
920 2 50 33     7 if (defined $newdir and length $newdir) {
921             # not sure why, but EXIF box is padded with leading 0's in my sample
922 2 100       5 my $pad = $dirName eq 'Exif' ? "\0\0\0\0" : '';
923 2 50 33     9 if ($$et{IsJXL} and $compress) {
924             # create as Brotli-compressed metadata
925 0 0       0 if (eval { require IO::Compress::Brotli }) {
  0         0  
926 0         0 my $compressed;
927 0         0 eval { $compressed = IO::Compress::Brotli::bro($pad . $newdir) };
  0         0  
928 0 0 0     0 if ($@ or not $compressed) {
929 0         0 BrotliWarn($et, $dirName);
930             } else {
931 0         0 $et->VPrint(0, " Writing Brotli-compressed $dir\n");
932 0         0 $newdir = $compressed;
933 0         0 $pad = $tag;
934 0         0 $tag = 'brob';
935             }
936             } else {
937 0         0 $et->Warn('Install IO::Compress::Brotli to create Brotli-compressed metadata');
938             }
939             }
940 2         7 my $boxhdr = pack('N', length($newdir) + length($pad) + 8) . $tag;
941 2 50       5 Write($outfile, $boxhdr, $pad, $newdir) or return 0;
942 2         7 next;
943             }
944             }
945 11 100       19 next unless $uuid{$dirName};
946 2         3 my $tagInfo;
947 2         2 foreach $tagInfo (@{$Image::ExifTool::Jpeg2000::Main{uuid}}) {
  2         5  
948 10 100       18 next unless $$tagInfo{Name} eq $dirName;
949 2         2 my $subdir = $$tagInfo{SubDirectory};
950 2         9 my $tagTable = GetTagTable($$subdir{TagTable});
951             my %dirInfo = (
952 2   33     13 DirName => $$subdir{DirName} || $dirName,
953             Parent => 'JP2',
954             );
955             # remove "UUID-" from start of directory name to allow appropriate
956             # directories to be written as a block
957 2         9 $dirInfo{DirName} =~ s/^UUID-//;
958 2         10 my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
959 2 50 33     9 if (defined $newdir and length $newdir) {
960 2         8 my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName};
961 2 50       7 Write($outfile, $boxhdr, $newdir) or return 0;
962 2         7 last;
963             }
964             }
965             }
966 2         13 return 1;
967             }
968              
969             #------------------------------------------------------------------------------
970             # Create Color Specification Box
971             # Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
972             # Returns: 1 on success
973             sub CreateColorSpec($$)
974             {
975 1     1 0 3 my ($et, $outfile) = @_;
976 1         4 my $meth = $et->GetNewValue('Jpeg2000:ColorSpecMethod');
977 1   50     22 my $prec = $et->GetNewValue('Jpeg2000:ColorSpecPrecedence') || 0;
978 1   50     4 my $approx = $et->GetNewValue('Jpeg2000:ColorSpecApproximation') || 0;
979 1         3 my $icc = $et->GetNewValue('ICC_Profile');
980 1         3 my $space = $et->GetNewValue('Jpeg2000:ColorSpace');
981 1         4 my $cdata = $et->GetNewValue('Jpeg2000:ColorSpecData');
982 1 50       5 unless ($meth) {
983 1 50       12 if ($icc) {
    50          
    0          
984 0         0 $meth = 2;
985             } elsif (defined $space) {
986 1         5 $meth = 1;
987             } elsif (defined $cdata) {
988 0         0 $meth = 4;
989             } else {
990 0         0 $et->Warn('Color space not defined'), return 0;
991             }
992             }
993 1 50 0     7 if ($meth eq '1') {
    0          
    0          
994 1 50       5 defined $space or $et->Warn('Must specify ColorSpace'), return 0;
995 1         6 $cdata = pack('N', $space);
996             } elsif ($meth eq '2' or $meth eq '3') {
997 0 0       0 defined $icc or $et->Warn('Must specify ICC_Profile'), return 0;
998 0         0 $cdata = $icc;
999             } elsif ($meth eq '4') {
1000 0 0       0 defined $cdata or $et->Warn('Must specify ColorSpecData'), return 0;
1001             } else {
1002 0         0 $et->Warn('Unknown ColorSpecMethod'), return 0;
1003             }
1004 1         19 my $boxhdr = pack('N', length($cdata) + 11) . 'colr';
1005 1 50       13 Write($outfile, $boxhdr, pack('CCC',$meth,$prec,$approx), $cdata) or return 0;
1006 1         5 ++$$et{CHANGED};
1007 1         6 $et->VPrint(1, " + Jpeg2000:ColorSpec\n");
1008 1         9 return 1;
1009             }
1010              
1011             #------------------------------------------------------------------------------
1012             # Process JPEG 2000 box
1013             # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table
1014             # Returns: 1 on success when reading, or -1 on write error
1015             # (or JP2 box or undef when writing from buffer)
1016             sub ProcessJpeg2000Box($$$)
1017             {
1018 152     152 0 269 my ($et, $dirInfo, $tagTablePtr) = @_;
1019 152         261 my $dataPt = $$dirInfo{DataPt};
1020 152         233 my $dataLen = $$dirInfo{DataLen};
1021 152   100     372 my $dataPos = $$dirInfo{DataPos} || 0;
1022 152   100     323 my $dirLen = $$dirInfo{DirLen} || 0;
1023 152   100     331 my $dirStart = $$dirInfo{DirStart} || 0;
1024 152   100     295 my $base = $$dirInfo{Base} || 0;
1025 152         206 my $outfile = $$dirInfo{OutFile};
1026 152   100     310 my $dirName = $$dirInfo{DirName} || '';
1027 152         220 my $dirEnd = $dirStart + $dirLen;
1028 152         215 my ($err, $outBuff, $verbose, $doColour, $hash, $raf);
1029              
1030 152 100       243 if ($dataPt) {
1031             # save C2PA JUMBF as a block if requested
1032 144 50 66     387 if ($dirName eq 'JUMBF' and $$et{REQ_TAG_LOOKUP}{jumbf} and not $$dirInfo{NoBlockSave}) {
      33        
1033 0 0 0     0 if ($dirStart or $dirLen ne length($$dataPt)) {
1034 0         0 my $dat = substr($$dataPt, $dirStart, $dirLen);
1035 0         0 $et->FoundTag(JUMBF => \$dat);
1036             } else {
1037 0         0 $et->FoundTag(JUMBF => $dataPt);
1038             }
1039             }
1040             } else {
1041 8         14 $raf = $$dirInfo{RAF}; # read from RAF
1042             }
1043              
1044 152 100       264 if ($outfile) {
1045 3 100       8 unless ($raf) {
1046             # buffer output to be used for return value
1047 1         4 $outBuff = '';
1048 1         2 $outfile = \$outBuff;
1049             }
1050             # determine if we will be writing colr box
1051 3 100       22 if ($dirName eq 'JP2Header') {
1052 1 0 33     6 $doColour = 2 if defined $et->GetNewValue('ColorSpecMethod') or $et->GetNewValue('ICC_Profile') or
      33        
      33        
      33        
      0        
1053             defined $et->GetNewValue('ColorSpecPrecedence') or defined $et->GetNewValue('ColorSpace') or
1054             defined $et->GetNewValue('ColorSpecApproximation') or defined $et->GetNewValue('ColorSpecData');
1055             }
1056             } else {
1057             # (must not set verbose flag when writing!)
1058 149         294 $verbose = $$et{OPTIONS}{Verbose};
1059 149 50       289 $et->VerboseDir($dirName) if $verbose;
1060             # do hash if requested, but only for top-level image data
1061 149 100       275 $hash = $$et{ImageDataHash} if $raf;
1062             }
1063             # loop through all contained boxes
1064 152         212 my ($pos, $boxLen, $lastBox);
1065 152         205 for ($pos=$dirStart; ; $pos+=$boxLen) {
1066 498         652 my ($boxID, $buff, $valuePtr);
1067 498         593 my $hdrLen = 8; # the box header length
1068 498 100       956 if ($raf) {
    100          
1069 45         112 $dataPos = $raf->Tell() - $base;
1070 45         123 my $n = $raf->Read($buff,$hdrLen);
1071 45 100       78 unless ($n == $hdrLen) {
1072 7 50       20 $n and $err = '', last;
1073 7 100 33     23 CreateNewBoxes($et, $outfile) or $err = 1 if $outfile;
1074 7         19 last;
1075             }
1076 38         63 $dataPt = \$buff;
1077 38         43 $dirLen = $dirEnd = $hdrLen;
1078 38         52 $pos = 0;
1079             } elsif ($pos >= $dirEnd - $hdrLen) {
1080 145 50       246 $err = '' unless $pos == $dirEnd;
1081 145         241 last;
1082             }
1083 346         768 $boxLen = unpack("x$pos N",$$dataPt); # (length includes header and data)
1084 346         699 $boxID = substr($$dataPt, $pos+4, 4);
1085             # (ftbl box contains flst boxes with absolute file offsets, not currently handled)
1086 346 50 66     684 if ($outfile and $boxID eq 'ftbl') {
1087 0         0 $et->Error("Can't yet handle fragmented JPX files");
1088 0         0 return -1;
1089             }
1090             # remove old colr boxes if necessary
1091 346 100 100     671 if ($doColour and $boxID eq 'colr') {
1092 1 50       5 if ($doColour == 1) { # did we successfully write the new colr box?
1093 1         5 $et->VPrint(1," - Jpeg2000:ColorSpec\n");
1094 1         2 ++$$et{CHANGED};
1095 1         4 next;
1096             }
1097 0         0 $et->Warn('Out-of-order colr box encountered');
1098 0         0 undef $doColour;
1099             }
1100 345         413 $lastBox = $boxID;
1101 345         428 $pos += $hdrLen; # move to end of box header
1102 345 50       718 if ($boxLen == 1) {
    50          
1103             # box header contains an additional 8-byte integer for length
1104 0         0 $hdrLen += 8;
1105 0 0       0 if ($raf) {
1106 0         0 my $buf2;
1107 0 0       0 if ($raf->Read($buf2,8) == 8) {
1108 0         0 $buff .= $buf2;
1109 0         0 $dirLen = $dirEnd = $hdrLen;
1110             }
1111             }
1112 0 0       0 $pos > $dirEnd - 8 and $err = '', last;
1113 0         0 my ($hi, $lo) = unpack("x$pos N2",$$dataPt);
1114 0 0       0 $hi and $err = "Can't currently handle JPEG 2000 boxes > 4 GB", last;
1115 0         0 $pos += 8; # move to end of extended-length box header
1116 0         0 $boxLen = $lo - $hdrLen; # length of remaining box data
1117             } elsif ($boxLen == 0) {
1118 0 0       0 if ($raf) {
1119 0 0       0 if ($outfile) {
1120 0 0       0 CreateNewBoxes($et, $outfile) or $err = 1;
1121             # copy over the rest of the file
1122 0 0       0 Write($outfile, $$dataPt) or $err = 1;
1123 0         0 while ($raf->Read($buff, 65536)) {
1124 0 0       0 Write($outfile, $buff) or $err = 1;
1125             }
1126             } else {
1127 0 0       0 if ($verbose) {
1128 0         0 my $msg = sprintf("offset 0x%.4x to end of file", $dataPos + $base + $pos);
1129 0         0 $et->VPrint(0, "$$et{INDENT}- Tag '${boxID}' ($msg)\n");
1130             }
1131 0 0 0     0 if ($hash and $isImageData{$boxID}) {
1132 0         0 $et->ImageDataHash($raf, undef, $boxID);
1133             }
1134             }
1135 0         0 last; # (ignore the rest of the file when reading)
1136             }
1137 0         0 $boxLen = $dirEnd - $pos; # data runs to end of file
1138             } else {
1139 345         443 $boxLen -= $hdrLen; # length of remaining box data
1140             }
1141 345 50       610 $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
1142 345         801 my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
1143 345 50 33     722 unless (defined $tagInfo or $verbose) {
1144             # no need to process this box
1145 0 0       0 if ($raf) {
    0          
1146 0 0 0     0 if ($outfile) {
    0          
1147 0 0       0 Write($outfile, $$dataPt) or $err = 1;
1148 0 0       0 $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
1149 0 0       0 Write($outfile, $buff) or $err = 1;
1150             } elsif ($hash and $isImageData{$boxID}) {
1151 0         0 $et->ImageDataHash($raf, $boxLen, $boxID);
1152             } else {
1153 0 0       0 $raf->Seek($boxLen, 1) or $err = 'Seek error', last;
1154             }
1155             } elsif ($outfile) {
1156 0 0       0 Write($outfile, substr($$dataPt, $pos-$hdrLen, $boxLen+$hdrLen)) or $err = '', last;
1157             }
1158 0         0 next;
1159             }
1160 345 100       697 if ($raf) {
    50          
1161             # read the box data
1162 38         71 $dataPos = $raf->Tell() - $base;
1163 38 50       67 $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
1164 38 0 33     63 if ($hash and $isImageData{$boxID}) {
1165 0         0 $hash->add($buff);
1166 0         0 $et->VPrint(0, "$$et{INDENT}(ImageDataHash: $boxLen bytes of $boxID data)\n");
1167             }
1168 38         41 $valuePtr = 0;
1169 38         50 $dataLen = $boxLen;
1170             } elsif ($pos + $boxLen > $dirEnd) {
1171 0         0 $err = '';
1172 0         0 last;
1173             } else {
1174 307         381 $valuePtr = $pos;
1175             }
1176 345 100 66     955 if (defined $tagInfo and not $tagInfo) {
1177             # GetTagInfo() required the value for a Condition
1178 12 100       31 my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128);
1179 12         31 $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
1180             }
1181             # delete all UUID boxes and any writable box if deleting all information
1182 345 100 66     614 if ($outfile and $tagInfo) {
1183 9 50 66     39 if ($boxID eq 'uuid' and $$et{DEL_GROUP}{'*'}) {
    100          
1184 0         0 $et->VPrint(0, " Deleting $$tagInfo{Name}\n");
1185 0         0 ++$$et{CHANGED};
1186 0         0 next;
1187             } elsif ($$tagInfo{Writable}) {
1188 2         3 my $isOverwriting;
1189 2 50       6 if ($$et{DEL_GROUP}{Jpeg2000}) {
1190 0         0 $isOverwriting = 1;
1191             } else {
1192 2         6 my $nvHash = $et->GetNewValueHash($tagInfo);
1193 2         7 $isOverwriting = $et->IsOverwriting($nvHash);
1194             }
1195 2 50       4 if ($isOverwriting) {
    0          
1196 2         6 my $val = substr($$dataPt, $valuePtr, $boxLen);
1197 2         9 $et->VerboseValue("- Jpeg2000:$$tagInfo{Name}", $val);
1198 2         3 ++$$et{CHANGED};
1199 2         6 next;
1200             } elsif (not $$tagInfo{List}) {
1201 0         0 delete $$et{AddJp2Tags}{$boxID};
1202             }
1203             }
1204             }
1205             # create new tag for JUMBF data values with name corresponding to JUMBFLabel
1206 343 100 66     1444 if ($tagInfo and $$et{JUMBFLabel} and (not $$tagInfo{SubDirectory} or $$tagInfo{BlockExtract})) {
      66        
      100        
1207 60   50     608 $tagInfo = { %$tagInfo, Name => $$et{JUMBFLabel} . ($$tagInfo{JUMBF_Suffix} || '') };
1208 60         227 ($$tagInfo{Description} = Image::ExifTool::MakeDescription($$tagInfo{Name})) =~ s/C2 PA/C2PA/;
1209 60         229 AddTagToTable($tagTablePtr, '_JUMBF_' . $$et{JUMBFLabel}, $tagInfo);
1210 60         117 delete $$tagInfo{Protected}; # (must do this so -j -b returns JUMBF binary data)
1211 60         95 $$tagInfo{TagID} = $boxID;
1212             }
1213 343 50       512 if ($verbose) {
1214 0         0 $et->VerboseInfo($boxID, $tagInfo,
1215             Table => $tagTablePtr,
1216             DataPt => $dataPt,
1217             Size => $boxLen,
1218             Start => $valuePtr,
1219             Addr => $valuePtr + $dataPos + $base,
1220             );
1221 0 0       0 next unless $tagInfo;
1222             }
1223 343 100 66     598 if ($$tagInfo{SubDirectory}) {
    100          
    100          
1224 337         450 my $subdir = $$tagInfo{SubDirectory};
1225 337         382 my $subdirStart = $valuePtr;
1226 337         429 my $subdirLen = $boxLen;
1227 337 100       595 if (defined $$subdir{Start}) {
1228             #### eval Start ($valuePtr, $dataPt)
1229 11         519 $subdirStart = eval($$subdir{Start});
1230 11         46 $subdirLen -= $subdirStart - $valuePtr;
1231 11 50       29 if ($subdirLen < 0) {
1232 0         0 $subdirStart = $valuePtr;
1233 0         0 $subdirLen = 0;
1234             }
1235             }
1236             my %subdirInfo = (
1237             Parent => 'JP2',
1238             DataPt => $dataPt,
1239             DataPos => -$subdirStart, # (relative to Base)
1240             DataLen => $dataLen,
1241             DirStart => $subdirStart,
1242             DirLen => $subdirLen,
1243             DirName => $$subdir{DirName} || $$tagInfo{Name},
1244 337   66     2373 OutFile => $outfile,
1245             Base => $base + $dataPos + $subdirStart,
1246             );
1247 337         649 my $uuid = $uuid{$$tagInfo{Name}};
1248             # remove "UUID-" prefix to allow appropriate directories to be written as a block
1249 337         591 $subdirInfo{DirName} =~ s/^UUID-//;
1250 337   66     757 my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
1251 337 100       523 if ($outfile) {
1252             # (special case for brob box, which may be EXIF or XMP)
1253 6         11 my $fakeID = $boxID;
1254 6 50       15 if ($boxID eq 'brob') {
1255             # I have seen 'brob' ID's with funny cases, so standardize these
1256 0 0       0 $fakeID = 'xml ' if $$dataPt =~ /^xml /i;
1257 0 0       0 $fakeID = 'Exif' if $$dataPt =~ /^Exif/i;
1258             }
1259 6         10 my $newdir;
1260             # only edit writable UUID, Exif and jp2h boxes
1261 6 100 66     55 if ($uuid or $fakeID eq 'Exif' or ($fakeID eq 'xml ' and $$et{IsJXL}) or
    50 33        
      66        
      66        
      66        
1262             ($boxID eq 'jp2h' and $$et{EDIT_DIRS}{jp2h}))
1263             {
1264 2         6 my $compress = $et->Options('Compress');
1265 2         4 $subdirInfo{Parent} = $fakeID;
1266 2 0 33     5 $subdirInfo{Compact} = 1 if $compress and $$et{IsJXL};
1267 2         9 $newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
1268 2 50 33     20 next if defined $newdir and not length $newdir; # next if deleting the box
1269             # compress JXL EXIF or XMP metadata if requested
1270 2 0 33     13 if (defined $newdir and $$et{IsJXL} and defined $compress and
      33        
      0        
      33        
1271             ($fakeID eq 'Exif' or $fakeID eq 'xml '))
1272             {
1273 0 0 0     0 if ($compress and $boxID ne 'brob') {
    0 0        
1274             # rewrite as a Brotli-compressed 'brob' box
1275 0 0       0 if (eval { require IO::Compress::Brotli }) {
  0         0  
1276 0 0       0 my $pad = $boxID eq 'Exif' ? "\0\0\0\0" : '';
1277 0         0 my $compressed;
1278 0         0 eval { $compressed = IO::Compress::Brotli::bro($pad . $newdir) };
  0         0  
1279 0 0 0     0 if ($@ or not $compressed) {
1280 0         0 BrotliWarn($et, $boxID);
1281             } else {
1282 0         0 $et->VPrint(0, " Writing Brotli-compressed $boxID\n");
1283 0         0 $newdir = $boxID . $compressed;
1284 0         0 $boxID = 'brob';
1285 0         0 $subdirStart = $valuePtr = 0;
1286 0         0 ++$$et{CHANGED};
1287             }
1288             } else {
1289 0         0 $et->Warn('Install IO::Compress::Brotli to write Brotli-compressed metadata');
1290             }
1291             } elsif (not $compress and $boxID eq 'brob') {
1292             # (in this case, ProcessBrotli has returned uncompressed data,
1293             # so change to the uncompressed 'xml ' or 'Exif' box type)
1294 0         0 $et->VPrint(0, " Writing uncompressed $fakeID\n");
1295 0         0 $boxID = $fakeID;
1296 0         0 $subdirStart = $valuePtr = 0;
1297 0         0 ++$$et{CHANGED};
1298             }
1299             }
1300             } elsif (defined $uuid) {
1301 0         0 $et->Warn("Not editing $$tagInfo{Name} box", 1);
1302             }
1303             # remove this directory from our create list
1304 6         15 delete $$et{AddJp2Dirs}{$fakeID}; # (eg. 'Exif' or 'xml ')
1305 6 50       11 if ($boxID eq 'brob') {
1306             # (can't make tag Name 'XMP' or 'Exif' for Brotli-compressed tags because it
1307             # would break the logic in WriteDirectory(), so we do a lookup here instead)
1308 0         0 delete $$et{AddJp2Dirs}{{'xml '=>'XMP','Exif'=>'EXIF'}->{$fakeID}};
1309             } else {
1310 6         18 delete $$et{AddJp2Dirs}{$$tagInfo{Name}}; # (eg. 'EXIF' or 'XMP')
1311             }
1312             # use old box data if not changed
1313 6 100       18 defined $newdir or $newdir = substr($$dataPt, $subdirStart, $subdirLen);
1314 6         10 my $prefixLen = $subdirStart - $valuePtr;
1315 6         24 my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID;
1316 6 100       16 $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
1317 6 50       18 Write($outfile, $boxhdr, $newdir) or $err = 1;
1318             # write new colr box immediately after ihdr
1319 6 100 66     28 if ($doColour and $boxID eq 'ihdr') {
1320             # (shouldn't be multiple ihdr boxes, but just in case, write only 1)
1321 1 50       6 $doColour = $doColour==2 ? CreateColorSpec($et, $outfile) : 0;
1322             }
1323             } else {
1324             # extract as a block if specified
1325 331 100       606 $subdirInfo{BlockInfo} = $tagInfo if $$tagInfo{BlockExtract};
1326 331 50 66     646 $et->Warn("Reading non-standard $$tagInfo{Name} box") if defined $uuid and $uuid eq '0';
1327 331 50       1061 unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
1328 0 0       0 if ($subTable eq $tagTablePtr) {
1329 0         0 $err = 'JPEG 2000 format error';
1330 0         0 last;
1331             }
1332 0         0 $et->Warn("Unrecognized $$tagInfo{Name} box");
1333             }
1334             }
1335             } elsif ($$tagInfo{Format} and not $outfile) {
1336             # only save tag values if Format was specified
1337 2         2 my $rational;
1338 2         8 my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen, \$rational);
1339 2 50       5 if (defined $val) {
1340 2         5 my $key = $et->FoundTag($tagInfo, $val);
1341             # save Rational value
1342 2 50 33     8 $$et{TAG_EXTRA}{$key}{Rational} = $rational if defined $rational and defined $key;
1343             }
1344             } elsif ($outfile) {
1345 1         4 my $boxhdr = pack('N', $boxLen + 8) . $boxID;
1346 1 50       5 Write($outfile, $boxhdr, substr($$dataPt, $valuePtr, $boxLen)) or $err = 1;
1347             }
1348             }
1349 152 50       257 if (defined $err) {
1350 0 0       0 $err or $err = 'Truncated JPEG 2000 box';
1351 0 0       0 if ($outfile) {
1352 0 0       0 $et->Error($err) unless $err eq '1';
1353 0 0       0 return $raf ? -1 : undef;
1354             }
1355 0         0 $et->Warn($err);
1356             }
1357 152 100 100     352 return $outBuff if $outfile and not $raf;
1358 151         322 return 1;
1359             }
1360              
1361             #------------------------------------------------------------------------------
1362             # Return bits from a bitstream object
1363             # Inputs: 0) array ref, 1) number of bits
1364             # Returns: specified number of bits as an integer, and shifts input bitstream
1365             sub GetBits($$)
1366             {
1367 18     18 0 23 my ($a, $n) = @_;
1368 18         16 my $v = 0;
1369 18         17 my $bit = 1;
1370 18         17 my $i;
1371 18         25 while ($n--) {
1372 78         105 for ($i=0; $i<@$a; ++$i) {
1373             # consume bits LSB first
1374 936         927 my $set = $$a[$i] & 1;
1375 936         853 $$a[$i] >>= 1;
1376 936 100       958 if ($i) {
1377 858 100       1243 $$a[$i-1] |= 0x80 if $set;
1378             } else {
1379 78 100       108 $v |= $bit if $set;
1380 78         90 $bit <<= 1;
1381             }
1382             }
1383             }
1384 18         35 return $v;
1385             }
1386              
1387             #------------------------------------------------------------------------------
1388             # Read/write Brotli-encoded metadata
1389             # Inputs: 0) ExifTool ref, 1) dirInfoRef, 2) tag table ref
1390             # Returns: 1 on success when reading, or new data when writing (undef if unchanged)
1391             # (ref https://libjxl.readthedocs.io/en/latest/api_decoder.html)
1392             sub ProcessBrotli($$$)
1393             {
1394 2     2 0 4 my ($et, $dirInfo, $tagTablePtr) = @_;
1395 2         5 my $dataPt = $$dirInfo{DataPt};
1396              
1397 2 50       5 return 0 unless length($$dataPt) > 4;
1398              
1399 2         4 my $isWriting = $$dirInfo{IsWriting};
1400 2         5 my $type = substr($$dataPt, 0, 4);
1401 2 50       11 $et->VerboseDir("Decrypted Brotli '${type}'") unless $isWriting;
1402 2         8 my %knownType = ( exif => 'Exif', 'xml ' => 'xml ', jumb => 'jumb' );
1403 2         5 my $stdType = $knownType{lc $type};
1404 2 50       4 unless ($stdType) {
1405 0         0 $et->Warn('Unknown Brotli box type', 1);
1406 0         0 return 1;
1407             }
1408 2 50       5 if ($type ne $stdType) {
1409 0         0 $et->Warn("Incorrect case for Brotli '${type}' data (should be '${stdType}')");
1410 0         0 $type = $stdType;
1411             }
1412 2 50       3 if (eval { require IO::Uncompress::Brotli }) {
  2         13  
1413 2 50 33     5 if ($isWriting and not eval { require IO::Compress::Brotli }) {
  0         0  
1414 0         0 $et->Warn('Install IO::Compress::Brotli to write Brotli-compressed metadata');
1415 0         0 return undef;
1416             }
1417 2         6 my $compress = $et->Options('Compress');
1418 2 50       5 my $verbose = $isWriting ? 0 : $et->Options('Verbose');
1419 2         31 my $dat = substr($$dataPt, 4);
1420 2         5 eval { $dat = IO::Uncompress::Brotli::unbro($dat, 100000000) };
  2         6  
1421 2 50       622 $@ and BrotliWarn($et, $type, 1), return 1;
1422 2 50       5 $verbose > 2 and $et->VerboseDump(\$dat, Prefix => $$et{INDENT} . ' ');
1423 2         7 my %dirInfo = ( DataPt => \$dat );
1424 2 100       6 if ($type eq 'xml ') {
    50          
    0          
1425 1         3 $dirInfo{DirName} = 'XMP'; # (necessary for block read/write)
1426 1         6 require Image::ExifTool::XMP;
1427 1 50       4 if ($isWriting) {
1428 0 0       0 $dirInfo{Compact} = 1 if $compress; # (no need to add padding if writing compressed)
1429 0         0 $dat = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
1430             } else {
1431 1         7 Image::ExifTool::XMP::ProcessXMP($et, \%dirInfo, $tagTablePtr);
1432             }
1433             } elsif ($type eq 'Exif') {
1434 1         3 $dirInfo{DirName} = 'EXIF'; # (necessary for block read/write)
1435 1 50       4 $dirInfo{DirStart} = 4 + (length($dat) > 4 ? unpack("N", $dat) : 0);
1436 1 50       5 if ($dirInfo{DirStart} > length $dat) {
    50          
1437 0         0 $et->Warn("Corrupted Brotli '${type}' data");
1438             } elsif ($isWriting) {
1439 0         0 $dat = $et->WriteDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::WriteTIFF);
1440             # add back header word
1441 0 0 0     0 $dat = "\0\0\0\0" . $dat if defined $dat and length $dat;
1442             } else {
1443 1         11 $et->ProcessTIFF(\%dirInfo, $tagTablePtr);
1444             }
1445             } elsif ($type eq 'jumb') {
1446 0 0       0 return undef if $isWriting; # (can't yet write JUMBF)
1447 0         0 Image::ExifTool::Jpeg2000::ProcessJUMB($et, \%dirInfo, $tagTablePtr); # (untested)
1448             }
1449 2 50       8 if ($isWriting) {
1450 0 0       0 return undef unless defined $dat;
1451             # rewrite as uncompressed if Compress option is set to 0 (or '')
1452 0 0 0     0 return $dat if defined $compress and not $compress;
1453 0         0 eval { $dat = IO::Compress::Brotli::bro($dat) };
  0         0  
1454 0 0       0 $@ and BrotliWarn($et, $type), return undef;
1455 0         0 $et->VPrint(0, " Writing Brotli-compressed $type\n");
1456 0         0 return $type . $dat;
1457             }
1458             } else {
1459 0         0 $et->Warn('Install IO::Uncompress::Brotli to decode Brotli-compressed metadata');
1460 0 0       0 return undef if $isWriting;
1461             }
1462 2         5 return 1;
1463             }
1464              
1465             #------------------------------------------------------------------------------
1466             # Extract parameters from JPEG XL codestream [unverified!]
1467             # Inputs: 0) ExifTool ref, 1) codestream ref
1468             # Returns: 1 on success
1469             sub ProcessJXLCodestream($$)
1470             {
1471 3     3 0 7 my ($et, $dataPt) = @_;
1472              
1473 3 50       21 return 0 unless $$dataPt =~ /^(\0\0\0\0)?\xff\x0a/; # validate codestream
1474             # ignore if already extracted (ie. subsequent jxlp boxes)
1475 3 50       9 return 0 if $$et{ProcessedJXLCodestream};
1476 3         6 $$et{ProcessedJXLCodestream} = 1;
1477             # work with first 64 bytes of codestream data
1478             # (and add padding if necessary to avoid unpacking past end of data)
1479 3         5 my $dat;
1480 3 50       10 if (length $$dataPt > 64) {
    100          
1481 0         0 $dat = substr($$dataPt, 0, 64);
1482             } elsif (length $$dataPt < 18) {
1483 1         2 $dat = $$dataPt . ("\0" x 18); # (so we'll have a minimum 14 bytes to work with)
1484             } else {
1485 2         4 $dat = $$dataPt;
1486             }
1487 3         8 $dat =~ s/^\0\0\0\0//; # remove jxlp header word
1488 3         15 my @a = unpack 'x2C12', $dat;
1489 3         4 my ($x, $y);
1490 3         10 my $small = GetBits(\@a, 1);
1491 3 50       7 if ($small) {
1492 0         0 $y = (GetBits(\@a, 5) + 1) * 8;
1493             } else {
1494 3         15 $y = GetBits(\@a, [9, 13, 18, 30]->[GetBits(\@a, 2)]) + 1;
1495             }
1496 3         9 my $ratio = GetBits(\@a, 3);
1497 3 50       8 if ($ratio == 0) {
1498 3 50       6 if ($small) {
1499 0         0 $x = (GetBits(\@a, 5) + 1) * 8;;
1500             } else {
1501 3         9 $x = GetBits(\@a, [9, 13, 18, 30]->[GetBits(\@a, 2)]) + 1;
1502             }
1503             } else {
1504 0         0 my $r = [[1,1],[12,10],[4,3],[3,2],[16,9],[5,4],[2,1]]->[$ratio-1];
1505 0         0 $x = int($y * $$r[0] / $$r[1]);
1506             }
1507 3         23 $et->FoundTag(ImageWidth => $x);
1508 3         8 $et->FoundTag(ImageHeight => $y);
1509 3         45 return 1;
1510             }
1511              
1512             #------------------------------------------------------------------------------
1513             # Read/write meta information from a C2PA/JUMBF file
1514             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
1515             # Returns: 1 on success, 0 if this wasn't a valid JUMBF file
1516             sub ProcessJUMBF($$)
1517             {
1518 0     0 0 0 my ($et, $dirInfo) = @_;
1519 0         0 my $raf = $$dirInfo{RAF};
1520 0         0 my $hdr;
1521              
1522             # check to be sure this is a valid JPG2000 file
1523 0 0 0     0 return 0 unless $raf->Read($hdr,20) == 20 and $raf->Seek(0,0);
1524 0 0       0 return 0 unless $hdr =~ /^.{4}jumb\0.{3}jumd(.{4})/;
1525 0 0       0 $et->SetFileType($1 eq 'c2pa' ? 'C2PA' : 'JUMBF');
1526 0         0 my %dirInfo = (
1527             RAF => $raf,
1528             DirName => 'JUMBF',
1529             );
1530 0         0 my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
1531 0         0 return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
1532             }
1533              
1534             #------------------------------------------------------------------------------
1535             # Read/write meta information from a JPEG 2000 image
1536             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
1537             # Returns: 1 on success, 0 if this wasn't a valid JPEG 2000 file, or -1 on write error
1538             sub ProcessJP2($$)
1539             {
1540 8     8 0 26 local $_;
1541 8         16 my ($et, $dirInfo) = @_;
1542 8         17 my $raf = $$dirInfo{RAF};
1543 8         14 my $outfile = $$dirInfo{OutFile};
1544 8         10 my $hdr;
1545              
1546             # check to be sure this is a valid JPG2000 file
1547 8 50       23 return 0 unless $raf->Read($hdr,12) == 12;
1548 8 100 66     54 unless ($hdr eq "\0\0\0\x0cjP \x0d\x0a\x87\x0a" or # (ref 1)
      100        
1549             $hdr eq "\0\0\0\x0cjP\x1a\x1a\x0d\x0a\x87\x0a" or # (ref 2)
1550             $$et{IsJXL})
1551             {
1552 1 50       3 return 0 unless $hdr =~ /^\xff\x4f\xff\x51\0/; # check for JP2 codestream format
1553 1 50       4 if ($outfile) {
1554 0         0 $et->Error('Writing of J2C files is not yet supported');
1555 0         0 return 0
1556             }
1557             # add J2C markers if not done already
1558 1 50       5 unless ($Image::ExifTool::jpegMarker{0x4f}) {
1559 1         35 $Image::ExifTool::jpegMarker{$_} = $j2cMarker{$_} foreach keys %j2cMarker;
1560             }
1561 1         6 $et->SetFileType('J2C');
1562 1         4 $raf->Seek(0,0);
1563 1         7 return $et->ProcessJPEG($dirInfo); # decode with JPEG processor
1564             }
1565 7 100       17 if ($outfile) {
1566 2 50       12 Write($outfile, $hdr) or return -1;
1567 2 100       8 if ($$et{IsJXL}) {
1568 1         4 $et->InitWriteDirs(\%jxlMap);
1569 1         4 $$et{AddJp2Tags} = { }; # (don't add JP2 tags in JXL files)
1570             } else {
1571 1         6 $et->InitWriteDirs(\%jp2Map);
1572 1         4 $$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main);
1573             }
1574             # save list of directories to create
1575 2         4 my %addDirs = %{$$et{ADD_DIRS}}; # (make a copy)
  2         24  
1576 2         9 $$et{AddJp2Dirs} = \%addDirs;
1577             } else {
1578 5         9 my ($buff, $fileType);
1579             # recognize JPX and JPM as unique types of JP2
1580 5 50 33     13 if ($raf->Read($buff, 12) == 12 and $buff =~ /^.{4}ftyp(.{4})/s) {
1581 5 50       26 $fileType = 'JPX' if $1 eq 'jpx ';
1582 5 50       12 $fileType = 'JPM' if $1 eq 'jpm ';
1583 5 100       12 $fileType = 'JXL' if $1 eq 'jxl ';
1584 5 50       14 $fileType = 'JPH' if $1 eq 'jph ';
1585             }
1586 5 50       18 $raf->Seek(-length($buff), 1) if defined $buff;
1587 5         22 $et->SetFileType($fileType);
1588             }
1589 7         30 SetByteOrder('MM'); # JPEG 2000 files are big-endian
1590             my %dirInfo = (
1591             RAF => $raf,
1592             DirName => 'JP2',
1593             OutFile => $$dirInfo{OutFile},
1594 7         32 );
1595 7         16 my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
1596 7         34 return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
1597             }
1598              
1599             #------------------------------------------------------------------------------
1600             # Read/write meta information in a JPEG XL image
1601             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
1602             # Returns: 1 on success, 0 if this wasn't a valid JPEG XL file, -1 on write error
1603             sub ProcessJXL($$)
1604             {
1605 4     4 0 8 my ($et, $dirInfo) = @_;
1606 4         8 my $raf = $$dirInfo{RAF};
1607 4         8 my $outfile = $$dirInfo{OutFile};
1608 4         6 my ($hdr, $buff);
1609              
1610 4 50       12 return 0 unless $raf->Read($hdr,12) == 12;
1611 4 100       13 if ($hdr eq "\0\0\0\x0cJXL \x0d\x0a\x87\x0a") {
    50          
1612             # JPEG XL in ISO BMFF container
1613 2         6 $$et{IsJXL} = 1;
1614             } elsif ($hdr =~ /^\xff\x0a/) {
1615             # JPEG XL codestream
1616 2 100       5 if ($outfile) {
1617 1 50       5 if ($$et{OPTIONS}{IgnoreMinorErrors}) {
1618 1         23 $et->Warn('Wrapped JXL codestream in ISO BMFF container');
1619             } else {
1620 0         0 $et->Error('Will wrap JXL codestream in ISO BMFF container for writing',1);
1621 0         0 return 0;
1622             }
1623 1         2 $$et{IsJXL} = 2;
1624 1         4 my $buff = "\0\0\0\x0cJXL \x0d\x0a\x87\x0a\0\0\0\x14ftypjxl \0\0\0\0jxl ";
1625             # add metadata to empty ISO BMFF container
1626 1         4 $$dirInfo{RAF} = File::RandomAccess->new(\$buff);
1627             } else {
1628 1         29 $et->SetFileType('JXL Codestream','image/jxl', 'jxl');
1629 1 50 33     4 if ($$et{ImageDataHash} and $raf->Seek(0,0)) {
1630 0         0 $et->ImageDataHash($raf, undef, 'JXL');
1631             }
1632 1         5 return ProcessJXLCodestream($et, \$hdr);
1633             }
1634             } else {
1635 0         0 return 0;
1636             }
1637 3 50       8 $raf->Seek(0,0) or $et->Error('Seek error'), return 0;
1638              
1639 3         18 my $success = ProcessJP2($et, $dirInfo);
1640              
1641 3 50 66     38 if ($outfile and $success > 0 and $$et{IsJXL} == 2) {
      66        
1642             # attach the JXL codestream box to the ISO BMFF file
1643 1 50       6 $raf->Seek(0,2) or return -1;
1644 1         3 my $size = $raf->Tell();
1645 1 50       2 $raf->Seek(0,0) or return -1;
1646 1         3 SetByteOrder('MM');
1647 1 50       3 Write($outfile, Set32u($size + 8), 'jxlc') or return -1;
1648 1         4 while ($raf->Read($buff, 65536)) {
1649 1 50       2 Write($outfile, $buff) or return -1;
1650             }
1651             }
1652 3         9 return $success;
1653             }
1654              
1655             1; # end
1656              
1657             __END__