123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366 |
- #------------------------------------------------------------------------------
- # 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).
- #
- # Procedure:
- #
- # 1. Create a Fixup object for each data block containing pointers
- # 2. Call AddFixup with the offset of each pointer in the block
- # - pointer is assumed int32u with the current byte order
- # - may also be called with a fixup reference for contained blocks
- # 3. Add the necessary pointer offset to $$fixup{Shift}
- # 4. Add data size to $$fixup{Start} if data is added before the block
- # - automatically also shifts pointers by this amount
- # 5. Call ApplyFixup to apply the fixup to all pointers
- # - resets Shift and Start to 0 after applying fixup
- #------------------------------------------------------------------------------
- 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-2016, 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
|