893 lines
29 KiB
Perl
893 lines
29 KiB
Perl
# ======================================================================
|
|
# Iff.pm
|
|
# Copyright 2003, Sony Online Entertainment
|
|
# All rights reserved.
|
|
# ======================================================================
|
|
|
|
package Iff;
|
|
use strict;
|
|
|
|
use Fcntl;
|
|
|
|
# ======================================================================
|
|
# Iff public variables.
|
|
# ======================================================================
|
|
|
|
# our $relativePathName;
|
|
|
|
# ======================================================================
|
|
# Setup variables that can be imported by Exporter into user modules.
|
|
# ======================================================================
|
|
|
|
use vars qw(@ISA @EXPORT_OK $VERSION);
|
|
use Exporter;
|
|
$VERSION = 1.00;
|
|
@ISA = qw(Exporter);
|
|
|
|
# These symbols are okay to export if specifically requested.
|
|
@EXPORT_OK = qw();
|
|
|
|
# ======================================================================
|
|
# Iff private variables.
|
|
# ======================================================================
|
|
|
|
my $debug = 0;
|
|
my %handlerByTag;
|
|
|
|
# ======================================================================
|
|
# Iff public functions.
|
|
# ======================================================================
|
|
|
|
# ----------------------------------------------------------------------
|
|
# Called to prepare a newly-blessed Iff object's hash members for use.
|
|
#
|
|
# @syntax $object->initialize()
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub initialize
|
|
{
|
|
# Get self reference.
|
|
my $self = shift;
|
|
|
|
# Initialize all instance members.
|
|
$self->{data} = "";
|
|
$self->{index} = 0;
|
|
$self->{stack} = [];
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# Called to read and return IFF block information at a specified position
|
|
# in the data stream.
|
|
#
|
|
# @syntax $object->readBlockHeaderAtIndex(indexRef)
|
|
# @type instance method
|
|
#
|
|
# @param indexRef specifies the position to start reading block information
|
|
# on input, and will contain the updated position of the start of
|
|
# contents, properly adjusted for forms and chunks.
|
|
#
|
|
# @return undef if there was a read error or if block contents cannot possibly
|
|
# fit in data buffer.
|
|
# if block is a form: (1, formName, formContentsStartPosition, formContentsEndPosition+1)
|
|
# if block is a chunk: (2, chunkName, chunkContentsStartPosition, chunkContentsEndPosition+1)
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub readBlockHeaderAtIndex
|
|
{
|
|
# Process args.
|
|
my $self = shift;
|
|
my $streamIndexRef = shift;
|
|
|
|
my $dataLength = length($self->{data});
|
|
|
|
return undef if !defined($dataLength) || ($dataLength < 8);
|
|
|
|
# Read block name.
|
|
my $firstTag = substr($self->{data}, $$streamIndexRef, 4);
|
|
$$streamIndexRef += 4;
|
|
|
|
# Read block size.
|
|
my $contentLength = 0;
|
|
my $sizeByte;
|
|
|
|
$contentLength += (ord(substr($self->{data}, $$streamIndexRef, 1)) << 24);
|
|
++$$streamIndexRef;
|
|
|
|
$contentLength += (ord(substr($self->{data}, $$streamIndexRef, 1)) << 16);
|
|
++$$streamIndexRef;
|
|
|
|
$contentLength += (ord(substr($self->{data}, $$streamIndexRef, 1)) << 8);
|
|
++$$streamIndexRef;
|
|
|
|
$contentLength += ord(substr($self->{data}, $$streamIndexRef, 1));
|
|
++$$streamIndexRef;
|
|
|
|
# If a form, read the form name.
|
|
if ($firstTag ne "FORM")
|
|
{
|
|
# Return a chunk.
|
|
return (2, $firstTag, $$streamIndexRef, $$streamIndexRef + $contentLength);
|
|
}
|
|
else
|
|
{
|
|
# Read form name.
|
|
return undef if ($dataLength < 12);
|
|
|
|
my $secondTag = substr($self->{data}, $$streamIndexRef, 4);
|
|
$$streamIndexRef += 4;
|
|
|
|
# Return a form.
|
|
$contentLength -= 4;
|
|
return (1, $secondTag, $$streamIndexRef, $$streamIndexRef + $contentLength);
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax object->checkBlock(contentIndexRef)
|
|
# @type instance method
|
|
#
|
|
# @param contentIndexRef on input contains the index of the start of the
|
|
# block to check. On output it contains the next position for
|
|
# reading in the stream.
|
|
#
|
|
# @return 1 if block and all child blocks are valid; 0 if no valid
|
|
# block exists at specified index.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub checkBlock
|
|
{
|
|
# Process args.
|
|
my $self = shift;
|
|
my $contentIndexRef = shift;
|
|
|
|
# Get length of IFF data.
|
|
my $dataLength = length($self->{data});
|
|
return 0 if !defined($dataLength);
|
|
return 0 if ($$contentIndexRef + 8) >= $dataLength;
|
|
|
|
# Read the header at the specified position.
|
|
my @result = $self->readBlockHeaderAtIndex($contentIndexRef);
|
|
return 0 if !@result;
|
|
|
|
# Verify that the end of block content is not beyond our data limit.
|
|
return 0 if $result[3] > $dataLength;
|
|
|
|
# Success if this is a chunk.
|
|
if ($result[0] == 2)
|
|
{
|
|
# Move data index to end of contents + 1.
|
|
$$contentIndexRef = $result[3];
|
|
return 1;
|
|
}
|
|
elsif ($result[0] == 1)
|
|
{
|
|
# Process form contents recursively until we hit the end of the form contents.
|
|
while ($$contentIndexRef < $result[3])
|
|
{
|
|
my $initialIndex = $$contentIndexRef;
|
|
return 0 if !$self->checkBlock($contentIndexRef) || ($$contentIndexRef < $initialIndex + 8);
|
|
}
|
|
|
|
# Successfully verified
|
|
return ($$contentIndexRef == $result[3]);
|
|
}
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax object->isValidData()
|
|
# @type instance method
|
|
# @return 1 if data is valid iff data; 0 if data exists and is
|
|
# invalid.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub isValidData
|
|
{
|
|
# Get self reference.
|
|
my $self = shift;
|
|
|
|
# Ensure we have data.
|
|
return 0 if !defined($self->{data});
|
|
|
|
# Get number of data bytes.
|
|
my $dataLength = length $self->{data};
|
|
return 1 if ($dataLength == 0);
|
|
|
|
# Verify that first block consumes all data.
|
|
my $contentIndex = 0;
|
|
my @result = $self->readBlockHeaderAtIndex(\$contentIndex);
|
|
return 0 if !@result;
|
|
return 0 if $result[3] != $dataLength;
|
|
|
|
# Test all blocks.
|
|
$contentIndex = 0;
|
|
return $self->checkBlock(\$contentIndex);
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub pushStack
|
|
{
|
|
my $self = shift;
|
|
my $infoRef = shift;
|
|
|
|
my $stackRef = $self->{stack};
|
|
push @$stackRef, $infoRef;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub popStack
|
|
{
|
|
my $self = shift;
|
|
my $stackRef = $self->{stack};
|
|
return pop @$stackRef;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub getTopOfStack
|
|
{
|
|
my $self = shift;
|
|
my $stackRef = $self->{stack};
|
|
return $$stackRef[(scalar @$stackRef) - 1];
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub fatal
|
|
{
|
|
my $self = shift;
|
|
my $message = shift;
|
|
|
|
print "Iff:fatal@[";
|
|
|
|
my $stackRef = $self->{stack};
|
|
foreach my $infoRef (@$stackRef)
|
|
{
|
|
print "$$infoRef[1]/";
|
|
}
|
|
|
|
printf "]: %s\n", defined($message) ? $message : "<undefined>";
|
|
exit -1;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->isCurrentForm()
|
|
# @type instance method
|
|
#
|
|
# Indicates if the block (chunk or form) that starts at the
|
|
# current read location within the Iff is a form.
|
|
#
|
|
# @return something that evalues to true if the block is a form; otherwise returns 0.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub isCurrentForm
|
|
{
|
|
# Setup args.
|
|
my $self = shift;
|
|
|
|
# Get block header info for block starting at current read location.
|
|
my $blockIndex = $self->{index};
|
|
die "Iff: bad member variable" if !defined($blockIndex);
|
|
|
|
my @blockInfo = $self->readBlockHeaderAtIndex(\$blockIndex);
|
|
return 0 if !@blockInfo;
|
|
|
|
return ($blockInfo[0] == 1);
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->getCurrentName()
|
|
# @type instance method
|
|
#
|
|
# Returns the name of the block (chunk or form) that starts at the
|
|
# current read location within the Iff.
|
|
#
|
|
# @return undef if there was an error processing the data; otherwise
|
|
# it returns the block name as a string.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub getCurrentName
|
|
{
|
|
# Setup args.
|
|
my $self = shift;
|
|
|
|
# Get block header info for block starting at current read location.
|
|
my $blockIndex = $self->{index};
|
|
die "Iff: bad member variable" if !defined($blockIndex);
|
|
|
|
my @blockInfo = $self->readBlockHeaderAtIndex(\$blockIndex);
|
|
return undef if !@blockInfo;
|
|
return $blockInfo[1];
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub enterForm
|
|
{
|
|
# Process args.
|
|
my $self = shift;
|
|
my $formName = shift;
|
|
|
|
# Ensure we're not already in a chunk.
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("enterForm(): currently in a chunk.") if (defined($topOfStackRef) && @$topOfStackRef && ($$topOfStackRef[0] == 2));
|
|
|
|
# Read the block header at current data position, adjusting index as needed.
|
|
my @formInfo = $self->readBlockHeaderAtIndex(\$self->{index});
|
|
$self->fatal("current is not a form.") if !scalar(@formInfo) || ($formInfo[0] != 1);
|
|
$self->fatal("expecting form [$formName], found [$formInfo[1]].") if (defined($formName) && ($formName ne $formInfo[1]));
|
|
|
|
# Push the form info onto the traversal stack.
|
|
$self->pushStack([@formInfo]);
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub exitForm
|
|
{
|
|
# Process args.
|
|
my $self = shift;
|
|
my $formName = shift;
|
|
|
|
# Get the top of the stack.
|
|
my $infoRef = $self->popStack();
|
|
$self->fatal("called exitForm when not in a form.") if (!defined($infoRef) || ($$infoRef[0] != 1));
|
|
$self->fatal("called exitForm expecting form [$formName], found [$$infoRef[1]].") if (defined($formName) && ($formName ne $$infoRef[1]));
|
|
|
|
# Move index one past end of the form.
|
|
$self->{index} = $$infoRef[3];
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub enterChunk
|
|
{
|
|
# Process args.
|
|
my $self = shift;
|
|
my $chunkName = shift;
|
|
|
|
# Ensure we're not already in a chunk.
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("enterChunk(): already in chunk.") if (defined($topOfStackRef) && @$topOfStackRef && ($$topOfStackRef[0] == 2));
|
|
|
|
# Read the block header at current data position, adjusting index as needed.
|
|
my @chunkInfo = $self->readBlockHeaderAtIndex(\$self->{index});
|
|
$self->fatal("current is not a chunk.") if !scalar(@chunkInfo) || ($chunkInfo[0] != 2);
|
|
$self->fatal("expecting chunk [$chunkName], found [$chunkInfo[1]].") if (defined($chunkName) && ($chunkName ne $chunkInfo[1]));
|
|
|
|
# Push the chunk info onto the traversal stack.
|
|
$self->pushStack([@chunkInfo]);
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub exitChunk
|
|
{
|
|
# Process args.
|
|
my $self = shift;
|
|
my $chunkName = shift;
|
|
|
|
# Get the top of the stack.
|
|
my $infoRef = $self->popStack();
|
|
$self->fatal("called exitChunk() when not in a chunk.") if (!defined($infoRef) || ($$infoRef[0] != 2));
|
|
$self->fatal("called exitChunk() expecting chunk [$chunkName], found [$$infoRef[1]].") if (defined($chunkName) && ($chunkName ne $$infoRef[1]));
|
|
|
|
# Move index one past end of the chunk.
|
|
$self->{index} = $$infoRef[3];
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->getChunkLengthLeft()
|
|
# @type instance method
|
|
#
|
|
# @return string read as C-style string from current chunk.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub getChunkLengthLeft
|
|
{
|
|
my $self = shift;
|
|
|
|
# Verify that we're currently in a chunk.
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("getChunkLengthLeft(): not in chunk.") if (!defined($topOfStackRef) || !@$topOfStackRef || ($$topOfStackRef[0] != 2));
|
|
$self->fatal("getChunkLengthLeft(): read position is not with the chunk!") if ($self->{index} > $$topOfStackRef[3]) || ($self->{index} < $$topOfStackRef[2]);
|
|
|
|
# Return the number of bytes still available for reading in the chunk.
|
|
return ($$topOfStackRef[3] - $self->{index});
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->read_string()
|
|
# @type instance method
|
|
#
|
|
# @return string read as C-style string from current chunk.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub read_string
|
|
{
|
|
my $self = shift;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("read_string() called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
|
|
my $returnString = "";
|
|
my $lastReadChar;
|
|
|
|
# Read string, don't include trailing null.
|
|
while (($self->{index} < $$topOfStackRef[3]) && (ord($lastReadChar = substr($self->{data}, $self->{index}, 1)) != 0))
|
|
{
|
|
$returnString .= $lastReadChar;
|
|
++$self->{index};
|
|
}
|
|
|
|
# Skip trailing null from input stream.
|
|
if (($self->{index} < $$topOfStackRef[3]) && (ord($lastReadChar) == 0))
|
|
{
|
|
++$self->{index};
|
|
}
|
|
|
|
return $returnString;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->write_string(string)
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub write_string
|
|
{
|
|
my ($self, $string) = @_;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("write_string() called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
|
|
# Append null termination to string
|
|
$string .= chr(0);
|
|
|
|
# Get size difference from new string compared to old string
|
|
my $sizeDifference = ((length $string) - ($$topOfStackRef[3] - $self->{index}));
|
|
print "\n" if ($debug);
|
|
print "Size difference: $sizeDifference\n" if ($debug);
|
|
|
|
print "Old string went from $$topOfStackRef[2] to $$topOfStackRef[3]\n" if($debug);
|
|
# Get data before portion we need to change - everything before chunk data
|
|
my $beforeChunk = substr($self->{data}, 0, $self->{index});
|
|
# Get data after portion we need to change - everything after chunk data
|
|
my $afterChunk = substr($self->{data}, $$topOfStackRef[3], ((length $self->{data}) - $$topOfStackRef[3]));
|
|
print "Length of total data: ".(length $self->{data})."\n" if ($debug);
|
|
print "Length of before: ".(length $beforeChunk)."\n" if ($debug);
|
|
print "Length of after: ".(length $afterChunk)."\n" if ($debug);
|
|
|
|
# Update current data
|
|
$self->{data} = ($beforeChunk.$string.$afterChunk);
|
|
print "Length of total data: ".(length $self->{data})."\n" if ($debug);
|
|
|
|
# Add size difference to chunk and forms above it
|
|
my $stackRef = $self->{stack};
|
|
foreach my $stackElemRef (@$stackRef)
|
|
{
|
|
print "\n" if ($debug);
|
|
print (join "\t", @$stackElemRef) if ($debug);
|
|
print "\n" if ($debug);
|
|
# Update end index in stack
|
|
$$stackElemRef[3] += $sizeDifference;
|
|
print "New end: $$stackElemRef[3]\n" if ($debug);
|
|
|
|
# Get index for size of element
|
|
my $sizeIndex = $$stackElemRef[2] - (($$stackElemRef[0] == 1) ? 8 : 4);
|
|
print "Index for size $sizeIndex\n" if ($debug);
|
|
|
|
# Get data before and after change we will make
|
|
my $beforeChange = substr($self->{data}, 0, $sizeIndex);
|
|
my $afterChange = substr($self->{data}, ($sizeIndex + 4), ((length $self->{data})- ($sizeIndex + 4)));
|
|
print "Length of total data: ".(length $self->{data})."\n" if ($debug);
|
|
print "Length of before: ".(length $beforeChange)."\n" if ($debug);
|
|
print "Length of after: ".(length $afterChange)."\n" if ($debug);
|
|
|
|
# Get old size as stored in $self->{data}
|
|
my $contentLength = 0;
|
|
$contentLength += (ord(substr($self->{data}, $sizeIndex, 1)) << 24);
|
|
++$sizeIndex;
|
|
$contentLength += (ord(substr($self->{data}, $sizeIndex, 1)) << 16);
|
|
++$sizeIndex;
|
|
$contentLength += (ord(substr($self->{data}, $sizeIndex, 1)) << 8);
|
|
++$sizeIndex;
|
|
$contentLength += ord(substr($self->{data}, $sizeIndex, 1));
|
|
++$sizeIndex;
|
|
print "Old Size: $contentLength\n" if ($debug);
|
|
|
|
# Update size
|
|
$contentLength += $sizeDifference;
|
|
print "New Size: $contentLength\n" if ($debug);
|
|
|
|
# Get new size into byte format
|
|
my $sizeOutput = "";
|
|
$sizeOutput .= chr(($contentLength >> 24) % 256);
|
|
$sizeOutput .= chr(($contentLength >> 16) % 256);
|
|
$sizeOutput .= chr(($contentLength >> 8) % 256);
|
|
$sizeOutput .= chr($contentLength % 256);
|
|
|
|
# Update data
|
|
$self->{data} = ($beforeChange.$sizeOutput.$afterChange);
|
|
print "Length of total data: ".(length $self->{data})."\n" if ($debug);
|
|
|
|
}
|
|
|
|
# Update the index to one past the string
|
|
$self->{index} += length $string;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->read_uint8()
|
|
# @type instance method
|
|
#
|
|
# @return integer value of current chunk byte.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub read_uint8
|
|
{
|
|
my $self = shift;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("read_uint8(): called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
$self->fatal("read_uint8(): read position is outside of chunk") if ($self->{index} >= $$topOfStackRef[3]) || ($self->{index} < $$topOfStackRef[2]);
|
|
|
|
my $returnInt = ord(substr($self->{data}, $self->{index}, 1));
|
|
++$self->{index};
|
|
|
|
return $returnInt;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->write_uint8(uint)
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub write_uint8
|
|
{
|
|
my $self = shift;
|
|
my $newval = shift;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("write_uint8(): called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
$self->fatal("write_uint8(): write position is outside of chunk") if ($self->{index} >= $$topOfStackRef[3]) || ($self->{index} < $$topOfStackRef[2]);
|
|
|
|
my $newbyte = chr($newval % 256);
|
|
|
|
my $before = substr($self->{data}, 0, $self->{index});
|
|
my $after = substr($self->{data}, ($self->{index} + 1), ((length $self->{data}) - ($self->{index} + 1)));
|
|
|
|
my $self->{data} = ($before.$newbyte.$after);
|
|
++$self->{index};
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->read_uint16()
|
|
# @type instance method
|
|
#
|
|
# @return integer value of little-endian-style 16-bit value starting at current chunk byte.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub read_uint16
|
|
{
|
|
my $self = shift;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("read_uint16(): called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
$self->fatal("read_uint16(): read position is outside of chunk") if ($self->{index} >= $$topOfStackRef[3]) || ($self->{index} < $$topOfStackRef[2]);
|
|
$self->fatal("read_uint16(): not enough bytes left in chunk") if (($self->{index} + 2) > $$topOfStackRef[3]);
|
|
|
|
my $returnInt = ord(substr($self->{data}, $self->{index}, 1));
|
|
++$self->{index};
|
|
|
|
$returnInt += (ord(substr($self->{data}, $self->{index}, 1)) << 8);
|
|
++$self->{index};
|
|
|
|
return $returnInt;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->write_uint16(uint)
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub write_uint16
|
|
{
|
|
my $self = shift;
|
|
my $newval = shift;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("write_uint16(): called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
$self->fatal("write_uint16(): write position is outside of chunk") if ($self->{index} >= $$topOfStackRef[3]) || ($self->{index} < $$topOfStackRef[2]);
|
|
$self->fatal("write_uint16(): not enough bytes left in chunk") if (($self->{index} + 2) > $$topOfStackRef[3]);
|
|
|
|
my $newbytes = "";
|
|
$newbytes .= chr($newval % 256);
|
|
$newbytes .= chr(($newval >> 8) % 256);
|
|
|
|
my $before = substr($self->{data}, 0, $self->{index});
|
|
my $after = substr($self->{data}, ($self->{index} + 2), ((length $self->{data}) - ($self->{index} + 2)));
|
|
|
|
my $self->{data} = ($before.$newbytes.$after);
|
|
$self->{index} += 2;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->read_uint32()
|
|
# @type instance method
|
|
#
|
|
# @return integer value of little-endian-style 32-bit value starting at current chunk byte.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub read_uint32
|
|
{
|
|
my $self = shift;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("read_uint32(): called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
$self->fatal("read_uint32(): read position is outside of chunk") if ($self->{index} >= $$topOfStackRef[3]) || ($self->{index} < $$topOfStackRef[2]);
|
|
$self->fatal("read_uint32(): not enough bytes left in chunk") if (($self->{index} + 4) > $$topOfStackRef[3]);
|
|
|
|
my $returnInt = ord(substr($self->{data}, $self->{index}, 1));
|
|
++$self->{index};
|
|
|
|
$returnInt += (ord(substr($self->{data}, $self->{index}, 1)) << 8);
|
|
++$self->{index};
|
|
|
|
$returnInt += (ord(substr($self->{data}, $self->{index}, 1)) << 16);
|
|
++$self->{index};
|
|
|
|
$returnInt += (ord(substr($self->{data}, $self->{index}, 1)) << 24);
|
|
++$self->{index};
|
|
|
|
return $returnInt;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->write_uint16(uint)
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub write_uint32
|
|
{
|
|
my $self = shift;
|
|
my $newval = shift;
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("write_uint32(): called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
$self->fatal("write_uint32(): write position is outside of chunk") if ($self->{index} >= $$topOfStackRef[3]) || ($self->{index} < $$topOfStackRef[2]);
|
|
$self->fatal("write_uint32(): not enough bytes left in chunk") if (($self->{index} + 4) > $$topOfStackRef[3]);
|
|
|
|
my $newbytes = "";
|
|
$newbytes .= chr($newval % 256);
|
|
$newbytes .= chr(($newval >> 8) % 256);
|
|
$newbytes .= chr(($newval >> 16) % 256);
|
|
$newbytes .= chr(($newval >> 24) % 256);
|
|
|
|
my $before = substr($self->{data}, 0, $self->{index});
|
|
my $after = substr($self->{data}, ($self->{index} + 4), ((length $self->{data}) - ($self->{index} + 4)));
|
|
|
|
my $self->{data} = ($before.$newbytes.$after);
|
|
$self->{index} += 4;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->skipBytes(byteCount)
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub skipBytes
|
|
{
|
|
my $self = shift;
|
|
my $skipCount = shift;
|
|
$self->fatal("skip_bytes(): bad skip count arg") if !defined($skipCount);
|
|
|
|
my $topOfStackRef = $self->getTopOfStack();
|
|
$self->fatal("skip_bytes(): called while not in chunk") if !@$topOfStackRef || ($$topOfStackRef[0] != 2);
|
|
$self->fatal("skip_bytes(): tried to skip past end of chunk") if ($self->{index} + $skipCount) > $$topOfStackRef[3];
|
|
|
|
$self->{index} += $skipCount;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->walkChildBlocks(callbackRef)
|
|
# @type instance method
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub walkChildBlocks
|
|
{
|
|
# Setup args.
|
|
my $self = shift;
|
|
my $callbackRef = shift;
|
|
|
|
# Abort if this block is a chunk.
|
|
my $blockRef = $self->getTopOfStack();
|
|
$self->fatal("walkChildBlocks() called on a chunk") if ($$blockRef[0] != 1);
|
|
|
|
# Determine end of current block.
|
|
my $startBlockIndex = (defined($blockRef) ? $$blockRef[2] : 0);
|
|
my $endBlockIndex = (defined($blockRef) ? $$blockRef[3] : length($self->{data}));
|
|
my $callbackReturnCode = 1;
|
|
|
|
for ($self->{index} = $startBlockIndex; ($self->{index} < $endBlockIndex) && ($callbackReturnCode >= 0); )
|
|
{
|
|
# Get block info for block at index.
|
|
my @childInfo = $self->readBlockHeaderAtIndex(\$self->{index});
|
|
$self->fatal("failed to get block info") unless (@childInfo && (($childInfo[0] == 1) || ($childInfo[0] == 2)));
|
|
|
|
# Enter child block.
|
|
$self->pushStack([@childInfo]);
|
|
|
|
# Make callback.
|
|
my $childIsChunk = ($childInfo[0] == 2);
|
|
$callbackReturnCode = &$callbackRef($self, $childInfo[1], $childIsChunk);
|
|
|
|
# Recursively walk child's children if user callback didn't stop the traversal and
|
|
# the child block is not a chunk.
|
|
if (($callbackReturnCode >= 1) && !$childIsChunk)
|
|
{
|
|
$callbackReturnCode = $self->walkChildBlocks($callbackRef);
|
|
}
|
|
|
|
# Exit from child block.
|
|
$self->popStack();
|
|
|
|
# Since we don't trust what the callback may have done to index, set it to what we think it should be,
|
|
# the end of the child block we just handled + 1.
|
|
$self->{index} = $childInfo[3];
|
|
}
|
|
|
|
return $callbackReturnCode;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax $object->walkIff(callbackRef)
|
|
# @type instance method
|
|
#
|
|
# This function will enter each block in the block hierarchy contained
|
|
# by the current traversal level. Calling this function while in a
|
|
# chunk does nothing. Traversal always starts at the beginning of the
|
|
# enclosing chunk.
|
|
#
|
|
# The caller is given control via the given reference to a callback
|
|
# function. It is called like this:
|
|
#
|
|
# &$callbackRef(iff, blockName, isChunk)
|
|
#
|
|
# The callback function returns one of the following:
|
|
# -1: completely stop traversal (no more callbacks will be made).
|
|
# 0: prevent further traversal below this node. Only effective when visiting a form.
|
|
# 1: continue traversal as normal.
|
|
#
|
|
# The callback function should not traverse outside of the given block
|
|
# during the callback.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub walkIff
|
|
{
|
|
print "walkIff(): begin\n" if $debug;
|
|
|
|
# Process args.
|
|
my $self = shift;
|
|
my $callbackRef = shift;
|
|
die "Iff::walk(): invalid callbackRef arg specified" if ref($callbackRef) ne "CODE";
|
|
|
|
# Check if we're in a chunk.
|
|
my $infoRef = $self->getTopOfStack();
|
|
if (@$infoRef && ($$infoRef[0] == 2))
|
|
{
|
|
# Nothing to do, we're in a chunk.
|
|
return;
|
|
}
|
|
|
|
# If we're at root level, bail unless we're at the start of the data.
|
|
if (!defined($infoRef) && (length $self->{data} == 0))
|
|
{
|
|
# Nothing to do.
|
|
return;
|
|
}
|
|
|
|
$self->walkChildBlocks($callbackRef);
|
|
|
|
print "walkIff(): end\n" if $debug;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax Iff->createFromFileHandle(fileHandleRef)
|
|
# @type class method
|
|
#
|
|
# This class member function assumes that the entire file contents of
|
|
# fileHandleRef is one complete IFF. If there is any leading or trailing
|
|
# space in the file or if the file contains only a partial IFF, this
|
|
# function will not allow creation of an IFF object. The caller cannot
|
|
# assume anything about the position of fileHandlerRef after this call
|
|
# and the caller is still responsible for closing the file handle.
|
|
#
|
|
# @param fileHandleRef reference to the file handle that contains the
|
|
# Iff data to read.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub createFromFileHandle
|
|
{
|
|
# Process args.
|
|
my ($class, @args) = @_;
|
|
die "Missing file handle reference arg" if !@args || !ref($args[0]);
|
|
my $fileHandleRef = $args[0];
|
|
|
|
# Create the new object.
|
|
my $self = {};
|
|
bless $self;
|
|
|
|
# Initialize data members.
|
|
$self->initialize();
|
|
|
|
# Set file access mode to binary.
|
|
die "Could not set file handle [$fileHandleRef] to binary mode: $!" if !binmode($fileHandleRef);
|
|
|
|
# Rewind the file, read entire contents.
|
|
die "Could not set file handle [$fileHandleRef] to start of file: $!" if !seek($fileHandleRef, 0, 0);
|
|
|
|
# Get file size.
|
|
my @fileStat = stat $fileHandleRef;
|
|
die "Something went wrong with the stat on [$fileHandleRef]: $!" if !@fileStat;
|
|
my $fileSize = $fileStat[7];
|
|
|
|
# Read the data.
|
|
#die "Failed to read file contents for [$fileHandleRef]: $!" if !read($fileHandleRef, $self->{data}, $fileSize);
|
|
return undef if !read($fileHandleRef, $self->{data}, $fileSize);
|
|
|
|
# Check if this is valid iff data.
|
|
return undef if !$self->isValidData();
|
|
|
|
# Ready for service.
|
|
return $self;
|
|
}
|
|
|
|
# ======================================================================
|
|
|
|
# ----------------------------------------------------------------------
|
|
# @syntax Iff->writeToFileHandle(fileHandleRef)
|
|
# @type class method
|
|
#
|
|
# This class member will write out the current Iff to the file handle
|
|
# reference specified. It will not change the current state of the Iff
|
|
# in case the user still wants to make changes to it. The user can
|
|
# assume that the position of fileHandleRef is at the end of the iff
|
|
# data if and only if this function returns successfully.
|
|
#
|
|
# @param fileHandleRef reference to the file handle that the Iff data
|
|
# will be written to.
|
|
# ----------------------------------------------------------------------
|
|
|
|
sub writeToFileHandle
|
|
{
|
|
# Process args
|
|
my ($self, @args) = @_;
|
|
die "Missing file handle reference arg" if !@args || !ref($args[0]);
|
|
my $fileHandleRef = $args[0];
|
|
|
|
# Verify that current data is valid iff data
|
|
die "Can not write invalid iff data to file" if !$self->isValidData();
|
|
|
|
# Set file access mode to binary.
|
|
die "Could not set file handle [$fileHandleRef] to binary mode: $!" if !binmode($fileHandleRef);
|
|
|
|
# Rewind the file.
|
|
die "Could not set file handle [$fileHandleRef] to start of file: $!" if !seek($fileHandleRef, 0, 0);
|
|
|
|
# Write to file
|
|
die "Failed to write file contents for [$fileHandleRef]: $!" if !syswrite($fileHandleRef, $self->{data}, length $self->{data});
|
|
}
|
|
|
|
1;
|