source: gs2-extensions/parallel-building/trunk/src/perllib/cpan/Image/ExifTool/PSP.pm@ 24626

Last change on this file since 24626 was 24626, checked in by jmt12, 13 years ago

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