File Coverage

blib/lib/Image/ExifTool/FotoStation.pm
Criterion Covered Total %
statement 55 69 79.7
branch 19 38 50.0
condition 9 16 56.2
subroutine 4 4 100.0
pod 0 1 0.0
total 87 128 67.9


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: FotoStation.pm
3             #
4             # Description: Read/write FotoWare FotoStation trailer
5             #
6             # Revisions: 10/28/2006 - P. Harvey Created
7             #------------------------------------------------------------------------------
8              
9             package Image::ExifTool::FotoStation;
10              
11 13     13   4672 use strict;
  13         37  
  13         508  
12 13     13   86 use vars qw($VERSION);
  13         57  
  13         671  
13 13     13   96 use Image::ExifTool qw(:DataAccess :Utils);
  13         34  
  13         14074  
14              
15             $VERSION = '1.04';
16              
17             sub 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             Groups => { 2 => 'Preview' },
42             Writable => 1,
43             RawConv => '$self->ValidateImage(\$val,$tag)',
44             },
45             0x04 => {
46             Name => 'PreviewImage',
47             Groups => { 2 => 'Preview' },
48             Writable => 1,
49             RawConv => '$self->ValidateImage(\$val,$tag)',
50             },
51             );
52              
53             # crop coordinate conversions
54             my %cropConv = (
55             ValueConv => '$val / 1000',
56             ValueConvInv => '$val * 1000',
57             PrintConv => '"$val%"',
58             PrintConvInv => '$val=~tr/ %//d; $val',
59             );
60              
61             # soft crop record
62             %Image::ExifTool::FotoStation::SoftEdit = (
63             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
64             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
65             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
66             WRITABLE => 1,
67             FORMAT => 'int32s',
68             FIRST_ENTRY => 0,
69             GROUPS => { 2 => 'Image' },
70             0 => {
71             Name => 'OriginalImageWidth',
72             },
73             1 => 'OriginalImageHeight',
74             2 => 'ColorPlanes',
75             3 => {
76             Name => 'XYResolution',
77             ValueConv => '$val / 1000',
78             ValueConvInv => '$val * 1000',
79             },
80             4 => {
81             Name => 'Rotation',
82             Notes => q{
83             rotations are stored as degrees CCW * 100, but converted to degrees CW by
84             ExifTool
85             },
86             # raw value is 0, 9000, 18000 or 27000
87             ValueConv => '$val ? 360 - $val / 100 : 0',
88             ValueConvInv => '$val ? (360 - $val) * 100 : 0',
89             },
90             # 5 Validity Check (0x11222211)
91             6 => {
92             Name => 'CropLeft',
93             %cropConv,
94             },
95             7 => {
96             Name => 'CropTop',
97             %cropConv,
98             },
99             8 => {
100             Name => 'CropRight',
101             %cropConv,
102             },
103             9 => {
104             Name => 'CropBottom',
105             %cropConv,
106             },
107             11 => {
108             Name => 'CropRotation',
109             # raw value in the range -4500 to 4500
110             ValueConv => '-$val / 100',
111             ValueConvInv => '-$val * 100',
112             },
113             );
114              
115             #------------------------------------------------------------------------------
116             # Read/write FotoStation information in a file
117             # Inputs: 0) ExifTool object reference, 1) dirInfo reference
118             # Returns: 1 on success, 0 if this file didn't contain FotoStation information
119             # - updates DataPos to point to start of FotoStation information
120             # - updates DirLen to trailer length
121             sub ProcessFotoStation($$)
122             {
123 67     67 0 289 my ($et, $dirInfo) = @_;
124 67 100       387 $et or return 1; # allow dummy access to autoload this package
125 29         85 my ($buff, $footer, $dirBuff, $tagTablePtr);
126 29         123 my $raf = $$dirInfo{RAF};
127 29         90 my $outfile = $$dirInfo{OutFile};
128 29   100     124 my $offset = $$dirInfo{Offset} || 0;
129 29         140 my $verbose = $et->Options('Verbose');
130 29         217 my $out = $et->Options('TextOut');
131 29         112 my $rtnVal = 0;
132              
133 29         134 $$dirInfo{DirLen} = 0; # initialize returned trailer length
134 29         145 $raf->Seek(-$offset, 2); # seek to specified offset from end of file
135              
136             # loop through FotoStation records
137 29         96 for (;;) {
138             # look for trailer signature
139 87 50 33     369 last unless $raf->Seek(-10, 1) and $raf->Read($footer, 10) == 10;
140 87         464 my ($tag, $size, $sig) = unpack('nNN', $footer);
141 87 50 66     618 last unless $sig == 0xa1b2c3d4 and $size >= 10 and $raf->Seek(-$size, 1);
      66        
142 58         193 $size -= 10; # size of data only
143 58 50       222 last unless $raf->Read($buff, $size) == $size;
144 58         308 $raf->Seek(-$size, 1);
145             # set variables returned in dirInfo hash
146 58         311 $$dirInfo{DataPos} = $raf->Tell();
147 58         179 $$dirInfo{DirLen} += $size + 10;
148              
149 58 100       193 unless ($tagTablePtr) {
150 29         130 $tagTablePtr = GetTagTable('Image::ExifTool::FotoStation::Main');
151 29         159 SetByteOrder('MM'); # necessary for the binary data
152 29         157 $rtnVal = 1; # we found a valid FotoStation trailer
153             }
154 58 100       207 unless ($outfile) {
155             # print verbose trailer information
156 42 50 33     281 if ($verbose or $$et{HTML_DUMP}) {
157             $et->DumpTrailer({
158             RAF => $raf,
159             DataPos => $$dirInfo{DataPos},
160 0         0 DirLen => $size + 10,
161             DirName => "FotoStation_$tag",
162             });
163             }
164             # extract information for this tag
165             $et->HandleTag($tagTablePtr, $tag, $buff,
166             DataPt => \$buff,
167             Start => 0,
168             Size => $size,
169             DataPos => $$dirInfo{DataPos},
170 42         248 );
171 42         116 next;
172             }
173 16 50       75 if ($$et{DEL_GROUP}{FotoStation}) {
174 0 0       0 $verbose and print $out " Deleting FotoStation trailer\n";
175 0         0 $verbose = 0; # no more verbose messages after this
176 0         0 ++$$et{CHANGED};
177 0         0 next;
178             }
179             # rewrite this information
180 16         69 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
181 16 50       64 if ($tagInfo) {
182 16         31 my $newVal;
183 16         51 my $tagName = $$tagInfo{Name};
184 16 50       57 if ($$tagInfo{SubDirectory}) {
185             my %subdirInfo = (
186             DataPt => \$buff,
187             DirStart => 0,
188             DirLen => $size,
189             DataPos => $$dirInfo{DataPos},
190 16         129 DirName => $tagName,
191             Parent => 'FotoStation',
192             );
193 16         70 my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
194 16         75 $newVal = $et->WriteDirectory(\%subdirInfo, $subTable);
195             } else {
196 0         0 my $nvHash = $et->GetNewValueHash($tagInfo);
197 0 0       0 if ($et->IsOverwriting($nvHash) > 0) {
198 0         0 $newVal = $et->GetNewValue($nvHash);
199 0 0       0 $newVal = '' unless defined $newVal;
200 0 0       0 if ($verbose > 1) {
201 0         0 my $n = length $newVal;
202 0 0       0 print $out " - FotoStation:$tagName ($size bytes)\n" if $size;
203 0 0       0 print $out " + FotoStation:$tagName ($n bytes)\n" if $n;
204             }
205 0         0 ++$$et{CHANGED};
206             }
207             }
208 16 100       108 if (defined $newVal) {
209             # note: length may be 0 here, but we write the empty record anyway
210 9         25 $buff = $newVal;
211 9         30 $size = length($newVal) + 10;
212 9         45 $footer = pack('nNN', $tag, $size, $sig);
213             }
214             }
215 16 100       49 if (defined $dirBuff) {
216             # maintain original record order
217 8         84 $dirBuff = $buff . $footer . $dirBuff;
218             } else {
219 8         30 $dirBuff = $buff . $footer;
220             }
221             }
222             # write the modified FotoStation trailer
223 29 100 50     184 Write($outfile, $dirBuff) or $rtnVal = -1 if $dirBuff;
224 29         119 return $rtnVal;
225             }
226              
227             1; # end
228              
229             __END__