"Fossies" - the Fresh Open Source Software Archive

Member "Image-ExifTool-12.39/lib/Image/ExifTool/Jpeg2000.pm" (12 Jan 2022, 50837 Bytes) of package /linux/misc/Image-ExifTool-12.39.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Jpeg2000.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 12.38_vs_12.39.

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