Edit file File name : Jpeg2000.pm Content :#------------------------------------------------------------------------------ # File: Jpeg2000.pm # # Description: Read JPEG 2000 meta information # # Revisions: 02/11/2005 - P. Harvey Created # 06/22/2007 - PH Added write support (EXIF, IPTC and XMP only) # # References: 1) http://www.jpeg.org/public/fcd15444-2.pdf # 2) ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf #------------------------------------------------------------------------------ package Image::ExifTool::Jpeg2000; use strict; use vars qw($VERSION); use Image::ExifTool qw(:DataAccess :Utils); $VERSION = '1.32'; sub ProcessJpeg2000Box($$$); sub ProcessJUMD($$$); my %resolutionUnit = ( -3 => 'km', -2 => '100 m', -1 => '10 m', 0 => 'm', 1 => '10 cm', 2 => 'cm', 3 => 'mm', 4 => '0.1 mm', 5 => '0.01 mm', 6 => 'um', ); # map of where information is written in JPEG2000 image my %jp2Map = ( IPTC => 'UUID-IPTC', IFD0 => 'UUID-EXIF', XMP => 'UUID-XMP', 'UUID-IPTC' => 'JP2', 'UUID-EXIF' => 'JP2', 'UUID-XMP' => 'JP2', jp2h => 'JP2', colr => 'jp2h', ICC_Profile => 'colr', IFD1 => 'IFD0', EXIF => 'IFD0', # to write EXIF as a block ExifIFD => 'IFD0', GPS => 'IFD0', SubIFD => 'IFD0', GlobParamIFD => 'IFD0', PrintIM => 'IFD0', InteropIFD => 'ExifIFD', MakerNotes => 'ExifIFD', ); # map of where information is written in a JXL image my %jxlMap = ( IFD0 => 'Exif', XMP => 'XML', 'Exif' => 'JP2', IFD1 => 'IFD0', EXIF => 'IFD0', # to write EXIF as a block ExifIFD => 'IFD0', GPS => 'IFD0', SubIFD => 'IFD0', GlobParamIFD => 'IFD0', PrintIM => 'IFD0', InteropIFD => 'ExifIFD', MakerNotes => 'ExifIFD', ); # UUID's for writable UUID directories (by tag name) my %uuid = ( 'UUID-EXIF' => 'JpgTiffExif->JP2', 'UUID-EXIF2' => '', # (flags a warning when writing) 'UUID-EXIF_bad' => '0', # (flags a warning when reading and writing) 'UUID-IPTC' => "\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38", 'UUID-XMP' => "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac", # (can't yet write GeoJP2 information) # 'UUID-GeoJP2' => "\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03", ); # JPEG2000 codestream markers (ref ISO/IEC FCD15444-1/2) my %j2cMarker = ( 0x4f => 'SOC', # start of codestream 0x51 => 'SIZ', # image and tile size 0x52 => 'COD', # coding style default 0x53 => 'COC', # coding style component 0x55 => 'TLM', # tile-part lengths 0x57 => 'PLM', # packet length, main header 0x58 => 'PLT', # packet length, tile-part header 0x5c => 'QCD', # quantization default 0x5d => 'QCC', # quantization component 0x5e => 'RGN', # region of interest 0x5f => 'POD', # progression order default 0x60 => 'PPM', # packed packet headers, main 0x61 => 'PPT', # packed packet headers, tile-part 0x63 => 'CRG', # component registration 0x64 => 'CME', # comment and extension 0x90 => 'SOT', # start of tile-part 0x91 => 'SOP', # start of packet 0x92 => 'EPH', # end of packet header 0x93 => 'SOD', # start of data # extensions (ref ISO/IEC FCD15444-2) 0x70 => 'DCO', # variable DC offset 0x71 => 'VMS', # visual masking 0x72 => 'DFS', # downsampling factor style 0x73 => 'ADS', # arbitrary decomposition style # 0x72 => 'ATK', # arbitrary transformation kernels ? 0x78 => 'CBD', # component bit depth 0x74 => 'MCT', # multiple component transformation definition 0x75 => 'MCC', # multiple component collection 0x77 => 'MIC', # multiple component intermediate collection 0x76 => 'NLT', # non-linearity point transformation ); # JPEG 2000 "box" (ie. atom) names # Note: only tags with a defined "Format" are extracted %Image::ExifTool::Jpeg2000::Main = ( GROUPS => { 2 => 'Image' }, PROCESS_PROC => \&ProcessJpeg2000Box, WRITE_PROC => \&ProcessJpeg2000Box, PREFERRED => 1, # always add these tags when writing NOTES => q{ The tags below are found in JPEG 2000 images and the JUMBF metadata in JPEG images, but not all of these are extracted. Note that ExifTool currently writes only EXIF, IPTC and XMP tags in Jpeg2000 images. }, # # NOTE: ONLY TAGS WITH "Format" DEFINED ARE EXTRACTED! # 'jP ' => 'JP2Signature', # (ref 1) "jP\x1a\x1a" => 'JP2Signature', # (ref 2) prfl => 'Profile', ftyp => { Name => 'FileType', SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::FileType' }, }, rreq => 'ReaderRequirements', jp2h => { Name => 'JP2Header', SubDirectory => { }, }, # JP2Header sub boxes... ihdr => { Name => 'ImageHeader', SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::ImageHeader', }, }, bpcc => 'BitsPerComponent', colr => { Name => 'ColorSpecification', SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::ColorSpec', }, }, pclr => 'Palette', cdef => 'ComponentDefinition', 'res '=> { Name => 'Resolution', SubDirectory => { }, }, # Resolution sub boxes... resc => { Name => 'CaptureResolution', SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::CaptureResolution', }, }, resd => { Name => 'DisplayResolution', SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::DisplayResolution', }, }, jpch => { Name => 'CodestreamHeader', SubDirectory => { }, }, # CodestreamHeader sub boxes... 'lbl '=> { Name => 'Label', Format => 'string', }, cmap => 'ComponentMapping', roid => 'ROIDescription', jplh => { Name => 'CompositingLayerHeader', SubDirectory => { }, }, # CompositingLayerHeader sub boxes... cgrp => 'ColorGroup', opct => 'Opacity', creg => 'CodestreamRegistration', dtbl => 'DataReference', ftbl => { Name => 'FragmentTable', Subdirectory => { }, }, # FragmentTable sub boxes... flst => 'FragmentList', cref => 'Cross-Reference', mdat => 'MediaData', comp => 'Composition', copt => 'CompositionOptions', inst => 'InstructionSet', asoc => { Name => 'Association', SubDirectory => { }, }, # (Association box may contain any other sub-box) nlst => 'NumberList', bfil => 'BinaryFilter', drep => 'DesiredReproductions', # DesiredReproductions sub boxes... gtso => 'GraphicsTechnologyStandardOutput', chck => 'DigitalSignature', mp7b => 'MPEG7Binary', free => 'Free', jp2c => [{ Name => 'ContiguousCodestream', Condition => 'not $$self{jumd_level}', },{ Name => 'PreviewImage', Groups => { 2 => 'Preview' }, Format => 'undef', Binary => 1, }], jp2i => { Name => 'IntellectualProperty', SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' }, }, 'xml '=> [{ Name => 'XML', Condition => 'not $$self{IsJXL}', Writable => 'undef', Flags => [ 'Binary', 'Protected', 'BlockExtract' ], List => 1, Notes => q{ by default, the XML data in this tag is parsed using the ExifTool XMP module to to allow individual tags to be accessed when reading, but it may also be extracted as a block via the "XML" tag, which is also how this tag is written and copied. It may also be extracted as a block by setting the API BlockExtract option. This is a List-type tag because multiple XML blocks may exist }, # (note: extracting as a block was broken in 11.04, and finally fixed in 12.14) SubDirectory => { TagTable => 'Image::ExifTool::XMP::XML' }, },{ Name => 'XMP', Notes => 'used for XMP in JPEG XL files', # NOTE: the hacked code relies on this being at index 1 of the tagInfo list! SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' }, }], uuid => [ { Name => 'UUID-EXIF', # (this is the EXIF that we create) Condition => '$$valPt=~/^JpgTiffExif->JP2(?!Exif\0\0)/', SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main', ProcessProc => \&Image::ExifTool::ProcessTIFF, WriteProc => \&Image::ExifTool::WriteTIFF, DirName => 'EXIF', Start => '$valuePtr + 16', }, }, { Name => 'UUID-EXIF2', # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5 Condition => '$$valPt=~/^\x05\x37\xcd\xab\x9d\x0c\x44\x31\xa7\x2a\xfa\x56\x1f\x2a\x11\x3e/', SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main', ProcessProc => \&Image::ExifTool::ProcessTIFF, WriteProc => \&Image::ExifTool::WriteTIFF, DirName => 'EXIF', Start => '$valuePtr + 16', }, }, { Name => 'UUID-EXIF_bad', # written by Digikam Condition => '$$valPt=~/^JpgTiffExif->JP2/', SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main', ProcessProc => \&Image::ExifTool::ProcessTIFF, WriteProc => \&Image::ExifTool::WriteTIFF, DirName => 'EXIF', Start => '$valuePtr + 22', }, }, { Name => 'UUID-IPTC', # (this is the IPTC that we create) Condition => '$$valPt=~/^\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38/', SubDirectory => { TagTable => 'Image::ExifTool::IPTC::Main', Start => '$valuePtr + 16', }, }, { Name => 'UUID-IPTC2', # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5 Condition => '$$valPt=~/^\x09\xa1\x4e\x97\xc0\xb4\x42\xe0\xbe\xbf\x36\xdf\x6f\x0c\xe3\x6f/', SubDirectory => { TagTable => 'Image::ExifTool::IPTC::Main', Start => '$valuePtr + 16', }, }, { Name => 'UUID-XMP', # ref http://www.adobe.com/products/xmp/pdfs/xmpspec.pdf Condition => '$$valPt=~/^\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac/', SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main', Start => '$valuePtr + 16', }, }, { Name => 'UUID-GeoJP2', # ref http://www.remotesensing.org/jpeg2000/ Condition => '$$valPt=~/^\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03/', SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main', ProcessProc => \&Image::ExifTool::ProcessTIFF, Start => '$valuePtr + 16', }, }, { Name => 'UUID-Photoshop', # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5 Condition => '$$valPt=~/^\x2c\x4c\x01\x00\x85\x04\x40\xb9\xa0\x3e\x56\x21\x48\xd6\xdf\xeb/', SubDirectory => { TagTable => 'Image::ExifTool::Photoshop::Main', Start => '$valuePtr + 16', }, }, { Name => 'UUID-Signature', # (seen in JUMB data of JPEG images) # (may be able to remove this when JUMBF specification is finalized) Condition => '$$valPt=~/^casg\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/', Format => 'undef', ValueConv => 'substr($val,16)', }, { Name => 'UUID-C2PAClaimSignature', # (seen in incorrectly-formatted JUMB data of JPEG images) # (may be able to remove this when JUMBF specification is finalized) Condition => '$$valPt=~/^c2cs\x00\x11\x00\x10\x80\x00\x00\xaa\x00\x38\x9b\x71/', SubDirectory => { TagTable => 'Image::ExifTool::CBOR::Main', Start => '$valuePtr + 16', }, }, { Name => 'UUID-Unknown', }, # also written by Adobe JPEG2000 plugin v1.5: # 3a 0d 02 18 0a e9 41 15 b3 76 4b ca 41 ce 0e 71 - 1 byte (01) # 47 c9 2c cc d1 a1 45 81 b9 04 38 bb 54 67 71 3b - 1 byte (01) # bc 45 a7 74 dd 50 4e c6 a9 f6 f3 a1 37 f4 7e 90 - 4 bytes (00 00 00 32) # d7 c8 c5 ef 95 1f 43 b2 87 57 04 25 00 f5 38 e8 - 4 bytes (00 00 00 32) ], uinf => { Name => 'UUIDInfo', SubDirectory => { }, }, # UUIDInfo sub boxes... ulst => 'UUIDList', 'url '=> { Name => 'URL', Format => 'string', }, # JUMBF boxes (ref https://github.com/thorfdbg/codestream-parser) jumd => { Name => 'JUMBFDescr', SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::JUMD' }, }, jumb => { Name => 'JUMBFBox', SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::Main', ProcessProc => \&ProcessJUMB, }, }, json => { Name => 'JSONData', Flags => [ 'Binary', 'Protected', 'BlockExtract' ], Notes => q{ by default, data in this tag is parsed using the ExifTool JSON module to to allow individual tags to be accessed when reading, but it may also be extracted as a block via the "JSONData" tag or by setting the API BlockExtract option }, SubDirectory => { TagTable => 'Image::ExifTool::JSON::Main' }, }, cbor => { Name => 'CBORData', Flags => [ 'Binary', 'Protected' ], SubDirectory => { TagTable => 'Image::ExifTool::CBOR::Main' }, }, bfdb => { # used in JUMBF (see # (used when tag is renamed according to JUMDLabel) Name => 'BinaryDataType', Notes => 'JUMBF, MIME type and optional file name', Format => 'undef', # (ignore "toggles" byte and just extract MIME type and file name) ValueConv => '$_=substr($val,1); s/\0+$//; s/\0/, /; $_', JUMBF_Suffix => 'Type', # (used when tag is renamed according to JUMDLabel) }, bidb => { # used in JUMBF Name => 'BinaryData', Notes => 'JUMBF', Groups => { 2 => 'Preview' }, Format => 'undef', Binary => 1, JUMBF_Suffix => 'Data', # (used when tag is renamed according to JUMDLabel) }, # # stuff seen in JPEG XL images: # # jbrd - JPEG Bitstream Reconstruction Data (allows lossless conversion back to original JPG) jxlc => { Name => 'JXLCodestream', Format => 'undef', Notes => q{ Codestream in JPEG XL image. Currently processed only to determine ImageSize }, RawConv => 'Image::ExifTool::Jpeg2000::ProcessJXLCodestream($self,\$val); undef', }, Exif => { Name => 'EXIF', SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main', ProcessProc => \&Image::ExifTool::ProcessTIFF, WriteProc => \&Image::ExifTool::WriteTIFF, DirName => 'EXIF', Start => '$valuePtr + 4', }, }, ); %Image::ExifTool::Jpeg2000::ImageHeader = ( PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, GROUPS => { 2 => 'Image' }, 0 => { Name => 'ImageHeight', Format => 'int32u', }, 4 => { Name => 'ImageWidth', Format => 'int32u', }, 8 => { Name => 'NumberOfComponents', Format => 'int16u', }, 10 => { Name => 'BitsPerComponent', PrintConv => q{ $val == 0xff and return 'Variable'; my $sign = ($val & 0x80) ? 'Signed' : 'Unsigned'; return (($val & 0x7f) + 1) . " Bits, $sign"; }, }, 11 => { Name => 'Compression', PrintConv => { 0 => 'Uncompressed', 1 => 'Modified Huffman', 2 => 'Modified READ', 3 => 'Modified Modified READ', 4 => 'JBIG', 5 => 'JPEG', 6 => 'JPEG-LS', 7 => 'JPEG 2000', 8 => 'JBIG2', }, }, ); # (ref fcd15444-1/2/6.pdf) # (also see http://developer.apple.com/mac/library/documentation/QuickTime/QTFF/QTFFChap1/qtff1.html) %Image::ExifTool::Jpeg2000::FileType = ( PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, GROUPS => { 2 => 'Video' }, FORMAT => 'int32u', 0 => { Name => 'MajorBrand', Format => 'undef[4]', PrintConv => { 'jp2 ' => 'JPEG 2000 Image (.JP2)', # image/jp2 'jpm ' => 'JPEG 2000 Compound Image (.JPM)', # image/jpm 'jpx ' => 'JPEG 2000 with extensions (.JPX)', # image/jpx 'jxl ' => 'JPEG XL Image (.JXL)', # image/jxl }, }, 1 => { Name => 'MinorVersion', Format => 'undef[4]', ValueConv => 'sprintf("%x.%x.%x", unpack("nCC", $val))', }, 2 => { Name => 'CompatibleBrands', Format => 'undef[$size-8]', # ignore any entry with a null, and return others as a list ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a', }, ); %Image::ExifTool::Jpeg2000::CaptureResolution = ( PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, GROUPS => { 2 => 'Image' }, FORMAT => 'int8s', 0 => { Name => 'CaptureYResolution', Format => 'rational32u', }, 4 => { Name => 'CaptureXResolution', Format => 'rational32u', }, 8 => { Name => 'CaptureYResolutionUnit', SeparateTable => 'ResolutionUnit', PrintConv => \%resolutionUnit, }, 9 => { Name => 'CaptureXResolutionUnit', SeparateTable => 'ResolutionUnit', PrintConv => \%resolutionUnit, }, ); %Image::ExifTool::Jpeg2000::DisplayResolution = ( PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, GROUPS => { 2 => 'Image' }, FORMAT => 'int8s', 0 => { Name => 'DisplayYResolution', Format => 'rational32u', }, 4 => { Name => 'DisplayXResolution', Format => 'rational32u', }, 8 => { Name => 'DisplayYResolutionUnit', SeparateTable => 'ResolutionUnit', PrintConv => \%resolutionUnit, }, 9 => { Name => 'DisplayXResolutionUnit', SeparateTable => 'ResolutionUnit', PrintConv => \%resolutionUnit, }, ); %Image::ExifTool::Jpeg2000::ColorSpec = ( PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, WRITE_PROC => \&Image::ExifTool::WriteBinaryData, # (we don't actually call this) GROUPS => { 2 => 'Image' }, FORMAT => 'int8s', WRITABLE => 1, # (Note: 'colr' is not a real group, but is used as a hack to write the # necessary colr box. This hack necessitated another hack in TagInfoXML.pm # to avoid reporting this fake group in the XML output) WRITE_GROUP => 'colr', DATAMEMBER => [ 0 ], IS_SUBDIR => [ 3 ], NOTES => q{ The table below contains tags in the color specification (colr) box. This box may be rewritten by writing either ICC_Profile, ColorSpace or ColorSpecData. When writing, any existing colr boxes are replaced with the newly created colr box. B<NOTE>: Care must be taken when writing this color specification because writing a specification that is incompatible with the image data may make the image undisplayable. }, 0 => { Name => 'ColorSpecMethod', RawConv => '$$self{ColorSpecMethod} = $val', Protected => 1, Notes => q{ default for writing is 2 when writing ICC_Profile, 1 when writing ColorSpace, or 4 when writing ColorSpecData }, PrintConv => { 1 => 'Enumerated', 2 => 'Restricted ICC', 3 => 'Any ICC', 4 => 'Vendor Color', }, }, 1 => { Name => 'ColorSpecPrecedence', Notes => 'default for writing is 0', Protected => 1, }, 2 => { Name => 'ColorSpecApproximation', Notes => 'default for writing is 0', Protected => 1, PrintConv => { 0 => 'Not Specified', 1 => 'Accurate', 2 => 'Exceptional Quality', 3 => 'Reasonable Quality', 4 => 'Poor Quality', }, }, 3 => [ { Name => 'ICC_Profile', Condition => q{ $$self{ColorSpecMethod} == 2 or $$self{ColorSpecMethod} == 3 }, Format => 'undef[$size-3]', SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main', }, }, { Name => 'ColorSpace', Condition => '$$self{ColorSpecMethod} == 1', Format => 'int32u', Protected => 1, PrintConv => { # ref 15444-2 2002-05-15 0 => 'Bi-level', 1 => 'YCbCr(1)', 3 => 'YCbCr(2)', 4 => 'YCbCr(3)', 9 => 'PhotoYCC', 11 => 'CMY', 12 => 'CMYK', 13 => 'YCCK', 14 => 'CIELab', 15 => 'Bi-level(2)', # (incorrectly listed as 18 in 15444-2 2000-12-07) 16 => 'sRGB', 17 => 'Grayscale', 18 => 'sYCC', 19 => 'CIEJab', 20 => 'e-sRGB', 21 => 'ROMM-RGB', # incorrect in 15444-2 2000-12-07 #22 => 'sRGB based YCbCr', #23 => 'YPbPr(1125/60)', #24 => 'YPbPr(1250/50)', 22 => 'YPbPr(1125/60)', 23 => 'YPbPr(1250/50)', 24 => 'e-sYCC', }, }, { Name => 'ColorSpecData', Format => 'undef[$size-3]', Writable => 'undef', Protected => 1, Binary => 1, }, ], ); # JUMBF description box %Image::ExifTool::Jpeg2000::JUMD = ( PROCESS_PROC => \&ProcessJUMD, GROUPS => { 0 => 'JUMBF', 1 => 'JUMBF', 2 => 'Image' }, NOTES => 'Information extracted from the JUMBF description box.', 'type' => { Name => 'JUMDType', ValueConv => 'unpack "H*", $val', PrintConv => q{ my @a = $val =~ /^(\w{8})(\w{4})(\w{4})(\w{16})$/; return $val unless @a; my $ascii = pack 'H*', $a[0]; $a[0] = "($ascii)" if $ascii =~ /^[a-zA-Z0-9]{4}$/; return join '-', @a; }, # seen: # cacb/cast/caas/cacl/casg/json-00110010800000aa00389b71 # 6579d6fbdba2446bb2ac1b82feeb89d1 - JPEG image }, 'label' => { Name => 'JUMDLabel' }, 'toggles' => { Name => 'JUMDToggles', Unknown => 1, PrintConv => { BITMASK => { 0 => 'Requestable', 1 => 'Label', 2 => 'ID', 3 => 'Signature', }}, }, 'id' => { Name => 'JUMDID', Description => 'JUMD ID' }, 'sig' => { Name => 'JUMDSignature', PrintConv => 'unpack "H*", $val' }, ); #------------------------------------------------------------------------------ # Read JUMBF box to keep track of sub-document numbers # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref # Returns: 1 on success sub ProcessJUMB($$$) { my ($et, $dirInfo, $tagTablePtr) = @_; if ($$et{jumd_level}) { ++$$et{jumd_level}[-1]; # increment current sub-document number } else { $$et{jumd_level} = [ ++$$et{DOC_COUNT} ]; # new top-level sub-document $$et{SET_GROUP0} = 'JUMBF'; } $$et{DOC_NUM} = join '-', @{$$et{jumd_level}}; push @{$$et{jumd_level}}, 0; ProcessJpeg2000Box($et, $dirInfo, $tagTablePtr); delete $$et{DOC_NUM}; delete $$et{JUMBFLabel}; pop @{$$et{jumd_level}}; if (@{$$et{jumd_level}} < 2) { delete $$et{jumd_level}; delete $$et{SET_GROUP0}; } return 1; } #------------------------------------------------------------------------------ # Read JUMBF description box (ref https://github.com/thorfdbg/codestream-parser) # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref # Returns: 1 on success sub ProcessJUMD($$$) { my ($et, $dirInfo, $tagTablePtr) = @_; my $dataPt = $$dirInfo{DataPt}; my $pos = $$dirInfo{DirStart}; my $end = $pos + $$dirInfo{DirLen}; $et->VerboseDir('JUMD', 0, $end-$pos); delete $$et{JUMBFLabel}; $$dirInfo{DirLen} < 17 and $et->Warn('Truncated JUMD directory'), return 0; my $type = substr($$dataPt, $pos, 4); $et->HandleTag($tagTablePtr, 'type', substr($$dataPt, $pos, 16)); $pos += 16; my $flags = Get8u($dataPt, $pos++); $et->HandleTag($tagTablePtr, 'toggles', $flags); if ($flags & 0x02) { # label exists? pos($$dataPt) = $pos; $$dataPt =~ /\0/g or $et->Warn('Missing JUMD label terminator'), return 0; my $len = pos($$dataPt) - $pos; my $name = substr($$dataPt, $pos, $len); $et->HandleTag($tagTablePtr, 'label', $name); $pos += $len; if ($len) { $name =~ s/[^-_a-zA-Z0-9]([a-z])/\U$1/g; # capitalize characters after illegal characters $name =~ tr/-_a-zA-Z0-9//dc; # remove other illegal characters $name =~ s/__/_/; # collapse double underlines $name = ucfirst $name; # capitalize first letter $name = "Tag$name" if length($name) < 2; # must at least 2 characters long $$et{JUMBFLabel} = $name; } } if ($flags & 0x04) { # ID exists? $pos + 4 > $end and $et->Warn('Missing JUMD ID'), return 0; $et->HandleTag($tagTablePtr, 'id', Get32u($dataPt, $pos)); $pos += 4; } if ($flags & 0x08) { # signature exists? $pos + 32 > $end and $et->Warn('Missing JUMD signature'), return 0; $et->HandleTag($tagTablePtr, 'sig', substr($$dataPt, $pos, 32)); $pos += 32; } $pos == $end or $et->Warn('Extra data in JUMD box'." $pos $end", 1); return 1; } #------------------------------------------------------------------------------ # Create new JPEG 2000 boxes when writing # (Currently only supports adding top-level Writable JPEG2000 tags and certain UUID boxes) # Inputs: 0) ExifTool object ref, 1) Output file or scalar ref # Returns: 1 on success sub CreateNewBoxes($$) { my ($et, $outfile) = @_; my $addTags = $$et{AddJp2Tags}; my $addDirs = $$et{AddJp2Dirs}; delete $$et{AddJp2Tags}; delete $$et{AddJp2Dirs}; my ($tag, $dirName); # add JPEG2000 tags foreach $tag (sort keys %$addTags) { my $tagInfo = $$addTags{$tag}; my $nvHash = $et->GetNewValueHash($tagInfo); # (native JPEG2000 information is always preferred, so don't check IsCreating) next unless $$tagInfo{List} or $et->IsOverwriting($nvHash) > 0; next if $$nvHash{EditOnly}; my @vals = $et->GetNewValue($nvHash); my $val; foreach $val (@vals) { my $boxhdr = pack('N', length($val) + 8) . $$tagInfo{TagID}; Write($outfile, $boxhdr, $val) or return 0; ++$$et{CHANGED}; $et->VerboseValue("+ Jpeg2000:$$tagInfo{Name}", $val); } } # add UUID boxes (and/or JXL Exif/XML boxes) foreach $dirName (sort keys %$addDirs) { # handle JPEG XL XMP and EXIF if ($dirName eq 'XML' or $dirName eq 'Exif') { my ($tag, $dir) = $dirName eq 'XML' ? ('xml ', 'XMP') : ('Exif', 'EXIF'); my $tagInfo = $Image::ExifTool::Jpeg2000::Main{$tag}; $tagInfo = $$tagInfo[1] if ref $tagInfo eq 'ARRAY'; # (hack for stupid JXL XMP) my $subdir = $$tagInfo{SubDirectory}; my $tagTable = GetTagTable($$subdir{TagTable}); $tagTable = GetTagTable('Image::ExifTool::XMP::Main') if $dir eq 'XMP'; my %dirInfo = ( DirName => $dir, Parent => 'JP2', ); my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc}); if (defined $newdir and length $newdir) { # not sure why, but EXIF box is padded with leading 0's in my sample my $pad = $dirName eq 'Exif' ? "\0\0\0\0" : ''; my $boxhdr = pack('N', length($newdir) + length($pad) + 8) . $tag; Write($outfile, $boxhdr, $pad, $newdir) or return 0; next; } } next unless $uuid{$dirName}; my $tagInfo; foreach $tagInfo (@{$Image::ExifTool::Jpeg2000::Main{uuid}}) { next unless $$tagInfo{Name} eq $dirName; my $subdir = $$tagInfo{SubDirectory}; my $tagTable = GetTagTable($$subdir{TagTable}); my %dirInfo = ( DirName => $$subdir{DirName} || $dirName, Parent => 'JP2', ); # remove "UUID-" from start of directory name to allow appropriate # directories to be written as a block $dirInfo{DirName} =~ s/^UUID-//; my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc}); if (defined $newdir and length $newdir) { my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName}; Write($outfile, $boxhdr, $newdir) or return 0; last; } } } return 1; } #------------------------------------------------------------------------------ # Create Color Specification Box # Inputs: 0) ExifTool object ref, 1) Output file or scalar ref # Returns: 1 on success sub CreateColorSpec($$) { my ($et, $outfile) = @_; my $meth = $et->GetNewValue('Jpeg2000:ColorSpecMethod'); my $prec = $et->GetNewValue('Jpeg2000:ColorSpecPrecedence') || 0; my $approx = $et->GetNewValue('Jpeg2000:ColorSpecApproximation') || 0; my $icc = $et->GetNewValue('ICC_Profile'); my $space = $et->GetNewValue('Jpeg2000:ColorSpace'); my $cdata = $et->GetNewValue('Jpeg2000:ColorSpecData'); unless ($meth) { if ($icc) { $meth = 2; } elsif (defined $space) { $meth = 1; } elsif (defined $cdata) { $meth = 4; } else { $et->Warn('Color space not defined'), return 0; } } if ($meth eq '1') { defined $space or $et->Warn('Must specify ColorSpace'), return 0; $cdata = pack('N', $space); } elsif ($meth eq '2' or $meth eq '3') { defined $icc or $et->Warn('Must specify ICC_Profile'), return 0; $cdata = $icc; } elsif ($meth eq '4') { defined $cdata or $et->Warn('Must specify ColorSpecData'), return 0; } else { $et->Warn('Unknown ColorSpecMethod'), return 0; } my $boxhdr = pack('N', length($cdata) + 11) . 'colr'; Write($outfile, $boxhdr, pack('CCC',$meth,$prec,$approx), $cdata) or return 0; ++$$et{CHANGED}; $et->VPrint(1, " + Jpeg2000:ColorSpec\n"); return 1; } #------------------------------------------------------------------------------ # Process JPEG 2000 box # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table # Returns: 1 on success when reading, or -1 on write error # (or JP2 box or undef when writing from buffer) sub ProcessJpeg2000Box($$$) { my ($et, $dirInfo, $tagTablePtr) = @_; my $dataPt = $$dirInfo{DataPt}; my $dataLen = $$dirInfo{DataLen}; my $dataPos = $$dirInfo{DataPos}; my $dirLen = $$dirInfo{DirLen} || 0; my $dirStart = $$dirInfo{DirStart} || 0; my $base = $$dirInfo{Base} || 0; my $raf = $$dirInfo{RAF}; my $outfile = $$dirInfo{OutFile}; my $dirEnd = $dirStart + $dirLen; my ($err, $outBuff, $verbose, $doColour); if ($outfile) { unless ($raf) { # buffer output to be used for return value $outBuff = ''; $outfile = \$outBuff; } # determine if we will be writing colr box if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'JP2Header') { $doColour = 2 if defined $et->GetNewValue('ColorSpecMethod') or $et->GetNewValue('ICC_Profile') or defined $et->GetNewValue('ColorSpecPrecedence') or defined $et->GetNewValue('ColorSpace') or defined $et->GetNewValue('ColorSpecApproximation') or defined $et->GetNewValue('ColorSpecData'); } } else { # (must not set verbose flag when writing!) $verbose = $$et{OPTIONS}{Verbose}; $et->VerboseDir($$dirInfo{DirName}) if $verbose; } # loop through all contained boxes my ($pos, $boxLen, $lastBox); for ($pos=$dirStart; ; $pos+=$boxLen) { my ($boxID, $buff, $valuePtr); my $hdrLen = 8; # the box header length if ($raf) { $dataPos = $raf->Tell() - $base; my $n = $raf->Read($buff,$hdrLen); unless ($n == $hdrLen) { $n and $err = '', last; CreateNewBoxes($et, $outfile) or $err = 1 if $outfile; last; } $dataPt = \$buff; $dirLen = $dirEnd = $hdrLen; $pos = 0; } elsif ($pos >= $dirEnd - $hdrLen) { $err = '' unless $pos == $dirEnd; last; } $boxLen = unpack("x$pos N",$$dataPt); # (length includes header and data) $boxID = substr($$dataPt, $pos+4, 4); # remove old colr boxes if necessary if ($doColour and $boxID eq 'colr') { if ($doColour == 1) { # did we successfully write the new colr box? $et->VPrint(1," - Jpeg2000:ColorSpec\n"); ++$$et{CHANGED}; next; } $et->Warn('Out-of-order colr box encountered'); undef $doColour; } $lastBox = $boxID; $pos += $hdrLen; # move to end of box header if ($boxLen == 1) { # box header contains an additional 8-byte integer for length $hdrLen += 8; if ($raf) { my $buf2; if ($raf->Read($buf2,8) == 8) { $buff .= $buf2; $dirLen = $dirEnd = $hdrLen; } } $pos > $dirEnd - 8 and $err = '', last; my ($hi, $lo) = unpack("x$pos N2",$$dataPt); $hi and $err = "Can't currently handle JPEG 2000 boxes > 4 GB", last; $pos += 8; # move to end of extended-length box header $boxLen = $lo - $hdrLen; # length of remaining box data } elsif ($boxLen == 0) { if ($raf) { if ($outfile) { CreateNewBoxes($et, $outfile) or $err = 1; # copy over the rest of the file Write($outfile, $$dataPt) or $err = 1; while ($raf->Read($buff, 65536)) { Write($outfile, $buff) or $err = 1; } } elsif ($verbose) { my $msg = sprintf("offset 0x%.4x to end of file", $dataPos + $base + $pos); $et->VPrint(0, "$$et{INDENT}- Tag '${boxID}' ($msg)\n"); } last; # (ignore the rest of the file when reading) } $boxLen = $dirEnd - $pos; # data runs to end of file } else { $boxLen -= $hdrLen; # length of remaining box data } $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last; my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID); unless (defined $tagInfo or $verbose) { # no need to process this box if ($raf) { if ($outfile) { Write($outfile, $$dataPt) or $err = 1; $raf->Read($buff,$boxLen) == $boxLen or $err = '', last; Write($outfile, $buff) or $err = 1; } else { $raf->Seek($boxLen, 1) or $err = 'Seek error', last; } } elsif ($outfile) { Write($outfile, substr($$dataPt, $pos-$hdrLen, $boxLen+$hdrLen)) or $err = '', last; } next; } if ($raf) { # read the box data $dataPos = $raf->Tell() - $base; $raf->Read($buff,$boxLen) == $boxLen or $err = '', last; $valuePtr = 0; $dataLen = $boxLen; } elsif ($pos + $boxLen > $dirEnd) { $err = ''; last; } else { $valuePtr = $pos; } if (defined $tagInfo and not $tagInfo) { # GetTagInfo() required the value for a Condition my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128); $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID, \$tmpVal); } # delete all UUID boxes and any writable box if deleting all information if ($outfile and $tagInfo) { if ($boxID eq 'uuid' and $$et{DEL_GROUP}{'*'}) { $et->VPrint(0, " Deleting $$tagInfo{Name}\n"); ++$$et{CHANGED}; next; } elsif ($$tagInfo{Writable}) { my $isOverwriting; if ($$et{DEL_GROUP}{Jpeg2000}) { $isOverwriting = 1; } else { my $nvHash = $et->GetNewValueHash($tagInfo); $isOverwriting = $et->IsOverwriting($nvHash); } if ($isOverwriting) { my $val = substr($$dataPt, $valuePtr, $boxLen); $et->VerboseValue("- Jpeg2000:$$tagInfo{Name}", $val); ++$$et{CHANGED}; next; } elsif (not $$tagInfo{List}) { delete $$et{AddJp2Tags}{$boxID}; } } } # create new tag for JUMBF data values with name corresponding to JUMBFLabel if ($tagInfo and $$et{JUMBFLabel} and (not $$tagInfo{SubDirectory} or $$tagInfo{BlockExtract})) { $tagInfo = { %$tagInfo, Name => $$et{JUMBFLabel} . ($$tagInfo{JUMBF_Suffix} || '') }; delete $$tagInfo{Description}; AddTagToTable($tagTablePtr, '_JUMBF_' . $$et{JUMBFLabel}, $tagInfo); delete $$tagInfo{Protected}; # (must do this so -j -b returns JUMBF binary data) $$tagInfo{TagID} = $boxID; } if ($verbose) { $et->VerboseInfo($boxID, $tagInfo, Table => $tagTablePtr, DataPt => $dataPt, Size => $boxLen, Start => $valuePtr, Addr => $valuePtr + $dataPos + $base, ); next unless $tagInfo; } if ($$tagInfo{SubDirectory}) { my $subdir = $$tagInfo{SubDirectory}; my $subdirStart = $valuePtr; if (defined $$subdir{Start}) { #### eval Start ($valuePtr) $subdirStart = eval($$subdir{Start}); } my $subdirLen = $boxLen - ($subdirStart - $valuePtr); my %subdirInfo = ( Parent => 'JP2', DataPt => $dataPt, DataPos => -$subdirStart, # (relative to Base) DataLen => $dataLen, DirStart => $subdirStart, DirLen => $subdirLen, DirName => $$subdir{DirName} || $$tagInfo{Name}, OutFile => $outfile, Base => $base + $dataPos + $subdirStart, ); my $uuid = $uuid{$$tagInfo{Name}}; # remove "UUID-" prefix to allow appropriate directories to be written as a block $subdirInfo{DirName} =~ s/^UUID-//; my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr; if ($outfile) { # remove this directory from our create list delete $$et{AddJp2Dirs}{$$tagInfo{Name}}; my $newdir; # only edit writable UUID, Exif and jp2h boxes if ($uuid or $boxID eq 'Exif' or ($boxID eq 'xml ' and $$et{IsJXL}) or ($boxID eq 'jp2h' and $$et{EDIT_DIRS}{jp2h})) { $newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc}); next if defined $newdir and not length $newdir; # next if deleting the box } elsif (defined $uuid) { $et->Warn("Not editing $$tagInfo{Name} box", 1); } # use old box data if not changed defined $newdir or $newdir = substr($$dataPt, $subdirStart, $subdirLen); my $prefixLen = $subdirStart - $valuePtr; my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID; $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen; Write($outfile, $boxhdr, $newdir) or $err = 1; # write new colr box immediately after ihdr if ($doColour and $boxID eq 'ihdr') { # (shouldn't be multiple ihdr boxes, but just in case, write only 1) $doColour = $doColour==2 ? CreateColorSpec($et, $outfile) : 0; } } else { # extract as a block if specified $subdirInfo{BlockInfo} = $tagInfo if $$tagInfo{BlockExtract}; $et->Warn("Reading non-standard $$tagInfo{Name} box") if defined $uuid and $uuid eq '0'; unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) { if ($subTable eq $tagTablePtr) { $err = 'JPEG 2000 format error'; last; } $et->Warn("Unrecognized $$tagInfo{Name} box"); } } } elsif ($$tagInfo{Format} and not $outfile) { # only save tag values if Format was specified my $rational; my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen, \$rational); if (defined $val) { my $key = $et->FoundTag($tagInfo, $val); # save Rational value $$et{RATIONAL}{$key} = $rational if defined $rational and defined $key; } } elsif ($outfile) { my $boxhdr = pack('N', $boxLen + 8) . $boxID; Write($outfile, $boxhdr, substr($$dataPt, $valuePtr, $boxLen)) or $err = 1; } } if (defined $err) { $err or $err = 'Truncated JPEG 2000 box'; if ($outfile) { $et->Error($err) unless $err eq '1'; return $raf ? -1 : undef; } $et->Warn($err); } return $outBuff if $outfile and not $raf; return 1; } #------------------------------------------------------------------------------ # Return bits from a bitstream object # Inputs: 0) array ref, 1) number of bits # Returns: specified number of bits as an integer, and shifts input bitstream sub GetBits($$) { my ($a, $n) = @_; my $v = 0; my $bit = 1; my $i; while ($n--) { for ($i=0; $i<@$a; ++$i) { # consume bits LSB first my $set = $$a[$i] & 1; $$a[$i] >>= 1; if ($i) { $$a[$i-1] |= 0x80 if $set; } else { $v |= $bit if $set; $bit <<= 1; } } } return $v; } #------------------------------------------------------------------------------ # Extract parameters from JPEG XL codestream [unverified!] # Inputs: 0) ExifTool ref, 1) codestream ref # Returns: 1 sub ProcessJXLCodestream($$) { my ($et, $dataPt) = @_; # add padding if necessary to avoid unpacking past end of data if (length $$dataPt < 14) { my $tmp = $$dataPt . ("\0" x 14); $dataPt = \$tmp; } my @a = unpack 'x2C12', $$dataPt; my ($x, $y); my $small = GetBits(\@a, 1); if ($small) { $y = (GetBits(\@a, 5) + 1) * 8; } else { $y = GetBits(\@a, [9, 13, 18, 30]->[GetBits(\@a, 2)]) + 1; } my $ratio = GetBits(\@a, 3); if ($ratio == 0) { if ($small) { $x = (GetBits(\@a, 5) + 1) * 8;; } else { $x = GetBits(\@a, [9, 13, 18, 30]->[GetBits(\@a, 2)]) + 1; } } else { my $r = [[1,1],[12,10],[4,3],[3,2],[16,9],[5,4],[2,1]]->[$ratio-1]; $x = int($y * $$r[0] / $$r[1]); } $et->FoundTag(ImageWidth => $x); $et->FoundTag(ImageHeight => $y); return 1; } #------------------------------------------------------------------------------ # Read/write meta information from a JPEG 2000 image # Inputs: 0) ExifTool object reference, 1) dirInfo reference # Returns: 1 on success, 0 if this wasn't a valid JPEG 2000 file, or -1 on write error sub ProcessJP2($$) { local $_; my ($et, $dirInfo) = @_; my $raf = $$dirInfo{RAF}; my $outfile = $$dirInfo{OutFile}; my $hdr; # check to be sure this is a valid JPG2000 file return 0 unless $raf->Read($hdr,12) == 12; unless ($hdr eq "\0\0\0\x0cjP \x0d\x0a\x87\x0a" or # (ref 1) $hdr eq "\0\0\0\x0cjP\x1a\x1a\x0d\x0a\x87\x0a" or # (ref 2) $$et{IsJXL}) { return 0 unless $hdr =~ /^\xff\x4f\xff\x51\0/; # check for JP2 codestream format if ($outfile) { $et->Error('Writing of J2C files is not yet supported'); return 0 } # add J2C markers if not done already unless ($Image::ExifTool::jpegMarker{0x4f}) { $Image::ExifTool::jpegMarker{$_} = $j2cMarker{$_} foreach keys %j2cMarker; } $et->SetFileType('J2C'); $raf->Seek(0,0); return $et->ProcessJPEG($dirInfo); # decode with JPEG processor } if ($outfile) { Write($outfile, $hdr) or return -1; if ($$et{IsJXL}) { $et->InitWriteDirs(\%jxlMap); $$et{AddJp2Tags} = { }; # (don't add JP2 tags in JXL files) } else { $et->InitWriteDirs(\%jp2Map); $$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main); } # save list of directories to create my %addDirs = %{$$et{ADD_DIRS}}; # (make a copy) $$et{AddJp2Dirs} = \%addDirs; } else { my ($buff, $fileType); # recognize JPX and JPM as unique types of JP2 if ($raf->Read($buff, 12) == 12 and $buff =~ /^.{4}ftyp(.{4})/s) { $fileType = 'JPX' if $1 eq 'jpx '; $fileType = 'JPM' if $1 eq 'jpm '; $fileType = 'JXL' if $1 eq 'jxl '; } $raf->Seek(-length($buff), 1) if defined $buff; $et->SetFileType($fileType); } SetByteOrder('MM'); # JPEG 2000 files are big-endian my %dirInfo = ( RAF => $raf, DirName => 'JP2', OutFile => $$dirInfo{OutFile}, ); my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main'); return $et->ProcessDirectory(\%dirInfo, $tagTablePtr); } #------------------------------------------------------------------------------ # Read meta information from a JPEG XL image # Inputs: 0) ExifTool object reference, 1) dirInfo reference # Returns: 1 on success, 0 if this wasn't a valid JPEG XL file, -1 on write error sub ProcessJXL($$) { my ($et, $dirInfo) = @_; my $raf = $$dirInfo{RAF}; my $outfile = $$dirInfo{OutFile}; my ($hdr, $buff); return 0 unless $raf->Read($hdr,12) == 12; if ($hdr eq "\0\0\0\x0cJXL \x0d\x0a\x87\x0a") { # JPEG XL in ISO BMFF container $$et{IsJXL} = 1; } elsif ($hdr =~ /^\xff\x0a/) { # JPEG XL codestream if ($outfile) { if ($$et{OPTIONS}{IgnoreMinorErrors}) { $et->Warn('Wrapped JXL codestream in ISO BMFF container'); } else { $et->Error('Will wrap JXL codestream in ISO BMFF container for writing',1); return 0; } $$et{IsJXL} = 2; my $buff = "\0\0\0\x0cJXL \x0d\x0a\x87\x0a\0\0\0\x14ftypjxl \0\0\0\0jxl "; # add metadata to empty ISO BMFF container $$dirInfo{RAF} = new File::RandomAccess(\$buff); } else { $et->SetFileType('JXL Codestream','image/jxl', 'jxl'); return ProcessJXLCodestream($et, \$hdr); } } else { return 0; } $raf->Seek(0,0) or $et->Error('Seek error'), return 0; my $success = ProcessJP2($et, $dirInfo); if ($outfile and $success > 0 and $$et{IsJXL} == 2) { # attach the JXL codestream box to the ISO BMFF file $raf->Seek(0,2) or return -1; my $size = $raf->Tell(); $raf->Seek(0,0) or return -1; SetByteOrder('MM'); Write($outfile, Set32u($size + 8), 'jxlc') or return -1; while ($raf->Read($buff, 65536)) { Write($outfile, $buff) or return -1; } } return $success; } 1; # end __END__ =head1 NAME Image::ExifTool::Jpeg2000 - Read JPEG 2000 meta information =head1 SYNOPSIS This module is used by Image::ExifTool =head1 DESCRIPTION This module contains routines required by Image::ExifTool to read JPEG 2000 files. =head1 AUTHOR Copyright 2003-2022, Phil Harvey (philharvey66 at gmail.com) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 REFERENCES =over 4 =item L<http://www.jpeg.org/public/fcd15444-2.pdf> =item L<ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf> =back =head1 SEE ALSO L<Image::ExifTool::TagNames/Jpeg2000 Tags>, L<Image::ExifTool(3pm)|Image::ExifTool> =cut Save