test_pie/external/exiftool/lib/Image/ExifTool/FotoStation.pm

262 lines
8.0 KiB
Perl

#------------------------------------------------------------------------------
# File: FotoStation.pm
#
# Description: Read/write FotoWare FotoStation trailer
#
# Revisions: 10/28/2006 - P. Harvey Created
#------------------------------------------------------------------------------
package Image::ExifTool::FotoStation;
use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);
$VERSION = '1.04';
sub ProcessFotoStation($$);
%Image::ExifTool::FotoStation::Main = (
PROCESS_PROC => \&ProcessFotoStation,
WRITE_PROC => \&ProcessFotoStation,
GROUPS => { 2 => 'Image' },
NOTES => q{
The following tables define information found in the FotoWare FotoStation
trailer.
},
0x01 => {
Name => 'IPTC',
SubDirectory => {
TagTable => 'Image::ExifTool::IPTC::Main',
},
},
0x02 => {
Name => 'SoftEdit',
SubDirectory => {
TagTable => 'Image::ExifTool::FotoStation::SoftEdit',
},
},
0x03 => {
Name => 'ThumbnailImage',
Groups => { 2 => 'Preview' },
Writable => 1,
RawConv => '$self->ValidateImage(\$val,$tag)',
},
0x04 => {
Name => 'PreviewImage',
Groups => { 2 => 'Preview' },
Writable => 1,
RawConv => '$self->ValidateImage(\$val,$tag)',
},
);
# crop coordinate conversions
my %cropConv = (
ValueConv => '$val / 1000',
ValueConvInv => '$val * 1000',
PrintConv => '"$val%"',
PrintConvInv => '$val=~tr/ %//d; $val',
);
# soft crop record
%Image::ExifTool::FotoStation::SoftEdit = (
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
WRITABLE => 1,
FORMAT => 'int32s',
FIRST_ENTRY => 0,
GROUPS => { 2 => 'Image' },
0 => {
Name => 'OriginalImageWidth',
},
1 => 'OriginalImageHeight',
2 => 'ColorPlanes',
3 => {
Name => 'XYResolution',
ValueConv => '$val / 1000',
ValueConvInv => '$val * 1000',
},
4 => {
Name => 'Rotation',
Notes => q{
rotations are stored as degrees CCW * 100, but converted to degrees CW by
ExifTool
},
# raw value is 0, 9000, 18000 or 27000
ValueConv => '$val ? 360 - $val / 100 : 0',
ValueConvInv => '$val ? (360 - $val) * 100 : 0',
},
# 5 Validity Check (0x11222211)
6 => {
Name => 'CropLeft',
%cropConv,
},
7 => {
Name => 'CropTop',
%cropConv,
},
8 => {
Name => 'CropRight',
%cropConv,
},
9 => {
Name => 'CropBottom',
%cropConv,
},
11 => {
Name => 'CropRotation',
# raw value in the range -4500 to 4500
ValueConv => '-$val / 100',
ValueConvInv => '-$val * 100',
},
);
#------------------------------------------------------------------------------
# Read/write FotoStation information in a file
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this file didn't contain FotoStation information
# - updates DataPos to point to start of FotoStation information
# - updates DirLen to trailer length
sub ProcessFotoStation($$)
{
my ($et, $dirInfo) = @_;
$et or return 1; # allow dummy access to autoload this package
my ($buff, $footer, $dirBuff, $tagTablePtr);
my $raf = $$dirInfo{RAF};
my $outfile = $$dirInfo{OutFile};
my $offset = $$dirInfo{Offset} || 0;
my $verbose = $et->Options('Verbose');
my $out = $et->Options('TextOut');
my $rtnVal = 0;
$$dirInfo{DirLen} = 0; # initialize returned trailer length
$raf->Seek(-$offset, 2); # seek to specified offset from end of file
# loop through FotoStation records
for (;;) {
# look for trailer signature
last unless $raf->Seek(-10, 1) and $raf->Read($footer, 10) == 10;
my ($tag, $size, $sig) = unpack('nNN', $footer);
last unless $sig == 0xa1b2c3d4 and $size >= 10 and $raf->Seek(-$size, 1);
$size -= 10; # size of data only
last unless $raf->Read($buff, $size) == $size;
$raf->Seek(-$size, 1);
# set variables returned in dirInfo hash
$$dirInfo{DataPos} = $raf->Tell();
$$dirInfo{DirLen} += $size + 10;
unless ($tagTablePtr) {
$tagTablePtr = GetTagTable('Image::ExifTool::FotoStation::Main');
SetByteOrder('MM'); # necessary for the binary data
$rtnVal = 1; # we found a valid FotoStation trailer
}
unless ($outfile) {
# print verbose trailer information
if ($verbose or $$et{HTML_DUMP}) {
$et->DumpTrailer({
RAF => $raf,
DataPos => $$dirInfo{DataPos},
DirLen => $size + 10,
DirName => "FotoStation_$tag",
});
}
# extract information for this tag
$et->HandleTag($tagTablePtr, $tag, $buff,
DataPt => \$buff,
Start => 0,
Size => $size,
DataPos => $$dirInfo{DataPos},
);
next;
}
if ($$et{DEL_GROUP}{FotoStation}) {
$verbose and print $out " Deleting FotoStation trailer\n";
$verbose = 0; # no more verbose messages after this
++$$et{CHANGED};
next;
}
# rewrite this information
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
if ($tagInfo) {
my $newVal;
my $tagName = $$tagInfo{Name};
if ($$tagInfo{SubDirectory}) {
my %subdirInfo = (
DataPt => \$buff,
DirStart => 0,
DirLen => $size,
DataPos => $$dirInfo{DataPos},
DirName => $tagName,
Parent => 'FotoStation',
);
my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
$newVal = $et->WriteDirectory(\%subdirInfo, $subTable);
} else {
my $nvHash = $et->GetNewValueHash($tagInfo);
if ($et->IsOverwriting($nvHash) > 0) {
$newVal = $et->GetNewValue($nvHash);
$newVal = '' unless defined $newVal;
if ($verbose > 1) {
my $n = length $newVal;
print $out " - FotoStation:$tagName ($size bytes)\n" if $size;
print $out " + FotoStation:$tagName ($n bytes)\n" if $n;
}
++$$et{CHANGED};
}
}
if (defined $newVal) {
# note: length may be 0 here, but we write the empty record anyway
$buff = $newVal;
$size = length($newVal) + 10;
$footer = pack('nNN', $tag, $size, $sig);
}
}
if (defined $dirBuff) {
# maintain original record order
$dirBuff = $buff . $footer . $dirBuff;
} else {
$dirBuff = $buff . $footer;
}
}
# write the modified FotoStation trailer
Write($outfile, $dirBuff) or $rtnVal = -1 if $dirBuff;
return $rtnVal;
}
1; # end
__END__
=head1 NAME
Image::ExifTool::FotoStation - Read/write FotoWare FotoStation trailer
=head1 SYNOPSIS
This module is used by Image::ExifTool
=head1 DESCRIPTION
This module contains definitions required by Image::ExifTool to read and
write information from the FotoWare FotoStation trailer.
=head1 AUTHOR
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 ACKNOWLEDGEMENTS
Thanks to Mark Tate for information about the FotoStation data format.
=head1 SEE ALSO
L<Image::ExifTool::TagNames/FotoStation Tags>,
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut