PSP.pm 9.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306
  1. #------------------------------------------------------------------------------
  2. # File: PSP.pm
  3. #
  4. # Description: Read Paint Shop Pro meta information
  5. #
  6. # Revisions: 2010/01/23 - P. Harvey Created
  7. #
  8. # References: 1) http://www.jasc.com/support/kb/articles/pspspec.asp
  9. #------------------------------------------------------------------------------
  10. package Image::ExifTool::PSP;
  11. use strict;
  12. use vars qw($VERSION);
  13. use Image::ExifTool qw(:DataAccess :Utils);
  14. use Image::ExifTool::Exif;
  15. $VERSION = '1.05';
  16. sub ProcessExtData($$$);
  17. # PSP info
  18. %Image::ExifTool::PSP::Main = (
  19. GROUPS => { 2 => 'Image' },
  20. VARS => { ALPHA_FIRST => 1 },
  21. NOTES => q{
  22. Tags extracted from Paint Shop Pro images (PSP, PSPIMAGE, PSPFRAME,
  23. PSPSHAPE, PSPTUBE and TUB extensions).
  24. },
  25. # FileVersions:
  26. # 3.0 => PSP 5
  27. # 4.0 => PSP 6
  28. # 5.0 => PSP 7
  29. # 6.0 => PSP 8
  30. # 7.0 => PSP 9
  31. # ? => PSP X
  32. # ? => PSP X1 (is this the same as X?)
  33. # ? => PSP X2
  34. # 10.0 => PSP X3 (= PSP 13)
  35. FileVersion => { PrintConv => '$val=~tr/ /./; $val' },
  36. 0 => [
  37. {
  38. Condition => '$$self{PSPFileVersion} > 3',
  39. Name => 'ImageInfo',
  40. SubDirectory => {
  41. TagTable => 'Image::ExifTool::PSP::Image',
  42. Start => 4,
  43. },
  44. },
  45. {
  46. Name => 'ImageInfo',
  47. SubDirectory => {
  48. TagTable => 'Image::ExifTool::PSP::Image',
  49. },
  50. },
  51. ],
  52. 1 => {
  53. Name => 'CreatorInfo',
  54. SubDirectory => { TagTable => 'Image::ExifTool::PSP::Creator' },
  55. },
  56. 10 => {
  57. Name => 'ExtendedInfo',
  58. SubDirectory => { TagTable => 'Image::ExifTool::PSP::Ext' },
  59. },
  60. # this is inside the composite image bank block (16), which I don't want to parse...
  61. #18 => {
  62. # Name => 'PreviewImage',
  63. # Groups => { 2 => 'Preview' },
  64. # RawConv => '$self->ValidateImage(\$val,$tag)',
  65. #},
  66. );
  67. # the PSP image block
  68. %Image::ExifTool::PSP::Image = (
  69. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  70. GROUPS => { 2 => 'Image' },
  71. 0 => { Name => 'ImageWidth', Format => 'int32u' },
  72. 4 => { Name => 'ImageHeight', Format => 'int32u' },
  73. 8 => { Name => 'ImageResolution', Format => 'double' },
  74. 16 => {
  75. Name => 'ResolutionUnit',
  76. Format => 'int8u',
  77. PrintConv => {
  78. 0 => 'None',
  79. 1 => 'inches',
  80. 2 => 'cm',
  81. },
  82. },
  83. 17 => {
  84. Name => 'Compression',
  85. Format => 'int16u',
  86. PrintConv => {
  87. 0 => 'None',
  88. 1 => 'RLE',
  89. 2 => 'LZ77',
  90. 3 => 'JPEG',
  91. },
  92. },
  93. 19 => { Name => 'BitsPerSample',Format => 'int16u' },
  94. 21 => { Name => 'Planes', Format => 'int16u' },
  95. 23 => { Name => 'NumColors', Format => 'int32u' },
  96. );
  97. # the PSP creator data block
  98. %Image::ExifTool::PSP::Creator = (
  99. PROCESS_PROC => \&ProcessExtData,
  100. GROUPS => { 2 => 'Image' },
  101. PRIORITY => 0, # prefer EXIF if it exists
  102. 0 => 'Title',
  103. 1 => {
  104. Name => 'CreateDate',
  105. Format => 'int32u',
  106. Groups => { 2 => 'Time' },
  107. ValueConv => 'Image::ExifTool::ConvertUnixTime($val,1)',
  108. PrintConv => '$self->ConvertDateTime($val)',
  109. },
  110. 2 => {
  111. Name => 'ModifyDate',
  112. Format => 'int32u',
  113. Groups => { 2 => 'Time' },
  114. ValueConv => 'Image::ExifTool::ConvertUnixTime($val,1)',
  115. PrintConv => '$self->ConvertDateTime($val)',
  116. },
  117. 3 => {
  118. Name => 'Artist',
  119. Groups => { 2 => 'Author' },
  120. },
  121. 4 => {
  122. Name => 'Copyright',
  123. Groups => { 2 => 'Author' },
  124. },
  125. 5 => 'Description',
  126. 6 => {
  127. Name => 'CreatorAppID',
  128. Format => 'int32u',
  129. PrintConv => {
  130. 0 => 'Unknown',
  131. 1 => 'Paint Shop Pro',
  132. },
  133. },
  134. 7 => {
  135. Name => 'CreatorAppVersion',
  136. Format => 'int8u',
  137. Count => 4,
  138. ValueConv => 'join(" ",reverse split " ", $val)', # low byte first
  139. PrintConv => '$val=~tr/ /./; $val',
  140. },
  141. );
  142. # the PSP extended data block
  143. %Image::ExifTool::PSP::Ext = (
  144. PROCESS_PROC => \&ProcessExtData,
  145. GROUPS => { 2 => 'Image' },
  146. 3 => {
  147. Name => 'EXIFInfo', #(don't change this name, it is used in the code)
  148. SubDirectory => { TagTable => 'Image::ExifTool::Exif::Main' },
  149. },
  150. );
  151. #------------------------------------------------------------------------------
  152. # Extract information from the extended data block
  153. # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
  154. # Returns: 1 on success
  155. sub ProcessExtData($$$)
  156. {
  157. my ($et, $dirInfo, $tagTablePtr) = @_;
  158. my $dataPt = $$dirInfo{DataPt};
  159. my $dirLen = $$dirInfo{DirLen};
  160. my $pos = 0;
  161. # loop through sub-blocks
  162. while ($pos + 10 < $dirLen) {
  163. unless (substr($$dataPt, $pos, 4) eq "~FL\0") {
  164. $et->Warn('Lost synchronization while reading sub blocks');
  165. last;
  166. }
  167. my $tag = Get16u($dataPt, $pos + 4);
  168. my $len = Get32u($dataPt, $pos + 6);
  169. $pos += 10 + $len;
  170. if ($pos > $dirLen) {
  171. $et->Warn("Truncated sub block ID=$tag len=$len");
  172. last;
  173. }
  174. next unless $$tagTablePtr{$tag};
  175. my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag) or next;
  176. my $start = $pos - $len;
  177. unless ($$tagInfo{Name} eq 'EXIFInfo') {
  178. $et->HandleTag($tagTablePtr, $tag, undef,
  179. TagInfo => $tagInfo,
  180. DataPt => $dataPt,
  181. DataPos => $$dirInfo{DataPos},
  182. DataLen => length $$dataPt,
  183. Start => $start,
  184. Size => $len,
  185. );
  186. next;
  187. }
  188. # validate EXIF block header and set byte order
  189. next unless $len > 14 and substr($$dataPt, $pos - $len, 6) eq "Exif\0\0";
  190. next unless SetByteOrder(substr($$dataPt, $start + 6, 2));
  191. # This is REALLY annoying... They use a standard TIFF offset to point to
  192. # the first IFD, but after that the offsets are relative to the start of
  193. # the IFD instead of the TIFF base, which means that I must handle it as a
  194. # special case. Dumb, dumb...
  195. $start += 14;
  196. my %dirInfo = (
  197. DirName => 'EXIF',
  198. Parent => 'PSP',
  199. DataPt => $dataPt,
  200. DataPos => -$start, # data position relative to Base
  201. DataLen => length $$dataPt,
  202. DirStart => $start,
  203. Base => $start + $$dirInfo{DataPos}, # absolute base offset
  204. Multi => 0,
  205. );
  206. my $exifTable = GetTagTable($$tagInfo{SubDirectory}{TagTable});
  207. Image::ExifTool::Exif::ProcessExif($et, \%dirInfo, $exifTable);
  208. SetByteOrder('II');
  209. }
  210. return 1;
  211. }
  212. #------------------------------------------------------------------------------
  213. # Extract information from a PSP file
  214. # Inputs: 0) ExifTool object reference, 1) dirInfo reference
  215. # Returns: 1 on success, 0 if this wasn't a valid PSP file
  216. sub ProcessPSP($$)
  217. {
  218. my ($et, $dirInfo) = @_;
  219. my $raf = $$dirInfo{RAF};
  220. my ($buff, $tag, $len, $err);
  221. return 0 unless $raf->Read($buff, 32) == 32 and
  222. $buff eq "Paint Shop Pro Image File\x0a\x1a\0\0\0\0\0" and
  223. $raf->Read($buff, 4) == 4;
  224. $et->SetFileType();
  225. SetByteOrder('II');
  226. my $tagTablePtr = GetTagTable('Image::ExifTool::PSP::Main');
  227. my @a = unpack('v*', $buff);
  228. # figure out block header length for this format PSP file
  229. my $hlen = $a[0] > 3 ? 10 : 14;
  230. $$et{PSPFileVersion} = $a[0]; # save for use in Condition
  231. $et->HandleTag($tagTablePtr, FileVersion => "@a");
  232. # loop through blocks in file
  233. my $pos = 36;
  234. for (;;) {
  235. last unless $raf->Read($buff, $hlen) == $hlen;
  236. unless ($buff =~ /^~BK\0/) {
  237. $et->Warn('Lost synchronization while reading main PSP blocks');
  238. last;
  239. }
  240. $tag = Get16u(\$buff, 4);
  241. $len = Get32u(\$buff, $hlen - 4);
  242. $pos += $hlen + $len;
  243. unless ($$tagTablePtr{$tag}) {
  244. $raf->Seek($len, 1) or $err=1, last;
  245. next;
  246. }
  247. $raf->Read($buff, $len) == $len or $err=1, last;
  248. $et->HandleTag($tagTablePtr, $tag, $buff,
  249. DataPt => \$buff,
  250. DataPos => $pos - $len,
  251. Size => $len,
  252. );
  253. }
  254. $err and $et->Warn("Truncated main block ID=$tag len=$len");
  255. return 1;
  256. }
  257. 1; # end
  258. __END__
  259. =head1 NAME
  260. Image::ExifTool::PSP - Read Paint Shop Pro meta information
  261. =head1 SYNOPSIS
  262. This module is used by Image::ExifTool
  263. =head1 DESCRIPTION
  264. This module contains routines required by Image::ExifTool to extract
  265. information from Paint Shop Pro images.
  266. =head1 AUTHOR
  267. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  268. This library is free software; you can redistribute it and/or modify it
  269. under the same terms as Perl itself.
  270. =head1 REFERENCES
  271. =over 4
  272. =item L<http://www.jasc.com/support/kb/articles/pspspec.asp>
  273. =back
  274. =head1 SEE ALSO
  275. L<Image::ExifTool::TagNames/PSP Tags>,
  276. L<Image::ExifTool(3pm)|Image::ExifTool>
  277. =cut