# Convert Linux (little-endian) 32-bit Storable format to 64-bit.
# Doesn't yet handle a few Storable types.
# Tweak xxx lines for your architectures.
#
# Greg Ubben, 18 June 2012
#
sub fix_frozen {
local $data = shift;
local $pos = 15; # xxx length of new header below
local $lev = 0;
# version, byte order, sizes (int, long, ptr, double)
$data =~ s{^\x04\x07\x041234\x04\x04\x04\x08} # xxx
{\x04\x08\x0812345678\x04\x08\x08\x08} # xxx
or die "not a 32-bit x86 Storable";
object();
die "length error" if $pos != length( $data );
return $data;
}
sub object {
local $_ = chr( 64 + byte() );
local $lev = $lev + 1;
#printf "%8d %*s\n", $pos, $lev * 2, $_; # DEBUG
return if /E|N|O|P/;
return $pos += 1 if /H/;
return $pos += 4 if /@|I/;
return $pos += byte() if /J|W/;
return $pos += len() if /A|X/;
return object() if /D|T|K|L|M/;
return object( $pos += vnum()) if /Q/;
return object( vnum() ) if /R/;
return fix_integer() if /F/;
return fix_double() if /G/;
if (/B|C|Y/) { # array or hash
my $n = len();
$pos++ if /Y/;
while ($n--) {
object();
$pos++ if /Y/;
$pos += len() if not /B/;
}
return;
}
die sprintf "Type %d unknown at pos %d\n", ord()-64, $pos-1;
}
sub byte {
return ord( substr( $data, $pos++, 1 ));
}
sub len {
my $len = unpack 'L', substr( $data, $pos, 4 ); # xxx 'V' or 'N'
+ ?
$pos += 4;
return $len;
}
sub vnum {
my $n = byte();
return ($n < 128 ? $n : len());
}
sub fix_integer { # xxx
my $n = unpack 'l', substr( $data, $pos, 4 ); # was 32-bit
substr( $data, $pos, 4 ) = pack 'q', $n; # now 64-bit
$pos += 8;
}
sub fix_double { # xxx
$pos += 8; # assume same floating-point format
}
|