source: gsdl/trunk/perllib/cpan/Image/ExifTool/Jpeg2000.pm@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav
File size: 19.9 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.12';
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 # jp2h => 'JP2', (not yet functional)
42 # ICC_Profile => 'jp2h', (not yet functional)
43 IFD1 => 'IFD0',
44 EXIF => 'IFD0', # to write EXIF as a block
45 ExifIFD => 'IFD0',
46 GPS => 'IFD0',
47 SubIFD => 'IFD0',
48 GlobParamIFD => 'IFD0',
49 PrintIM => 'IFD0',
50 InteropIFD => 'ExifIFD',
51 MakerNotes => 'ExifIFD',
52);
53
54# UUID's for writable UUID directories (by tag name)
55my %uuid = (
56 'UUID-EXIF' => 'JpgTiffExif->JP2',
57 'UUID-IPTC' => "\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38",
58 'UUID-XMP' => "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac",
59 # (can't yet write GeoJP2 information)
60 # 'UUID-GeoJP2' => "\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03",
61);
62
63# JPEG 2000 "box" (ie. segment) names
64%Image::ExifTool::Jpeg2000::Main = (
65 GROUPS => { 2 => 'Image' },
66 PROCESS_PROC => \&ProcessJpeg2000Box,
67 WRITE_PROC => \&ProcessJpeg2000Box,
68 NOTES => q{
69 The tags below are extracted from JPEG 2000 images, however ExifTool
70 currently writes only EXIF, IPTC and XMP tags in these images.
71 },
72 'jP ' => 'JP2Signature', # (ref 1)
73 "jP\x1a\x1a" => 'JP2Signature', # (ref 2)
74 prfl => 'Profile',
75 ftyp => { Name => 'FileType', Priority => 0 },
76 rreq => 'ReaderRequirements',
77 jp2h => {
78 Name => 'JP2Header',
79 SubDirectory => { },
80 },
81 # JP2Header sub boxes...
82 ihdr => {
83 Name => 'ImageHeader',
84 SubDirectory => {
85 TagTable => 'Image::ExifTool::Jpeg2000::ImageHeader',
86 },
87 },
88 bpcc => 'BitsPerComponent',
89 colr => [
90 {
91 Name => 'ICC_Profile',
92 Condition => '$$valPt =~ /^(\x02|\x03)/',
93 SubDirectory => {
94 TagTable => 'Image::ExifTool::ICC_Profile::Main',
95 Start => '$valuePtr + 3',
96 },
97 },
98 {
99 Name => 'Colorspace',
100 Condition => '$$valPt =~ /^\x01/',
101 Format => 'binary',
102 ValueConv => 'unpack("x3N", $val)',
103 PrintConv => {
104 16 => 'sRGB',
105 17 => 'Grayscale',
106 18 => 'sYCC',
107 },
108 },
109 {
110 Name => 'ColorSpecification',
111 Binary => 1,
112 },
113 ],
114 pclr => 'Palette',
115 cdef => 'ComponentDefinition',
116 'res '=> {
117 Name => 'Resolution',
118 SubDirectory => { },
119 },
120 # Resolution sub boxes...
121 resc => {
122 Name => 'CaptureResolution',
123 SubDirectory => {
124 TagTable => 'Image::ExifTool::Jpeg2000::CaptureResolution',
125 },
126 },
127 resd => {
128 Name => 'DisplayResolution',
129 SubDirectory => {
130 TagTable => 'Image::ExifTool::Jpeg2000::DisplayResolution',
131 },
132 },
133 jpch => {
134 Name => 'CodestreamHeader',
135 SubDirectory => { },
136 },
137 # CodestreamHeader sub boxes...
138 'lbl '=> {
139 Name => 'Label',
140 Format => 'string',
141 },
142 cmap => 'ComponentMapping',
143 roid => 'ROIDescription',
144 jplh => {
145 Name => 'CompositingLayerHeader',
146 SubDirectory => { },
147 },
148 # CompositingLayerHeader sub boxes...
149 cgrp => 'ColorGroup',
150 opct => 'Opacity',
151 creg => 'CodestreamRegistration',
152 dtbl => 'DataReference',
153 ftbl => {
154 Name => 'FragmentTable',
155 Subdirectory => { },
156 },
157 # FragmentTable sub boxes...
158 flst => 'FragmentList',
159 cref => 'Cross-Reference',
160 mdat => 'MediaData',
161 comp => 'Composition',
162 copt => 'CompositionOptions',
163 inst => 'InstructionSet',
164 asoc => 'Association',
165 nlst => 'NumberList',
166 bfil => 'BinaryFilter',
167 drep => 'DesiredReproductions',
168 # DesiredReproductions sub boxes...
169 gtso => 'GraphicsTechnologyStandardOutput',
170 chck => 'DigitalSignature',
171 mp7b => 'MPEG7Binary',
172 free => 'Free',
173 jp2c => 'ContiguousCodestream',
174 jp2i => {
175 Name => 'IntellectualProperty',
176 SubDirectory => {
177 TagTable => 'Image::ExifTool::XMP::Main',
178 },
179 },
180 'xml '=> {
181 Name => 'XML',
182 SubDirectory => {
183 TagTable => 'Image::ExifTool::XMP::Main',
184 },
185 },
186 uuid => [
187 {
188 Name => 'UUID-EXIF',
189 Condition => '$$valPt=~/^JpgTiffExif->JP2/',
190 SubDirectory => {
191 TagTable => 'Image::ExifTool::Exif::Main',
192 ProcessProc => \&Image::ExifTool::ProcessTIFF,
193 WriteProc => \&Image::ExifTool::WriteTIFF,
194 Start => '$valuePtr + 16',
195 },
196 },
197 {
198 Name => 'UUID-IPTC',
199 Condition => '$$valPt=~/^\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38/',
200 SubDirectory => {
201 TagTable => 'Image::ExifTool::IPTC::Main',
202 Start => '$valuePtr + 16',
203 },
204 },
205 {
206 Name => 'UUID-XMP',
207 # ref http://www.adobe.com/products/xmp/pdfs/xmpspec.pdf
208 Condition => '$$valPt=~/^\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac/',
209 SubDirectory => {
210 TagTable => 'Image::ExifTool::XMP::Main',
211 Start => '$valuePtr + 16',
212 },
213 },
214 {
215 Name => 'UUID-GeoJP2',
216 # ref http://www.remotesensing.org/jpeg2000/
217 Condition => '$$valPt=~/^\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03/',
218 SubDirectory => {
219 TagTable => 'Image::ExifTool::Exif::Main',
220 ProcessProc => \&Image::ExifTool::ProcessTIFF,
221 Start => '$valuePtr + 16',
222 },
223 },
224 {
225 Name => 'UUID-Unknown',
226 },
227 ],
228 uinf => {
229 Name => 'UUIDInfo',
230 SubDirectory => { },
231 },
232 # UUIDInfo sub boxes...
233 ulst => 'UUIDList',
234 'url '=> {
235 Name => 'URL',
236 Format => 'string',
237 },
238);
239
240%Image::ExifTool::Jpeg2000::ImageHeader = (
241 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
242 GROUPS => { 2 => 'Image' },
243 0 => {
244 Name => 'ImageHeight',
245 Format => 'int32u',
246 },
247 4 => {
248 Name => 'ImageWidth',
249 Format => 'int32u',
250 },
251 8 => {
252 Name => 'NumberOfComponents',
253 Format => 'int16u',
254 },
255 10 => {
256 Name => 'BitsPerComponent',
257 PrintConv => q{
258 $val == 0xff and return 'Variable';
259 my $sign = ($val & 0x80) ? 'Signed' : 'Unsigned';
260 return (($val & 0x7f) + 1) . " Bits, $sign";
261 },
262 },
263 11 => {
264 Name => 'Compression',
265 PrintConv => {
266 0 => 'Uncompressed',
267 1 => 'Modified Huffman',
268 2 => 'Modified READ',
269 3 => 'Modified Modified READ',
270 4 => 'JBIG',
271 5 => 'JPEG',
272 6 => 'JPEG-LS',
273 7 => 'JPEG 2000',
274 8 => 'JBIG2',
275 },
276 },
277);
278
279%Image::ExifTool::Jpeg2000::CaptureResolution = (
280 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
281 GROUPS => { 2 => 'Image' },
282 FORMAT => 'int8s',
283 0 => {
284 Name => 'CaptureYResolution',
285 Format => 'rational32u',
286 },
287 4 => {
288 Name => 'CaptureXResolution',
289 Format => 'rational32u',
290 },
291 8 => {
292 Name => 'CaptureYResolutionUnit',
293 SeparateTable => 'ResolutionUnit',
294 PrintConv => \%resolutionUnit,
295 },
296 9 => {
297 Name => 'CaptureXResolutionUnit',
298 SeparateTable => 'ResolutionUnit',
299 PrintConv => \%resolutionUnit,
300 },
301);
302
303%Image::ExifTool::Jpeg2000::DisplayResolution = (
304 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
305 GROUPS => { 2 => 'Image' },
306 FORMAT => 'int8s',
307 0 => {
308 Name => 'DisplayYResolution',
309 Format => 'rational32u',
310 },
311 4 => {
312 Name => 'DisplayXResolution',
313 Format => 'rational32u',
314 },
315 8 => {
316 Name => 'DisplayYResolutionUnit',
317 SeparateTable => 'ResolutionUnit',
318 PrintConv => \%resolutionUnit,
319 },
320 9 => {
321 Name => 'DisplayXResolutionUnit',
322 SeparateTable => 'ResolutionUnit',
323 PrintConv => \%resolutionUnit,
324 },
325);
326
327#------------------------------------------------------------------------------
328# Create new JPEG 2000 boxes when writing
329# (Currently only supports adding certain UUID boxes)
330# Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
331# Returns: 1 on success
332sub CreateNewBoxes($$)
333{
334 my ($exifTool, $outfile) = @_;
335 my $addDirs = $$exifTool{AddJp2Dirs};
336 delete $$exifTool{AddJp2Dirs};
337 my $dirName;
338 foreach $dirName (sort keys %$addDirs) {
339 next unless $uuid{$dirName};
340 my $tagInfo;
341 foreach $tagInfo (@{$Image::ExifTool::Jpeg2000::Main{uuid}}) {
342 next unless $$tagInfo{Name} eq $dirName;
343 my $subdir = $$tagInfo{SubDirectory};
344 my $tagTable = GetTagTable($$subdir{TagTable});
345 my %dirInfo = (
346 DirName => $dirName,
347 Parent => 'JP2',
348 );
349 my $newdir = $exifTool->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
350 if (defined $newdir and length $newdir) {
351 my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName};
352 Write($outfile, $boxhdr, $newdir) or return 0;
353 last;
354 }
355 }
356 }
357 return 1;
358}
359
360#------------------------------------------------------------------------------
361# Process JPEG 2000 box
362# Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table
363# Returns: 1 on success when reading, or -1 on write error
364# (or JP2 box or undef when writing from buffer)
365sub ProcessJpeg2000Box($$$)
366{
367 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
368 my $dataPt = $$dirInfo{DataPt};
369 my $dataLen = $$dirInfo{DataLen};
370 my $dataPos = $$dirInfo{DataPos};
371 my $dirLen = $$dirInfo{DirLen} || 0;
372 my $dirStart = $$dirInfo{DirStart} || 0;
373 my $raf = $$dirInfo{RAF};
374 my $outfile = $$dirInfo{OutFile};
375 my $dirEnd = $dirStart + $dirLen;
376 my ($err, $outBuff, $verbose);
377
378 if ($outfile) {
379 unless ($raf) {
380 # buffer output to be used for return value
381 $outBuff = '';
382 $outfile = \$outBuff;
383 }
384 } else {
385 # (must not set verbose flag when writing!)
386 $verbose = $exifTool->{OPTIONS}->{Verbose};
387 }
388 # loop through all contained boxes
389 my ($pos, $boxLen);
390 for ($pos=$dirStart; ; $pos+=$boxLen) {
391 my ($boxID, $buff, $valuePtr);
392 if ($raf) {
393 $dataPos = $raf->Tell();
394 my $n = $raf->Read($buff,8);
395 unless ($n == 8) {
396 $n and $err = '', last;
397 if ($outfile) {
398 CreateNewBoxes($exifTool, $outfile) or $err = 1;
399 }
400 last;
401 }
402 $dataPt = \$buff;
403 $dirLen = 8;
404 $pos = 0;
405 } elsif ($pos >= $dirEnd - 8) {
406 $err = '' unless $pos == $dirEnd;
407 last;
408 }
409 $boxLen = unpack("x$pos N",$$dataPt);
410 $boxID = substr($$dataPt, $pos+4, 4);
411 $pos += 8;
412 if ($boxLen == 1) {
413 if (not $raf and $pos < $dirLen - 8) {
414 $err = 'JPEG 2000 format error';
415 } else {
416 $err = "Can't currently handle huge JPEG 2000 boxes";
417 }
418 last;
419 } elsif ($boxLen == 0) {
420 if ($raf) {
421 if ($outfile) {
422 CreateNewBoxes($exifTool, $outfile) or $err = 1;
423 # copy over the rest of the file
424 Write($outfile, $$dataPt) or $err = 1;
425 while ($raf->Read($buff, 65536)) {
426 Write($outfile, $buff) or $err = 1;
427 }
428 }
429 last; # (ignore the rest of the file when reading)
430 }
431 $boxLen = $dirLen - $pos;
432 } else {
433 $boxLen -= 8;
434 }
435 $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
436 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $boxID);
437 unless (defined $tagInfo or $verbose) {
438 # no need to process this box
439 if ($raf) {
440 if ($outfile) {
441 Write($outfile, $$dataPt) or $err = 1;
442 $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
443 Write($outfile, $buff) or $err = 1;
444 } else {
445 $raf->Seek($boxLen, 1) or $err = 'Seek error', last;
446 }
447 } elsif ($outfile) {
448 Write($outfile, substr($$dataPt, $pos-8, $boxLen+8)) or $err = '', last;
449 }
450 next;
451 }
452 if ($raf) {
453 # read the box data
454 $dataPos = $raf->Tell();
455 $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
456 $valuePtr = 0;
457 $dataLen = $boxLen;
458 } elsif ($boxLen + $pos > $dirStart + $dirLen) {
459 $err = '';
460 last;
461 } else {
462 $valuePtr = $pos;
463 }
464 if (defined $tagInfo and not $tagInfo) {
465 # GetTagInfo() required the value for a Condition
466 my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 48 ? $boxLen : 48);
467 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
468 }
469 # delete all UUID boxes if deleting all information
470 if ($outfile and $boxID eq 'uuid' and $exifTool->{DEL_GROUP}->{'*'}) {
471 $exifTool->VPrint(0, " Deleting $$tagInfo{Name}\n");
472 ++$exifTool->{CHANGED};
473 next;
474 }
475 if ($verbose) {
476 $exifTool->VerboseInfo($boxID, $tagInfo,
477 Table => $tagTablePtr,
478 DataPt => $dataPt,
479 Size => $boxLen,
480 Start => $valuePtr,
481 );
482 next unless $tagInfo;
483 }
484 if ($$tagInfo{SubDirectory}) {
485 my $subdir = $$tagInfo{SubDirectory};
486 my $subdirStart = $valuePtr;
487 if (defined $$subdir{Start}) {
488 #### eval Start ($valuePtr)
489 $subdirStart = eval($$subdir{Start});
490 }
491 my $subdirLen = $boxLen - ($subdirStart - $valuePtr);
492 my %subdirInfo = (
493 Parent => 'JP2',
494 DataPt => $dataPt,
495 DataPos => $dataPos,
496 DataLen => $dataLen,
497 DirStart => $subdirStart,
498 DirLen => $subdirLen,
499 DirName => $$tagInfo{Name},
500 OutFile => $outfile,
501 Base => $dataPos + $subdirStart,
502 );
503 my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
504 if ($outfile) {
505 # remove this directory from our create list
506 delete $exifTool->{AddJp2Dirs}->{$$tagInfo{Name}};
507 my $newdir;
508 # only edit writable UUID boxes
509 if ($uuid{$$tagInfo{Name}}) {
510 $newdir = $exifTool->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
511 next if defined $newdir and not length $newdir; # next if deleting the box
512 }
513 # use old box data if not changed
514 defined $newdir or $newdir = substr($$dataPt, $subdirStart, $subdirLen);
515 my $prefixLen = $subdirStart - $valuePtr;
516 my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID;
517 $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
518 Write($outfile, $boxhdr, $newdir) or $err = 1;
519 } elsif (not $exifTool->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
520 if ($subTable eq $tagTablePtr) {
521 $err = 'JPEG 2000 format error';
522 } else {
523 $err = "Unrecognized $$tagInfo{Name} box";
524 }
525 last;
526 }
527 } elsif ($$tagInfo{Format} and not $outfile) {
528 # only save tag values if Format was specified
529 my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen);
530 $exifTool->FoundTag($tagInfo, $val) if defined $val;
531 } elsif ($outfile) {
532 my $boxhdr = pack('N', $boxLen + 8) . $boxID;
533 Write($outfile, $boxhdr, substr($$dataPt, $valuePtr, $boxLen)) or $err = 1;
534 }
535 }
536 if (defined $err) {
537 $err or $err = 'Truncated JPEG 2000 box';
538 if ($outfile) {
539 $exifTool->Error($err) unless $err eq '1';
540 return $raf ? -1 : undef;
541 }
542 $exifTool->Warn($err);
543 }
544 return $outBuff if $outfile and not $raf;
545 return 1;
546}
547
548#------------------------------------------------------------------------------
549# Read/write meta information from a JPEG 2000 image
550# Inputs: 0) ExifTool object reference, 1) dirInfo reference
551# Returns: 1 on success, 0 if this wasn't a valid JPEG 2000 file, or -1 on write error
552sub ProcessJP2($$)
553{
554 my ($exifTool, $dirInfo) = @_;
555 my $raf = $$dirInfo{RAF};
556 my $outfile = $$dirInfo{OutFile};
557 my $rtnVal = 0;
558 my $hdr;
559
560 # check to be sure this is a valid JPG2000 file
561 return 0 unless $raf->Read($hdr,12) == 12;
562 return 0 unless $hdr eq "\x00\x00\x00\x0cjP \x0d\x0a\x87\x0a" or # (ref 1)
563 $hdr eq "\x00\x00\x00\x0cjP\x1a\x1a\x0d\x0a\x87\x0a"; # (ref 2)
564
565 if ($outfile) {
566 Write($outfile, $hdr) or return -1;
567 $exifTool->InitWriteDirs(\%jp2Map);
568 # save list of directories to create
569 my %addDirs = %{$$exifTool{ADD_DIRS}};
570 $$exifTool{AddJp2Dirs} = \%addDirs;
571 } else {
572 $exifTool->SetFileType();
573 }
574 SetByteOrder('MM'); # JPEG 2000 files are big-endian
575 my %dirInfo = (
576 RAF => $raf,
577 DirName => 'JP2',
578 OutFile => $$dirInfo{OutFile},
579 );
580 my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
581 return $exifTool->ProcessDirectory(\%dirInfo, $tagTablePtr);
582}
583
5841; # end
585
586__END__
587
588=head1 NAME
589
590Image::ExifTool::Jpeg2000 - Read JPEG 2000 meta information
591
592=head1 SYNOPSIS
593
594This module is used by Image::ExifTool
595
596=head1 DESCRIPTION
597
598This module contains routines required by Image::ExifTool to read JPEG 2000
599files.
600
601=head1 AUTHOR
602
603Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
604
605This library is free software; you can redistribute it and/or modify it
606under the same terms as Perl itself.
607
608=head1 REFERENCES
609
610=over 4
611
612=item L<http://www.jpeg.org/public/fcd15444-2.pdf>
613
614=item L<ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf>
615
616=back
617
618=head1 SEE ALSO
619
620L<Image::ExifTool::TagNames/Jpeg2000 Tags>,
621L<Image::ExifTool(3pm)|Image::ExifTool>
622
623=cut
624
Note: See TracBrowser for help on using the repository browser.