#------------------------------------------------------------------------------
# File: Fixup.pm
#
# Description: Utility to handle pointer fixups
#
# Revisions: 01/19/2005 - P. Harvey Created
# 04/11/2005 - P. Harvey Allow fixups to be tagged with a marker,
# and add new marker-related routines
# 06/21/2006 - P. Harvey Patch to work with negative offsets
# 07/07/2006 - P. Harvey Added support for 16-bit pointers
# 02/19/2013 - P. Harvey Added IsEmpty()
#
# Data Members:
#
# Start - Position in data where a zero pointer points to.
# Shift - Amount to shift offsets (relative to Start).
# Fixups - List of Fixup object references to to shift relative to this Fixup.
# Pointers - Hash of references to fixup pointer arrays, keyed by ByteOrder
# string (with "2" added if pointer is 16-bit [default is 32-bit],
# plus "_$marker" suffix if tagged with a marker name).
#------------------------------------------------------------------------------
package Image::ExifTool::Fixup;
use strict;
use Image::ExifTool qw(GetByteOrder SetByteOrder Get32u Get32s Set32u
Get16u Get16s Set16u);
use vars qw($VERSION);
$VERSION = '1.05';
sub AddFixup($$;$$);
sub ApplyFixup($$);
sub Dump($;$);
#------------------------------------------------------------------------------
# New - create new Fixup object
# Inputs: 0) reference to Fixup object or Fixup class name
sub new
{
local $_;
my $that = shift;
my $class = ref($that) || $that || 'Image::ExifTool::Fixup';
my $self = bless {}, $class;
# initialize required members
$self->{Start} = 0;
$self->{Shift} = 0;
return $self;
}
#------------------------------------------------------------------------------
# Clone this object
# Inputs: 0) reference to Fixup object or Fixup class name
# Returns: reference to new Fixup object
sub Clone($)
{
my $self = shift;
my $clone = new Image::ExifTool::Fixup;
$clone->{Start} = $self->{Start};
$clone->{Shift} = $self->{Shift};
my $phash = $self->{Pointers};
if ($phash) {
$clone->{Pointers} = { };
my $byteOrder;
foreach $byteOrder (keys %$phash) {
my @pointers = @{$phash->{$byteOrder}};
$clone->{Pointers}->{$byteOrder} = \@pointers;
}
}
if ($self->{Fixups}) {
$clone->{Fixups} = [ ];
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
push @{$clone->{Fixups}}, $subFixup->Clone();
}
}
return $clone;
}
#------------------------------------------------------------------------------
# Add fixup pointer or another fixup object below this one
# Inputs: 0) Fixup object reference
# 1) Scalar for pointer offset, or reference to Fixup object
# 2) Optional marker name for the pointer
# 3) Optional pointer format ('int16u' or 'int32u', defaults to 'int32u')
# Notes: Byte ordering must be set properly for the pointer being added (must keep
# track of the byte order of each offset since MakerNotes may have different byte order!)
sub AddFixup($$;$$)
{
my ($self, $pointer, $marker, $format) = @_;
if (ref $pointer) {
$self->{Fixups} or $self->{Fixups} = [ ];
push @{$self->{Fixups}}, $pointer;
} else {
my $byteOrder = GetByteOrder();
if (defined $format) {
if ($format eq 'int16u') {
$byteOrder .= '2';
} elsif ($format ne 'int32u') {
warn "Bad Fixup pointer format $format\n";
}
}
$byteOrder .= "_$marker" if defined $marker;
my $phash = $self->{Pointers};
$phash or $phash = $self->{Pointers} = { };
$phash->{$byteOrder} or $phash->{$byteOrder} = [ ];
push @{$phash->{$byteOrder}}, $pointer;
}
}
#------------------------------------------------------------------------------
# fix up pointer offsets
# Inputs: 0) Fixup object reference, 1) data reference
# Outputs: Collapses fixup hierarchy into linear lists of fixup pointers
sub ApplyFixup($$)
{
my ($self, $dataPt) = @_;
my $start = $self->{Start};
my $shift = $self->{Shift} + $start; # make shift relative to start
my $phash = $self->{Pointers};
# fix up pointers in this fixup
if ($phash and ($start or $shift)) {
my $saveOrder = GetByteOrder(); # save original byte ordering
my ($byteOrder, $ptr);
foreach $byteOrder (keys %$phash) {
SetByteOrder(substr($byteOrder,0,2));
# apply the fixup offset shift (must get as signed integer
# to avoid overflow in case it was negative before)
my ($get, $set) = ($byteOrder =~ /^(II2|MM2)/) ?
(\&Get16s, \&Set16u) : (\&Get32s, \&Set32u);
foreach $ptr (@{$phash->{$byteOrder}}) {
$ptr += $start; # update pointer to new start location
next unless $shift;
&$set(&$get($dataPt, $ptr) + $shift, $dataPt, $ptr);
}
}
SetByteOrder($saveOrder); # restore original byte ordering
}
# recurse into contained fixups
if ($self->{Fixups}) {
# create our pointer hash if it doesn't exist
$phash or $phash = $self->{Pointers} = { };
# loop through all contained fixups
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
# adjust the subfixup start and shift
$subFixup->{Start} += $start;
$subFixup->{Shift} += $shift - $start;
# recursively apply contained fixups
ApplyFixup($subFixup, $dataPt);
my $shash = $subFixup->{Pointers} or next;
# add all pointers to our collapsed lists
my $byteOrder;
foreach $byteOrder (keys %$shash) {
$phash->{$byteOrder} or $phash->{$byteOrder} = [ ];
push @{$phash->{$byteOrder}}, @{$shash->{$byteOrder}};
delete $shash->{$byteOrder};
}
delete $subFixup->{Pointers};
}
delete $self->{Fixups}; # remove our contained fixups
}
# reset our Start/Shift for the collapsed fixup
$self->{Start} = $self->{Shift} = 0;
}
#------------------------------------------------------------------------------
# Is this Fixup empty?
# Inputs: 0) Fixup object ref
# Returns: True if there are no offsets to fix
sub IsEmpty($)
{
my $self = shift;
my $phash = $self->{Pointers};
if ($phash) {
my $key;
foreach $key (keys %$phash) {
next unless ref $$phash{$key} eq 'ARRAY';
return 0 if @{$$phash{$key}};
}
}
return 1;
}
#------------------------------------------------------------------------------
# Does specified marker exist?
# Inputs: 0) Fixup object reference, 1) marker name
# Returns: True if fixup contains specified marker name
sub HasMarker($$)
{
my ($self, $marker) = @_;
my $phash = $self->{Pointers};
return 0 unless $phash;
return 1 if grep /_$marker$/, keys %$phash;
return 0 unless $self->{Fixups};
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
return 1 if $subFixup->HasMarker($marker);
}
return 0;
}
#------------------------------------------------------------------------------
# Set all marker pointers to specified value
# Inputs: 0) Fixup object reference, 1) data reference
# 2) marker name, 3) pointer value, 4) offset to start of data
sub SetMarkerPointers($$$$;$)
{
my ($self, $dataPt, $marker, $value, $startOffset) = @_;
my $start = $self->{Start} + ($startOffset || 0);
my $phash = $self->{Pointers};
if ($phash) {
my $saveOrder = GetByteOrder(); # save original byte ordering
my ($byteOrder, $ptr);
foreach $byteOrder (keys %$phash) {
next unless $byteOrder =~ /^(II|MM)(2?)_$marker$/;
SetByteOrder($1);
my $set = $2 ? \&Set16u : \&Set32u;
foreach $ptr (@{$phash->{$byteOrder}}) {
&$set($value, $dataPt, $ptr + $start);
}
}
SetByteOrder($saveOrder); # restore original byte ordering
}
if ($self->{Fixups}) {
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
$subFixup->SetMarkerPointers($dataPt, $marker, $value, $start);
}
}
}
#------------------------------------------------------------------------------
# Get pointer values for specified marker
# Inputs: 0) Fixup object reference, 1) data reference,
# 2) marker name, 3) offset to start of data
# Returns: List of marker pointers in list context, or first marker pointer otherwise
sub GetMarkerPointers($$$;$)
{
my ($self, $dataPt, $marker, $startOffset) = @_;
my $start = $self->{Start} + ($startOffset || 0);
my $phash = $self->{Pointers};
my @pointers;
if ($phash) {
my $saveOrder = GetByteOrder();
my ($byteOrder, $ptr);
foreach $byteOrder (grep /_$marker$/, keys %$phash) {
SetByteOrder(substr($byteOrder,0,2));
my $get = ($byteOrder =~ /^(II2|MM2)/) ? \&Get16u : \&Get32u;
foreach $ptr (@{$phash->{$byteOrder}}) {
push @pointers, &$get($dataPt, $ptr + $start);
}
}
SetByteOrder($saveOrder); # restore original byte ordering
}
if ($self->{Fixups}) {
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
push @pointers, $subFixup->GetMarkerPointers($dataPt, $marker, $start);
}
}
return @pointers if wantarray;
return $pointers[0];
}
#------------------------------------------------------------------------------
# Dump fixup to console for debugging
# Inputs: 0) Fixup object reference, 1) optional initial indent string
sub Dump($;$)
{
my ($self, $indent) = @_;
$indent or $indent = '';
printf "${indent}Fixup start=0x%x shift=0x%x\n", $self->{Start}, $self->{Shift};
my $phash = $self->{Pointers};
if ($phash) {
my $byteOrder;
foreach $byteOrder (sort keys %$phash) {
print "$indent $byteOrder: ", join(' ',@{$phash->{$byteOrder}}),"\n";
}
}
if ($self->{Fixups}) {
my $subFixup;
foreach $subFixup (@{$self->{Fixups}}) {
Dump($subFixup, $indent . ' ');
}
}
}
1; # end
__END__
=head1 NAME
Image::ExifTool::Fixup - Utility to handle pointer fixups
=head1 SYNOPSIS
use Image::ExifTool::Fixup;
$fixup = new Image::ExifTool::Fixup;
# add a new fixup to a pointer at the specified offset in data
$fixup->AddFixup($offset);
# add a new Fixup object to the tree
$fixup->AddFixup($subFixup);
$fixup->{Start} += $shift1; # shift pointer offsets and values
$fixup->{Shift} += $shift2; # shift pointer values only
# recursively apply fixups to the specified data
$fixup->ApplyFixups(\$data);
$fixup->Dump(); # dump debugging information
$fixup->IsEmpty(); # return true if no offsets to fix
=head1 DESCRIPTION
This module contains the code to keep track of pointers in memory and to
shift these pointers as required. It is used by ExifTool to maintain the
pointers in image file directories (IFD's).
=head1 NOTES
Keeps track of pointers with different byte ordering, and relies on
Image::ExifTool::GetByteOrder() to determine the current byte ordering
when adding new pointers to a fixup.
Maintains a hierarchical list of fixups so that the whole hierarchy can
be shifted by a simple shift at the base. Hierarchy is collapsed to a
linear list when ApplyFixups() is called.
=head1 AUTHOR
Copyright 2003-2015, 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 SEE ALSO
L<Image::ExifTool(3pm)|Image::ExifTool>
=cut