Ignore:
Timestamp:
2021-02-26T19:39:51+13:00 (3 years ago)
Author:
anupama
Message:

Committing the improvements to EmbeddedMetaPlugin's processing of Keywords vs other metadata fields. Keywords were literally stored as arrays of words rather than phrases in PDFs (at least in Diego's sample PDF), whereas other meta fields like Subjects and Creators stored them as arrays of phrases. To get both to work, Kathy updated EXIF to a newer version, to retrieve the actual EXIF values stored in the PDF. And Kathy and Dr Bainbridge came up with a new option that I added called apply_join_before_split_to_metafields that's a regex which can list the metadata fields to apply the join_before_split to and whcih previously always got applied to all metadata fields. Now it's applied to any *Keywords metafields by default, as that's the metafield we have experience of that behaves differently to the others, as it stores by word instead of phrases. Tested on Diego's sample PDF. Diego has double-checked it to works on his sample PDF too, setting the split char to ; and turning on the join_before_split and leaving apply_join_before_split_to_metafields at its default of .*Keywords. File changes are strings.properties for the tooltip, the plugin introducing the option and working with it and Kathy's EXIF updates affecting cpan/File and cpan/Image.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • main/trunk/greenstone2/perllib/cpan/Image/ExifTool/Jpeg2000.pm

    r24107 r34921  
    1717use Image::ExifTool qw(:DataAccess :Utils);
    1818
    19 $VERSION = '1.16';
     19$VERSION = '1.27';
    2020
    2121sub ProcessJpeg2000Box($$$);
    … …  
    5858my %uuid = (
    5959    'UUID-EXIF'   => 'JpgTiffExif->JP2',
     60    'UUID-EXIF2'  => '',    # (flags a warning when writing)
     61    'UUID-EXIF_bad' => '0', # (flags a warning when reading and writing)
    6062    'UUID-IPTC'   => "\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38",
    6163    'UUID-XMP'    => "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac",
    … …  
    6466);
    6567
     68# JPEG2000 codestream markers (ref ISO/IEC FCD15444-1/2)
     69my %j2cMarker = (
     70    0x4f => 'SOC', # start of codestream
     71    0x51 => 'SIZ', # image and tile size
     72    0x52 => 'COD', # coding style default
     73    0x53 => 'COC', # coding style component
     74    0x55 => 'TLM', # tile-part lengths
     75    0x57 => 'PLM', # packet length, main header
     76    0x58 => 'PLT', # packet length, tile-part header
     77    0x5c => 'QCD', # quantization default
     78    0x5d => 'QCC', # quantization component
     79    0x5e => 'RGN', # region of interest
     80    0x5f => 'POD', # progression order default
     81    0x60 => 'PPM', # packed packet headers, main
     82    0x61 => 'PPT', # packed packet headers, tile-part
     83    0x63 => 'CRG', # component registration
     84    0x64 => 'CME', # comment and extension
     85    0x90 => 'SOT', # start of tile-part
     86    0x91 => 'SOP', # start of packet
     87    0x92 => 'EPH', # end of packet header
     88    0x93 => 'SOD', # start of data
     89    # extensions (ref ISO/IEC FCD15444-2)
     90    0x70 => 'DCO', # variable DC offset
     91    0x71 => 'VMS', # visual masking
     92    0x72 => 'DFS', # downsampling factor style
     93    0x73 => 'ADS', # arbitrary decomposition style
     94  # 0x72 => 'ATK', # arbitrary transformation kernels ?
     95    0x78 => 'CBD', # component bit depth
     96    0x74 => 'MCT', # multiple component transformation definition
     97    0x75 => 'MCC', # multiple component collection
     98    0x77 => 'MIC', # multiple component intermediate collection
     99    0x76 => 'NLT', # non-linearity point transformation
     100);
     101
    66102# JPEG 2000 "box" (ie. atom) names
     103# Note: only tags with a defined "Format" are extracted
    67104%Image::ExifTool::Jpeg2000::Main = (
    68105    GROUPS => { 2 => 'Image' },
    69106    PROCESS_PROC => \&ProcessJpeg2000Box,
    70107    WRITE_PROC => \&ProcessJpeg2000Box,
     108    PREFERRED => 1, # always add these tags when writing
    71109    NOTES => q{
    72110        The tags below are extracted from JPEG 2000 images, however ExifTool
    … …  
    93131        },
    94132        bpcc => 'BitsPerComponent',
    95         colr => [
    96             {
    97                 Name => 'ICC_Profile',
    98                 Condition => '$$valPt =~ /^(\x02|\x03)/',
    99                 SubDirectory => {
    100                     TagTable => 'Image::ExifTool::ICC_Profile::Main',
    101                     Start => '$valuePtr + 3',
    102                 },
    103             },
    104             {
    105                 Name => 'Colorspace',
    106                 Condition => '$$valPt =~ /^\x01/',
    107                 Format => 'binary',
    108                 ValueConv => 'unpack("x3N", $val)',
    109                 PrintConv => {
    110                     16 => 'sRGB',
    111                     17 => 'Grayscale',
    112                     18 => 'sYCC',
    113                 },
    114             },
    115             {
    116                 Name => 'ColorSpecification',
    117                 Binary => 1,
    118             },
    119         ],
     133        colr => {
     134            Name => 'ColorSpecification',
     135            SubDirectory => {
     136                TagTable => 'Image::ExifTool::Jpeg2000::ColorSpec',
     137            },
     138        },
    120139        pclr => 'Palette',
    121140        cdef => 'ComponentDefinition',
    … …  
    168187    copt => 'CompositionOptions',
    169188    inst => 'InstructionSet',
    170     asoc => 'Association',
     189    asoc => {
     190        Name => 'Association',
     191        SubDirectory => { },
     192    },
     193        # (Association box may contain any other sub-box)
    171194    nlst => 'NumberList',
    172195    bfil => 'BinaryFilter',
    … …  
    180203    jp2i => {
    181204        Name => 'IntellectualProperty',
    182         SubDirectory => {
    183             TagTable => 'Image::ExifTool::XMP::Main',
    184         },
     205        SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
    185206    },
    186207   'xml '=> {
    187208        Name => 'XML',
    188         SubDirectory => {
    189             TagTable => 'Image::ExifTool::XMP::Main',
    190         },
     209        Writable => 'undef',
     210        Flags => [ 'Binary', 'Protected', 'BlockExtract' ],
     211        List => 1,
     212        Notes => q{
     213            by default, the XML data in this tag is parsed using the ExifTool XMP module
     214            to to allow individual tags to be accessed when reading, but it may also be
     215            extracted as a block via the "XML" tag, which is also how this tag is
     216            written and copied.  This is a List-type tag because multiple XML blocks may
     217            exist
     218        },
     219        # (note: extracting as a block was broken in 11.04, and finally fixed in 12.14)
     220        SubDirectory => { TagTable => 'Image::ExifTool::XMP::XML' },
    191221    },
    192222    uuid => [
    193223        {
    194224            Name => 'UUID-EXIF',
    195             Condition => '$$valPt=~/^JpgTiffExif->JP2/',
     225            # (this is the EXIF that we create)
     226            Condition => '$$valPt=~/^JpgTiffExif->JP2(?!Exif\0\0)/',
    196227            SubDirectory => {
    197228                TagTable => 'Image::ExifTool::Exif::Main',
    … …  
    203234        },
    204235        {
     236            Name => 'UUID-EXIF2',
     237            # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
     238            Condition => '$$valPt=~/^\x05\x37\xcd\xab\x9d\x0c\x44\x31\xa7\x2a\xfa\x56\x1f\x2a\x11\x3e/',
     239            SubDirectory => {
     240                TagTable => 'Image::ExifTool::Exif::Main',
     241                ProcessProc => \&Image::ExifTool::ProcessTIFF,
     242                WriteProc => \&Image::ExifTool::WriteTIFF,
     243                DirName => 'EXIF',
     244                Start => '$valuePtr + 16',
     245            },
     246        },
     247        {
     248            Name => 'UUID-EXIF_bad',
     249            # written by Digikam
     250            Condition => '$$valPt=~/^JpgTiffExif->JP2/',
     251            SubDirectory => {
     252                TagTable => 'Image::ExifTool::Exif::Main',
     253                ProcessProc => \&Image::ExifTool::ProcessTIFF,
     254                WriteProc => \&Image::ExifTool::WriteTIFF,
     255                DirName => 'EXIF',
     256                Start => '$valuePtr + 22',
     257            },
     258        },
     259        {
    205260            Name => 'UUID-IPTC',
     261            # (this is the IPTC that we create)
    206262            Condition => '$$valPt=~/^\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38/',
     263            SubDirectory => {
     264                TagTable => 'Image::ExifTool::IPTC::Main',
     265                Start => '$valuePtr + 16',
     266            },
     267        },
     268        {
     269            Name => 'UUID-IPTC2',
     270            # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
     271            Condition => '$$valPt=~/^\x09\xa1\x4e\x97\xc0\xb4\x42\xe0\xbe\xbf\x36\xdf\x6f\x0c\xe3\x6f/',
    207272            SubDirectory => {
    208273                TagTable => 'Image::ExifTool::IPTC::Main',
    … …  
    230295        },
    231296        {
     297            Name => 'UUID-Photoshop',
     298            # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
     299            Condition => '$$valPt=~/^\x2c\x4c\x01\x00\x85\x04\x40\xb9\xa0\x3e\x56\x21\x48\xd6\xdf\xeb/',
     300            SubDirectory => {
     301                TagTable => 'Image::ExifTool::Photoshop::Main',
     302                Start => '$valuePtr + 16',
     303            },
     304        },
     305        {
    232306            Name => 'UUID-Unknown',
    233307        },
     308        # also written by Adobe JPEG2000 plugin v1.5:
     309        # 3a 0d 02 18 0a e9 41 15 b3 76 4b ca 41 ce 0e 71 - 1 byte (01)
     310        # 47 c9 2c cc d1 a1 45 81 b9 04 38 bb 54 67 71 3b - 1 byte (01)
     311        # bc 45 a7 74 dd 50 4e c6 a9 f6 f3 a1 37 f4 7e 90 - 4 bytes (00 00 00 32)
     312        # d7 c8 c5 ef 95 1f 43 b2 87 57 04 25 00 f5 38 e8 - 4 bytes (00 00 00 32)
    234313    ],
    235314    uinf => {
    … …  
    308387        Format => 'undef[$size-8]',
    309388        # ignore any entry with a null, and return others as a list
    310         ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a', 
     389        ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a',
    311390    },
    312391);
    … …  
    360439);
    361440
     441%Image::ExifTool::Jpeg2000::ColorSpec = (
     442    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
     443    GROUPS => { 2 => 'Image' },
     444    FORMAT => 'int8s',
     445    0 => {
     446        Name => 'ColorSpecMethod',
     447        RawConv => '$$self{ColorSpecMethod} = $val',
     448        PrintConv => {
     449            1 => 'Enumerated',
     450            2 => 'Restricted ICC',
     451            3 => 'Any ICC',
     452            4 => 'Vendor Color',
     453        },
     454    },
     455    1 => 'ColorSpecPrecedence',
     456    2 => {
     457        Name => 'ColorSpecApproximation',
     458        PrintConv => {
     459            0 => 'Not Specified',
     460            1 => 'Accurate',
     461            2 => 'Exceptional Quality',
     462            3 => 'Reasonable Quality',
     463            4 => 'Poor Quality',
     464        },
     465    },
     466    3 => [
     467        {
     468            Name => 'ICC_Profile',
     469            Condition => q{
     470                $$self{ColorSpecMethod} == 2 or
     471                $$self{ColorSpecMethod} == 3
     472            },
     473            Format => 'undef[$size-3]',
     474            SubDirectory => {
     475                TagTable => 'Image::ExifTool::ICC_Profile::Main',
     476            },
     477        },
     478        {
     479            Name => 'ColorSpace',
     480            Condition => '$$self{ColorSpecMethod} == 1',
     481            Format => 'int32u',
     482            PrintConv => { # ref 15444-2 2002-05-15
     483                0 => 'Bi-level',
     484                1 => 'YCbCr(1)',
     485                3 => 'YCbCr(2)',
     486                4 => 'YCbCr(3)',
     487                9 => 'PhotoYCC',
     488                11 => 'CMY',
     489                12 => 'CMYK',
     490                13 => 'YCCK',
     491                14 => 'CIELab',
     492                15 => 'Bi-level(2)', # (incorrectly listed as 18 in 15444-2 2000-12-07)
     493                16 => 'sRGB',
     494                17 => 'Grayscale',
     495                18 => 'sYCC',
     496                19 => 'CIEJab',
     497                20 => 'e-sRGB',
     498                21 => 'ROMM-RGB',
     499                # incorrect in 15444-2 2000-12-07
     500                #22 => 'sRGB based YCbCr',
     501                #23 => 'YPbPr(1125/60)',
     502                #24 => 'YPbPr(1250/50)',
     503                22 => 'YPbPr(1125/60)',
     504                23 => 'YPbPr(1250/50)',
     505                24 => 'e-sYCC',
     506            },
     507        },
     508        {
     509            Name => 'ColorSpecData',
     510            Format => 'undef[$size-3]',
     511            Binary => 1,
     512        },
     513    ],
     514);
     515
    362516#------------------------------------------------------------------------------
    363517# Create new JPEG 2000 boxes when writing
    364 # (Currently only supports adding certain UUID boxes)
     518# (Currently only supports adding top-level Writable JPEG2000 tags and certain UUID boxes)
    365519# Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
    366520# Returns: 1 on success
    367521sub CreateNewBoxes($$)
    368522{
    369     my ($exifTool, $outfile) = @_;
    370     my $addDirs = $$exifTool{AddJp2Dirs};
    371     delete $$exifTool{AddJp2Dirs};
    372     my $dirName;
     523    my ($et, $outfile) = @_;
     524    my $addTags = $$et{AddJp2Tags};
     525    my $addDirs = $$et{AddJp2Dirs};
     526    delete $$et{AddJp2Tags};
     527    delete $$et{AddJp2Dirs};
     528    my ($tag, $dirName);
     529    # add JPEG2000 tags
     530    foreach $tag (sort keys %$addTags) {
     531        my $tagInfo = $$addTags{$tag};
     532        my $nvHash = $et->GetNewValueHash($tagInfo);
     533        # (native JPEG2000 information is always preferred, so don't check IsCreating)
     534        next unless $$tagInfo{List} or $et->IsOverwriting($nvHash) > 0;
     535        next if $$nvHash{EditOnly};
     536        my @vals = $et->GetNewValue($nvHash);
     537        my $val;
     538        foreach $val (@vals) {
     539            my $boxhdr = pack('N', length($val) + 8) . $$tagInfo{TagID};
     540            Write($outfile, $boxhdr, $val) or return 0;
     541            ++$$et{CHANGED};
     542            $et->VerboseValue("+ Jpeg2000:$$tagInfo{Name}", $val);
     543        }
     544    }
     545    # add UUID boxes
    373546    foreach $dirName (sort keys %$addDirs) {
    374547        next unless $uuid{$dirName};
    … …  
    382555                Parent => 'JP2',
    383556            );
    384             my $newdir = $exifTool->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
     557            # remove "UUID-" from start of directory name to allow appropriate
     558            # directories to be written as a block
     559            $dirInfo{DirName} =~ s/^UUID-//;
     560            my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
    385561            if (defined $newdir and length $newdir) {
    386562                my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName};
    … …  
    400576sub ProcessJpeg2000Box($$$)
    401577{
    402     my ($exifTool, $dirInfo, $tagTablePtr) = @_;
     578    my ($et, $dirInfo, $tagTablePtr) = @_;
    403579    my $dataPt = $$dirInfo{DataPt};
    404580    my $dataLen = $$dirInfo{DataLen};
    … …  
    406582    my $dirLen = $$dirInfo{DirLen} || 0;
    407583    my $dirStart = $$dirInfo{DirStart} || 0;
     584    my $base = $$dirInfo{Base} || 0;
    408585    my $raf = $$dirInfo{RAF};
    409586    my $outfile = $$dirInfo{OutFile};
    … …  
    419596    } else {
    420597        # (must not set verbose flag when writing!)
    421         $verbose = $exifTool->{OPTIONS}->{Verbose};
     598        $verbose = $$et{OPTIONS}{Verbose};
     599        $et->VerboseDir($$dirInfo{DirName}) if $verbose;
    422600    }
    423601    # loop through all contained boxes
    … …  
    425603    for ($pos=$dirStart; ; $pos+=$boxLen) {
    426604        my ($boxID, $buff, $valuePtr);
     605        my $hdrLen = 8;     # the box header length
    427606        if ($raf) {
    428             $dataPos = $raf->Tell();
    429             my $n = $raf->Read($buff,8);
    430             unless ($n == 8) {
     607            $dataPos = $raf->Tell() - $base;
     608            my $n = $raf->Read($buff,$hdrLen);
     609            unless ($n == $hdrLen) {
    431610                $n and $err = '', last;
    432611                if ($outfile) {
    433                     CreateNewBoxes($exifTool, $outfile) or $err = 1;
     612                    CreateNewBoxes($et, $outfile) or $err = 1;
    434613                }
    435614                last;
    436615            }
    437616            $dataPt = \$buff;
    438             $dirLen = 8;
     617            $dirLen = $dirEnd = $hdrLen;
    439618            $pos = 0;
    440         } elsif ($pos >= $dirEnd - 8) {
     619        } elsif ($pos >= $dirEnd - $hdrLen) {
    441620            $err = '' unless $pos == $dirEnd;
    442621            last;
    443622        }
    444         $boxLen = unpack("x$pos N",$$dataPt);
     623        $boxLen = unpack("x$pos N",$$dataPt);   # (length includes header and data)
    445624        $boxID = substr($$dataPt, $pos+4, 4);
    446         $pos += 8;
     625        $pos += $hdrLen;                # move to end of box header
    447626        if ($boxLen == 1) {
    448             if (not $raf and $pos < $dirLen - 8) {
    449                 $err = 'JPEG 2000 format error';
    450             } else {
    451                 $err = "Can't currently handle huge JPEG 2000 boxes";
     627            # box header contains an additional 8-byte integer for length
     628            $hdrLen += 8;
     629            if ($raf) {
     630                my $buf2;
     631                if ($raf->Read($buf2,8) == 8) {
     632                    $buff .= $buf2;
     633                    $dirLen = $dirEnd = $hdrLen;
     634                }
    452635            }
    453             last;
     636            $pos > $dirEnd - 8 and $err = '', last;
     637            my ($hi, $lo) = unpack("x$pos N2",$$dataPt);
     638            $hi and $err = "Can't currently handle JPEG 2000 boxes > 4 GB", last;
     639            $pos += 8;                  # move to end of extended-length box header
     640            $boxLen = $lo - $hdrLen;    # length of remaining box data
    454641        } elsif ($boxLen == 0) {
    455642            if ($raf) {
    456643                if ($outfile) {
    457                     CreateNewBoxes($exifTool, $outfile) or $err = 1;
     644                    CreateNewBoxes($et, $outfile) or $err = 1;
    458645                    # copy over the rest of the file
    459646                    Write($outfile, $$dataPt) or $err = 1;
    … …  
    461648                        Write($outfile, $buff) or $err = 1;
    462649                    }
     650                } elsif ($verbose) {
     651                    my $msg = sprintf("offset 0x%.4x to end of file", $dataPos + $base + $pos);
     652                    $et->VPrint(0, "$$et{INDENT}- Tag '${boxID}' ($msg)\n");
    463653                }
    464654                last;   # (ignore the rest of the file when reading)
    465655            }
    466             $boxLen = $dirLen - $pos;
     656            $boxLen = $dirEnd - $pos;   # data runs to end of file
    467657        } else {
    468             $boxLen -= 8;
     658            $boxLen -= $hdrLen;         # length of remaining box data
    469659        }
    470660        $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
    471         my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $boxID);
     661        my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
    472662        unless (defined $tagInfo or $verbose) {
    473663            # no need to process this box
    … …  
    481671                }
    482672            } elsif ($outfile) {
    483                 Write($outfile, substr($$dataPt, $pos-8, $boxLen+8)) or $err = '', last;
     673                Write($outfile, substr($$dataPt, $pos-$hdrLen, $boxLen+$hdrLen)) or $err = '', last;
    484674            }
    485675            next;
    … …  
    487677        if ($raf) {
    488678            # read the box data
    489             $dataPos = $raf->Tell();
     679            $dataPos = $raf->Tell() - $base;
    490680            $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
    491681            $valuePtr = 0;
    492682            $dataLen = $boxLen;
    493         } elsif ($boxLen + $pos > $dirStart + $dirLen) {
     683        } elsif ($pos + $boxLen > $dirEnd) {
    494684            $err = '';
    495685            last;
    … …  
    500690            # GetTagInfo() required the value for a Condition
    501691            my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128);
    502             $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
    503         }
    504         # delete all UUID boxes if deleting all information
    505         if ($outfile and $boxID eq 'uuid' and $exifTool->{DEL_GROUP}->{'*'}) {
    506             $exifTool->VPrint(0, "  Deleting $$tagInfo{Name}\n");
    507             ++$exifTool->{CHANGED};
    508             next;
     692            $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
     693        }
     694        # delete all UUID boxes and any writable box if deleting all information
     695        if ($outfile and $tagInfo) {
     696            if ($boxID eq 'uuid' and $$et{DEL_GROUP}{'*'}) {
     697                $et->VPrint(0, "  Deleting $$tagInfo{Name}\n");
     698                ++$$et{CHANGED};
     699                next;
     700            } elsif ($$tagInfo{Writable}) {
     701                my $isOverwriting;
     702                if ($$et{DEL_GROUP}{Jpeg2000}) {
     703                    $isOverwriting = 1;
     704                } else {
     705                    my $nvHash = $et->GetNewValueHash($tagInfo);
     706                    $isOverwriting = $et->IsOverwriting($nvHash);
     707                }
     708                if ($isOverwriting) {
     709                    my $val = substr($$dataPt, $valuePtr, $boxLen);
     710                    $et->VerboseValue("- Jpeg2000:$$tagInfo{Name}", $val);
     711                    ++$$et{CHANGED};
     712                    next;
     713                } elsif (not $$tagInfo{List}) {
     714                    delete $$et{AddJp2Tags}{$boxID};
     715                }
     716            }
    509717        }
    510718        if ($verbose) {
    511             $exifTool->VerboseInfo($boxID, $tagInfo,
     719            $et->VerboseInfo($boxID, $tagInfo,
    512720                Table  => $tagTablePtr,
    513721                DataPt => $dataPt,
    514722                Size   => $boxLen,
    515723                Start  => $valuePtr,
     724                Addr   => $valuePtr + $dataPos + $base,
    516725            );
    517726            next unless $tagInfo;
    … …  
    528737                Parent => 'JP2',
    529738                DataPt => $dataPt,
    530                 DataPos => $dataPos,
     739                DataPos => -$subdirStart, # (relative to Base)
    531740                DataLen => $dataLen,
    532741                DirStart => $subdirStart,
    … …  
    534743                DirName => $$subdir{DirName} || $$tagInfo{Name},
    535744                OutFile => $outfile,
    536                 Base => $dataPos + $subdirStart,
     745                Base => $base + $dataPos + $subdirStart,
    537746            );
     747            my $uuid = $uuid{$$tagInfo{Name}};
     748            # remove "UUID-" prefix to allow appropriate directories to be written as a block
     749            $subdirInfo{DirName} =~ s/^UUID-//;
    538750            my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
    539751            if ($outfile) {
    540752                # remove this directory from our create list
    541                 delete $exifTool->{AddJp2Dirs}->{$$tagInfo{Name}};
     753                delete $$et{AddJp2Dirs}{$$tagInfo{Name}};
    542754                my $newdir;
    543755                # only edit writable UUID boxes
    544                 if ($uuid{$$tagInfo{Name}}) {
    545                     $newdir = $exifTool->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
     756                if ($uuid) {
     757                    $newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
    546758                    next if defined $newdir and not length $newdir; # next if deleting the box
     759                } elsif (defined $uuid) {
     760                    $et->Warn("Not editing $$tagInfo{Name} box", 1);
    547761                }
    548762                # use old box data if not changed
    … …  
    552766                $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
    553767                Write($outfile, $boxhdr, $newdir) or $err = 1;
    554             } elsif (not $exifTool->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
    555                 if ($subTable eq $tagTablePtr) {
    556                     $err = 'JPEG 2000 format error';
    557                 } else {
    558                     $err = "Unrecognized $$tagInfo{Name} box";
     768            } else {
     769                # extract as a block if specified
     770                $subdirInfo{BlockInfo} = $tagInfo if $$tagInfo{BlockExtract};
     771                $et->Warn("Reading non-standard $$tagInfo{Name} box") if defined $uuid and $uuid eq '0';
     772                unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
     773                    if ($subTable eq $tagTablePtr) {
     774                        $err = 'JPEG 2000 format error';
     775                        last;
     776                    }
     777                    $et->Warn("Unrecognized $$tagInfo{Name} box");
    559778                }
    560                 last;
    561779            }
    562780        } elsif ($$tagInfo{Format} and not $outfile) {
    563781            # only save tag values if Format was specified
    564             my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen);
    565             $exifTool->FoundTag($tagInfo, $val) if defined $val;
     782            my $rational;
     783            my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen, \$rational);
     784            if (defined $val) {
     785                my $key = $et->FoundTag($tagInfo, $val);
     786                # save Rational value
     787                $$et{RATIONAL}{$key} = $rational if defined $rational and defined $key;
     788            }
    566789        } elsif ($outfile) {
    567790            my $boxhdr = pack('N', $boxLen + 8) . $boxID;
    … …  
    572795        $err or $err = 'Truncated JPEG 2000 box';
    573796        if ($outfile) {
    574             $exifTool->Error($err) unless $err eq '1';
     797            $et->Error($err) unless $err eq '1';
    575798            return $raf ? -1 : undef;
    576799        }
    577         $exifTool->Warn($err);
     800        $et->Warn($err);
    578801    }
    579802    return $outBuff if $outfile and not $raf;
    … …  
    587810sub ProcessJP2($$)
    588811{
    589     my ($exifTool, $dirInfo) = @_;
     812    local $_;
     813    my ($et, $dirInfo) = @_;
    590814    my $raf = $$dirInfo{RAF};
    591815    my $outfile = $$dirInfo{OutFile};
    … …  
    594818    # check to be sure this is a valid JPG2000 file
    595819    return 0 unless $raf->Read($hdr,12) == 12;
    596     return 0 unless $hdr eq "\x00\x00\x00\x0cjP  \x0d\x0a\x87\x0a" or     # (ref 1)
    597                     $hdr eq "\x00\x00\x00\x0cjP\x1a\x1a\x0d\x0a\x87\x0a"; # (ref 2)
    598 
     820    unless ($hdr eq "\x00\x00\x00\x0cjP  \x0d\x0a\x87\x0a" or     # (ref 1)
     821            $hdr eq "\x00\x00\x00\x0cjP\x1a\x1a\x0d\x0a\x87\x0a") # (ref 2)
     822    {
     823        return 0 unless $hdr =~ /^\xff\x4f\xff\x51\0/;  # check for JP2 codestream format
     824        if ($outfile) {
     825            $et->Error('Writing of J2C files is not yet supported');
     826            return 0
     827        }
     828        # add J2C markers if not done already
     829        unless ($Image::ExifTool::jpegMarker{0x4f}) {
     830            $Image::ExifTool::jpegMarker{$_} = $j2cMarker{$_} foreach keys %j2cMarker;
     831        }
     832        $et->SetFileType('J2C');
     833        $raf->Seek(0,0);
     834        return $et->ProcessJPEG($dirInfo);    # decode with JPEG processor
     835    }
    599836    if ($outfile) {
    600837        Write($outfile, $hdr) or return -1;
    601         $exifTool->InitWriteDirs(\%jp2Map);
     838        $et->InitWriteDirs(\%jp2Map);
    602839        # save list of directories to create
    603         my %addDirs = %{$$exifTool{ADD_DIRS}};
    604         $$exifTool{AddJp2Dirs} = \%addDirs;
     840        my %addDirs = %{$$et{ADD_DIRS}};
     841        $$et{AddJp2Dirs} = \%addDirs;
     842        $$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main);
    605843    } else {
    606844        my ($buff, $fileType);
    … …  
    611849        }
    612850        $raf->Seek(-length($buff), 1) if defined $buff;
    613         $exifTool->SetFileType($fileType);
     851        $et->SetFileType($fileType);
    614852    }
    615853    SetByteOrder('MM'); # JPEG 2000 files are big-endian
    … …  
    620858    );
    621859    my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
    622     return $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
     860    return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
    623861}
    624862
    … …  
    642880=head1 AUTHOR
    643881
    644 Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
     882Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
    645883
    646884This library is free software; you can redistribute it and/or modify it
Note: See TracChangeset for help on using the changeset viewer.