diff options
Diffstat (limited to 'lib/Image/ExifTool/Jpeg2000.pm')
| -rw-r--r-- | lib/Image/ExifTool/Jpeg2000.pm | 116 |
1 files changed, 105 insertions, 11 deletions
diff --git a/lib/Image/ExifTool/Jpeg2000.pm b/lib/Image/ExifTool/Jpeg2000.pm index cdb7b49b..75ae5d02 100644 --- a/lib/Image/ExifTool/Jpeg2000.pm +++ b/lib/Image/ExifTool/Jpeg2000.pm @@ -16,7 +16,7 @@ use strict; use vars qw($VERSION); use Image::ExifTool qw(:DataAccess :Utils); -$VERSION = '1.31'; +$VERSION = '1.32'; sub ProcessJpeg2000Box($$$); sub ProcessJUMD($$$); @@ -42,8 +42,9 @@ my %jp2Map = ( 'UUID-IPTC' => 'JP2', 'UUID-EXIF' => 'JP2', 'UUID-XMP' => 'JP2', - # jp2h => 'JP2', (not yet functional) - # ICC_Profile => 'jp2h', (not yet functional) + jp2h => 'JP2', + colr => 'jp2h', + ICC_Profile => 'colr', IFD1 => 'IFD0', EXIF => 'IFD0', # to write EXIF as a block ExifIFD => 'IFD0', @@ -560,11 +561,31 @@ my %j2cMarker = ( %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, + 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', @@ -572,9 +593,15 @@ my %j2cMarker = ( 4 => 'Vendor Color', }, }, - 1 => 'ColorSpecPrecedence', + 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', @@ -599,6 +626,7 @@ my %j2cMarker = ( Name => 'ColorSpace', Condition => '$$self{ColorSpecMethod} == 1', Format => 'int32u', + Protected => 1, PrintConv => { # ref 15444-2 2002-05-15 0 => 'Bi-level', 1 => 'YCbCr(1)', @@ -628,6 +656,8 @@ my %j2cMarker = ( { Name => 'ColorSpecData', Format => 'undef[$size-3]', + Writable => 'undef', + Protected => 1, Binary => 1, }, ], @@ -818,6 +848,48 @@ sub CreateNewBoxes($$) } #------------------------------------------------------------------------------ +# 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 @@ -834,7 +906,7 @@ sub ProcessJpeg2000Box($$$) my $raf = $$dirInfo{RAF}; my $outfile = $$dirInfo{OutFile}; my $dirEnd = $dirStart + $dirLen; - my ($err, $outBuff, $verbose); + my ($err, $outBuff, $verbose, $doColour); if ($outfile) { unless ($raf) { @@ -842,13 +914,19 @@ sub ProcessJpeg2000Box($$$) $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); + my ($pos, $boxLen, $lastBox); for ($pos=$dirStart; ; $pos+=$boxLen) { my ($boxID, $buff, $valuePtr); my $hdrLen = 8; # the box header length @@ -857,9 +935,7 @@ sub ProcessJpeg2000Box($$$) my $n = $raf->Read($buff,$hdrLen); unless ($n == $hdrLen) { $n and $err = '', last; - if ($outfile) { - CreateNewBoxes($et, $outfile) or $err = 1; - } + CreateNewBoxes($et, $outfile) or $err = 1 if $outfile; last; } $dataPt = \$buff; @@ -871,6 +947,17 @@ sub ProcessJpeg2000Box($$$) } $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 @@ -1009,8 +1096,10 @@ sub ProcessJpeg2000Box($$$) # remove this directory from our create list delete $$et{AddJp2Dirs}{$$tagInfo{Name}}; my $newdir; - # only edit writable UUID and Exif boxes - if ($uuid or $boxID eq 'Exif' or ($boxID eq 'xml ' and $$et{IsJXL})) { + # 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) { @@ -1022,6 +1111,11 @@ sub ProcessJpeg2000Box($$$) 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}; |