source: main/trunk/greenstone2/perllib/cpan/Image/ExifTool/Jpeg2000.pm@ 34921

Last change on this file since 34921 was 34921, checked in by anupama, 3 years ago

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 size: 31.5 KB
Line 
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
13package Image::ExifTool::Jpeg2000;
14
15use strict;
16use vars qw($VERSION);
17use Image::ExifTool qw(:DataAccess :Utils);
18
19$VERSION = '1.27';
20
21sub ProcessJpeg2000Box($$$);
22
23my %resolutionUnit = (
24 -3 => 'km',
25 -2 => '100 m',
26 -1 => '10 m',
27 0 => 'm',
28 1 => '10 cm',
29 2 => 'cm',
30 3 => 'mm',
31 4 => '0.1 mm',
32 5 => '0.01 mm',
33 6 => 'um',
34);
35
36# map of where information is written in JPEG2000 image
37my %jp2Map = (
38 IPTC => 'UUID-IPTC',
39 IFD0 => 'UUID-EXIF',
40 XMP => 'UUID-XMP',
41 'UUID-IPTC' => 'JP2',
42 'UUID-EXIF' => 'JP2',
43 'UUID-XMP' => 'JP2',
44 # jp2h => 'JP2', (not yet functional)
45 # ICC_Profile => 'jp2h', (not yet functional)
46 IFD1 => 'IFD0',
47 EXIF => 'IFD0', # to write EXIF as a block
48 ExifIFD => 'IFD0',
49 GPS => 'IFD0',
50 SubIFD => 'IFD0',
51 GlobParamIFD => 'IFD0',
52 PrintIM => 'IFD0',
53 InteropIFD => 'ExifIFD',
54 MakerNotes => 'ExifIFD',
55);
56
57# UUID's for writable UUID directories (by tag name)
58my %uuid = (
59 'UUID-EXIF' => 'JpgTiffExif->JP2',
60 'UUID-EXIF2' => '', # (flags a warning when writing)
61 'UUID-EXIF_bad' => '0', # (flags a warning when reading and writing)
62 'UUID-IPTC' => "\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38",
63 'UUID-XMP' => "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac",
64 # (can't yet write GeoJP2 information)
65 # 'UUID-GeoJP2' => "\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03",
66);
67
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
102# JPEG 2000 "box" (ie. atom) names
103# Note: only tags with a defined "Format" are extracted
104%Image::ExifTool::Jpeg2000::Main = (
105 GROUPS => { 2 => 'Image' },
106 PROCESS_PROC => \&ProcessJpeg2000Box,
107 WRITE_PROC => \&ProcessJpeg2000Box,
108 PREFERRED => 1, # always add these tags when writing
109 NOTES => q{
110 The tags below are extracted from JPEG 2000 images, however ExifTool
111 currently writes only EXIF, IPTC and XMP tags in these images.
112 },
113 'jP ' => 'JP2Signature', # (ref 1)
114 "jP\x1a\x1a" => 'JP2Signature', # (ref 2)
115 prfl => 'Profile',
116 ftyp => {
117 Name => 'FileType',
118 SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::FileType' },
119 },
120 rreq => 'ReaderRequirements',
121 jp2h => {
122 Name => 'JP2Header',
123 SubDirectory => { },
124 },
125 # JP2Header sub boxes...
126 ihdr => {
127 Name => 'ImageHeader',
128 SubDirectory => {
129 TagTable => 'Image::ExifTool::Jpeg2000::ImageHeader',
130 },
131 },
132 bpcc => 'BitsPerComponent',
133 colr => {
134 Name => 'ColorSpecification',
135 SubDirectory => {
136 TagTable => 'Image::ExifTool::Jpeg2000::ColorSpec',
137 },
138 },
139 pclr => 'Palette',
140 cdef => 'ComponentDefinition',
141 'res '=> {
142 Name => 'Resolution',
143 SubDirectory => { },
144 },
145 # Resolution sub boxes...
146 resc => {
147 Name => 'CaptureResolution',
148 SubDirectory => {
149 TagTable => 'Image::ExifTool::Jpeg2000::CaptureResolution',
150 },
151 },
152 resd => {
153 Name => 'DisplayResolution',
154 SubDirectory => {
155 TagTable => 'Image::ExifTool::Jpeg2000::DisplayResolution',
156 },
157 },
158 jpch => {
159 Name => 'CodestreamHeader',
160 SubDirectory => { },
161 },
162 # CodestreamHeader sub boxes...
163 'lbl '=> {
164 Name => 'Label',
165 Format => 'string',
166 },
167 cmap => 'ComponentMapping',
168 roid => 'ROIDescription',
169 jplh => {
170 Name => 'CompositingLayerHeader',
171 SubDirectory => { },
172 },
173 # CompositingLayerHeader sub boxes...
174 cgrp => 'ColorGroup',
175 opct => 'Opacity',
176 creg => 'CodestreamRegistration',
177 dtbl => 'DataReference',
178 ftbl => {
179 Name => 'FragmentTable',
180 Subdirectory => { },
181 },
182 # FragmentTable sub boxes...
183 flst => 'FragmentList',
184 cref => 'Cross-Reference',
185 mdat => 'MediaData',
186 comp => 'Composition',
187 copt => 'CompositionOptions',
188 inst => 'InstructionSet',
189 asoc => {
190 Name => 'Association',
191 SubDirectory => { },
192 },
193 # (Association box may contain any other sub-box)
194 nlst => 'NumberList',
195 bfil => 'BinaryFilter',
196 drep => 'DesiredReproductions',
197 # DesiredReproductions sub boxes...
198 gtso => 'GraphicsTechnologyStandardOutput',
199 chck => 'DigitalSignature',
200 mp7b => 'MPEG7Binary',
201 free => 'Free',
202 jp2c => 'ContiguousCodestream',
203 jp2i => {
204 Name => 'IntellectualProperty',
205 SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
206 },
207 'xml '=> {
208 Name => 'XML',
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' },
221 },
222 uuid => [
223 {
224 Name => 'UUID-EXIF',
225 # (this is the EXIF that we create)
226 Condition => '$$valPt=~/^JpgTiffExif->JP2(?!Exif\0\0)/',
227 SubDirectory => {
228 TagTable => 'Image::ExifTool::Exif::Main',
229 ProcessProc => \&Image::ExifTool::ProcessTIFF,
230 WriteProc => \&Image::ExifTool::WriteTIFF,
231 DirName => 'EXIF',
232 Start => '$valuePtr + 16',
233 },
234 },
235 {
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 {
260 Name => 'UUID-IPTC',
261 # (this is the IPTC that we create)
262 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/',
272 SubDirectory => {
273 TagTable => 'Image::ExifTool::IPTC::Main',
274 Start => '$valuePtr + 16',
275 },
276 },
277 {
278 Name => 'UUID-XMP',
279 # ref http://www.adobe.com/products/xmp/pdfs/xmpspec.pdf
280 Condition => '$$valPt=~/^\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac/',
281 SubDirectory => {
282 TagTable => 'Image::ExifTool::XMP::Main',
283 Start => '$valuePtr + 16',
284 },
285 },
286 {
287 Name => 'UUID-GeoJP2',
288 # ref http://www.remotesensing.org/jpeg2000/
289 Condition => '$$valPt=~/^\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03/',
290 SubDirectory => {
291 TagTable => 'Image::ExifTool::Exif::Main',
292 ProcessProc => \&Image::ExifTool::ProcessTIFF,
293 Start => '$valuePtr + 16',
294 },
295 },
296 {
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 {
306 Name => 'UUID-Unknown',
307 },
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)
313 ],
314 uinf => {
315 Name => 'UUIDInfo',
316 SubDirectory => { },
317 },
318 # UUIDInfo sub boxes...
319 ulst => 'UUIDList',
320 'url '=> {
321 Name => 'URL',
322 Format => 'string',
323 },
324);
325
326%Image::ExifTool::Jpeg2000::ImageHeader = (
327 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
328 GROUPS => { 2 => 'Image' },
329 0 => {
330 Name => 'ImageHeight',
331 Format => 'int32u',
332 },
333 4 => {
334 Name => 'ImageWidth',
335 Format => 'int32u',
336 },
337 8 => {
338 Name => 'NumberOfComponents',
339 Format => 'int16u',
340 },
341 10 => {
342 Name => 'BitsPerComponent',
343 PrintConv => q{
344 $val == 0xff and return 'Variable';
345 my $sign = ($val & 0x80) ? 'Signed' : 'Unsigned';
346 return (($val & 0x7f) + 1) . " Bits, $sign";
347 },
348 },
349 11 => {
350 Name => 'Compression',
351 PrintConv => {
352 0 => 'Uncompressed',
353 1 => 'Modified Huffman',
354 2 => 'Modified READ',
355 3 => 'Modified Modified READ',
356 4 => 'JBIG',
357 5 => 'JPEG',
358 6 => 'JPEG-LS',
359 7 => 'JPEG 2000',
360 8 => 'JBIG2',
361 },
362 },
363);
364
365# (ref fcd15444-1/2/6.pdf)
366# (also see http://developer.apple.com/mac/library/documentation/QuickTime/QTFF/QTFFChap1/qtff1.html)
367%Image::ExifTool::Jpeg2000::FileType = (
368 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
369 GROUPS => { 2 => 'Video' },
370 FORMAT => 'int32u',
371 0 => {
372 Name => 'MajorBrand',
373 Format => 'undef[4]',
374 PrintConv => {
375 'jp2 ' => 'JPEG 2000 Image (.JP2)', # image/jp2
376 'jpm ' => 'JPEG 2000 Compound Image (.JPM)', # image/jpm
377 'jpx ' => 'JPEG 2000 with extensions (.JPX)', # image/jpx
378 },
379 },
380 1 => {
381 Name => 'MinorVersion',
382 Format => 'undef[4]',
383 ValueConv => 'sprintf("%x.%x.%x", unpack("nCC", $val))',
384 },
385 2 => {
386 Name => 'CompatibleBrands',
387 Format => 'undef[$size-8]',
388 # ignore any entry with a null, and return others as a list
389 ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a',
390 },
391);
392
393%Image::ExifTool::Jpeg2000::CaptureResolution = (
394 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
395 GROUPS => { 2 => 'Image' },
396 FORMAT => 'int8s',
397 0 => {
398 Name => 'CaptureYResolution',
399 Format => 'rational32u',
400 },
401 4 => {
402 Name => 'CaptureXResolution',
403 Format => 'rational32u',
404 },
405 8 => {
406 Name => 'CaptureYResolutionUnit',
407 SeparateTable => 'ResolutionUnit',
408 PrintConv => \%resolutionUnit,
409 },
410 9 => {
411 Name => 'CaptureXResolutionUnit',
412 SeparateTable => 'ResolutionUnit',
413 PrintConv => \%resolutionUnit,
414 },
415);
416
417%Image::ExifTool::Jpeg2000::DisplayResolution = (
418 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
419 GROUPS => { 2 => 'Image' },
420 FORMAT => 'int8s',
421 0 => {
422 Name => 'DisplayYResolution',
423 Format => 'rational32u',
424 },
425 4 => {
426 Name => 'DisplayXResolution',
427 Format => 'rational32u',
428 },
429 8 => {
430 Name => 'DisplayYResolutionUnit',
431 SeparateTable => 'ResolutionUnit',
432 PrintConv => \%resolutionUnit,
433 },
434 9 => {
435 Name => 'DisplayXResolutionUnit',
436 SeparateTable => 'ResolutionUnit',
437 PrintConv => \%resolutionUnit,
438 },
439);
440
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
516#------------------------------------------------------------------------------
517# Create new JPEG 2000 boxes when writing
518# (Currently only supports adding top-level Writable JPEG2000 tags and certain UUID boxes)
519# Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
520# Returns: 1 on success
521sub CreateNewBoxes($$)
522{
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
546 foreach $dirName (sort keys %$addDirs) {
547 next unless $uuid{$dirName};
548 my $tagInfo;
549 foreach $tagInfo (@{$Image::ExifTool::Jpeg2000::Main{uuid}}) {
550 next unless $$tagInfo{Name} eq $dirName;
551 my $subdir = $$tagInfo{SubDirectory};
552 my $tagTable = GetTagTable($$subdir{TagTable});
553 my %dirInfo = (
554 DirName => $$subdir{DirName} || $dirName,
555 Parent => 'JP2',
556 );
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});
561 if (defined $newdir and length $newdir) {
562 my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName};
563 Write($outfile, $boxhdr, $newdir) or return 0;
564 last;
565 }
566 }
567 }
568 return 1;
569}
570
571#------------------------------------------------------------------------------
572# Process JPEG 2000 box
573# Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table
574# Returns: 1 on success when reading, or -1 on write error
575# (or JP2 box or undef when writing from buffer)
576sub ProcessJpeg2000Box($$$)
577{
578 my ($et, $dirInfo, $tagTablePtr) = @_;
579 my $dataPt = $$dirInfo{DataPt};
580 my $dataLen = $$dirInfo{DataLen};
581 my $dataPos = $$dirInfo{DataPos};
582 my $dirLen = $$dirInfo{DirLen} || 0;
583 my $dirStart = $$dirInfo{DirStart} || 0;
584 my $base = $$dirInfo{Base} || 0;
585 my $raf = $$dirInfo{RAF};
586 my $outfile = $$dirInfo{OutFile};
587 my $dirEnd = $dirStart + $dirLen;
588 my ($err, $outBuff, $verbose);
589
590 if ($outfile) {
591 unless ($raf) {
592 # buffer output to be used for return value
593 $outBuff = '';
594 $outfile = \$outBuff;
595 }
596 } else {
597 # (must not set verbose flag when writing!)
598 $verbose = $$et{OPTIONS}{Verbose};
599 $et->VerboseDir($$dirInfo{DirName}) if $verbose;
600 }
601 # loop through all contained boxes
602 my ($pos, $boxLen);
603 for ($pos=$dirStart; ; $pos+=$boxLen) {
604 my ($boxID, $buff, $valuePtr);
605 my $hdrLen = 8; # the box header length
606 if ($raf) {
607 $dataPos = $raf->Tell() - $base;
608 my $n = $raf->Read($buff,$hdrLen);
609 unless ($n == $hdrLen) {
610 $n and $err = '', last;
611 if ($outfile) {
612 CreateNewBoxes($et, $outfile) or $err = 1;
613 }
614 last;
615 }
616 $dataPt = \$buff;
617 $dirLen = $dirEnd = $hdrLen;
618 $pos = 0;
619 } elsif ($pos >= $dirEnd - $hdrLen) {
620 $err = '' unless $pos == $dirEnd;
621 last;
622 }
623 $boxLen = unpack("x$pos N",$$dataPt); # (length includes header and data)
624 $boxID = substr($$dataPt, $pos+4, 4);
625 $pos += $hdrLen; # move to end of box header
626 if ($boxLen == 1) {
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 }
635 }
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
641 } elsif ($boxLen == 0) {
642 if ($raf) {
643 if ($outfile) {
644 CreateNewBoxes($et, $outfile) or $err = 1;
645 # copy over the rest of the file
646 Write($outfile, $$dataPt) or $err = 1;
647 while ($raf->Read($buff, 65536)) {
648 Write($outfile, $buff) or $err = 1;
649 }
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");
653 }
654 last; # (ignore the rest of the file when reading)
655 }
656 $boxLen = $dirEnd - $pos; # data runs to end of file
657 } else {
658 $boxLen -= $hdrLen; # length of remaining box data
659 }
660 $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
661 my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
662 unless (defined $tagInfo or $verbose) {
663 # no need to process this box
664 if ($raf) {
665 if ($outfile) {
666 Write($outfile, $$dataPt) or $err = 1;
667 $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
668 Write($outfile, $buff) or $err = 1;
669 } else {
670 $raf->Seek($boxLen, 1) or $err = 'Seek error', last;
671 }
672 } elsif ($outfile) {
673 Write($outfile, substr($$dataPt, $pos-$hdrLen, $boxLen+$hdrLen)) or $err = '', last;
674 }
675 next;
676 }
677 if ($raf) {
678 # read the box data
679 $dataPos = $raf->Tell() - $base;
680 $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
681 $valuePtr = 0;
682 $dataLen = $boxLen;
683 } elsif ($pos + $boxLen > $dirEnd) {
684 $err = '';
685 last;
686 } else {
687 $valuePtr = $pos;
688 }
689 if (defined $tagInfo and not $tagInfo) {
690 # GetTagInfo() required the value for a Condition
691 my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128);
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 }
717 }
718 if ($verbose) {
719 $et->VerboseInfo($boxID, $tagInfo,
720 Table => $tagTablePtr,
721 DataPt => $dataPt,
722 Size => $boxLen,
723 Start => $valuePtr,
724 Addr => $valuePtr + $dataPos + $base,
725 );
726 next unless $tagInfo;
727 }
728 if ($$tagInfo{SubDirectory}) {
729 my $subdir = $$tagInfo{SubDirectory};
730 my $subdirStart = $valuePtr;
731 if (defined $$subdir{Start}) {
732 #### eval Start ($valuePtr)
733 $subdirStart = eval($$subdir{Start});
734 }
735 my $subdirLen = $boxLen - ($subdirStart - $valuePtr);
736 my %subdirInfo = (
737 Parent => 'JP2',
738 DataPt => $dataPt,
739 DataPos => -$subdirStart, # (relative to Base)
740 DataLen => $dataLen,
741 DirStart => $subdirStart,
742 DirLen => $subdirLen,
743 DirName => $$subdir{DirName} || $$tagInfo{Name},
744 OutFile => $outfile,
745 Base => $base + $dataPos + $subdirStart,
746 );
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-//;
750 my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
751 if ($outfile) {
752 # remove this directory from our create list
753 delete $$et{AddJp2Dirs}{$$tagInfo{Name}};
754 my $newdir;
755 # only edit writable UUID boxes
756 if ($uuid) {
757 $newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
758 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);
761 }
762 # use old box data if not changed
763 defined $newdir or $newdir = substr($$dataPt, $subdirStart, $subdirLen);
764 my $prefixLen = $subdirStart - $valuePtr;
765 my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID;
766 $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
767 Write($outfile, $boxhdr, $newdir) or $err = 1;
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");
778 }
779 }
780 } elsif ($$tagInfo{Format} and not $outfile) {
781 # only save tag values if Format was specified
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 }
789 } elsif ($outfile) {
790 my $boxhdr = pack('N', $boxLen + 8) . $boxID;
791 Write($outfile, $boxhdr, substr($$dataPt, $valuePtr, $boxLen)) or $err = 1;
792 }
793 }
794 if (defined $err) {
795 $err or $err = 'Truncated JPEG 2000 box';
796 if ($outfile) {
797 $et->Error($err) unless $err eq '1';
798 return $raf ? -1 : undef;
799 }
800 $et->Warn($err);
801 }
802 return $outBuff if $outfile and not $raf;
803 return 1;
804}
805
806#------------------------------------------------------------------------------
807# Read/write meta information from a JPEG 2000 image
808# Inputs: 0) ExifTool object reference, 1) dirInfo reference
809# Returns: 1 on success, 0 if this wasn't a valid JPEG 2000 file, or -1 on write error
810sub ProcessJP2($$)
811{
812 local $_;
813 my ($et, $dirInfo) = @_;
814 my $raf = $$dirInfo{RAF};
815 my $outfile = $$dirInfo{OutFile};
816 my $hdr;
817
818 # check to be sure this is a valid JPG2000 file
819 return 0 unless $raf->Read($hdr,12) == 12;
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 }
836 if ($outfile) {
837 Write($outfile, $hdr) or return -1;
838 $et->InitWriteDirs(\%jp2Map);
839 # save list of directories to create
840 my %addDirs = %{$$et{ADD_DIRS}};
841 $$et{AddJp2Dirs} = \%addDirs;
842 $$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main);
843 } else {
844 my ($buff, $fileType);
845 # recognize JPX and JPM as unique types of JP2
846 if ($raf->Read($buff, 12) == 12 and $buff =~ /^.{4}ftyp(.{4})/s) {
847 $fileType = 'JPX' if $1 eq 'jpx ';
848 $fileType = 'JPM' if $1 eq 'jpm ';
849 }
850 $raf->Seek(-length($buff), 1) if defined $buff;
851 $et->SetFileType($fileType);
852 }
853 SetByteOrder('MM'); # JPEG 2000 files are big-endian
854 my %dirInfo = (
855 RAF => $raf,
856 DirName => 'JP2',
857 OutFile => $$dirInfo{OutFile},
858 );
859 my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
860 return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
861}
862
8631; # end
864
865__END__
866
867=head1 NAME
868
869Image::ExifTool::Jpeg2000 - Read JPEG 2000 meta information
870
871=head1 SYNOPSIS
872
873This module is used by Image::ExifTool
874
875=head1 DESCRIPTION
876
877This module contains routines required by Image::ExifTool to read JPEG 2000
878files.
879
880=head1 AUTHOR
881
882Copyright 2003-2021, Phil Harvey (philharvey66 at gmail.com)
883
884This library is free software; you can redistribute it and/or modify it
885under the same terms as Perl itself.
886
887=head1 REFERENCES
888
889=over 4
890
891=item L<http://www.jpeg.org/public/fcd15444-2.pdf>
892
893=item L<ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf>
894
895=back
896
897=head1 SEE ALSO
898
899L<Image::ExifTool::TagNames/Jpeg2000 Tags>,
900L<Image::ExifTool(3pm)|Image::ExifTool>
901
902=cut
903
Note: See TracBrowser for help on using the repository browser.