Jpeg2000.pm 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882
  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. package Image::ExifTool::Jpeg2000;
  13. use strict;
  14. use vars qw($VERSION);
  15. use Image::ExifTool qw(:DataAccess :Utils);
  16. $VERSION = '1.25';
  17. sub ProcessJpeg2000Box($$$);
  18. my %resolutionUnit = (
  19. -3 => 'km',
  20. -2 => '100 m',
  21. -1 => '10 m',
  22. 0 => 'm',
  23. 1 => '10 cm',
  24. 2 => 'cm',
  25. 3 => 'mm',
  26. 4 => '0.1 mm',
  27. 5 => '0.01 mm',
  28. 6 => 'um',
  29. );
  30. # map of where information is written in JPEG2000 image
  31. my %jp2Map = (
  32. IPTC => 'UUID-IPTC',
  33. IFD0 => 'UUID-EXIF',
  34. XMP => 'UUID-XMP',
  35. 'UUID-IPTC' => 'JP2',
  36. 'UUID-EXIF' => 'JP2',
  37. 'UUID-XMP' => 'JP2',
  38. # jp2h => 'JP2', (not yet functional)
  39. # ICC_Profile => 'jp2h', (not yet functional)
  40. IFD1 => 'IFD0',
  41. EXIF => 'IFD0', # to write EXIF as a block
  42. ExifIFD => 'IFD0',
  43. GPS => 'IFD0',
  44. SubIFD => 'IFD0',
  45. GlobParamIFD => 'IFD0',
  46. PrintIM => 'IFD0',
  47. InteropIFD => 'ExifIFD',
  48. MakerNotes => 'ExifIFD',
  49. );
  50. # UUID's for writable UUID directories (by tag name)
  51. my %uuid = (
  52. 'UUID-EXIF' => 'JpgTiffExif->JP2',
  53. 'UUID-IPTC' => "\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38",
  54. 'UUID-XMP' => "\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac",
  55. # (can't yet write GeoJP2 information)
  56. # 'UUID-GeoJP2' => "\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03",
  57. );
  58. # JPEG2000 codestream markers (ref ISO/IEC FCD15444-1/2)
  59. my %j2cMarker = (
  60. 0x4f => 'SOC', # start of codestream
  61. 0x51 => 'SIZ', # image and tile size
  62. 0x52 => 'COD', # coding style default
  63. 0x53 => 'COC', # coding style component
  64. 0x55 => 'TLM', # tile-part lengths
  65. 0x57 => 'PLM', # packet length, main header
  66. 0x58 => 'PLT', # packet length, tile-part header
  67. 0x5c => 'QCD', # quantization default
  68. 0x5d => 'QCC', # quantization component
  69. 0x5e => 'RGN', # region of interest
  70. 0x5f => 'POD', # progression order default
  71. 0x60 => 'PPM', # packed packet headers, main
  72. 0x61 => 'PPT', # packed packet headers, tile-part
  73. 0x63 => 'CRG', # component registration
  74. 0x64 => 'CME', # comment and extension
  75. 0x90 => 'SOT', # start of tile-part
  76. 0x91 => 'SOP', # start of packet
  77. 0x92 => 'EPH', # end of packet header
  78. 0x93 => 'SOD', # start of data
  79. # extensions (ref ISO/IEC FCD15444-2)
  80. 0x70 => 'DCO', # variable DC offset
  81. 0x71 => 'VMS', # visual masking
  82. 0x72 => 'DFS', # downsampling factor style
  83. 0x73 => 'ADS', # arbitrary decomposition style
  84. # 0x72 => 'ATK', # arbitrary transformation kernels ?
  85. 0x78 => 'CBD', # component bit depth
  86. 0x74 => 'MCT', # multiple component transformation definition
  87. 0x75 => 'MCC', # multiple component collection
  88. 0x77 => 'MIC', # multiple component intermediate collection
  89. 0x76 => 'NLT', # non-linearity point transformation
  90. );
  91. # JPEG 2000 "box" (ie. atom) names
  92. # Note: only tags with a defined "Format" are extracted
  93. %Image::ExifTool::Jpeg2000::Main = (
  94. GROUPS => { 2 => 'Image' },
  95. PROCESS_PROC => \&ProcessJpeg2000Box,
  96. WRITE_PROC => \&ProcessJpeg2000Box,
  97. PREFERRED => 1, # always add these tags when writing
  98. NOTES => q{
  99. The tags below are extracted from JPEG 2000 images, however ExifTool
  100. currently writes only EXIF, IPTC and XMP tags in these images.
  101. },
  102. 'jP ' => 'JP2Signature', # (ref 1)
  103. "jP\x1a\x1a" => 'JP2Signature', # (ref 2)
  104. prfl => 'Profile',
  105. ftyp => {
  106. Name => 'FileType',
  107. SubDirectory => { TagTable => 'Image::ExifTool::Jpeg2000::FileType' },
  108. },
  109. rreq => 'ReaderRequirements',
  110. jp2h => {
  111. Name => 'JP2Header',
  112. SubDirectory => { },
  113. },
  114. # JP2Header sub boxes...
  115. ihdr => {
  116. Name => 'ImageHeader',
  117. SubDirectory => {
  118. TagTable => 'Image::ExifTool::Jpeg2000::ImageHeader',
  119. },
  120. },
  121. bpcc => 'BitsPerComponent',
  122. colr => {
  123. Name => 'ColorSpecification',
  124. SubDirectory => {
  125. TagTable => 'Image::ExifTool::Jpeg2000::ColorSpec',
  126. },
  127. },
  128. pclr => 'Palette',
  129. cdef => 'ComponentDefinition',
  130. 'res '=> {
  131. Name => 'Resolution',
  132. SubDirectory => { },
  133. },
  134. # Resolution sub boxes...
  135. resc => {
  136. Name => 'CaptureResolution',
  137. SubDirectory => {
  138. TagTable => 'Image::ExifTool::Jpeg2000::CaptureResolution',
  139. },
  140. },
  141. resd => {
  142. Name => 'DisplayResolution',
  143. SubDirectory => {
  144. TagTable => 'Image::ExifTool::Jpeg2000::DisplayResolution',
  145. },
  146. },
  147. jpch => {
  148. Name => 'CodestreamHeader',
  149. SubDirectory => { },
  150. },
  151. # CodestreamHeader sub boxes...
  152. 'lbl '=> {
  153. Name => 'Label',
  154. Format => 'string',
  155. },
  156. cmap => 'ComponentMapping',
  157. roid => 'ROIDescription',
  158. jplh => {
  159. Name => 'CompositingLayerHeader',
  160. SubDirectory => { },
  161. },
  162. # CompositingLayerHeader sub boxes...
  163. cgrp => 'ColorGroup',
  164. opct => 'Opacity',
  165. creg => 'CodestreamRegistration',
  166. dtbl => 'DataReference',
  167. ftbl => {
  168. Name => 'FragmentTable',
  169. Subdirectory => { },
  170. },
  171. # FragmentTable sub boxes...
  172. flst => 'FragmentList',
  173. cref => 'Cross-Reference',
  174. mdat => 'MediaData',
  175. comp => 'Composition',
  176. copt => 'CompositionOptions',
  177. inst => 'InstructionSet',
  178. asoc => 'Association',
  179. nlst => 'NumberList',
  180. bfil => 'BinaryFilter',
  181. drep => 'DesiredReproductions',
  182. # DesiredReproductions sub boxes...
  183. gtso => 'GraphicsTechnologyStandardOutput',
  184. chck => 'DigitalSignature',
  185. mp7b => 'MPEG7Binary',
  186. free => 'Free',
  187. jp2c => 'ContiguousCodestream',
  188. jp2i => {
  189. Name => 'IntellectualProperty',
  190. SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
  191. },
  192. 'xml '=> {
  193. Name => 'XML',
  194. Writable => 'undef',
  195. Flags => [ 'Binary', 'Protected', 'BlockExtract' ],
  196. List => 1,
  197. Notes => q{
  198. by default, the XML data in this tag is parsed using the ExifTool XMP module
  199. to to allow individual tags to be accessed when reading, but it may also be
  200. extracted as a block via the "XML" tag, which is also how this tag is
  201. written and copied. This is a List-type tag because multiple XML blocks may
  202. exist
  203. },
  204. SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
  205. },
  206. uuid => [
  207. {
  208. Name => 'UUID-EXIF',
  209. # (this is the EXIF that we create)
  210. Condition => '$$valPt=~/^JpgTiffExif->JP2/',
  211. SubDirectory => {
  212. TagTable => 'Image::ExifTool::Exif::Main',
  213. ProcessProc => \&Image::ExifTool::ProcessTIFF,
  214. WriteProc => \&Image::ExifTool::WriteTIFF,
  215. DirName => 'EXIF',
  216. Start => '$valuePtr + 16',
  217. },
  218. },
  219. {
  220. Name => 'UUID-EXIF2',
  221. # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
  222. Condition => '$$valPt=~/^\x05\x37\xcd\xab\x9d\x0c\x44\x31\xa7\x2a\xfa\x56\x1f\x2a\x11\x3e/',
  223. SubDirectory => {
  224. TagTable => 'Image::ExifTool::Exif::Main',
  225. ProcessProc => \&Image::ExifTool::ProcessTIFF,
  226. WriteProc => \&Image::ExifTool::WriteTIFF,
  227. DirName => 'EXIF',
  228. Start => '$valuePtr + 16',
  229. },
  230. },
  231. {
  232. Name => 'UUID-IPTC',
  233. # (this is the IPTC that we create)
  234. Condition => '$$valPt=~/^\x33\xc7\xa4\xd2\xb8\x1d\x47\x23\xa0\xba\xf1\xa3\xe0\x97\xad\x38/',
  235. SubDirectory => {
  236. TagTable => 'Image::ExifTool::IPTC::Main',
  237. Start => '$valuePtr + 16',
  238. },
  239. },
  240. {
  241. Name => 'UUID-IPTC2',
  242. # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
  243. Condition => '$$valPt=~/^\x09\xa1\x4e\x97\xc0\xb4\x42\xe0\xbe\xbf\x36\xdf\x6f\x0c\xe3\x6f/',
  244. SubDirectory => {
  245. TagTable => 'Image::ExifTool::IPTC::Main',
  246. Start => '$valuePtr + 16',
  247. },
  248. },
  249. {
  250. Name => 'UUID-XMP',
  251. # ref http://www.adobe.com/products/xmp/pdfs/xmpspec.pdf
  252. Condition => '$$valPt=~/^\xbe\x7a\xcf\xcb\x97\xa9\x42\xe8\x9c\x71\x99\x94\x91\xe3\xaf\xac/',
  253. SubDirectory => {
  254. TagTable => 'Image::ExifTool::XMP::Main',
  255. Start => '$valuePtr + 16',
  256. },
  257. },
  258. {
  259. Name => 'UUID-GeoJP2',
  260. # ref http://www.remotesensing.org/jpeg2000/
  261. Condition => '$$valPt=~/^\xb1\x4b\xf8\xbd\x08\x3d\x4b\x43\xa5\xae\x8c\xd7\xd5\xa6\xce\x03/',
  262. SubDirectory => {
  263. TagTable => 'Image::ExifTool::Exif::Main',
  264. ProcessProc => \&Image::ExifTool::ProcessTIFF,
  265. Start => '$valuePtr + 16',
  266. },
  267. },
  268. {
  269. Name => 'UUID-Photoshop',
  270. # written by Photoshop 7.01+Adobe JPEG2000-plugin v1.5
  271. Condition => '$$valPt=~/^\x2c\x4c\x01\x00\x85\x04\x40\xb9\xa0\x3e\x56\x21\x48\xd6\xdf\xeb/',
  272. SubDirectory => {
  273. TagTable => 'Image::ExifTool::Photoshop::Main',
  274. Start => '$valuePtr + 16',
  275. },
  276. },
  277. {
  278. Name => 'UUID-Unknown',
  279. },
  280. # also written by Adobe JPEG2000 plugin v1.5:
  281. # 3a 0d 02 18 0a e9 41 15 b3 76 4b ca 41 ce 0e 71 - 1 byte (01)
  282. # 47 c9 2c cc d1 a1 45 81 b9 04 38 bb 54 67 71 3b - 1 byte (01)
  283. # bc 45 a7 74 dd 50 4e c6 a9 f6 f3 a1 37 f4 7e 90 - 4 bytes (00 00 00 32)
  284. # d7 c8 c5 ef 95 1f 43 b2 87 57 04 25 00 f5 38 e8 - 4 bytes (00 00 00 32)
  285. ],
  286. uinf => {
  287. Name => 'UUIDInfo',
  288. SubDirectory => { },
  289. },
  290. # UUIDInfo sub boxes...
  291. ulst => 'UUIDList',
  292. 'url '=> {
  293. Name => 'URL',
  294. Format => 'string',
  295. },
  296. );
  297. %Image::ExifTool::Jpeg2000::ImageHeader = (
  298. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  299. GROUPS => { 2 => 'Image' },
  300. 0 => {
  301. Name => 'ImageHeight',
  302. Format => 'int32u',
  303. },
  304. 4 => {
  305. Name => 'ImageWidth',
  306. Format => 'int32u',
  307. },
  308. 8 => {
  309. Name => 'NumberOfComponents',
  310. Format => 'int16u',
  311. },
  312. 10 => {
  313. Name => 'BitsPerComponent',
  314. PrintConv => q{
  315. $val == 0xff and return 'Variable';
  316. my $sign = ($val & 0x80) ? 'Signed' : 'Unsigned';
  317. return (($val & 0x7f) + 1) . " Bits, $sign";
  318. },
  319. },
  320. 11 => {
  321. Name => 'Compression',
  322. PrintConv => {
  323. 0 => 'Uncompressed',
  324. 1 => 'Modified Huffman',
  325. 2 => 'Modified READ',
  326. 3 => 'Modified Modified READ',
  327. 4 => 'JBIG',
  328. 5 => 'JPEG',
  329. 6 => 'JPEG-LS',
  330. 7 => 'JPEG 2000',
  331. 8 => 'JBIG2',
  332. },
  333. },
  334. );
  335. # (ref fcd15444-1/2/6.pdf)
  336. # (also see http://developer.apple.com/mac/library/documentation/QuickTime/QTFF/QTFFChap1/qtff1.html)
  337. %Image::ExifTool::Jpeg2000::FileType = (
  338. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  339. GROUPS => { 2 => 'Video' },
  340. FORMAT => 'int32u',
  341. 0 => {
  342. Name => 'MajorBrand',
  343. Format => 'undef[4]',
  344. PrintConv => {
  345. 'jp2 ' => 'JPEG 2000 Image (.JP2)', # image/jp2
  346. 'jpm ' => 'JPEG 2000 Compound Image (.JPM)', # image/jpm
  347. 'jpx ' => 'JPEG 2000 with extensions (.JPX)', # image/jpx
  348. },
  349. },
  350. 1 => {
  351. Name => 'MinorVersion',
  352. Format => 'undef[4]',
  353. ValueConv => 'sprintf("%x.%x.%x", unpack("nCC", $val))',
  354. },
  355. 2 => {
  356. Name => 'CompatibleBrands',
  357. Format => 'undef[$size-8]',
  358. # ignore any entry with a null, and return others as a list
  359. ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a',
  360. },
  361. );
  362. %Image::ExifTool::Jpeg2000::CaptureResolution = (
  363. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  364. GROUPS => { 2 => 'Image' },
  365. FORMAT => 'int8s',
  366. 0 => {
  367. Name => 'CaptureYResolution',
  368. Format => 'rational32u',
  369. },
  370. 4 => {
  371. Name => 'CaptureXResolution',
  372. Format => 'rational32u',
  373. },
  374. 8 => {
  375. Name => 'CaptureYResolutionUnit',
  376. SeparateTable => 'ResolutionUnit',
  377. PrintConv => \%resolutionUnit,
  378. },
  379. 9 => {
  380. Name => 'CaptureXResolutionUnit',
  381. SeparateTable => 'ResolutionUnit',
  382. PrintConv => \%resolutionUnit,
  383. },
  384. );
  385. %Image::ExifTool::Jpeg2000::DisplayResolution = (
  386. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  387. GROUPS => { 2 => 'Image' },
  388. FORMAT => 'int8s',
  389. 0 => {
  390. Name => 'DisplayYResolution',
  391. Format => 'rational32u',
  392. },
  393. 4 => {
  394. Name => 'DisplayXResolution',
  395. Format => 'rational32u',
  396. },
  397. 8 => {
  398. Name => 'DisplayYResolutionUnit',
  399. SeparateTable => 'ResolutionUnit',
  400. PrintConv => \%resolutionUnit,
  401. },
  402. 9 => {
  403. Name => 'DisplayXResolutionUnit',
  404. SeparateTable => 'ResolutionUnit',
  405. PrintConv => \%resolutionUnit,
  406. },
  407. );
  408. %Image::ExifTool::Jpeg2000::ColorSpec = (
  409. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  410. GROUPS => { 2 => 'Image' },
  411. FORMAT => 'int8s',
  412. 0 => {
  413. Name => 'ColorSpecMethod',
  414. RawConv => '$$self{ColorSpecMethod} = $val',
  415. PrintConv => {
  416. 1 => 'Enumerated',
  417. 2 => 'Restricted ICC',
  418. 3 => 'Any ICC',
  419. 4 => 'Vendor Color',
  420. },
  421. },
  422. 1 => 'ColorSpecPrecedence',
  423. 2 => {
  424. Name => 'ColorSpecApproximation',
  425. PrintConv => {
  426. 0 => 'Not Specified',
  427. 1 => 'Accurate',
  428. 2 => 'Exceptional Quality',
  429. 3 => 'Reasonable Quality',
  430. 4 => 'Poor Quality',
  431. },
  432. },
  433. 3 => [
  434. {
  435. Name => 'ICC_Profile',
  436. Condition => q{
  437. $$self{ColorSpecMethod} == 2 or
  438. $$self{ColorSpecMethod} == 3
  439. },
  440. Format => 'undef[$size-3]',
  441. SubDirectory => {
  442. TagTable => 'Image::ExifTool::ICC_Profile::Main',
  443. },
  444. },
  445. {
  446. Name => 'ColorSpace',
  447. Condition => '$$self{ColorSpecMethod} == 1',
  448. Format => 'int32u',
  449. PrintConv => { # ref 15444-2 2002-05-15
  450. 0 => 'Bi-level',
  451. 1 => 'YCbCr(1)',
  452. 3 => 'YCbCr(2)',
  453. 4 => 'YCbCr(3)',
  454. 9 => 'PhotoYCC',
  455. 11 => 'CMY',
  456. 12 => 'CMYK',
  457. 13 => 'YCCK',
  458. 14 => 'CIELab',
  459. 15 => 'Bi-level(2)', # (incorrectly listed as 18 in 15444-2 2000-12-07)
  460. 16 => 'sRGB',
  461. 17 => 'Grayscale',
  462. 18 => 'sYCC',
  463. 19 => 'CIEJab',
  464. 20 => 'e-sRGB',
  465. 21 => 'ROMM-RGB',
  466. # incorrect in 15444-2 2000-12-07
  467. #22 => 'sRGB based YCbCr',
  468. #23 => 'YPbPr(1125/60)',
  469. #24 => 'YPbPr(1250/50)',
  470. 22 => 'YPbPr(1125/60)',
  471. 23 => 'YPbPr(1250/50)',
  472. 24 => 'e-sYCC',
  473. },
  474. },
  475. {
  476. Name => 'ColorSpecData',
  477. Format => 'undef[$size-3]',
  478. Binary => 1,
  479. },
  480. ],
  481. );
  482. #------------------------------------------------------------------------------
  483. # Create new JPEG 2000 boxes when writing
  484. # (Currently only supports adding top-level Writable JPEG2000 tags and certain UUID boxes)
  485. # Inputs: 0) ExifTool object ref, 1) Output file or scalar ref
  486. # Returns: 1 on success
  487. sub CreateNewBoxes($$)
  488. {
  489. my ($et, $outfile) = @_;
  490. my $addTags = $$et{AddJp2Tags};
  491. my $addDirs = $$et{AddJp2Dirs};
  492. delete $$et{AddJp2Tags};
  493. delete $$et{AddJp2Dirs};
  494. my ($tag, $dirName);
  495. # add JPEG2000 tags
  496. foreach $tag (sort keys %$addTags) {
  497. my $tagInfo = $$addTags{$tag};
  498. my $nvHash = $et->GetNewValueHash($tagInfo);
  499. # (native JPEG2000 information is always preferred, so don't check IsCreating)
  500. next unless $$tagInfo{List} or $et->IsOverwriting($nvHash) > 0;
  501. next if $$nvHash{EditOnly};
  502. my @vals = $et->GetNewValue($nvHash);
  503. my $val;
  504. foreach $val (@vals) {
  505. my $boxhdr = pack('N', length($val) + 8) . $$tagInfo{TagID};
  506. Write($outfile, $boxhdr, $val) or return 0;
  507. ++$$et{CHANGED};
  508. $et->VerboseValue("+ Jpeg2000:$$tagInfo{Name}", $val);
  509. }
  510. }
  511. # add UUID boxes
  512. foreach $dirName (sort keys %$addDirs) {
  513. next unless $uuid{$dirName};
  514. my $tagInfo;
  515. foreach $tagInfo (@{$Image::ExifTool::Jpeg2000::Main{uuid}}) {
  516. next unless $$tagInfo{Name} eq $dirName;
  517. my $subdir = $$tagInfo{SubDirectory};
  518. my $tagTable = GetTagTable($$subdir{TagTable});
  519. my %dirInfo = (
  520. DirName => $$subdir{DirName} || $dirName,
  521. Parent => 'JP2',
  522. );
  523. # remove "UUID-" from start of directory name to allow appropriate
  524. # directories to be written as a block
  525. $dirInfo{DirName} =~ s/^UUID-//;
  526. my $newdir = $et->WriteDirectory(\%dirInfo, $tagTable, $$subdir{WriteProc});
  527. if (defined $newdir and length $newdir) {
  528. my $boxhdr = pack('N', length($newdir) + 24) . 'uuid' . $uuid{$dirName};
  529. Write($outfile, $boxhdr, $newdir) or return 0;
  530. last;
  531. }
  532. }
  533. }
  534. return 1;
  535. }
  536. #------------------------------------------------------------------------------
  537. # Process JPEG 2000 box
  538. # Inputs: 0) ExifTool object reference, 1) dirInfo reference, 2) Pointer to tag table
  539. # Returns: 1 on success when reading, or -1 on write error
  540. # (or JP2 box or undef when writing from buffer)
  541. sub ProcessJpeg2000Box($$$)
  542. {
  543. my ($et, $dirInfo, $tagTablePtr) = @_;
  544. my $dataPt = $$dirInfo{DataPt};
  545. my $dataLen = $$dirInfo{DataLen};
  546. my $dataPos = $$dirInfo{DataPos};
  547. my $dirLen = $$dirInfo{DirLen} || 0;
  548. my $dirStart = $$dirInfo{DirStart} || 0;
  549. my $base = $$dirInfo{Base} || 0;
  550. my $raf = $$dirInfo{RAF};
  551. my $outfile = $$dirInfo{OutFile};
  552. my $dirEnd = $dirStart + $dirLen;
  553. my ($err, $outBuff, $verbose);
  554. if ($outfile) {
  555. unless ($raf) {
  556. # buffer output to be used for return value
  557. $outBuff = '';
  558. $outfile = \$outBuff;
  559. }
  560. } else {
  561. # (must not set verbose flag when writing!)
  562. $verbose = $$et{OPTIONS}{Verbose};
  563. $et->VerboseDir($$dirInfo{DirName}) if $verbose;
  564. }
  565. # loop through all contained boxes
  566. my ($pos, $boxLen);
  567. for ($pos=$dirStart; ; $pos+=$boxLen) {
  568. my ($boxID, $buff, $valuePtr);
  569. my $hdrLen = 8; # the box header length
  570. if ($raf) {
  571. $dataPos = $raf->Tell() - $base;
  572. my $n = $raf->Read($buff,$hdrLen);
  573. unless ($n == $hdrLen) {
  574. $n and $err = '', last;
  575. if ($outfile) {
  576. CreateNewBoxes($et, $outfile) or $err = 1;
  577. }
  578. last;
  579. }
  580. $dataPt = \$buff;
  581. $dirLen = $dirEnd = $hdrLen;
  582. $pos = 0;
  583. } elsif ($pos >= $dirEnd - $hdrLen) {
  584. $err = '' unless $pos == $dirEnd;
  585. last;
  586. }
  587. $boxLen = unpack("x$pos N",$$dataPt); # (length includes header and data)
  588. $boxID = substr($$dataPt, $pos+4, 4);
  589. $pos += $hdrLen; # move to end of box header
  590. if ($boxLen == 1) {
  591. # box header contains an additional 8-byte integer for length
  592. $hdrLen += 8;
  593. if ($raf) {
  594. my $buf2;
  595. if ($raf->Read($buf2,8) == 8) {
  596. $buff .= $buf2;
  597. $dirLen = $dirEnd = $hdrLen;
  598. }
  599. }
  600. $pos > $dirEnd - 8 and $err = '', last;
  601. my ($hi, $lo) = unpack("x$pos N2",$$dataPt);
  602. $hi and $err = "Can't currently handle JPEG 2000 boxes > 4 GB", last;
  603. $pos += 8; # move to end of extended-length box header
  604. $boxLen = $lo - $hdrLen; # length of remaining box data
  605. } elsif ($boxLen == 0) {
  606. if ($raf) {
  607. if ($outfile) {
  608. CreateNewBoxes($et, $outfile) or $err = 1;
  609. # copy over the rest of the file
  610. Write($outfile, $$dataPt) or $err = 1;
  611. while ($raf->Read($buff, 65536)) {
  612. Write($outfile, $buff) or $err = 1;
  613. }
  614. } elsif ($verbose) {
  615. my $msg = sprintf("offset 0x%.4x to end of file", $dataPos + $base + $pos);
  616. $et->VPrint(0, "$$et{INDENT}- Tag '$boxID' ($msg)\n");
  617. }
  618. last; # (ignore the rest of the file when reading)
  619. }
  620. $boxLen = $dirEnd - $pos; # data runs to end of file
  621. } else {
  622. $boxLen -= $hdrLen; # length of remaining box data
  623. }
  624. $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
  625. my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
  626. unless (defined $tagInfo or $verbose) {
  627. # no need to process this box
  628. if ($raf) {
  629. if ($outfile) {
  630. Write($outfile, $$dataPt) or $err = 1;
  631. $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
  632. Write($outfile, $buff) or $err = 1;
  633. } else {
  634. $raf->Seek($boxLen, 1) or $err = 'Seek error', last;
  635. }
  636. } elsif ($outfile) {
  637. Write($outfile, substr($$dataPt, $pos-$hdrLen, $boxLen+$hdrLen)) or $err = '', last;
  638. }
  639. next;
  640. }
  641. if ($raf) {
  642. # read the box data
  643. $dataPos = $raf->Tell() - $base;
  644. $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
  645. $valuePtr = 0;
  646. $dataLen = $boxLen;
  647. } elsif ($pos + $boxLen > $dirEnd) {
  648. $err = '';
  649. last;
  650. } else {
  651. $valuePtr = $pos;
  652. }
  653. if (defined $tagInfo and not $tagInfo) {
  654. # GetTagInfo() required the value for a Condition
  655. my $tmpVal = substr($$dataPt, $valuePtr, $boxLen < 128 ? $boxLen : 128);
  656. $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID, \$tmpVal);
  657. }
  658. # delete all UUID boxes and any writable box if deleting all information
  659. if ($outfile and $tagInfo) {
  660. if ($boxID eq 'uuid' and $$et{DEL_GROUP}{'*'}) {
  661. $et->VPrint(0, " Deleting $$tagInfo{Name}\n");
  662. ++$$et{CHANGED};
  663. next;
  664. } elsif ($$tagInfo{Writable}) {
  665. my $isOverwriting;
  666. if ($$et{DEL_GROUP}{Jpeg2000}) {
  667. $isOverwriting = 1;
  668. } else {
  669. my $nvHash = $et->GetNewValueHash($tagInfo);
  670. $isOverwriting = $et->IsOverwriting($nvHash);
  671. }
  672. if ($isOverwriting) {
  673. my $val = substr($$dataPt, $valuePtr, $boxLen);
  674. $et->VerboseValue("- Jpeg2000:$$tagInfo{Name}", $val);
  675. ++$$et{CHANGED};
  676. next;
  677. } elsif (not $$tagInfo{List}) {
  678. delete $$et{AddJp2Tags}{$boxID};
  679. }
  680. }
  681. }
  682. if ($verbose) {
  683. $et->VerboseInfo($boxID, $tagInfo,
  684. Table => $tagTablePtr,
  685. DataPt => $dataPt,
  686. Size => $boxLen,
  687. Start => $valuePtr,
  688. Addr => $valuePtr + $dataPos + $base,
  689. );
  690. next unless $tagInfo;
  691. }
  692. if ($$tagInfo{SubDirectory}) {
  693. my $subdir = $$tagInfo{SubDirectory};
  694. my $subdirStart = $valuePtr;
  695. if (defined $$subdir{Start}) {
  696. #### eval Start ($valuePtr)
  697. $subdirStart = eval($$subdir{Start});
  698. }
  699. my $subdirLen = $boxLen - ($subdirStart - $valuePtr);
  700. my %subdirInfo = (
  701. Parent => 'JP2',
  702. DataPt => $dataPt,
  703. DataPos => -$subdirStart, # (relative to Base)
  704. DataLen => $dataLen,
  705. DirStart => $subdirStart,
  706. DirLen => $subdirLen,
  707. DirName => $$subdir{DirName} || $$tagInfo{Name},
  708. OutFile => $outfile,
  709. Base => $base + $dataPos + $subdirStart,
  710. );
  711. # remove "UUID-" prefix to allow appropriate directories to be written as a block
  712. $subdirInfo{DirName} =~ s/^UUID-//;
  713. my $subTable = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
  714. if ($outfile) {
  715. # remove this directory from our create list
  716. delete $$et{AddJp2Dirs}{$$tagInfo{Name}};
  717. my $newdir;
  718. # only edit writable UUID boxes
  719. if ($uuid{$$tagInfo{Name}}) {
  720. $newdir = $et->WriteDirectory(\%subdirInfo, $subTable, $$subdir{WriteProc});
  721. next if defined $newdir and not length $newdir; # next if deleting the box
  722. }
  723. # use old box data if not changed
  724. defined $newdir or $newdir = substr($$dataPt, $subdirStart, $subdirLen);
  725. my $prefixLen = $subdirStart - $valuePtr;
  726. my $boxhdr = pack('N', length($newdir) + 8 + $prefixLen) . $boxID;
  727. $boxhdr .= substr($$dataPt, $valuePtr, $prefixLen) if $prefixLen;
  728. Write($outfile, $boxhdr, $newdir) or $err = 1;
  729. } else {
  730. # extract as a block if specified
  731. $subdirInfo{BlockInfo} = $tagInfo if $$tagInfo{BlockExtract};
  732. unless ($et->ProcessDirectory(\%subdirInfo, $subTable, $$subdir{ProcessProc})) {
  733. if ($subTable eq $tagTablePtr) {
  734. $err = 'JPEG 2000 format error';
  735. } else {
  736. $err = "Unrecognized $$tagInfo{Name} box";
  737. next if $$tagInfo{Name} eq 'XML';
  738. }
  739. last;
  740. }
  741. }
  742. } elsif ($$tagInfo{Format} and not $outfile) {
  743. # only save tag values if Format was specified
  744. my $rational;
  745. my $val = ReadValue($dataPt, $valuePtr, $$tagInfo{Format}, undef, $boxLen, \$rational);
  746. if (defined $val) {
  747. my $key = $et->FoundTag($tagInfo, $val);
  748. # save Rational value
  749. $$et{RATIONAL}{$key} = $rational if defined $rational and defined $key;
  750. }
  751. } elsif ($outfile) {
  752. my $boxhdr = pack('N', $boxLen + 8) . $boxID;
  753. Write($outfile, $boxhdr, substr($$dataPt, $valuePtr, $boxLen)) or $err = 1;
  754. }
  755. }
  756. if (defined $err) {
  757. $err or $err = 'Truncated JPEG 2000 box';
  758. if ($outfile) {
  759. $et->Error($err) unless $err eq '1';
  760. return $raf ? -1 : undef;
  761. }
  762. $et->Warn($err);
  763. }
  764. return $outBuff if $outfile and not $raf;
  765. return 1;
  766. }
  767. #------------------------------------------------------------------------------
  768. # Read/write meta information from a JPEG 2000 image
  769. # Inputs: 0) ExifTool object reference, 1) dirInfo reference
  770. # Returns: 1 on success, 0 if this wasn't a valid JPEG 2000 file, or -1 on write error
  771. sub ProcessJP2($$)
  772. {
  773. local $_;
  774. my ($et, $dirInfo) = @_;
  775. my $raf = $$dirInfo{RAF};
  776. my $outfile = $$dirInfo{OutFile};
  777. my $hdr;
  778. # check to be sure this is a valid JPG2000 file
  779. return 0 unless $raf->Read($hdr,12) == 12;
  780. unless ($hdr eq "\x00\x00\x00\x0cjP \x0d\x0a\x87\x0a" or # (ref 1)
  781. $hdr eq "\x00\x00\x00\x0cjP\x1a\x1a\x0d\x0a\x87\x0a") # (ref 2)
  782. {
  783. return 0 unless $hdr =~ /^\xff\x4f\xff\x51\0/; # check for JP2 codestream format
  784. if ($outfile) {
  785. $et->Error('Writing of J2C files is not yet supported');
  786. return 0
  787. }
  788. # add J2C markers if not done already
  789. unless ($Image::ExifTool::jpegMarker{0x4f}) {
  790. $Image::ExifTool::jpegMarker{$_} = $j2cMarker{$_} foreach keys %j2cMarker;
  791. }
  792. $et->SetFileType('J2C');
  793. $raf->Seek(0,0);
  794. return $et->ProcessJPEG($dirInfo); # decode with JPEG processor
  795. }
  796. if ($outfile) {
  797. Write($outfile, $hdr) or return -1;
  798. $et->InitWriteDirs(\%jp2Map);
  799. # save list of directories to create
  800. my %addDirs = %{$$et{ADD_DIRS}};
  801. $$et{AddJp2Dirs} = \%addDirs;
  802. $$et{AddJp2Tags} = $et->GetNewTagInfoHash(\%Image::ExifTool::Jpeg2000::Main);
  803. } else {
  804. my ($buff, $fileType);
  805. # recognize JPX and JPM as unique types of JP2
  806. if ($raf->Read($buff, 12) == 12 and $buff =~ /^.{4}ftyp(.{4})/s) {
  807. $fileType = 'JPX' if $1 eq 'jpx ';
  808. $fileType = 'JPM' if $1 eq 'jpm ';
  809. }
  810. $raf->Seek(-length($buff), 1) if defined $buff;
  811. $et->SetFileType($fileType);
  812. }
  813. SetByteOrder('MM'); # JPEG 2000 files are big-endian
  814. my %dirInfo = (
  815. RAF => $raf,
  816. DirName => 'JP2',
  817. OutFile => $$dirInfo{OutFile},
  818. );
  819. my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main');
  820. return $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
  821. }
  822. 1; # end
  823. __END__
  824. =head1 NAME
  825. Image::ExifTool::Jpeg2000 - Read JPEG 2000 meta information
  826. =head1 SYNOPSIS
  827. This module is used by Image::ExifTool
  828. =head1 DESCRIPTION
  829. This module contains routines required by Image::ExifTool to read JPEG 2000
  830. files.
  831. =head1 AUTHOR
  832. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  833. This library is free software; you can redistribute it and/or modify it
  834. under the same terms as Perl itself.
  835. =head1 REFERENCES
  836. =over 4
  837. =item L<http://www.jpeg.org/public/fcd15444-2.pdf>
  838. =item L<ftp://ftp.remotesensing.org/jpeg2000/fcd15444-1.pdf>
  839. =back
  840. =head1 SEE ALSO
  841. L<Image::ExifTool::TagNames/Jpeg2000 Tags>,
  842. L<Image::ExifTool(3pm)|Image::ExifTool>
  843. =cut