PNG.pm 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227
  1. #------------------------------------------------------------------------------
  2. # File: PNG.pm
  3. #
  4. # Description: Read and write PNG meta information
  5. #
  6. # Revisions: 06/10/2005 - P. Harvey Created
  7. # 06/23/2005 - P. Harvey Added MNG and JNG support
  8. # 09/16/2005 - P. Harvey Added write support
  9. #
  10. # References: 1) http://www.libpng.org/pub/png/spec/1.2/
  11. # 2) http://www.faqs.org/docs/png/
  12. # 3) http://www.libpng.org/pub/mng/
  13. # 4) http://www.libpng.org/pub/png/spec/register/
  14. # 5) ftp://ftp.simplesystems.org/pub/png/documents/pngext-1.4.0-pdg.html
  15. #
  16. # Notes: Writing meta information in PNG images is a pain in the butt
  17. # for a number of reasons: One biggie is that you have to
  18. # decompress then decode the ASCII/hex profile information before
  19. # you can edit it, then you have to ASCII/hex-encode, recompress
  20. # and calculate a CRC before you can write it out again. gaaaak.
  21. #------------------------------------------------------------------------------
  22. package Image::ExifTool::PNG;
  23. use strict;
  24. use vars qw($VERSION $AUTOLOAD);
  25. use Image::ExifTool qw(:DataAccess :Utils);
  26. $VERSION = '1.36';
  27. sub ProcessPNG_tEXt($$$);
  28. sub ProcessPNG_iTXt($$$);
  29. sub ProcessPNG_Compressed($$$);
  30. sub CalculateCRC($;$$$);
  31. sub HexEncode($);
  32. sub AddChunks($$;@);
  33. sub Add_iCCP($$);
  34. sub DoneDir($$$;$);
  35. sub GetLangInfo($$);
  36. sub BuildTextChunk($$$$$);
  37. my $noCompressLib;
  38. # look up for file type, header chunk and end chunk, based on file signature
  39. my %pngLookup = (
  40. "\x89PNG\r\n\x1a\n" => ['PNG', 'IHDR', 'IEND' ],
  41. "\x8aMNG\r\n\x1a\n" => ['MNG', 'MHDR', 'MEND' ],
  42. "\x8bJNG\r\n\x1a\n" => ['JNG', 'JHDR', 'IEND' ],
  43. );
  44. # map for directories in PNG images
  45. my %pngMap = (
  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. IFD0 => 'PNG',
  56. XMP => 'PNG',
  57. ICC_Profile => 'PNG',
  58. Photoshop => 'PNG',
  59. 'PNG-pHYs' => 'PNG',
  60. IPTC => 'Photoshop',
  61. MakerNotes => 'ExifIFD',
  62. );
  63. # color type of current image
  64. $Image::ExifTool::PNG::colorType = -1;
  65. # PNG chunks
  66. %Image::ExifTool::PNG::Main = (
  67. WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
  68. GROUPS => { 2 => 'Image' },
  69. PREFERRED => 1, # always add these tags when writing
  70. NOTES => q{
  71. Tags extracted from PNG images. See
  72. L<http://www.libpng.org/pub/png/spec/1.2/> for the official PNG 1.2
  73. specification.
  74. According to the specification, a PNG file should end at the IEND chunk,
  75. however ExifTool will preserve any data found after this when writing unless
  76. it is specifically deleted with -Trailer:All=. When reading, a minor
  77. warning is issued if this trailer exists, and ExifTool will attempt to parse
  78. this data as additional PNG chunks.
  79. },
  80. bKGD => {
  81. Name => 'BackgroundColor',
  82. ValueConv => 'join(" ",unpack(length($val) < 2 ? "C" : "n*", $val))',
  83. },
  84. cHRM => {
  85. Name => 'PrimaryChromaticities',
  86. SubDirectory => { TagTable => 'Image::ExifTool::PNG::PrimaryChromaticities' },
  87. },
  88. dSIG => {
  89. Name => 'DigitalSignature',
  90. Binary => 1,
  91. },
  92. fRAc => {
  93. Name => 'FractalParameters',
  94. Binary => 1,
  95. },
  96. gAMA => {
  97. Name => 'Gamma',
  98. Notes => q{
  99. ExifTool reports the gamma for decoding the image, which is consistent with
  100. the EXIF convention, but is the inverse of the stored encoding gamma
  101. },
  102. ValueConv => 'my $a=unpack("N",$val);$a ? int(1e9/$a+0.5)/1e4 : $val',
  103. },
  104. gIFg => {
  105. Name => 'GIFGraphicControlExtension',
  106. Binary => 1,
  107. },
  108. gIFt => {
  109. Name => 'GIFPlainTextExtension',
  110. Binary => 1,
  111. },
  112. gIFx => {
  113. Name => 'GIFApplicationExtension',
  114. Binary => 1,
  115. },
  116. hIST => {
  117. Name => 'PaletteHistogram',
  118. Binary => 1,
  119. },
  120. iCCP => {
  121. Name => 'ICC_Profile',
  122. Notes => 'this is where ExifTool will write a new ICC_Profile',
  123. SubDirectory => {
  124. TagTable => 'Image::ExifTool::ICC_Profile::Main',
  125. ProcessProc => \&ProcessPNG_Compressed,
  126. },
  127. },
  128. 'iCCP-name' => {
  129. Name => 'ProfileName',
  130. Notes => 'not a real tag ID, this tag represents the iCCP profile name',
  131. },
  132. # IDAT
  133. # IEND
  134. IHDR => {
  135. Name => 'ImageHeader',
  136. SubDirectory => { TagTable => 'Image::ExifTool::PNG::ImageHeader' },
  137. },
  138. iTXt => {
  139. Name => 'InternationalText',
  140. SubDirectory => {
  141. TagTable => 'Image::ExifTool::PNG::TextualData',
  142. ProcessProc => \&ProcessPNG_iTXt,
  143. },
  144. },
  145. oFFs => {
  146. Name => 'ImageOffset',
  147. ValueConv => q{
  148. my @a = unpack("NNC",$val);
  149. $a[2] = ($a[2] ? "microns" : "pixels");
  150. return "$a[0], $a[1] ($a[2])";
  151. },
  152. },
  153. pCAL => {
  154. Name => 'PixelCalibration',
  155. Binary => 1,
  156. },
  157. pHYs => {
  158. Name => 'PhysicalPixel',
  159. SubDirectory => {
  160. TagTable => 'Image::ExifTool::PNG::PhysicalPixel',
  161. DirName => 'PNG-pHYs', # (needed for writing)
  162. },
  163. },
  164. PLTE => {
  165. Name => 'Palette',
  166. ValueConv => 'length($val) <= 3 ? join(" ",unpack("C*",$val)) : \$val',
  167. },
  168. sBIT => {
  169. Name => 'SignificantBits',
  170. ValueConv => 'join(" ",unpack("C*",$val))',
  171. },
  172. sCAL => { # png 1.4.0
  173. Name => 'SubjectScale',
  174. SubDirectory => { TagTable => 'Image::ExifTool::PNG::SubjectScale' },
  175. },
  176. sPLT => {
  177. Name => 'SuggestedPalette',
  178. Binary => 1,
  179. PrintConv => 'split("\0",$$val,1)', # extract palette name
  180. },
  181. sRGB => {
  182. Name => 'SRGBRendering',
  183. ValueConv => 'unpack("C",$val)',
  184. PrintConv => {
  185. 0 => 'Perceptual',
  186. 1 => 'Relative Colorimetric',
  187. 2 => 'Saturation',
  188. 3 => 'Absolute Colorimetric',
  189. },
  190. },
  191. sTER => { # png 1.4.0
  192. Name => 'StereoImage',
  193. SubDirectory => { TagTable => 'Image::ExifTool::PNG::StereoImage' },
  194. },
  195. tEXt => {
  196. Name => 'TextualData',
  197. SubDirectory => { TagTable => 'Image::ExifTool::PNG::TextualData' },
  198. },
  199. tIME => {
  200. Name => 'ModifyDate',
  201. Groups => { 2 => 'Time' },
  202. Writable => 1,
  203. Shift => 'Time',
  204. ValueConv => 'sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d", unpack("nC5", $val))',
  205. ValueConvInv => q{
  206. my @a = ($val=~/^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
  207. @a == 6 or warn('Invalid date'), return undef;
  208. return pack('nC5', @a);
  209. },
  210. PrintConv => '$self->ConvertDateTime($val)',
  211. PrintConvInv => '$self->InverseDateTime($val)',
  212. },
  213. tRNS => {
  214. Name => 'Transparency',
  215. ValueConv => q{
  216. return \$val if length($val) > 6;
  217. join(" ",unpack($Image::ExifTool::PNG::colorType == 3 ? "C*" : "n*", $val));
  218. },
  219. },
  220. tXMP => {
  221. Name => 'XMP',
  222. Notes => 'obsolete location specified by a September 2001 XMP draft',
  223. NonStandard => 1,
  224. SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' },
  225. },
  226. vpAg => { # private imagemagick chunk
  227. Name => 'VirtualPage',
  228. SubDirectory => { TagTable => 'Image::ExifTool::PNG::VirtualPage' },
  229. },
  230. zTXt => {
  231. Name => 'CompressedText',
  232. SubDirectory => {
  233. TagTable => 'Image::ExifTool::PNG::TextualData',
  234. ProcessProc => \&ProcessPNG_Compressed,
  235. },
  236. },
  237. );
  238. # PNG IHDR chunk
  239. %Image::ExifTool::PNG::ImageHeader = (
  240. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  241. GROUPS => { 2 => 'Image' },
  242. 0 => {
  243. Name => 'ImageWidth',
  244. Format => 'int32u',
  245. },
  246. 4 => {
  247. Name => 'ImageHeight',
  248. Format => 'int32u',
  249. },
  250. 8 => 'BitDepth',
  251. 9 => {
  252. Name => 'ColorType',
  253. RawConv => '$Image::ExifTool::PNG::colorType = $val',
  254. PrintConv => {
  255. 0 => 'Grayscale',
  256. 2 => 'RGB',
  257. 3 => 'Palette',
  258. 4 => 'Grayscale with Alpha',
  259. 6 => 'RGB with Alpha',
  260. },
  261. },
  262. 10 => {
  263. Name => 'Compression',
  264. PrintConv => { 0 => 'Deflate/Inflate' },
  265. },
  266. 11 => {
  267. Name => 'Filter',
  268. PrintConv => { 0 => 'Adaptive' },
  269. },
  270. 12 => {
  271. Name => 'Interlace',
  272. PrintConv => { 0 => 'Noninterlaced', 1 => 'Adam7 Interlace' },
  273. },
  274. );
  275. # PNG cHRM chunk
  276. %Image::ExifTool::PNG::PrimaryChromaticities = (
  277. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  278. GROUPS => { 2 => 'Image' },
  279. FORMAT => 'int32u',
  280. 0 => { Name => 'WhitePointX', ValueConv => '$val / 100000' },
  281. 1 => { Name => 'WhitePointY', ValueConv => '$val / 100000' },
  282. 2 => { Name => 'RedX', ValueConv => '$val / 100000' },
  283. 3 => { Name => 'RedY', ValueConv => '$val / 100000' },
  284. 4 => { Name => 'GreenX', ValueConv => '$val / 100000' },
  285. 5 => { Name => 'GreenY', ValueConv => '$val / 100000' },
  286. 6 => { Name => 'BlueX', ValueConv => '$val / 100000' },
  287. 7 => { Name => 'BlueY', ValueConv => '$val / 100000' },
  288. );
  289. # PNG pHYs chunk
  290. %Image::ExifTool::PNG::PhysicalPixel = (
  291. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  292. WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
  293. WRITABLE => 1,
  294. GROUPS => { 1 => 'PNG-pHYs', 2 => 'Image' },
  295. WRITE_GROUP => 'PNG-pHYs',
  296. NOTES => q{
  297. These tags are found in the PNG pHYs chunk and belong to the PNG-pHYs family
  298. 1 group. They are all created together with default values if necessary
  299. when any of these tags is written, and may only be deleted as a group.
  300. },
  301. 0 => {
  302. Name => 'PixelsPerUnitX',
  303. Format => 'int32u',
  304. },
  305. 4 => {
  306. Name => 'PixelsPerUnitY',
  307. Format => 'int32u',
  308. },
  309. 8 => {
  310. Name => 'PixelUnits',
  311. PrintConv => { 0 => 'Unknown', 1 => 'meters' },
  312. },
  313. );
  314. # PNG sCAL chunk
  315. %Image::ExifTool::PNG::SubjectScale = (
  316. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  317. GROUPS => { 2 => 'Image' },
  318. 0 => {
  319. Name => 'SubjectUnits',
  320. PrintConv => { 1 => 'meters', 2 => 'radians' },
  321. },
  322. 1 => {
  323. Name => 'SubjectPixelWidth',
  324. Format => 'var_string',
  325. },
  326. 2 => {
  327. Name => 'SubjectPixelHeight',
  328. Format => 'var_string',
  329. },
  330. );
  331. # PNG vpAg chunk
  332. %Image::ExifTool::PNG::VirtualPage = (
  333. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  334. GROUPS => { 2 => 'Image' },
  335. FORMAT => 'int32u',
  336. 0 => 'VirtualImageWidth',
  337. 1 => 'VirtualImageHeight',
  338. 2 => {
  339. Name => 'VirtualPageUnits',
  340. Format => 'int8u',
  341. # what is the conversion for this?
  342. },
  343. );
  344. # PNG sTER chunk
  345. %Image::ExifTool::PNG::StereoImage = (
  346. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  347. GROUPS => { 2 => 'Image' },
  348. 0 => {
  349. Name => 'StereoMode',
  350. PrintConv => {
  351. 0 => 'Cross-fuse Layout',
  352. 1 => 'Diverging-fuse Layout',
  353. },
  354. },
  355. );
  356. my %unreg = ( Notes => 'unregistered' );
  357. # Tags for PNG tEXt zTXt and iTXt chunks
  358. # (NOTE: ValueConv is set dynamically, so don't set it here!)
  359. %Image::ExifTool::PNG::TextualData = (
  360. PROCESS_PROC => \&ProcessPNG_tEXt,
  361. WRITE_PROC => \&Image::ExifTool::DummyWriteProc,
  362. WRITABLE => 'string',
  363. PREFERRED => 1, # always add these tags when writing
  364. GROUPS => { 2 => 'Image' },
  365. LANG_INFO => \&GetLangInfo,
  366. NOTES => q{
  367. The PNG TextualData format allows arbitrary tag names to be used. The tags
  368. listed below are the only ones that can be written (unless new user-defined
  369. tags are added via the configuration file), however ExifTool will extract
  370. any other TextualData tags that are found. All TextualData tags (including
  371. tags not listed below) are removed when deleting all PNG tags.
  372. These tags may be stored as tEXt, zTXt or iTXt chunks in the PNG image. By
  373. default ExifTool writes new string-value tags as as uncompressed tEXt, or
  374. compressed zTXt if the Compress (-z) option is used and Compress::Zlib is
  375. available. Alternate language tags and values containing special characters
  376. (unless the Latin character set is used) are written as iTXt, and compressed
  377. if the Compress option is used and Compress::Zlib is available. Raw profile
  378. information is always created as compressed zTXt if Compress::Zlib is
  379. available, or tEXt otherwise. Standard XMP is written as uncompressed iTXt.
  380. Alternate languages are accessed by suffixing the tag name with a '-',
  381. followed by an RFC 3066 language code (eg. "PNG:Comment-fr", or
  382. "Title-en-US"). See L<http://www.ietf.org/rfc/rfc3066.txt> for the RFC 3066
  383. specification.
  384. Some of the tags below are not registered as part of the PNG specification,
  385. but are included here because they are generated by other software such as
  386. ImageMagick.
  387. },
  388. Title => { },
  389. Author => { Groups => { 2 => 'Author' } },
  390. Description => { },
  391. Copyright => { Groups => { 2 => 'Author' } },
  392. 'Creation Time' => {
  393. Name => 'CreationTime',
  394. Groups => { 2 => 'Time' },
  395. Shift => 'Time',
  396. },
  397. Software => { },
  398. Disclaimer => { },
  399. # change name to differentiate from ExifTool Warning
  400. Warning => { Name => 'PNGWarning', },
  401. Source => { },
  402. Comment => { },
  403. #
  404. # The following tags are not part of the original PNG specification,
  405. # but are written by ImageMagick and other software
  406. #
  407. Artist => { %unreg, Groups => { 2 => 'Author' } },
  408. Document => { %unreg },
  409. Label => { %unreg },
  410. Make => { %unreg, Groups => { 2 => 'Camera' } },
  411. Model => { %unreg, Groups => { 2 => 'Camera' } },
  412. 'create-date'=> {
  413. Name => 'CreateDate',
  414. Groups => { 2 => 'Time' },
  415. Shift => 'Time',
  416. %unreg,
  417. ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
  418. ValueConvInv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::FormatXMPDate($val)',
  419. PrintConv => '$self->ConvertDateTime($val)',
  420. PrintConvInv => '$self->InverseDateTime($val,undef,1)',
  421. },
  422. 'modify-date'=> {
  423. Name => 'ModDate', # (to distinguish from tIME chunk "ModifyDate")
  424. Groups => { 2 => 'Time' },
  425. Shift => 'Time',
  426. %unreg,
  427. ValueConv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::ConvertXMPDate($val)',
  428. ValueConvInv => 'require Image::ExifTool::XMP; Image::ExifTool::XMP::FormatXMPDate($val)',
  429. PrintConv => '$self->ConvertDateTime($val)',
  430. PrintConvInv => '$self->InverseDateTime($val,undef,1)',
  431. },
  432. TimeStamp => { %unreg, Groups => { 2 => 'Time' }, Shift => 'Time' },
  433. URL => { %unreg },
  434. 'XML:com.adobe.xmp' => {
  435. Name => 'XMP',
  436. Notes => q{
  437. unregistered, but this is the location according to the June 2002 or later
  438. XMP specification, and is where ExifTool will add a new XMP chunk if the
  439. image didn't already contain XMP
  440. },
  441. SubDirectory => {
  442. TagTable => 'Image::ExifTool::XMP::Main',
  443. },
  444. },
  445. 'Raw profile type APP1' => [
  446. {
  447. # EXIF table must come first because we key on this in ProcessProfile()
  448. # (No condition because this is just for BuildTagLookup)
  449. Name => 'APP1_Profile',
  450. Notes => 'unregistered. This is where ExifTool will create new EXIF',
  451. SubDirectory => {
  452. TagTable => 'Image::ExifTool::Exif::Main',
  453. ProcessProc => \&ProcessProfile,
  454. },
  455. },
  456. {
  457. Name => 'APP1_Profile',
  458. NonStandard => 1,
  459. SubDirectory => {
  460. TagTable => 'Image::ExifTool::XMP::Main',
  461. ProcessProc => \&ProcessProfile,
  462. },
  463. },
  464. ],
  465. 'Raw profile type exif' => {
  466. Name => 'EXIF_Profile',
  467. %unreg,
  468. SubDirectory => {
  469. TagTable => 'Image::ExifTool::Exif::Main',
  470. ProcessProc => \&ProcessProfile,
  471. },
  472. },
  473. 'Raw profile type icc' => {
  474. Name => 'ICC_Profile',
  475. %unreg,
  476. SubDirectory => {
  477. TagTable => 'Image::ExifTool::ICC_Profile::Main',
  478. ProcessProc => \&ProcessProfile,
  479. },
  480. },
  481. 'Raw profile type icm' => {
  482. Name => 'ICC_Profile',
  483. %unreg,
  484. SubDirectory => {
  485. TagTable => 'Image::ExifTool::ICC_Profile::Main',
  486. ProcessProc => \&ProcessProfile,
  487. },
  488. },
  489. 'Raw profile type iptc' => {
  490. Name => 'IPTC_Profile',
  491. Notes => q{
  492. unregistered. May be either IPTC IIM or Photoshop IRB format. This is
  493. where ExifTool will add new IPTC, inside a Photoshop IRB container
  494. },
  495. SubDirectory => {
  496. TagTable => 'Image::ExifTool::Photoshop::Main',
  497. ProcessProc => \&ProcessProfile,
  498. },
  499. },
  500. 'Raw profile type xmp' => {
  501. Name => 'XMP_Profile',
  502. %unreg,
  503. NonStandard => 1,
  504. SubDirectory => {
  505. TagTable => 'Image::ExifTool::XMP::Main',
  506. ProcessProc => \&ProcessProfile,
  507. },
  508. },
  509. 'Raw profile type 8bim' => {
  510. Name => 'Photoshop_Profile',
  511. %unreg,
  512. SubDirectory => {
  513. TagTable => 'Image::ExifTool::Photoshop::Main',
  514. ProcessProc => \&ProcessProfile,
  515. },
  516. },
  517. );
  518. #------------------------------------------------------------------------------
  519. # AutoLoad our writer routines when necessary
  520. #
  521. sub AUTOLOAD
  522. {
  523. return Image::ExifTool::DoAutoLoad($AUTOLOAD, @_);
  524. }
  525. #------------------------------------------------------------------------------
  526. # Get standard case for language code (this routine copied from XMP.pm)
  527. # Inputs: 0) Language code
  528. # Returns: Language code in standard case
  529. sub StandardLangCase($)
  530. {
  531. my $lang = shift;
  532. # make 2nd subtag uppercase only if it is 2 letters
  533. return lc($1) . uc($2) . lc($3) if $lang =~ /^([a-z]{2,3}|[xi])(-[a-z]{2})\b(.*)/i;
  534. return lc($lang);
  535. }
  536. #------------------------------------------------------------------------------
  537. # Get localized version of tagInfo hash
  538. # Inputs: 0) tagInfo hash ref, 1) language code (eg. "x-default")
  539. # Returns: new tagInfo hash ref, or undef if invalid
  540. sub GetLangInfo($$)
  541. {
  542. my ($tagInfo, $lang) = @_;
  543. $lang =~ tr/_/-/; # RFC 3066 specifies '-' as a separator
  544. # no alternate languages for XMP or raw profile directories
  545. return undef if $$tagInfo{SubDirectory};
  546. # language code must normalized for use in tag ID
  547. return Image::ExifTool::GetLangInfo($tagInfo, StandardLangCase($lang));
  548. }
  549. #------------------------------------------------------------------------------
  550. # Found a PNG tag -- extract info from subdirectory or decompress data if necessary
  551. # Inputs: 0) ExifTool object reference, 1) Pointer to tag table,
  552. # 2) Tag ID, 3) Tag value, 4) [optional] compressed data flag:
  553. # 0=not compressed, 1=unknown compression, 2-N=compression with type N-2
  554. # 5) optional output buffer ref, 6) character encoding (tEXt/zTXt/iTXt only)
  555. # 6) optional language code
  556. # Returns: 1 on success
  557. sub FoundPNG($$$$;$$$$)
  558. {
  559. my ($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, $enc, $lang) = @_;
  560. return 0 unless defined $val;
  561. my $verbose = $et->Options('Verbose');
  562. my $id = $tag; # generate tag ID which include language code
  563. if ($lang) {
  564. # case of language code must be normalized since they are case insensitive
  565. $lang = StandardLangCase($lang);
  566. $id .= '-' . $lang;
  567. }
  568. my $tagInfo = $et->GetTagInfo($tagTablePtr, $id) ||
  569. # (some software forgets to capitalize first letter)
  570. $et->GetTagInfo($tagTablePtr, ucfirst($id));
  571. # create alternate language tag if necessary
  572. if (not $tagInfo and $lang) {
  573. $tagInfo = $et->GetTagInfo($tagTablePtr, $tag) ||
  574. $et->GetTagInfo($tagTablePtr, ucfirst($tag));
  575. $tagInfo = GetLangInfo($tagInfo, $lang) if $tagInfo;
  576. }
  577. #
  578. # uncompress data if necessary
  579. #
  580. my ($wasCompressed, $deflateErr);
  581. if ($compressed and $compressed > 1) {
  582. if ($compressed == 2) { # Inflate/Deflate compression
  583. if (eval { require Compress::Zlib }) {
  584. my ($v2, $stat);
  585. my $inflate = Compress::Zlib::inflateInit();
  586. $inflate and ($v2, $stat) = $inflate->inflate($val);
  587. if ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
  588. $val = $v2;
  589. $compressed = 0;
  590. $wasCompressed = 1;
  591. } else {
  592. $deflateErr = "Error inflating $tag";
  593. }
  594. } elsif (not $noCompressLib) {
  595. $deflateErr = "Install Compress::Zlib to read compressed information";
  596. } else {
  597. $deflateErr = ''; # flag deflate error but no warning
  598. }
  599. } else {
  600. $compressed -= 2;
  601. $deflateErr = "Unknown compression method $compressed for $tag";
  602. }
  603. if ($compressed and $verbose and $tagInfo and $$tagInfo{SubDirectory}) {
  604. $et->VerboseDir("Unable to decompress $$tagInfo{Name}", 0, length($val));
  605. }
  606. # issue warning if relevant
  607. if ($deflateErr and (not $outBuff or
  608. ($tagInfo and $$tagInfo{SubDirectory} and $$et{EDIT_DIRS}{$$tagInfo{Name}})))
  609. {
  610. $et->Warn($deflateErr);
  611. $noCompressLib = 1 if $deflateErr =~ /^Install/;
  612. }
  613. }
  614. # translate character encoding if necessary (tEXt/zTXt/iTXt string values only)
  615. if ($enc and not $compressed and not ($tagInfo and $$tagInfo{SubDirectory})) {
  616. $val = $et->Decode($val, $enc);
  617. }
  618. #
  619. # extract information from subdirectory if available
  620. #
  621. if ($tagInfo) {
  622. my $tagName = $$tagInfo{Name};
  623. my $processed;
  624. if ($$tagInfo{SubDirectory} and not $compressed) {
  625. my $len = length $val;
  626. if ($verbose and $$et{INDENT} ne ' ') {
  627. if ($wasCompressed and $verbose > 2) {
  628. my $name = $tagName;
  629. $wasCompressed and $name = "Decompressed $name";
  630. $et->VerboseDir($name, 0, $len);
  631. $et->VerboseDump(\$val);
  632. }
  633. # don't indent next directory (since it is really the same data)
  634. $$et{INDENT} =~ s/..$//;
  635. }
  636. my $subdir = $$tagInfo{SubDirectory};
  637. my $processProc = $$subdir{ProcessProc};
  638. # nothing more to do if writing and subdirectory is not writable
  639. my $subTable = GetTagTable($$subdir{TagTable});
  640. return 1 if $outBuff and not $$subTable{WRITE_PROC};
  641. my $dirName = $$subdir{DirName} || $tagName;
  642. my %subdirInfo = (
  643. DataPt => \$val,
  644. DirStart => 0,
  645. DataLen => $len,
  646. DirLen => $len,
  647. DirName => $dirName,
  648. TagInfo => $tagInfo,
  649. ReadOnly => 1, # (only used by WriteXMP)
  650. OutBuff => $outBuff,
  651. );
  652. # no need to re-decompress if already done
  653. undef $processProc if $wasCompressed and $processProc eq \&ProcessPNG_Compressed;
  654. # rewrite this directory if necessary (but always process TextualData normally)
  655. if ($outBuff and not $processProc and $subTable ne \%Image::ExifTool::PNG::TextualData) {
  656. return 1 unless $$et{EDIT_DIRS}{$dirName};
  657. $$outBuff = $et->WriteDirectory(\%subdirInfo, $subTable);
  658. if ($tagName eq 'XMP' and $$outBuff) {
  659. if ($$et{FoundIDAT} and $$et{DEL_GROUP}{XMP}) {
  660. $et->VPrint(0,' Deleting XMP');
  661. $$outBuff = '';
  662. } else {
  663. # make sure the XMP is marked as read-only
  664. Image::ExifTool::XMP::ValidateXMP($outBuff,'r');
  665. }
  666. }
  667. DoneDir($et, $dirName, $outBuff, $$tagInfo{NonStandard});
  668. } else {
  669. # issue warning for standard XMP after IDAT (PNGEarlyXMP option)
  670. if ($tagName eq 'XMP' and not $$tagInfo{NonStandard} and
  671. $$et{FoundIDAT} and $$et{FoundIDAT} == 2)
  672. {
  673. $et->Warn('XMP found after PNG IDAT');
  674. $$et{FoundIDAT} = 1;
  675. }
  676. $processed = $et->ProcessDirectory(\%subdirInfo, $subTable, $processProc);
  677. }
  678. $compressed = 1; # pretend this is compressed since it is binary data
  679. }
  680. if ($outBuff) {
  681. my $writable = $$tagInfo{Writable};
  682. my $isOverwriting;
  683. if ($writable or ($$tagTablePtr{WRITABLE} and
  684. not defined $writable and not $$tagInfo{SubDirectory}))
  685. {
  686. # write new value for this tag if necessary
  687. my $newVal;
  688. if ($$et{DEL_GROUP}{PNG} or $$et{PNGDoneTag}{$tag} or
  689. $$et{PNGDoneTag}{ucfirst $tag})
  690. {
  691. # remove this tag now, but keep in ADD_PNG list to add back later
  692. $isOverwriting = 1;
  693. } else {
  694. # remove this from the list of PNG tags to add
  695. delete $$et{ADD_PNG}{$id};
  696. # (also handle case of tEXt tags written with lowercase first letter)
  697. delete $$et{ADD_PNG}{ucfirst($id)};
  698. my $nvHash = $et->GetNewValueHash($tagInfo);
  699. $isOverwriting = $et->IsOverwriting($nvHash);
  700. if (defined $deflateErr) {
  701. $newVal = $et->GetNewValue($nvHash);
  702. # can only write tag now if always overwriting
  703. if ($isOverwriting > 0) {
  704. $val = '<deflate error>';
  705. } elsif ($isOverwriting) {
  706. $isOverwriting = 0; # can't overwrite
  707. $et->Warn($deflateErr) if $deflateErr;
  708. }
  709. } else {
  710. if ($isOverwriting < 0) {
  711. $isOverwriting = $et->IsOverwriting($nvHash, $val);
  712. }
  713. # (must get new value after IsOverwriting() in case it was shifted)
  714. $newVal = $et->GetNewValue($nvHash);
  715. }
  716. }
  717. if ($isOverwriting) {
  718. $$outBuff = (defined $newVal) ? $newVal : '';
  719. ++$$et{CHANGED};
  720. $et->VerboseValue("- PNG:$tagName", $val);
  721. $et->VerboseValue("+ PNG:$tagName", $newVal) if defined $newVal;
  722. }
  723. }
  724. if (defined $$outBuff and length $$outBuff) {
  725. if ($enc) { # must be tEXt/zTXt/iTXt if $enc is set
  726. $$outBuff = BuildTextChunk($et, $tag, $tagInfo, $$outBuff, $lang);
  727. } elsif ($wasCompressed) {
  728. # re-compress the output data
  729. my $deflate;
  730. if (eval { require Compress::Zlib }) {
  731. my $deflate = Compress::Zlib::deflateInit();
  732. if ($deflate) {
  733. $$outBuff = $deflate->deflate($$outBuff);
  734. $$outBuff .= $deflate->flush() if defined $$outBuff;
  735. } else {
  736. undef $$outBuff;
  737. }
  738. }
  739. $$outBuff or $et->Warn("PNG:$tagName not written (compress error)");
  740. }
  741. }
  742. return 1;
  743. }
  744. return 1 if $processed;
  745. } elsif ($outBuff) {
  746. if ($$et{DEL_GROUP}{PNG} and $tagTablePtr eq \%Image::ExifTool::PNG::TextualData) {
  747. # delete all TextualData tags if deleting the PNG group
  748. $$outBuff = '';
  749. ++$$et{CHANGED};
  750. $et->VerboseValue("- PNG:$tag", $val);
  751. }
  752. return 1;
  753. } else {
  754. my $name;
  755. ($name = $tag) =~ s/\s+(.)/\u$1/g; # remove white space from tag name
  756. $tagInfo = { Name => $name };
  757. $$tagInfo{LangCode} = $lang if $lang;
  758. # make unknown profiles binary data type
  759. $$tagInfo{Binary} = 1 if $tag =~ /^Raw profile type /;
  760. $verbose and $et->VPrint(0, " | [adding $tag]\n");
  761. AddTagToTable($tagTablePtr, $tag, $tagInfo);
  762. }
  763. #
  764. # store this tag information
  765. #
  766. if ($verbose) {
  767. # temporarily remove subdirectory so it isn't printed in verbose information
  768. # since we aren't decoding it anyway;
  769. my $subdir = $$tagInfo{SubDirectory};
  770. delete $$tagInfo{SubDirectory};
  771. $et->VerboseInfo($tag, $tagInfo,
  772. Table => $tagTablePtr,
  773. DataPt => \$val,
  774. );
  775. $$tagInfo{SubDirectory} = $subdir if $subdir;
  776. }
  777. # set the RawConv dynamically depending on whether this is binary or not
  778. my $delRawConv;
  779. if ($compressed and not defined $$tagInfo{ValueConv}) {
  780. $$tagInfo{RawConv} = '\$val';
  781. $delRawConv = 1;
  782. }
  783. $et->FoundTag($tagInfo, $val);
  784. delete $$tagInfo{RawConv} if $delRawConv;
  785. return 1;
  786. }
  787. #------------------------------------------------------------------------------
  788. # Process encoded PNG profile information
  789. # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
  790. # Returns: 1 on success
  791. sub ProcessProfile($$$)
  792. {
  793. my ($et, $dirInfo, $tagTablePtr) = @_;
  794. my $dataPt = $$dirInfo{DataPt};
  795. my $tagInfo = $$dirInfo{TagInfo};
  796. my $outBuff = $$dirInfo{OutBuff};
  797. my $tagName = $$tagInfo{Name};
  798. # ImageMagick 5.3.6 writes profiles with the following headers:
  799. # "\nICC Profile\n", "\nIPTC profile\n", "\n\xaa\x01{generic prof\n"
  800. # and "\ngeneric profile\n"
  801. return 0 unless $$dataPt =~ /^\n(.*?)\n\s*(\d+)\n(.*)/s;
  802. my ($profileType, $len) = ($1, $2);
  803. # data is encoded in hex, so change back to binary
  804. my $buff = pack('H*', join('',split(' ',$3)));
  805. my $actualLen = length $buff;
  806. if ($len ne $actualLen) {
  807. $et->Warn("$tagName is wrong size (should be $len bytes but is $actualLen)");
  808. $len = $actualLen;
  809. }
  810. my $verbose = $et->Options('Verbose');
  811. if ($verbose) {
  812. if ($verbose > 2) {
  813. $et->VerboseDir("Decoded $tagName", 0, $len);
  814. $et->VerboseDump(\$buff);
  815. }
  816. # don't indent next directory (since it is really the same data)
  817. $$et{INDENT} =~ s/..$//;
  818. }
  819. my %dirInfo = (
  820. Parent => 'PNG',
  821. DataPt => \$buff,
  822. DataLen => $len,
  823. DirStart => 0,
  824. DirLen => $len,
  825. Base => 0,
  826. OutFile => $outBuff,
  827. );
  828. $$et{PROCESSED} = { }; # reset processed directory offsets
  829. my $processed = 0;
  830. my $oldChanged = $$et{CHANGED};
  831. my $exifTable = GetTagTable('Image::ExifTool::Exif::Main');
  832. my $editDirs = $$et{EDIT_DIRS};
  833. if ($tagTablePtr ne $exifTable) {
  834. # this is unfortunate, but the "IPTC" profile may be stored as either
  835. # IPTC IIM or a Photoshop IRB resource, so we must test for this
  836. if ($tagName eq 'IPTC_Profile' and $buff =~ /^\x1c/) {
  837. $tagTablePtr = GetTagTable('Image::ExifTool::IPTC::Main');
  838. }
  839. # process non-EXIF and non-APP1 profile as-is
  840. if ($outBuff) {
  841. # no need to rewrite this if not editing tags in this directory
  842. my $dir = $tagName;
  843. $dir =~ s/_Profile// unless $dir =~ /^ICC/;
  844. return 1 unless $$editDirs{$dir};
  845. $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
  846. DoneDir($et, $dir, $outBuff);
  847. } else {
  848. $processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
  849. }
  850. } elsif ($buff =~ /^$Image::ExifTool::exifAPP1hdr/) {
  851. # APP1 EXIF information
  852. return 1 if $outBuff and not $$editDirs{IFD0};
  853. my $hdrLen = length($Image::ExifTool::exifAPP1hdr);
  854. $dirInfo{DirStart} += $hdrLen;
  855. $dirInfo{DirLen} -= $hdrLen;
  856. if ($outBuff) {
  857. $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr,
  858. \&Image::ExifTool::WriteTIFF);
  859. $$outBuff = $Image::ExifTool::exifAPP1hdr . $$outBuff if $$outBuff;
  860. DoneDir($et, 'IFD0', $outBuff);
  861. } else {
  862. $processed = $et->ProcessTIFF(\%dirInfo);
  863. }
  864. } elsif ($buff =~ /^$Image::ExifTool::xmpAPP1hdr/) {
  865. # APP1 XMP information
  866. my $hdrLen = length($Image::ExifTool::xmpAPP1hdr);
  867. my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
  868. $dirInfo{DirStart} += $hdrLen;
  869. $dirInfo{DirLen} -= $hdrLen;
  870. if ($outBuff) {
  871. return 1 unless $$editDirs{XMP};
  872. $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr);
  873. $$outBuff and $$outBuff = $Image::ExifTool::xmpAPP1hdr . $$outBuff;
  874. DoneDir($et, 'XMP', $outBuff, 1);
  875. } else {
  876. $processed = $et->ProcessDirectory(\%dirInfo, $tagTablePtr);
  877. }
  878. } elsif ($buff =~ /^(MM\0\x2a|II\x2a\0)/) {
  879. # TIFF information
  880. return 1 if $outBuff and not $$editDirs{IFD0};
  881. if ($outBuff) {
  882. $$outBuff = $et->WriteDirectory(\%dirInfo, $tagTablePtr,
  883. \&Image::ExifTool::WriteTIFF);
  884. DoneDir($et, 'IFD0', $outBuff);
  885. } else {
  886. $processed = $et->ProcessTIFF(\%dirInfo);
  887. }
  888. } else {
  889. my $profName = $profileType;
  890. $profName =~ tr/\x00-\x1f\x7f-\xff/./;
  891. $et->Warn("Unknown raw profile '$profName'");
  892. }
  893. if ($outBuff and defined $$outBuff and length $$outBuff) {
  894. if ($$et{CHANGED} != $oldChanged) {
  895. my $hdr = sprintf("\n%s\n%8d\n", $profileType, length($$outBuff));
  896. # hex encode the data
  897. $$outBuff = $hdr . HexEncode($outBuff);
  898. } else {
  899. undef $$outBuff;
  900. }
  901. }
  902. return $processed;
  903. }
  904. #------------------------------------------------------------------------------
  905. # Process PNG compressed zTXt or iCCP chunk
  906. # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
  907. # Returns: 1 on success
  908. # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
  909. sub ProcessPNG_Compressed($$$)
  910. {
  911. my ($et, $dirInfo, $tagTablePtr) = @_;
  912. my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  913. return 0 unless defined $val;
  914. # set compressed to 2 + compression method to decompress the data
  915. my $compressed = 2 + unpack('C', $val);
  916. my $hdr = $tag . "\0" . substr($val, 0, 1);
  917. $val = substr($val, 1); # remove compression method byte
  918. my $success;
  919. my $outBuff = $$dirInfo{OutBuff};
  920. my $tagInfo = $$dirInfo{TagInfo};
  921. # use the PNG chunk tag instead of the embedded tag name for iCCP chunks
  922. if ($tagInfo and $$tagInfo{Name} eq 'ICC_Profile') {
  923. $et->VerboseDir('iCCP');
  924. $tagTablePtr = \%Image::ExifTool::PNG::Main;
  925. if (length($tag) and not $outBuff) {
  926. FoundPNG($et, $tagTablePtr, 'iCCP-name', $tag);
  927. }
  928. $success = FoundPNG($et, $tagTablePtr, 'iCCP', $val, $compressed, $outBuff);
  929. $$outBuff = $hdr . $$outBuff if $outBuff and $$outBuff;
  930. } else {
  931. $success = FoundPNG($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, 'Latin');
  932. }
  933. return $success;
  934. }
  935. #------------------------------------------------------------------------------
  936. # Process PNG tEXt chunk
  937. # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
  938. # Returns: 1 on success
  939. # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
  940. sub ProcessPNG_tEXt($$$)
  941. {
  942. my ($et, $dirInfo, $tagTablePtr) = @_;
  943. my ($tag, $val) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  944. my $outBuff = $$dirInfo{OutBuff};
  945. return FoundPNG($et, $tagTablePtr, $tag, $val, undef, $outBuff, 'Latin');
  946. }
  947. #------------------------------------------------------------------------------
  948. # Process PNG iTXt chunk
  949. # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) Pointer to tag table
  950. # Returns: 1 on success
  951. # Notes: writes new chunk data to ${$$dirInfo{OutBuff}} if writing tag
  952. sub ProcessPNG_iTXt($$$)
  953. {
  954. my ($et, $dirInfo, $tagTablePtr) = @_;
  955. my ($tag, $dat) = split /\0/, ${$$dirInfo{DataPt}}, 2;
  956. return 0 unless defined $dat and length($dat) >= 4;
  957. my ($compressed, $meth) = unpack('CC', $dat);
  958. my ($lang, $trans, $val) = split /\0/, substr($dat, 2), 3;
  959. # set compressed flag so we will decompress it in FoundPNG()
  960. $compressed and $compressed = 2 + $meth;
  961. my $outBuff = $$dirInfo{OutBuff};
  962. return FoundPNG($et, $tagTablePtr, $tag, $val, $compressed, $outBuff, 'UTF8', $lang);
  963. }
  964. #------------------------------------------------------------------------------
  965. # Extract meta information from a PNG image
  966. # Inputs: 0) ExifTool object reference, 1) dirInfo reference
  967. # Returns: 1 on success, 0 if this wasn't a valid PNG image, or -1 on write error
  968. sub ProcessPNG($$)
  969. {
  970. my ($et, $dirInfo) = @_;
  971. my $outfile = $$dirInfo{OutFile};
  972. my $raf = $$dirInfo{RAF};
  973. my $datChunk = '';
  974. my $datCount = 0;
  975. my $datBytes = 0;
  976. my ($sig, $err);
  977. # check to be sure this is a valid PNG/MNG/JNG image
  978. return 0 unless $raf->Read($sig,8) == 8 and $pngLookup{$sig};
  979. my $earlyXMP = $et->Options('PNGEarlyXMP');
  980. if ($outfile) {
  981. delete $$et{TextChunkType};
  982. Write($outfile, $sig) or $err = 1 if $outfile;
  983. # can only add tags in Main and TextualData tables
  984. $$et{ADD_PNG} = $et->GetNewTagInfoHash(
  985. \%Image::ExifTool::PNG::Main,
  986. \%Image::ExifTool::PNG::TextualData);
  987. # NOTE: PNGDoneTag and PNGDoneDir are used to keep track of metadata added
  988. # before the PNG IEND chunk is encountered. Currently this is implemented
  989. # only for XMP (written before IDAT with the PNGEarlyXMP option), but
  990. # may be implemented in the future for other types - PH
  991. $$et{PNGDoneTag} = { };
  992. $$et{PNGDoneDir} = { };
  993. # initialize with same directories, with PNG tags taking priority
  994. $et->InitWriteDirs(\%pngMap,'PNG');
  995. # write XMP before IDAT if we would delete it later anyway
  996. $earlyXMP = 1 if $$et{DEL_GROUP}{XMP};
  997. }
  998. my ($fileType, $hdrChunk, $endChunk) = @{$pngLookup{$sig}};
  999. $et->SetFileType($fileType); # set the FileType tag
  1000. SetByteOrder('MM'); # PNG files are big-endian
  1001. my $tagTablePtr = GetTagTable('Image::ExifTool::PNG::Main');
  1002. my $mngTablePtr;
  1003. if ($fileType ne 'PNG') {
  1004. $mngTablePtr = GetTagTable('Image::ExifTool::MNG::Main');
  1005. }
  1006. my $verbose = $et->Options('Verbose');
  1007. my $out = $et->Options('TextOut');
  1008. my ($hbuf, $dbuf, $cbuf, $wasHdr, $wasEnd);
  1009. # process the PNG/MNG/JNG chunks
  1010. undef $noCompressLib;
  1011. for (;;) {
  1012. my $n = $raf->Read($hbuf,8);
  1013. if ($wasEnd) {
  1014. last unless $n; # stop now if normal end of PNG
  1015. $et->WarnOnce("Trailer data after $fileType $endChunk chunk", 1);
  1016. last if $n < 8;
  1017. $$et{SET_GROUP1} = 'Trailer';
  1018. } elsif ($n != 8) {
  1019. $et->Warn("Truncated $fileType image") unless $wasEnd;
  1020. last;
  1021. }
  1022. my ($len, $chunk) = unpack('Na4',$hbuf);
  1023. if ($len > 0x7fffffff) {
  1024. $et->Warn("Invalid $fileType chunk size") unless $wasEnd;
  1025. last;
  1026. }
  1027. if ($verbose) {
  1028. # don't dump image data chunks in verbose mode (only give count instead)
  1029. if ($datCount and $chunk ne $datChunk) {
  1030. my $s = $datCount > 1 ? 's' : '';
  1031. print $out "$fileType $datChunk ($datCount chunk$s, total $datBytes bytes)\n";
  1032. $datCount = $datBytes = 0;
  1033. $datChunk = '';
  1034. }
  1035. if ($chunk =~ /^(IDAT|JDAT|JDAA)$/) {
  1036. $datChunk = $chunk;
  1037. $datCount++;
  1038. $datBytes += $len;
  1039. }
  1040. }
  1041. if ($outfile) {
  1042. if ($chunk eq $endChunk) {
  1043. # add any new chunks immediately before the IEND/MEND chunk
  1044. AddChunks($et, $outfile) or $err = 1;
  1045. } elsif ($chunk eq 'PLTE' or $chunk eq 'IDAT') {
  1046. if ($chunk eq 'IDAT') {
  1047. # add XMP before IDAT if specified
  1048. AddChunks($et, $outfile, 'XMP') or $err = 1 if $earlyXMP;
  1049. # pHYs comes before IDAT
  1050. AddChunks($et, $outfile, 'PNG-pHYs') or $err = 1;
  1051. }
  1052. # iCCP chunk must come before PLTE and IDAT
  1053. # (ignore errors -- will add later as text profile if this fails)
  1054. Add_iCCP($et, $outfile);
  1055. }
  1056. }
  1057. if ($chunk eq $endChunk) {
  1058. # read CRC
  1059. unless ($raf->Read($cbuf,4) == 4) {
  1060. $et->Warn("Truncated $fileType $endChunk chunk") unless $wasEnd;
  1061. last;
  1062. }
  1063. $verbose and print $out "$fileType $chunk (end of image)\n";
  1064. $wasEnd = 1;
  1065. if ($outfile) {
  1066. # write the IEND/MEND chunk with CRC
  1067. Write($outfile, $hbuf, $cbuf) or $err = 1;
  1068. if ($$et{DEL_GROUP}{Trailer}) {
  1069. if ($raf->Read($hbuf, 1)) {
  1070. $verbose and printf $out " Deleting PNG trailer\n";
  1071. ++$$et{CHANGED};
  1072. }
  1073. } else {
  1074. # copy over any existing trailer data
  1075. my $tot = 0;
  1076. for (;;) {
  1077. $n = $raf->Read($hbuf, 65536) or last;
  1078. $tot += $n;
  1079. Write($outfile, $hbuf) or $err = 1;
  1080. }
  1081. $tot and $verbose and printf $out " Copying PNG trailer ($tot bytes)\n";
  1082. }
  1083. last;
  1084. }
  1085. next;
  1086. }
  1087. # set FoundIDAT flag: 1=after IDAT, 2=after IDAT and warn about late XMP
  1088. $$et{FoundIDAT} = $earlyXMP ? 2 : 1 if $chunk eq 'IDAT';
  1089. # read chunk data and CRC
  1090. unless ($raf->Read($dbuf,$len)==$len and $raf->Read($cbuf, 4)==4) {
  1091. $et->Warn("Corrupted $fileType image") unless $wasEnd;
  1092. last;
  1093. }
  1094. unless ($wasHdr) {
  1095. if ($chunk eq $hdrChunk) {
  1096. $wasHdr = 1;
  1097. } elsif ($hdrChunk eq 'IHDR' and $chunk eq 'CgBI') {
  1098. $et->Warn('Non-standard PNG image (Apple iPhone format)');
  1099. } else {
  1100. $et->Warn("$fileType image did not start with $hdrChunk");
  1101. last;
  1102. }
  1103. }
  1104. if ($verbose) {
  1105. # check CRC when in verbose mode (since we don't care about speed)
  1106. my $crc = CalculateCRC(\$hbuf, undef, 4);
  1107. $crc = CalculateCRC(\$dbuf, $crc);
  1108. $crc == unpack('N',$cbuf) or $et->Warn("Bad CRC for $chunk chunk") unless $wasEnd;
  1109. if ($datChunk) {
  1110. Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1 if $outfile;
  1111. next;
  1112. }
  1113. print $out "$fileType $chunk ($len bytes):\n";
  1114. $et->VerboseDump(\$dbuf, Addr => $raf->Tell() - $len - 4) if $verbose > 2;
  1115. }
  1116. # only extract information from chunks in our tables
  1117. my ($theBuff, $outBuff);
  1118. $outBuff = \$theBuff if $outfile;
  1119. if ($$tagTablePtr{$chunk}) {
  1120. FoundPNG($et, $tagTablePtr, $chunk, $dbuf, undef, $outBuff);
  1121. } elsif ($mngTablePtr and $$mngTablePtr{$chunk}) {
  1122. FoundPNG($et, $mngTablePtr, $chunk, $dbuf, undef, $outBuff);
  1123. }
  1124. if ($outfile) {
  1125. if (defined $theBuff) {
  1126. next unless length $theBuff; # empty if we deleted the information
  1127. # change chunk type if necessary
  1128. if ($$et{TextChunkType}) {
  1129. $chunk = $$et{TextChunkType};
  1130. delete $$et{TextChunkType};
  1131. }
  1132. $hbuf = pack('Na4', length($theBuff), $chunk);
  1133. $dbuf = $theBuff;
  1134. my $crc = CalculateCRC(\$hbuf, undef, 4);
  1135. $crc = CalculateCRC(\$dbuf, $crc);
  1136. $cbuf = pack('N', $crc);
  1137. }
  1138. Write($outfile, $hbuf, $dbuf, $cbuf) or $err = 1;
  1139. }
  1140. }
  1141. delete $$et{SET_GROUP1};
  1142. return -1 if $outfile and ($err or not $wasEnd);
  1143. return 1; # this was a valid PNG/MNG/JNG image
  1144. }
  1145. 1; # end
  1146. __END__
  1147. =head1 NAME
  1148. Image::ExifTool::PNG - Read and write PNG meta information
  1149. =head1 SYNOPSIS
  1150. This module is used by Image::ExifTool
  1151. =head1 DESCRIPTION
  1152. This module contains routines required by Image::ExifTool to read and
  1153. write PNG (Portable Network Graphics), MNG (Multi-image Network Graphics)
  1154. and JNG (JPEG Network Graphics) images.
  1155. =head1 AUTHOR
  1156. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  1157. This library is free software; you can redistribute it and/or modify it
  1158. under the same terms as Perl itself.
  1159. =head1 REFERENCES
  1160. =over 4
  1161. =item L<http://www.libpng.org/pub/png/spec/1.2/>
  1162. =item L<http://www.faqs.org/docs/png/>
  1163. =item L<http://www.libpng.org/pub/mng/>
  1164. =item L<http://www.libpng.org/pub/png/spec/register/>
  1165. =back
  1166. =head1 SEE ALSO
  1167. L<Image::ExifTool::TagNames/PNG Tags>,
  1168. L<Image::ExifTool::TagNames/MNG Tags>,
  1169. L<Image::ExifTool(3pm)|Image::ExifTool>
  1170. =cut