source: main/trunk/greenstone2/perllib/cpan/Image/ExifTool/FotoStation.pm@ 24107

Last change on this file since 24107 was 24107, checked in by sjm84, 13 years ago

Updating the ExifTool perl modules

File size: 8.1 KB
Line 
1#------------------------------------------------------------------------------
2# File: FotoStation.pm
3#
4# Description: Read/write FotoWare FotoStation trailer
5#
6# Revisions: 10/28/2006 - P. Harvey Created
7#------------------------------------------------------------------------------
8
9package Image::ExifTool::FotoStation;
10
11use strict;
12use vars qw($VERSION);
13use Image::ExifTool qw(:DataAccess :Utils);
14
15$VERSION = '1.00';
16
17sub ProcessFotoStation($$);
18
19%Image::ExifTool::FotoStation::Main = (
20 PROCESS_PROC => \&ProcessFotoStation,
21 WRITE_PROC => \&ProcessFotoStation,
22 GROUPS => { 2 => 'Image' },
23 NOTES => q{
24 The following tables define information found in the FotoWare FotoStation
25 trailer.
26 },
27 0x01 => {
28 Name => 'IPTC',
29 SubDirectory => {
30 TagTable => 'Image::ExifTool::IPTC::Main',
31 },
32 },
33 0x02 => {
34 Name => 'SoftEdit',
35 SubDirectory => {
36 TagTable => 'Image::ExifTool::FotoStation::SoftEdit',
37 },
38 },
39 0x03 => {
40 Name => 'ThumbnailImage',
41 Writable => 1,
42 RawConv => '$self->ValidateImage(\$val,$tag)',
43 },
44 0x04 => {
45 Name => 'PreviewImage',
46 Writable => 1,
47 RawConv => '$self->ValidateImage(\$val,$tag)',
48 },
49);
50
51# crop coordinate conversions
52my %cropConv = (
53 ValueConv => '$val / 1000',
54 ValueConvInv => '$val * 1000',
55 PrintConv => '"$val%"',
56 PrintConvInv => '$val=~tr/ %//d; $val',
57);
58
59# soft crop record
60%Image::ExifTool::FotoStation::SoftEdit = (
61 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
62 WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
63 CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
64 WRITABLE => 1,
65 FORMAT => 'int32s',
66 FIRST_ENTRY => 0,
67 GROUPS => { 2 => 'Image' },
68 0 => {
69 Name => 'OriginalImageWidth',
70 },
71 1 => 'OriginalImageHeight',
72 2 => 'ColorPlanes',
73 3 => {
74 Name => 'XYResolution',
75 ValueConv => '$val / 1000',
76 ValueConvInv => '$val * 1000',
77 },
78 4 => {
79 Name => 'Rotation',
80 Notes => q{
81 rotations are stored as degrees CCW * 100, but converted to degrees CW by
82 ExifTool
83 },
84 # raw value is 0, 9000, 18000 or 27000
85 ValueConv => '$val ? 360 - $val / 100 : 0',
86 ValueConvInv => '$val ? (360 - $val) * 100 : 0',
87 },
88 # 5 Validity Check (0x11222211)
89 6 => {
90 Name => 'CropLeft',
91 %cropConv,
92 },
93 7 => {
94 Name => 'CropTop',
95 %cropConv,
96 },
97 8 => {
98 Name => 'CropRight',
99 %cropConv,
100 },
101 9 => {
102 Name => 'CropBottom',
103 %cropConv,
104 },
105 11 => {
106 Name => 'CropRotation',
107 # raw value in the range -4500 to 4500
108 ValueConv => '-$val / 100',
109 ValueConvInv => '-$val * 100',
110 },
111);
112
113#------------------------------------------------------------------------------
114# Read/write FotoStation information in a file
115# Inputs: 0) ExifTool object reference, 1) dirInfo reference
116# Returns: 1 on success, 0 if this file didn't contain FotoStation information
117# - updates DataPos to point to start of FotoStation information
118# - updates DirLen to trailer length
119sub ProcessFotoStation($$)
120{
121 my ($exifTool, $dirInfo) = @_;
122 $exifTool or return 1; # allow dummy access to autoload this package
123 my ($buff, $footer, $dirBuff, $tagTablePtr);
124 my $raf = $$dirInfo{RAF};
125 my $outfile = $$dirInfo{OutFile};
126 my $offset = $$dirInfo{Offset} || 0;
127 my $verbose = $exifTool->Options('Verbose');
128 my $out = $exifTool->Options('TextOut');
129 my $rtnVal = 0;
130
131 $$dirInfo{DirLen} = 0; # initialize returned trailer length
132 $raf->Seek(-$offset, 2); # seek to specified offset from end of file
133
134 # loop through FotoStation records
135 for (;;) {
136 # look for trailer signature
137 last unless $raf->Seek(-10, 1) and $raf->Read($footer, 10) == 10;
138 my ($tag, $size, $sig) = unpack('nNN', $footer);
139 last unless $sig == 0xa1b2c3d4 and $size >= 10 and $raf->Seek(-$size, 1);
140 $size -= 10; # size of data only
141 last unless $raf->Read($buff, $size) == $size;
142 $raf->Seek(-$size, 1);
143 # set variables returned in dirInfo hash
144 $$dirInfo{DataPos} = $raf->Tell();
145 $$dirInfo{DirLen} += $size + 10;
146
147 unless ($tagTablePtr) {
148 $tagTablePtr = GetTagTable('Image::ExifTool::FotoStation::Main');
149 SetByteOrder('MM'); # necessary for the binary data
150 $rtnVal = 1; # we found a valid FotoStation trailer
151 }
152 unless ($outfile) {
153 # print verbose trailer information
154 if ($verbose or $exifTool->{HTML_DUMP}) {
155 $exifTool->DumpTrailer({
156 RAF => $raf,
157 DataPos => $$dirInfo{DataPos},
158 DirLen => $size + 10,
159 DirName => "FotoStation_$tag",
160 });
161 }
162 # extract information for this tag
163 $exifTool->HandleTag($tagTablePtr, $tag, $buff,
164 DataPt => \$buff,
165 Start => 0,
166 Size => $size,
167 DataPos => $$dirInfo{DataPos});
168 next;
169 }
170 if ($exifTool->{DEL_GROUP}->{FotoStation}) {
171 $verbose and printf $out " Deleting FotoStation trailer\n";
172 $verbose = 0; # no more verbose messages after this
173 ++$exifTool->{CHANGED};
174 next;
175 }
176 # rewrite this information
177 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
178 if ($tagInfo) {
179 my $newVal;
180 my $tagName = $$tagInfo{Name};
181 if ($$tagInfo{SubDirectory}) {
182 my %subdirInfo = (
183 DataPt => \$buff,
184 DirStart => 0,
185 DirLen => $size,
186 DataPos => $$dirInfo{DataPos},
187 DirName => $tagName,
188 Parent => 'FotoStation',
189 );
190 my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
191 $newVal = $exifTool->WriteDirectory(\%subdirInfo, $subTable);
192 } else {
193 my $nvHash = $exifTool->GetNewValueHash($tagInfo);
194 if (Image::ExifTool::IsOverwriting($nvHash) > 0) {
195 $newVal = Image::ExifTool::GetNewValues($nvHash);
196 $newVal = '' unless defined $newVal;
197 if ($verbose > 1) {
198 my $n = length $newVal;
199 print $out " - FotoStation:$tagName ($size bytes)\n" if $size;
200 print $out " + FotoStation:$tagName ($n bytes)\n" if $n;
201 }
202 ++$exifTool->{CHANGED};
203 }
204 }
205 if (defined $newVal) {
206 # note: length may be 0 here, but we write the empty record anyway
207 $buff = $newVal;
208 $size = length($newVal) + 10;
209 $footer = pack('nNN', $tag, $size, $sig);
210 }
211 }
212 if (defined $dirBuff) {
213 # maintain original record order
214 $dirBuff = $buff . $footer . $dirBuff;
215 } else {
216 $dirBuff = $buff . $footer;
217 }
218 }
219 # write the modified FotoStation trailer
220 Write($outfile, $dirBuff) or $rtnVal = -1 if $dirBuff;
221 return $rtnVal;
222}
223
2241; # end
225
226__END__
227
228=head1 NAME
229
230Image::ExifTool::FotoStation - Read/write FotoWare FotoStation trailer
231
232=head1 SYNOPSIS
233
234This module is used by Image::ExifTool
235
236=head1 DESCRIPTION
237
238This module contains definitions required by Image::ExifTool to read and
239write information from the FotoWare FotoStation trailer.
240
241=head1 AUTHOR
242
243Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
244
245This library is free software; you can redistribute it and/or modify it
246under the same terms as Perl itself.
247
248=head1 ACKNOWLEDGEMENTS
249
250Thanks to Mark Tate for information about the FotoStation data format.
251
252=head1 SEE ALSO
253
254L<Image::ExifTool::TagNames/FotoStation Tags>,
255L<Image::ExifTool(3pm)|Image::ExifTool>
256
257=cut
258
Note: See TracBrowser for help on using the repository browser.