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   11428 use strict;
  12         31  
  12         634  
16 12     12   81 use vars qw($VERSION);
  12         25  
  12         802  
17 12     12   77 use Image::ExifTool qw(:DataAccess :Utils);
  12         30  
  12         126762  
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 263 my ($et, $dirInfo, $tagTablePtr) = @_;
780 120 100       316 if ($$et{jumd_level}) {
781 100         282 ++$$et{jumd_level}[-1]; # increment current sub-document number
782             } else {
783 20         98 $$et{jumd_level} = [ ++$$et{DOC_COUNT} ]; # new top-level sub-document
784 20         70 $$et{SET_GROUP0} = 'JUMBF';
785             }
786 120         208 $$et{DOC_NUM} = join '-', @{$$et{jumd_level}};
  120         582  
787 120         199 push @{$$et{jumd_level}}, 0;
  120         324  
788 120         761 ProcessJpeg2000Box($et, $dirInfo, $tagTablePtr);
789 120         294 delete $$et{DOC_NUM};
790 120         258 delete $$et{JUMBFLabel};
791 120         201 pop @{$$et{jumd_level}};
  120         265  
792 120 100       258 if (@{$$et{jumd_level}} < 2) {
  120         315  
793 20         46 delete $$et{jumd_level};
794 20         52 delete $$et{SET_GROUP0};
795             }
796 120         322 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 270 my ($et, $dirInfo, $tagTablePtr) = @_;
806 120         283 my $dataPt = $$dirInfo{DataPt};
807 120         232 my $pos = $$dirInfo{DirStart};
808 120         263 my $end = $pos + $$dirInfo{DirLen};
809 120         577 $et->VerboseDir('JUMD', 0, $end-$pos);
810 120         324 delete $$et{JUMBFLabel};
811 120 50       318 $$dirInfo{DirLen} < 17 and $et->Warn('Truncated JUMD directory'), return 0;
812 120         279 my $type = substr($$dataPt, $pos, 4);
813 120         540 $et->HandleTag($tagTablePtr, 'type', substr($$dataPt, $pos, 16));
814 120         276 $pos += 16;
815 120         506 my $flags = Get8u($dataPt, $pos++);
816 120         493 $et->HandleTag($tagTablePtr, 'toggles', $flags);
817 120 50       334 if ($flags & 0x02) { # label exists?
818 120         460 pos($$dataPt) = $pos;
819 120 50       560 $$dataPt =~ /\0/g or $et->Warn('Missing JUMD label terminator'), return 0;
820 120         264 my $len = pos($$dataPt) - $pos;
821 120         316 my $name = substr($$dataPt, $pos, $len);
822 120         420 $et->HandleTag($tagTablePtr, 'label', $name);
823 120         211 $pos += $len;
824 120 50       303 if ($len) {
825 120         1007 $name =~ s/[^-_a-zA-Z0-9]([a-z])/\U$1/g; # capitalize characters after illegal characters
826 120         335 $name =~ tr/-_a-zA-Z0-9//dc; # remove other illegal characters
827 120         288 $name =~ s/__/_/; # collapse double underlines
828 120         273 $name = ucfirst $name; # capitalize first letter
829 120         250 $name =~ s/C2pa/C2PA/; # capitalize C2PA
830 120 50       323 $name = "Tag$name" if length($name) < 2; # must at least 2 characters long
831 120         484 $$et{JUMBFLabel} = $name;
832             }
833             }
834 120 50       348 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       288 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         247 my $more = $end - $pos;
845 120 50       258 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         386 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 9 my ($et, $outfile) = @_;
882 2         7 my $addTags = $$et{AddJp2Tags};
883 2         6 my $addDirs = $$et{AddJp2Dirs};
884 2         9 delete $$et{AddJp2Tags};
885 2         6 delete $$et{AddJp2Dirs};
886 2         5 my ($tag, $dirName);
887             # add JPEG2000 tags
888 2         11 foreach $tag (sort keys %$addTags) {
889 1         4 my $tagInfo = $$addTags{$tag};
890 1         7 my $nvHash = $et->GetNewValueHash($tagInfo);
891             # (native JPEG2000 information is always preferred, so don't check IsCreating)
892 1 50 33     25 next unless $$tagInfo{List} or $et->IsOverwriting($nvHash) > 0;
893 1 50       6 next if $$nvHash{EditOnly};
894 1         6 my @vals = $et->GetNewValue($nvHash);
895 1         3 my $val;
896 1         4 foreach $val (@vals) {
897 1         8 my $boxhdr = pack('N', length($val) + 8) . $$tagInfo{TagID};
898 1 50       6 Write($outfile, $boxhdr, $val) or return 0;
899 1         29 ++$$et{CHANGED};
900 1         9 $et->VerboseValue("+ Jpeg2000:$$tagInfo{Name}", $val);
901             }
902             }
903             # add UUID boxes (and/or JXL Exif/XML boxes)
904 2         17 foreach $dirName (sort keys %$addDirs) {
905             # handle JPEG XL XMP and EXIF
906 13 100 100     63 if ($dirName eq 'xml ' or $dirName eq 'Exif') {
907 2 100       22 my ($tag, $dir) = $dirName eq 'xml ' ? ('xml ', 'XMP') : ('Exif', 'EXIF');
908 2         8 my $tagInfo = $Image::ExifTool::Jpeg2000::Main{$tag};
909 2 100       9 $tagInfo = $$tagInfo[1] if ref $tagInfo eq 'ARRAY'; # (hack for stupid JXL XMP)
910 2         6 my $subdir = $$tagInfo{SubDirectory};
911 2         10 my $tagTable = GetTagTable($$subdir{TagTable});
912 2 100       9 $tagTable = GetTagTable('Image::ExifTool::XMP::Main') if $dir eq 'XMP';
913 2         10 my %dirInfo = (
914             DirName => $dir,
915             Parent => $tag,
916             );
917 2         12 my $compress = $et->Options('Compress');
918 2 50 33     13 $dirInfo{Compact} = 1 if $$et{IsJXL} and $compress;
919 2         17 my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
920 2 50 33     13 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       10 my $pad = $dirName eq 'Exif' ? "\0\0\0\0" : '';
923 2 50 33     28 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         10 my $boxhdr = pack('N', length($newdir) + length($pad) + 8) . $tag;
941 2 50       10 Write($outfile, $boxhdr, $pad, $newdir) or return 0;
942 2         14 next;
943             }
944             }
945 11 100       31 next unless $uuid{$dirName};
946 2         5 my $tagInfo;
947 2         4 foreach $tagInfo (@{$Image::ExifTool::Jpeg2000::Main{uuid}}) {
  2         9  
948 10 100       29 next unless $$tagInfo{Name} eq $dirName;
949 2         6 my $subdir = $$tagInfo{SubDirectory};
950 2         11 my $tagTable = GetTagTable($$subdir{TagTable});
951             my %dirInfo = (
952 2   33     18 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         12 $dirInfo{DirName} =~ s/^UUID-//;
958 2         18 my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
959 2 50 33     15 if (defined $newdir and length $newdir) {
960 2         14 my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName};
961 2 50       10 Write($outfile, $boxhdr, $newdir) or return 0;
962 2         11 last;
963             }
964             }
965             }
966 2         21 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 4 my ($et, $outfile) = @_;
976 1         5 my $meth = $et->GetNewValue('Jpeg2000:ColorSpecMethod');
977 1   50     6 my $prec = $et->GetNewValue('Jpeg2000:ColorSpecPrecedence') || 0;
978 1   50     5 my $approx = $et->GetNewValue('Jpeg2000:ColorSpecApproximation') || 0;
979 1         5 my $icc = $et->GetNewValue('ICC_Profile');
980 1         5 my $space = $et->GetNewValue('Jpeg2000:ColorSpace');
981 1         8 my $cdata = $et->GetNewValue('Jpeg2000:ColorSpecData');
982 1 50       7 unless ($meth) {
983 1 50       6 if ($icc) {
    50          
    0          
984 0         0 $meth = 2;
985             } elsif (defined $space) {
986 1         4 $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     6 if ($meth eq '1') {
    0          
    0          
994 1 50       4 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         5 my $boxhdr = pack('N', length($cdata) + 11) . 'colr';
1005 1 50       10 Write($outfile, $boxhdr, pack('CCC',$meth,$prec,$approx), $cdata) or return 0;
1006 1         4 ++$$et{CHANGED};
1007 1         7 $et->VPrint(1, " + Jpeg2000:ColorSpec\n");
1008 1         10 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 338 my ($et, $dirInfo, $tagTablePtr) = @_;
1019 152         322 my $dataPt = $$dirInfo{DataPt};
1020 152         322 my $dataLen = $$dirInfo{DataLen};
1021 152   100     411 my $dataPos = $$dirInfo{DataPos} || 0;
1022 152   100     435 my $dirLen = $$dirInfo{DirLen} || 0;
1023 152   100     437 my $dirStart = $$dirInfo{DirStart} || 0;
1024 152   100     421 my $base = $$dirInfo{Base} || 0;
1025 152         366 my $outfile = $$dirInfo{OutFile};
1026 152   100     443 my $dirName = $$dirInfo{DirName} || '';
1027 152         264 my $dirEnd = $dirStart + $dirLen;
1028 152         275 my ($err, $outBuff, $verbose, $doColour, $hash, $raf);
1029              
1030 152 100       317 if ($dataPt) {
1031             # save C2PA JUMBF as a block if requested
1032 144 50 66     498 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         23 $raf = $$dirInfo{RAF}; # read from RAF
1042             }
1043              
1044 152 100       302 if ($outfile) {
1045 3 100       31 unless ($raf) {
1046             # buffer output to be used for return value
1047 1         3 $outBuff = '';
1048 1         3 $outfile = \$outBuff;
1049             }
1050             # determine if we will be writing colr box
1051 3 100       14 if ($dirName eq 'JP2Header') {
1052 1 0 33     7 $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         432 $verbose = $$et{OPTIONS}{Verbose};
1059 149 50       312 $et->VerboseDir($dirName) if $verbose;
1060             # do hash if requested, but only for top-level image data
1061 149 100       353 $hash = $$et{ImageDataHash} if $raf;
1062             }
1063             # loop through all contained boxes
1064 152         254 my ($pos, $boxLen, $lastBox);
1065 152         354 for ($pos=$dirStart; ; $pos+=$boxLen) {
1066 498         968 my ($boxID, $buff, $valuePtr);
1067 498         819 my $hdrLen = 8; # the box header length
1068 498 100       1400 if ($raf) {
    100          
1069 45         178 $dataPos = $raf->Tell() - $base;
1070 45         180 my $n = $raf->Read($buff,$hdrLen);
1071 45 100       124 unless ($n == $hdrLen) {
1072 7 50       22 $n and $err = '', last;
1073 7 100 33     45 CreateNewBoxes($et, $outfile) or $err = 1 if $outfile;
1074 7         26 last;
1075             }
1076 38         99 $dataPt = \$buff;
1077 38         73 $dirLen = $dirEnd = $hdrLen;
1078 38         76 $pos = 0;
1079             } elsif ($pos >= $dirEnd - $hdrLen) {
1080 145 50       365 $err = '' unless $pos == $dirEnd;
1081 145         306 last;
1082             }
1083 346         1156 $boxLen = unpack("x$pos N",$$dataPt); # (length includes header and data)
1084 346         1033 $boxID = substr($$dataPt, $pos+4, 4);
1085             # (ftbl box contains flst boxes with absolute file offsets, not currently handled)
1086 346 50 66     898 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     829 if ($doColour and $boxID eq 'colr') {
1092 1 50       6 if ($doColour == 1) { # did we successfully write the new colr box?
1093 1         6 $et->VPrint(1," - Jpeg2000:ColorSpec\n");
1094 1         3 ++$$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         586 $lastBox = $boxID;
1101 345         554 $pos += $hdrLen; # move to end of box header
1102 345 50       923 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         641 $boxLen -= $hdrLen; # length of remaining box data
1140             }
1141 345 50       802 $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
1142 345         1327 my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
1143 345 50 33     1017 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       898 if ($raf) {
    50          
1161             # read the box data
1162 38         128 $dataPos = $raf->Tell() - $base;
1163 38 50       110 $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
1164 38 0 33     121 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         66 $valuePtr = 0;
1169 38         72 $dataLen = $boxLen;
1170             } elsif ($pos + $boxLen > $dirEnd) {
1171 0         0 $err = '';
1172 0         0 last;
1173             } else {
1174 307         579 $valuePtr = $pos;
1175             }
1176 345 100 66     1552 if (defined $tagInfo and not $tagInfo) {
1177             # GetTagInfo() required the value for a Condition
1178 12 100       53 my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128);
1179 12         44 $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
1180             }
1181             # delete all UUID boxes and any writable box if deleting all information
1182 345 100 66     983 if ($outfile and $tagInfo) {
1183 9 50 66     62 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         5 my $isOverwriting;
1189 2 50       9 if ($$et{DEL_GROUP}{Jpeg2000}) {
1190 0         0 $isOverwriting = 1;
1191             } else {
1192 2         13 my $nvHash = $et->GetNewValueHash($tagInfo);
1193 2         10 $isOverwriting = $et->IsOverwriting($nvHash);
1194             }
1195 2 50       8 if ($isOverwriting) {
    0          
1196 2         9 my $val = substr($$dataPt, $valuePtr, $boxLen);
1197 2         14 $et->VerboseValue("- Jpeg2000:$$tagInfo{Name}", $val);
1198 2         5 ++$$et{CHANGED};
1199 2         8 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     2001 if ($tagInfo and $$et{JUMBFLabel} and (not $$tagInfo{SubDirectory} or $$tagInfo{BlockExtract})) {
      66        
      100        
1207 60   50     801 $tagInfo = { %$tagInfo, Name => $$et{JUMBFLabel} . ($$tagInfo{JUMBF_Suffix} || '') };
1208 60         321 ($$tagInfo{Description} = Image::ExifTool::MakeDescription($$tagInfo{Name})) =~ s/C2 PA/C2PA/;
1209 60         333 AddTagToTable($tagTablePtr, '_JUMBF_' . $$et{JUMBFLabel}, $tagInfo);
1210 60         148 delete $$tagInfo{Protected}; # (must do this so -j -b returns JUMBF binary data)
1211 60         156 $$tagInfo{TagID} = $boxID;
1212             }
1213 343 50       801 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     793 if ($$tagInfo{SubDirectory}) {
    100          
    100          
1224 337         626 my $subdir = $$tagInfo{SubDirectory};
1225 337         526 my $subdirStart = $valuePtr;
1226 337         597 my $subdirLen = $boxLen;
1227 337 100       828 if (defined $$subdir{Start}) {
1228             #### eval Start ($valuePtr, $dataPt)
1229 11         826 $subdirStart = eval($$subdir{Start});
1230 11         46 $subdirLen -= $subdirStart - $valuePtr;
1231 11 50       41 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     3719 OutFile => $outfile,
1245             Base => $base + $dataPos + $subdirStart,
1246             );
1247 337         913 my $uuid = $uuid{$$tagInfo{Name}};
1248             # remove "UUID-" prefix to allow appropriate directories to be written as a block
1249 337         878 $subdirInfo{DirName} =~ s/^UUID-//;
1250 337   66     1152 my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
1251 337 100       779 if ($outfile) {
1252             # (special case for brob box, which may be EXIF or XMP)
1253 6         14 my $fakeID = $boxID;
1254 6 50       22 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     88 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         11 my $compress = $et->Options('Compress');
1265 2         7 $subdirInfo{Parent} = $fakeID;
1266 2 0 33     7 $subdirInfo{Compact} = 1 if $compress and $$et{IsJXL};
1267 2         14 $newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
1268 2 50 33     17 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     18 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         21 delete $$et{AddJp2Dirs}{$fakeID}; # (eg. 'Exif' or 'xml ')
1305 6 50       20 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         21 delete $$et{AddJp2Dirs}{$$tagInfo{Name}}; # (eg. 'EXIF' or 'XMP')
1311             }
1312             # use old box data if not changed
1313 6 100       33 defined $newdir or $newdir = substr($$dataPt, $subdirStart, $subdirLen);
1314 6         14 my $prefixLen = $subdirStart - $valuePtr;
1315 6         36 my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID;
1316 6 100       26 $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
1317 6 50       46 Write($outfile, $boxhdr, $newdir) or $err = 1;
1318             # write new colr box immediately after ihdr
1319 6 100 66     53 if ($doColour and $boxID eq 'ihdr') {
1320             # (shouldn't be multiple ihdr boxes, but just in case, write only 1)
1321 1 50       9 $doColour = $doColour==2 ? CreateColorSpec($et, $outfile) : 0;
1322             }
1323             } else {
1324             # extract as a block if specified
1325 331 100       870 $subdirInfo{BlockInfo} = $tagInfo if $$tagInfo{BlockExtract};
1326 331 50 66     815 $et->Warn("Reading non-standard $$tagInfo{Name} box") if defined $uuid and $uuid eq '0';
1327 331 50       1673 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         4 my $rational;
1338 2         11 my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen, \$rational);
1339 2 50       5 if (defined $val) {
1340 2         8 my $key = $et->FoundTag($tagInfo, $val);
1341             # save Rational value
1342 2 50 33     12 $$et{TAG_EXTRA}{$key}{Rational} = $rational if defined $rational and defined $key;
1343             }
1344             } elsif ($outfile) {
1345 1         7 my $boxhdr = pack('N', $boxLen + 8) . $boxID;
1346 1 50       9 Write($outfile, $boxhdr, substr($$dataPt, $valuePtr, $boxLen)) or $err = 1;
1347             }
1348             }
1349 152 50       341 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     472 return $outBuff if $outfile and not $raf;
1358 151         444 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 37 my ($a, $n) = @_;
1368 18         25 my $v = 0;
1369 18         24 my $bit = 1;
1370 18         25 my $i;
1371 18         41 while ($n--) {
1372 78         147 for ($i=0; $i<@$a; ++$i) {
1373             # consume bits LSB first
1374 936         1419 my $set = $$a[$i] & 1;
1375 936         1264 $$a[$i] >>= 1;
1376 936 100       1478 if ($i) {
1377 858 100       2112 $$a[$i-1] |= 0x80 if $set;
1378             } else {
1379 78 100       140 $v |= $bit if $set;
1380 78         161 $bit <<= 1;
1381             }
1382             }
1383             }
1384 18         56 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 5 my ($et, $dirInfo, $tagTablePtr) = @_;
1395 2         3 my $dataPt = $$dirInfo{DataPt};
1396              
1397 2 50       7 return 0 unless length($$dataPt) > 4;
1398              
1399 2         6 my $isWriting = $$dirInfo{IsWriting};
1400 2         4 my $type = substr($$dataPt, 0, 4);
1401 2 50       11 $et->VerboseDir("Decrypted Brotli '${type}'") unless $isWriting;
1402 2         7 my %knownType = ( exif => 'Exif', 'xml ' => 'xml ', jumb => 'jumb' );
1403 2         4 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       4 my $verbose = $isWriting ? 0 : $et->Options('Verbose');
1419 2         36 my $dat = substr($$dataPt, 4);
1420 2         5 eval { $dat = IO::Uncompress::Brotli::unbro($dat, 100000000) };
  2         7  
1421 2 50       618 $@ 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       9 if ($type eq 'xml ') {
    50          
    0          
1425 1         5 $dirInfo{DirName} = 'XMP'; # (necessary for block read/write)
1426 1         9 require Image::ExifTool::XMP;
1427 1 50       3 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       6 $dirInfo{DirStart} = 4 + (length($dat) > 4 ? unpack("N", $dat) : 0);
1436 1 50       3 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         5 $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       9 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         8 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 9 my ($et, $dataPt) = @_;
1472              
1473 3 50       25 return 0 unless $$dataPt =~ /^(\0\0\0\0)?\xff\x0a/; # validate codestream
1474             # ignore if already extracted (ie. subsequent jxlp boxes)
1475 3 50       14 return 0 if $$et{ProcessedJXLCodestream};
1476 3         8 $$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         4 my $dat;
1480 3 50       14 if (length $$dataPt > 64) {
    100          
1481 0         0 $dat = substr($$dataPt, 0, 64);
1482             } elsif (length $$dataPt < 18) {
1483 1         3 $dat = $$dataPt . ("\0" x 18); # (so we'll have a minimum 14 bytes to work with)
1484             } else {
1485 2         6 $dat = $$dataPt;
1486             }
1487 3         8 $dat =~ s/^\0\0\0\0//; # remove jxlp header word
1488 3         17 my @a = unpack 'x2C12', $dat;
1489 3         7 my ($x, $y);
1490 3         12 my $small = GetBits(\@a, 1);
1491 3 50       11 if ($small) {
1492 0         0 $y = (GetBits(\@a, 5) + 1) * 8;
1493             } else {
1494 3         12 $y = GetBits(\@a, [9, 13, 18, 30]->[GetBits(\@a, 2)]) + 1;
1495             }
1496 3         29 my $ratio = GetBits(\@a, 3);
1497 3 50       12 if ($ratio == 0) {
1498 3 50       8 if ($small) {
1499 0         0 $x = (GetBits(\@a, 5) + 1) * 8;;
1500             } else {
1501 3         14 $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         37 $et->FoundTag(ImageWidth => $x);
1508 3         12 $et->FoundTag(ImageHeight => $y);
1509 3         74 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 16 local $_;
1541 8         22 my ($et, $dirInfo) = @_;
1542 8         19 my $raf = $$dirInfo{RAF};
1543 8         20 my $outfile = $$dirInfo{OutFile};
1544 8         14 my $hdr;
1545              
1546             # check to be sure this is a valid JPG2000 file
1547 8 50       31 return 0 unless $raf->Read($hdr,12) == 12;
1548 8 100 66     92 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       8 return 0 unless $hdr =~ /^\xff\x4f\xff\x51\0/; # check for JP2 codestream format
1553 1 50       5 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       4 unless ($Image::ExifTool::jpegMarker{0x4f}) {
1559 1         51 $Image::ExifTool::jpegMarker{$_} = $j2cMarker{$_} foreach keys %j2cMarker;
1560             }
1561 1         11 $et->SetFileType('J2C');
1562 1         8 $raf->Seek(0,0);
1563 1         9 return $et->ProcessJPEG($dirInfo); # decode with JPEG processor
1564             }
1565 7 100       32 if ($outfile) {
1566 2 50       16 Write($outfile, $hdr) or return -1;
1567 2 100       13 if ($$et{IsJXL}) {
1568 1         7 $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         9 $$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main);
1573             }
1574             # save list of directories to create
1575 2         7 my %addDirs = %{$$et{ADD_DIRS}}; # (make a copy)
  2         19  
1576 2         10 $$et{AddJp2Dirs} = \%addDirs;
1577             } else {
1578 5         13 my ($buff, $fileType);
1579             # recognize JPX and JPM as unique types of JP2
1580 5 50 33     18 if ($raf->Read($buff, 12) == 12 and $buff =~ /^.{4}ftyp(.{4})/s) {
1581 5 50       25 $fileType = 'JPX' if $1 eq 'jpx ';
1582 5 50       18 $fileType = 'JPM' if $1 eq 'jpm ';
1583 5 100       16 $fileType = 'JXL' if $1 eq 'jxl ';
1584 5 50       17 $fileType = 'JPH' if $1 eq 'jph ';
1585             }
1586 5 50       41 $raf->Seek(-length($buff), 1) if defined $buff;
1587 5         27 $et->SetFileType($fileType);
1588             }
1589 7         41 SetByteOrder('MM'); # JPEG 2000 files are big-endian
1590             my %dirInfo = (
1591             RAF => $raf,
1592             DirName => 'JP2',
1593             OutFile => $$dirInfo{OutFile},
1594 7         58 );
1595 7         30 my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
1596 7         42 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 10 my ($et, $dirInfo) = @_;
1606 4         11 my $raf = $$dirInfo{RAF};
1607 4         10 my $outfile = $$dirInfo{OutFile};
1608 4         6 my ($hdr, $buff);
1609              
1610 4 50       13 return 0 unless $raf->Read($hdr,12) == 12;
1611 4 100       18 if ($hdr eq "\0\0\0\x0cJXL \x0d\x0a\x87\x0a") {
    50          
1612             # JPEG XL in ISO BMFF container
1613 2         4 $$et{IsJXL} = 1;
1614             } elsif ($hdr =~ /^\xff\x0a/) {
1615             # JPEG XL codestream
1616 2 100       6 if ($outfile) {
1617 1 50       25 if ($$et{OPTIONS}{IgnoreMinorErrors}) {
1618 1         7 $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         4 $$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         6 $$dirInfo{RAF} = File::RandomAccess->new(\$buff);
1627             } else {
1628 1         18 $et->SetFileType('JXL Codestream','image/jxl', 'jxl');
1629 1 50 33     8 if ($$et{ImageDataHash} and $raf->Seek(0,0)) {
1630 0         0 $et->ImageDataHash($raf, undef, 'JXL');
1631             }
1632 1         6 return ProcessJXLCodestream($et, \$hdr);
1633             }
1634             } else {
1635 0         0 return 0;
1636             }
1637 3 50       10 $raf->Seek(0,0) or $et->Error('Seek error'), return 0;
1638              
1639 3         14 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       10 $raf->Seek(0,2) or return -1;
1644 1         5 my $size = $raf->Tell();
1645 1 50       4 $raf->Seek(0,0) or return -1;
1646 1         6 SetByteOrder('MM');
1647 1 50       5 Write($outfile, Set32u($size + 8), 'jxlc') or return -1;
1648 1         7 while ($raf->Read($buff, 65536)) {
1649 1 50       7 Write($outfile, $buff) or return -1;
1650             }
1651             }
1652 3         24 return $success;
1653             }
1654              
1655             1; # end
1656              
1657             __END__