|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Copyright (c) 1995-2001, Raphael Manfredi
|
|
Packit |
14c646 |
# Copyright (c) 2002-2014 by the Perl 5 Porters
|
|
Packit |
14c646 |
# Copyright (c) 2015-2016 cPanel Inc
|
|
Packit |
14c646 |
# Copyright (c) 2017 Reini Urban
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# You may redistribute only under the same terms as Perl 5, as specified
|
|
Packit |
14c646 |
# in the README file that comes with the distribution.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
require XSLoader;
|
|
Packit |
14c646 |
require Exporter;
|
|
Packit |
14c646 |
package Storable;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
our @ISA = qw(Exporter);
|
|
Packit |
14c646 |
our @EXPORT = qw(store retrieve);
|
|
Packit |
14c646 |
our @EXPORT_OK = qw(
|
|
Packit |
14c646 |
nstore store_fd nstore_fd fd_retrieve
|
|
Packit |
14c646 |
freeze nfreeze thaw
|
|
Packit |
14c646 |
dclone
|
|
Packit |
14c646 |
retrieve_fd
|
|
Packit |
14c646 |
lock_store lock_nstore lock_retrieve
|
|
Packit |
14c646 |
file_magic read_magic
|
|
Packit |
14c646 |
BLESS_OK TIE_OK FLAGS_COMPAT
|
|
Packit |
14c646 |
stack_depth stack_depth_hash
|
|
Packit |
14c646 |
);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
our ($canonical, $forgive_me);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
our $VERSION = '3.11';
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
our $recursion_limit;
|
|
Packit |
14c646 |
our $recursion_limit_hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
do "Storable/Limit.pm";
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$recursion_limit = 512
|
|
Packit |
14c646 |
unless defined $recursion_limit;
|
|
Packit |
14c646 |
$recursion_limit_hash = 256
|
|
Packit |
14c646 |
unless defined $recursion_limit_hash;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
BEGIN {
|
|
Packit |
14c646 |
if (eval {
|
|
Packit |
14c646 |
local $SIG{__DIE__};
|
|
Packit |
14c646 |
local @INC = @INC;
|
|
Packit |
14c646 |
pop @INC if $INC[-1] eq '.';
|
|
Packit |
14c646 |
require Log::Agent;
|
|
Packit |
14c646 |
1;
|
|
Packit |
14c646 |
}) {
|
|
Packit |
14c646 |
Log::Agent->import;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Use of Log::Agent is optional. If it hasn't imported these subs then
|
|
Packit |
14c646 |
# provide a fallback implementation.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
unless ($Storable::{logcroak} && *{$Storable::{logcroak}}{CODE}) {
|
|
Packit |
14c646 |
require Carp;
|
|
Packit |
14c646 |
*logcroak = sub {
|
|
Packit |
14c646 |
Carp::croak(@_);
|
|
Packit |
14c646 |
};
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
unless ($Storable::{logcarp} && *{$Storable::{logcarp}}{CODE}) {
|
|
Packit |
14c646 |
require Carp;
|
|
Packit |
14c646 |
*logcarp = sub {
|
|
Packit |
14c646 |
Carp::carp(@_);
|
|
Packit |
14c646 |
};
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# They might miss :flock in Fcntl
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
BEGIN {
|
|
Packit |
14c646 |
if (eval { require Fcntl; 1 } && exists $Fcntl::EXPORT_TAGS{'flock'}) {
|
|
Packit |
14c646 |
Fcntl->import(':flock');
|
|
Packit |
14c646 |
} else {
|
|
Packit |
14c646 |
eval q{
|
|
Packit |
14c646 |
sub LOCK_SH () { 1 }
|
|
Packit |
14c646 |
sub LOCK_EX () { 2 }
|
|
Packit |
14c646 |
};
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub CLONE {
|
|
Packit |
14c646 |
# clone context under threads
|
|
Packit |
14c646 |
Storable::init_perinterp();
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub BLESS_OK () { 2 }
|
|
Packit |
14c646 |
sub TIE_OK () { 4 }
|
|
Packit |
14c646 |
sub FLAGS_COMPAT () { BLESS_OK | TIE_OK }
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# By default restricted hashes are downgraded on earlier perls.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$Storable::flags = FLAGS_COMPAT;
|
|
Packit |
14c646 |
$Storable::downgrade_restricted = 1;
|
|
Packit |
14c646 |
$Storable::accept_future_minor = 1;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
XSLoader::load('Storable');
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Determine whether locking is possible, but only when needed.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub CAN_FLOCK; # TEMPLATE - replaced by Storable.pm.PL
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub show_file_magic {
|
|
Packit |
14c646 |
print <
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# To recognize the data files of the Perl module Storable,
|
|
Packit |
14c646 |
# the following lines need to be added to the local magic(5) file,
|
|
Packit |
14c646 |
# usually either /usr/share/misc/magic or /etc/magic.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
0 string perl-store perl Storable(v0.6) data
|
|
Packit |
14c646 |
>4 byte >0 (net-order %d)
|
|
Packit |
14c646 |
>>4 byte &01 (network-ordered)
|
|
Packit |
14c646 |
>>4 byte =3 (major 1)
|
|
Packit |
14c646 |
>>4 byte =2 (major 1)
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
0 string pst0 perl Storable(v0.7) data
|
|
Packit |
14c646 |
>4 byte >0
|
|
Packit |
14c646 |
>>4 byte &01 (network-ordered)
|
|
Packit |
14c646 |
>>4 byte =5 (major 2)
|
|
Packit |
14c646 |
>>4 byte =4 (major 2)
|
|
Packit |
14c646 |
>>5 byte >0 (minor %d)
|
|
Packit |
14c646 |
EOM
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub file_magic {
|
|
Packit |
14c646 |
require IO::File;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $file = shift;
|
|
Packit |
14c646 |
my $fh = IO::File->new;
|
|
Packit |
14c646 |
open($fh, "<", $file) || die "Can't open '$file': $!";
|
|
Packit |
14c646 |
binmode($fh);
|
|
Packit |
14c646 |
defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!";
|
|
Packit |
14c646 |
close($fh);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$file = "./$file" unless $file; # ensure TRUE value
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
return read_magic($buf, $file);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub read_magic {
|
|
Packit |
14c646 |
my($buf, $file) = @_;
|
|
Packit |
14c646 |
my %info;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $buflen = length($buf);
|
|
Packit |
14c646 |
my $magic;
|
|
Packit |
14c646 |
if ($buf =~ s/^(pst0|perl-store)//) {
|
|
Packit |
14c646 |
$magic = $1;
|
|
Packit |
14c646 |
$info{file} = $file || 1;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
else {
|
|
Packit |
14c646 |
return undef if $file;
|
|
Packit |
14c646 |
$magic = "";
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
return undef unless length($buf);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $net_order;
|
|
Packit |
14c646 |
if ($magic eq "perl-store" && ord(substr($buf, 0, 1)) > 1) {
|
|
Packit |
14c646 |
$info{version} = -1;
|
|
Packit |
14c646 |
$net_order = 0;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
else {
|
|
Packit |
14c646 |
$buf =~ s/(.)//s;
|
|
Packit |
14c646 |
my $major = (ord $1) >> 1;
|
|
Packit |
14c646 |
return undef if $major > 4; # sanity (assuming we never go that high)
|
|
Packit |
14c646 |
$info{major} = $major;
|
|
Packit |
14c646 |
$net_order = (ord $1) & 0x01;
|
|
Packit |
14c646 |
if ($major > 1) {
|
|
Packit |
14c646 |
return undef unless $buf =~ s/(.)//s;
|
|
Packit |
14c646 |
my $minor = ord $1;
|
|
Packit |
14c646 |
$info{minor} = $minor;
|
|
Packit |
14c646 |
$info{version} = "$major.$minor";
|
|
Packit |
14c646 |
$info{version_nv} = sprintf "%d.%03d", $major, $minor;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
else {
|
|
Packit |
14c646 |
$info{version} = $major;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
$info{version_nv} ||= $info{version};
|
|
Packit |
14c646 |
$info{netorder} = $net_order;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
unless ($net_order) {
|
|
Packit |
14c646 |
return undef unless $buf =~ s/(.)//s;
|
|
Packit |
14c646 |
my $len = ord $1;
|
|
Packit |
14c646 |
return undef unless length($buf) >= $len;
|
|
Packit |
14c646 |
return undef unless $len == 4 || $len == 8; # sanity
|
|
Packit |
14c646 |
@info{qw(byteorder intsize longsize ptrsize)}
|
|
Packit |
14c646 |
= unpack "a${len}CCC", $buf;
|
|
Packit |
14c646 |
(substr $buf, 0, $len + 3) = '';
|
|
Packit |
14c646 |
if ($info{version_nv} >= 2.002) {
|
|
Packit |
14c646 |
return undef unless $buf =~ s/(.)//s;
|
|
Packit |
14c646 |
$info{nvsize} = ord $1;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
$info{hdrsize} = $buflen - length($buf);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
return \%info;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub BIN_VERSION_NV {
|
|
Packit |
14c646 |
sprintf "%d.%03d", BIN_MAJOR(), BIN_MINOR();
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub BIN_WRITE_VERSION_NV {
|
|
Packit |
14c646 |
sprintf "%d.%03d", BIN_MAJOR(), BIN_WRITE_MINOR();
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# store
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Store target object hierarchy, identified by a reference to its root.
|
|
Packit |
14c646 |
# The stored object tree may later be retrieved to memory via retrieve.
|
|
Packit |
14c646 |
# Returns undef if an I/O error occurred, in which case the file is
|
|
Packit |
14c646 |
# removed.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub store {
|
|
Packit |
14c646 |
return _store(\&pstore, @_, 0);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# nstore
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as store, but in network order.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub nstore {
|
|
Packit |
14c646 |
return _store(\&net_pstore, @_, 0);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# lock_store
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as store, but flock the file first (advisory locking).
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub lock_store {
|
|
Packit |
14c646 |
return _store(\&pstore, @_, 1);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# lock_nstore
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as nstore, but flock the file first (advisory locking).
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub lock_nstore {
|
|
Packit |
14c646 |
return _store(\&net_pstore, @_, 1);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Internal store to file routine
|
|
Packit |
14c646 |
sub _store {
|
|
Packit |
14c646 |
my $xsptr = shift;
|
|
Packit |
14c646 |
my $self = shift;
|
|
Packit |
14c646 |
my ($file, $use_locking) = @_;
|
|
Packit |
14c646 |
logcroak "not a reference" unless ref($self);
|
|
Packit |
14c646 |
logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist
|
|
Packit |
14c646 |
local *FILE;
|
|
Packit |
14c646 |
if ($use_locking) {
|
|
Packit |
14c646 |
open(FILE, ">>", $file) || logcroak "can't write into $file: $!";
|
|
Packit |
14c646 |
unless (&CAN_FLOCK) {
|
|
Packit |
14c646 |
logcarp
|
|
Packit |
14c646 |
"Storable::lock_store: fcntl/flock emulation broken on $^O";
|
|
Packit |
14c646 |
return undef;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
flock(FILE, LOCK_EX) ||
|
|
Packit |
14c646 |
logcroak "can't get exclusive lock on $file: $!";
|
|
Packit |
14c646 |
truncate FILE, 0;
|
|
Packit |
14c646 |
# Unlocking will happen when FILE is closed
|
|
Packit |
14c646 |
} else {
|
|
Packit |
14c646 |
open(FILE, ">", $file) || logcroak "can't create $file: $!";
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
binmode FILE; # Archaic systems...
|
|
Packit |
14c646 |
my $da = $@; # Don't mess if called from exception handler
|
|
Packit |
14c646 |
my $ret;
|
|
Packit |
14c646 |
# Call C routine nstore or pstore, depending on network order
|
|
Packit |
14c646 |
eval { $ret = &$xsptr(*FILE, $self) };
|
|
Packit |
14c646 |
# close will return true on success, so the or short-circuits, the ()
|
|
Packit |
14c646 |
# expression is true, and for that case the block will only be entered
|
|
Packit |
14c646 |
# if $@ is true (ie eval failed)
|
|
Packit |
14c646 |
# if close fails, it returns false, $ret is altered, *that* is (also)
|
|
Packit |
14c646 |
# false, so the () expression is false, !() is true, and the block is
|
|
Packit |
14c646 |
# entered.
|
|
Packit |
14c646 |
if (!(close(FILE) or undef $ret) || $@) {
|
|
Packit |
14c646 |
unlink($file) or warn "Can't unlink $file: $!\n";
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
if ($@) {
|
|
Packit |
14c646 |
$@ =~ s/\.?\n$/,/ unless ref $@;
|
|
Packit |
14c646 |
logcroak $@;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
$@ = $da;
|
|
Packit |
14c646 |
return $ret;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# store_fd
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as store, but perform on an already opened file descriptor instead.
|
|
Packit |
14c646 |
# Returns undef if an I/O error occurred.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub store_fd {
|
|
Packit |
14c646 |
return _store_fd(\&pstore, @_);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# nstore_fd
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as store_fd, but in network order.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub nstore_fd {
|
|
Packit |
14c646 |
my ($self, $file) = @_;
|
|
Packit |
14c646 |
return _store_fd(\&net_pstore, @_);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Internal store routine on opened file descriptor
|
|
Packit |
14c646 |
sub _store_fd {
|
|
Packit |
14c646 |
my $xsptr = shift;
|
|
Packit |
14c646 |
my $self = shift;
|
|
Packit |
14c646 |
my ($file) = @_;
|
|
Packit |
14c646 |
logcroak "not a reference" unless ref($self);
|
|
Packit |
14c646 |
logcroak "too many arguments" unless @_ == 1; # No @foo in arglist
|
|
Packit |
14c646 |
my $fd = fileno($file);
|
|
Packit |
14c646 |
logcroak "not a valid file descriptor" unless defined $fd;
|
|
Packit |
14c646 |
my $da = $@; # Don't mess if called from exception handler
|
|
Packit |
14c646 |
my $ret;
|
|
Packit |
14c646 |
# Call C routine nstore or pstore, depending on network order
|
|
Packit |
14c646 |
eval { $ret = &$xsptr($file, $self) };
|
|
Packit |
14c646 |
logcroak $@ if $@ =~ s/\.?\n$/,/;
|
|
Packit |
14c646 |
local $\; print $file ''; # Autoflush the file if wanted
|
|
Packit |
14c646 |
$@ = $da;
|
|
Packit |
14c646 |
return $ret;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# freeze
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Store object and its hierarchy in memory and return a scalar
|
|
Packit |
14c646 |
# containing the result.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub freeze {
|
|
Packit |
14c646 |
_freeze(\&mstore, @_);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# nfreeze
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as freeze but in network order.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub nfreeze {
|
|
Packit |
14c646 |
_freeze(\&net_mstore, @_);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Internal freeze routine
|
|
Packit |
14c646 |
sub _freeze {
|
|
Packit |
14c646 |
my $xsptr = shift;
|
|
Packit |
14c646 |
my $self = shift;
|
|
Packit |
14c646 |
logcroak "not a reference" unless ref($self);
|
|
Packit |
14c646 |
logcroak "too many arguments" unless @_ == 0; # No @foo in arglist
|
|
Packit |
14c646 |
my $da = $@; # Don't mess if called from exception handler
|
|
Packit |
14c646 |
my $ret;
|
|
Packit |
14c646 |
# Call C routine mstore or net_mstore, depending on network order
|
|
Packit |
14c646 |
eval { $ret = &$xsptr($self) };
|
|
Packit |
14c646 |
if ($@) {
|
|
Packit |
14c646 |
$@ =~ s/\.?\n$/,/ unless ref $@;
|
|
Packit |
14c646 |
logcroak $@;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
$@ = $da;
|
|
Packit |
14c646 |
return $ret ? $ret : undef;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# retrieve
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Retrieve object hierarchy from disk, returning a reference to the root
|
|
Packit |
14c646 |
# object of that tree.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# retrieve(file, flags)
|
|
Packit |
14c646 |
# flags include by default BLESS_OK=2 | TIE_OK=4
|
|
Packit |
14c646 |
# with flags=0 or the global $Storable::flags set to 0, no resulting object
|
|
Packit |
14c646 |
# will be blessed nor tied.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub retrieve {
|
|
Packit |
14c646 |
_retrieve(shift, 0, @_);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# lock_retrieve
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as retrieve, but with advisory locking.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub lock_retrieve {
|
|
Packit |
14c646 |
_retrieve(shift, 1, @_);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Internal retrieve routine
|
|
Packit |
14c646 |
sub _retrieve {
|
|
Packit |
14c646 |
my ($file, $use_locking, $flags) = @_;
|
|
Packit |
14c646 |
$flags = $Storable::flags unless defined $flags;
|
|
Packit |
14c646 |
my $FILE;
|
|
Packit |
14c646 |
open($FILE, "<", $file) || logcroak "can't open $file: $!";
|
|
Packit |
14c646 |
binmode $FILE; # Archaic systems...
|
|
Packit |
14c646 |
my $self;
|
|
Packit |
14c646 |
my $da = $@; # Could be from exception handler
|
|
Packit |
14c646 |
if ($use_locking) {
|
|
Packit |
14c646 |
unless (&CAN_FLOCK) {
|
|
Packit |
14c646 |
logcarp
|
|
Packit |
14c646 |
"Storable::lock_store: fcntl/flock emulation broken on $^O";
|
|
Packit |
14c646 |
return undef;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
flock($FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
|
|
Packit |
14c646 |
# Unlocking will happen when FILE is closed
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
eval { $self = pretrieve($FILE, $flags) }; # Call C routine
|
|
Packit |
14c646 |
close($FILE);
|
|
Packit |
14c646 |
if ($@) {
|
|
Packit |
14c646 |
$@ =~ s/\.?\n$/,/ unless ref $@;
|
|
Packit |
14c646 |
logcroak $@;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
$@ = $da;
|
|
Packit |
14c646 |
return $self;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# fd_retrieve
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Same as retrieve, but perform from an already opened file descriptor instead.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub fd_retrieve {
|
|
Packit |
14c646 |
my ($file, $flags) = @_;
|
|
Packit |
14c646 |
$flags = $Storable::flags unless defined $flags;
|
|
Packit |
14c646 |
my $fd = fileno($file);
|
|
Packit |
14c646 |
logcroak "not a valid file descriptor" unless defined $fd;
|
|
Packit |
14c646 |
my $self;
|
|
Packit |
14c646 |
my $da = $@; # Could be from exception handler
|
|
Packit |
14c646 |
eval { $self = pretrieve($file, $flags) }; # Call C routine
|
|
Packit |
14c646 |
if ($@) {
|
|
Packit |
14c646 |
$@ =~ s/\.?\n$/,/ unless ref $@;
|
|
Packit |
14c646 |
logcroak $@;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
$@ = $da;
|
|
Packit |
14c646 |
return $self;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub retrieve_fd { &fd_retrieve } # Backward compatibility
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# thaw
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Recreate objects in memory from an existing frozen image created
|
|
Packit |
14c646 |
# by freeze. If the frozen image passed is undef, return undef.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# thaw(frozen_obj, flags)
|
|
Packit |
14c646 |
# flags include by default BLESS_OK=2 | TIE_OK=4
|
|
Packit |
14c646 |
# with flags=0 or the global $Storable::flags set to 0, no resulting object
|
|
Packit |
14c646 |
# will be blessed nor tied.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
sub thaw {
|
|
Packit |
14c646 |
my ($frozen, $flags) = @_;
|
|
Packit |
14c646 |
$flags = $Storable::flags unless defined $flags;
|
|
Packit |
14c646 |
return undef unless defined $frozen;
|
|
Packit |
14c646 |
my $self;
|
|
Packit |
14c646 |
my $da = $@; # Could be from exception handler
|
|
Packit |
14c646 |
eval { $self = mretrieve($frozen, $flags) };# Call C routine
|
|
Packit |
14c646 |
if ($@) {
|
|
Packit |
14c646 |
$@ =~ s/\.?\n$/,/ unless ref $@;
|
|
Packit |
14c646 |
logcroak $@;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
$@ = $da;
|
|
Packit |
14c646 |
return $self;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# _make_re($re, $flags)
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
# Internal function used to thaw a regular expression.
|
|
Packit |
14c646 |
#
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $re_flags;
|
|
Packit |
14c646 |
BEGIN {
|
|
Packit |
14c646 |
if ($] < 5.010) {
|
|
Packit |
14c646 |
$re_flags = qr/\A[imsx]*\z/;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
elsif ($] < 5.014) {
|
|
Packit |
14c646 |
$re_flags = qr/\A[msixp]*\z/;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
elsif ($] < 5.022) {
|
|
Packit |
14c646 |
$re_flags = qr/\A[msixpdual]*\z/;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
else {
|
|
Packit |
14c646 |
$re_flags = qr/\A[msixpdualn]*\z/;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub _make_re {
|
|
Packit |
14c646 |
my ($re, $flags) = @_;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$flags =~ $re_flags
|
|
Packit |
14c646 |
or die "regexp flags invalid";
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
my $qr = eval "qr/\$re/$flags";
|
|
Packit |
14c646 |
die $@ if $@;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$qr;
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
if ($] < 5.012) {
|
|
Packit |
14c646 |
eval <<'EOS'
|
|
Packit |
14c646 |
sub _regexp_pattern {
|
|
Packit |
14c646 |
my $re = "" . shift;
|
|
Packit |
14c646 |
$re =~ /\A\(\?([xism]*)(?:-[xism]*)?:(.*)\)\z/s
|
|
Packit |
14c646 |
or die "Cannot parse regexp /$re/";
|
|
Packit |
14c646 |
return ($2, $1);
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
1
|
|
Packit |
14c646 |
EOS
|
|
Packit |
14c646 |
or die "Cannot define _regexp_pattern: $@";
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
1;
|
|
Packit |
14c646 |
__END__
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 NAME
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable - persistence for Perl data structures
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 SYNOPSIS
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
use Storable;
|
|
Packit |
14c646 |
store \%table, 'file';
|
|
Packit |
14c646 |
$hashref = retrieve('file');
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
use Storable qw(nstore store_fd nstore_fd freeze thaw dclone);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Network order
|
|
Packit |
14c646 |
nstore \%table, 'file';
|
|
Packit |
14c646 |
$hashref = retrieve('file'); # There is NO nretrieve()
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Storing to and retrieving from an already opened file
|
|
Packit |
14c646 |
store_fd \@array, \*STDOUT;
|
|
Packit |
14c646 |
nstore_fd \%table, \*STDOUT;
|
|
Packit |
14c646 |
$aryref = fd_retrieve(\*SOCKET);
|
|
Packit |
14c646 |
$hashref = fd_retrieve(\*SOCKET);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Serializing to memory
|
|
Packit |
14c646 |
$serialized = freeze \%table;
|
|
Packit |
14c646 |
%table_clone = %{ thaw($serialized) };
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Deep (recursive) cloning
|
|
Packit |
14c646 |
$cloneref = dclone($ref);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
# Advisory locking
|
|
Packit |
14c646 |
use Storable qw(lock_store lock_nstore lock_retrieve)
|
|
Packit |
14c646 |
lock_store \%table, 'file';
|
|
Packit |
14c646 |
lock_nstore \%table, 'file';
|
|
Packit |
14c646 |
$hashref = lock_retrieve('file');
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 DESCRIPTION
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The Storable package brings persistence to your Perl data structures
|
|
Packit |
14c646 |
containing SCALAR, ARRAY, HASH or REF objects, i.e. anything that can be
|
|
Packit |
14c646 |
conveniently stored to disk and retrieved at a later time.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
It can be used in the regular procedural way by calling C<store> with
|
|
Packit |
14c646 |
a reference to the object to be stored, along with the file name where
|
|
Packit |
14c646 |
the image should be written.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The routine returns C<undef> for I/O problems or other internal error,
|
|
Packit |
14c646 |
a true value otherwise. Serious errors are propagated as a C<die> exception.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
To retrieve data stored to disk, use C<retrieve> with a file name.
|
|
Packit |
14c646 |
The objects stored into that file are recreated into memory for you,
|
|
Packit |
14c646 |
and a I<reference> to the root object is returned. In case an I/O error
|
|
Packit |
14c646 |
occurs while reading, C<undef> is returned instead. Other serious
|
|
Packit |
14c646 |
errors are propagated via C<die>.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Since storage is performed recursively, you might want to stuff references
|
|
Packit |
14c646 |
to objects that share a lot of common data into a single array or hash
|
|
Packit |
14c646 |
table, and then store that object. That way, when you retrieve back the
|
|
Packit |
14c646 |
whole thing, the objects will continue to share what they originally shared.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
At the cost of a slight header overhead, you may store to an already
|
|
Packit |
14c646 |
opened file descriptor using the C<store_fd> routine, and retrieve
|
|
Packit |
14c646 |
from a file via C<fd_retrieve>. Those names aren't imported by default,
|
|
Packit |
14c646 |
so you will have to do that explicitly if you need those routines.
|
|
Packit |
14c646 |
The file descriptor you supply must be already opened, for read
|
|
Packit |
14c646 |
if you're going to retrieve and for write if you wish to store.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
store_fd(\%table, *STDOUT) || die "can't store to stdout\n";
|
|
Packit |
14c646 |
$hashref = fd_retrieve(*STDIN);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
You can also store data in network order to allow easy sharing across
|
|
Packit |
14c646 |
multiple platforms, or when storing on a socket known to be remotely
|
|
Packit |
14c646 |
connected. The routines to call have an initial C<n> prefix for I<network>,
|
|
Packit |
14c646 |
as in C<nstore> and C<nstore_fd>. At retrieval time, your data will be
|
|
Packit |
14c646 |
correctly restored so you don't have to know whether you're restoring
|
|
Packit |
14c646 |
from native or network ordered data. Double values are stored stringified
|
|
Packit |
14c646 |
to ensure portability as well, at the slight risk of loosing some precision
|
|
Packit |
14c646 |
in the last decimals.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
When using C<fd_retrieve>, objects are retrieved in sequence, one
|
|
Packit |
14c646 |
object (i.e. one recursive tree) per associated C<store_fd>.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
If you're more from the object-oriented camp, you can inherit from
|
|
Packit |
14c646 |
Storable and directly store your objects by invoking C<store> as
|
|
Packit |
14c646 |
a method. The fact that the root of the to-be-stored tree is a
|
|
Packit |
14c646 |
blessed reference (i.e. an object) is special-cased so that the
|
|
Packit |
14c646 |
retrieve does not provide a reference to that object but rather the
|
|
Packit |
14c646 |
blessed object reference itself. (Otherwise, you'd get a reference
|
|
Packit |
14c646 |
to that blessed object).
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 MEMORY STORE
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The Storable engine can also store data into a Perl scalar instead, to
|
|
Packit |
14c646 |
later retrieve them. This is mainly used to freeze a complex structure in
|
|
Packit |
14c646 |
some safe compact memory place (where it can possibly be sent to another
|
|
Packit |
14c646 |
process via some IPC, since freezing the structure also serializes it in
|
|
Packit |
14c646 |
effect). Later on, and maybe somewhere else, you can thaw the Perl scalar
|
|
Packit |
14c646 |
out and recreate the original complex structure in memory.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Surprisingly, the routines to be called are named C<freeze> and C<thaw>.
|
|
Packit |
14c646 |
If you wish to send out the frozen scalar to another machine, use
|
|
Packit |
14c646 |
C<nfreeze> instead to get a portable image.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Note that freezing an object structure and immediately thawing it
|
|
Packit |
14c646 |
actually achieves a deep cloning of that structure:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
dclone(.) = thaw(freeze(.))
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable provides you with a C<dclone> interface which does not create
|
|
Packit |
14c646 |
that intermediary scalar but instead freezes the structure in some
|
|
Packit |
14c646 |
internal memory space and then immediately thaws it out.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 ADVISORY LOCKING
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The C<lock_store> and C<lock_nstore> routine are equivalent to
|
|
Packit |
14c646 |
C<store> and C<nstore>, except that they get an exclusive lock on
|
|
Packit |
14c646 |
the file before writing. Likewise, C<lock_retrieve> does the same
|
|
Packit |
14c646 |
as C<retrieve>, but also gets a shared lock on the file before reading.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
As with any advisory locking scheme, the protection only works if you
|
|
Packit |
14c646 |
systematically use C<lock_store> and C<lock_retrieve>. If one side of
|
|
Packit |
14c646 |
your application uses C<store> whilst the other uses C<lock_retrieve>,
|
|
Packit |
14c646 |
you will get no protection at all.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The internal advisory locking is implemented using Perl's flock()
|
|
Packit |
14c646 |
routine. If your system does not support any form of flock(), or if
|
|
Packit |
14c646 |
you share your files across NFS, you might wish to use other forms
|
|
Packit |
14c646 |
of locking by using modules such as LockFile::Simple which lock a
|
|
Packit |
14c646 |
file using a filesystem entry, instead of locking the file descriptor.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 SPEED
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The heart of Storable is written in C for decent speed. Extra low-level
|
|
Packit |
14c646 |
optimizations have been made when manipulating perl internals, to
|
|
Packit |
14c646 |
sacrifice encapsulation for the benefit of greater speed.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 CANONICAL REPRESENTATION
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Normally, Storable stores elements of hashes in the order they are
|
|
Packit |
14c646 |
stored internally by Perl, i.e. pseudo-randomly. If you set
|
|
Packit |
14c646 |
C<$Storable::canonical> to some C<TRUE> value, Storable will store
|
|
Packit |
14c646 |
hashes with the elements sorted by their key. This allows you to
|
|
Packit |
14c646 |
compare data structures by comparing their frozen representations (or
|
|
Packit |
14c646 |
even the compressed frozen representations), which can be useful for
|
|
Packit |
14c646 |
creating lookup tables for complicated queries.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Canonical order does not imply network order; those are two orthogonal
|
|
Packit |
14c646 |
settings.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 CODE REFERENCES
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Since Storable version 2.05, CODE references may be serialized with
|
|
Packit |
14c646 |
the help of L<B::Deparse>. To enable this feature, set
|
|
Packit |
14c646 |
C<$Storable::Deparse> to a true value. To enable deserialization,
|
|
Packit |
14c646 |
C<$Storable::Eval> should be set to a true value. Be aware that
|
|
Packit |
14c646 |
deserialization is done through C<eval>, which is dangerous if the
|
|
Packit |
14c646 |
Storable file contains malicious data. You can set C<$Storable::Eval>
|
|
Packit |
14c646 |
to a subroutine reference which would be used instead of C<eval>. See
|
|
Packit |
14c646 |
below for an example using a L<Safe> compartment for deserialization
|
|
Packit |
14c646 |
of CODE references.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
If C<$Storable::Deparse> and/or C<$Storable::Eval> are set to false
|
|
Packit |
14c646 |
values, then the value of C<$Storable::forgive_me> (see below) is
|
|
Packit |
14c646 |
respected while serializing and deserializing.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 FORWARD COMPATIBILITY
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This release of Storable can be used on a newer version of Perl to
|
|
Packit |
14c646 |
serialize data which is not supported by earlier Perls. By default,
|
|
Packit |
14c646 |
Storable will attempt to do the right thing, by C<croak()>ing if it
|
|
Packit |
14c646 |
encounters data that it cannot deserialize. However, the defaults
|
|
Packit |
14c646 |
can be changed as follows:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over 4
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item utf8 data
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Perl 5.6 added support for Unicode characters with code points > 255,
|
|
Packit |
14c646 |
and Perl 5.8 has full support for Unicode characters in hash keys.
|
|
Packit |
14c646 |
Perl internally encodes strings with these characters using utf8, and
|
|
Packit |
14c646 |
Storable serializes them as utf8. By default, if an older version of
|
|
Packit |
14c646 |
Perl encounters a utf8 value it cannot represent, it will C<croak()>.
|
|
Packit |
14c646 |
To change this behaviour so that Storable deserializes utf8 encoded
|
|
Packit |
14c646 |
values as the string of bytes (effectively dropping the I<is_utf8> flag)
|
|
Packit |
14c646 |
set C<$Storable::drop_utf8> to some C<TRUE> value. This is a form of
|
|
Packit |
14c646 |
data loss, because with C<$drop_utf8> true, it becomes impossible to tell
|
|
Packit |
14c646 |
whether the original data was the Unicode string, or a series of bytes
|
|
Packit |
14c646 |
that happen to be valid utf8.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item restricted hashes
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Perl 5.8 adds support for restricted hashes, which have keys
|
|
Packit |
14c646 |
restricted to a given set, and can have values locked to be read only.
|
|
Packit |
14c646 |
By default, when Storable encounters a restricted hash on a perl
|
|
Packit |
14c646 |
that doesn't support them, it will deserialize it as a normal hash,
|
|
Packit |
14c646 |
silently discarding any placeholder keys and leaving the keys and
|
|
Packit |
14c646 |
all values unlocked. To make Storable C<croak()> instead, set
|
|
Packit |
14c646 |
C<$Storable::downgrade_restricted> to a C<FALSE> value. To restore
|
|
Packit |
14c646 |
the default set it back to some C<TRUE> value.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The cperl PERL_PERTURB_KEYS_TOP hash strategy has a known problem with
|
|
Packit |
14c646 |
restricted hashes.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item huge objects
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
On 64bit systems some data structures may exceed the 2G (i.e. I32_MAX)
|
|
Packit |
14c646 |
limit. On 32bit systems also strings between I32 and U32 (2G-4G).
|
|
Packit |
14c646 |
Since Storable 3.00 (not in perl5 core) we are able to store and
|
|
Packit |
14c646 |
retrieve these objects, even if perl5 itself is not able to handle
|
|
Packit |
14c646 |
them. These are strings longer then 4G, arrays with more then 2G
|
|
Packit |
14c646 |
elements and hashes with more then 2G elements. cperl forbids hashes
|
|
Packit |
14c646 |
with more than 2G elements, but this fail in cperl then. perl5 itself
|
|
Packit |
14c646 |
at least until 5.26 allows it, but cannot iterate over them.
|
|
Packit |
14c646 |
Note that creating those objects might cause out of memory
|
|
Packit |
14c646 |
exceptions by the operating system before perl has a chance to abort.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item files from future versions of Storable
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Earlier versions of Storable would immediately croak if they encountered
|
|
Packit |
14c646 |
a file with a higher internal version number than the reading Storable
|
|
Packit |
14c646 |
knew about. Internal version numbers are increased each time new data
|
|
Packit |
14c646 |
types (such as restricted hashes) are added to the vocabulary of the file
|
|
Packit |
14c646 |
format. This meant that a newer Storable module had no way of writing a
|
|
Packit |
14c646 |
file readable by an older Storable, even if the writer didn't store newer
|
|
Packit |
14c646 |
data types.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This version of Storable will defer croaking until it encounters a data
|
|
Packit |
14c646 |
type in the file that it does not recognize. This means that it will
|
|
Packit |
14c646 |
continue to read files generated by newer Storable modules which are careful
|
|
Packit |
14c646 |
in what they write out, making it easier to upgrade Storable modules in a
|
|
Packit |
14c646 |
mixed environment.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The old behaviour of immediate croaking can be re-instated by setting
|
|
Packit |
14c646 |
C<$Storable::accept_future_minor> to some C<FALSE> value.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
All these variables have no effect on a newer Perl which supports the
|
|
Packit |
14c646 |
relevant feature.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 ERROR REPORTING
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable uses the "exception" paradigm, in that it does not try to
|
|
Packit |
14c646 |
workaround failures: if something bad happens, an exception is
|
|
Packit |
14c646 |
generated from the caller's perspective (see L<Carp> and C<croak()>).
|
|
Packit |
14c646 |
Use eval {} to trap those exceptions.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
When Storable croaks, it tries to report the error via the C<logcroak()>
|
|
Packit |
14c646 |
routine from the C<Log::Agent> package, if it is available.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Normal errors are reported by having store() or retrieve() return C<undef>.
|
|
Packit |
14c646 |
Such errors are usually I/O errors (or truncated stream errors at retrieval).
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
When Storable throws the "Max. recursion depth with nested structures
|
|
Packit |
14c646 |
exceeded" error we are already out of stack space. Unfortunately on
|
|
Packit |
14c646 |
some earlier perl versions cleaning up a recursive data structure
|
|
Packit |
14c646 |
recurses into the free calls, which will lead to stack overflows in
|
|
Packit |
14c646 |
the cleanup. This data structure is not properly cleaned up then, it
|
|
Packit |
14c646 |
will only be destroyed during global destruction.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 WIZARDS ONLY
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head2 Hooks
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Any class may define hooks that will be called during the serialization
|
|
Packit |
14c646 |
and deserialization process on objects that are instances of that class.
|
|
Packit |
14c646 |
Those hooks can redefine the way serialization is performed (and therefore,
|
|
Packit |
14c646 |
how the symmetrical deserialization should be conducted).
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Since we said earlier:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
dclone(.) = thaw(freeze(.))
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
everything we say about hooks should also hold for deep cloning. However,
|
|
Packit |
14c646 |
hooks get to know whether the operation is a mere serialization, or a cloning.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Therefore, when serializing hooks are involved,
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
dclone(.) <> thaw(freeze(.))
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Well, you could keep them in sync, but there's no guarantee it will always
|
|
Packit |
14c646 |
hold on classes somebody else wrote. Besides, there is little to gain in
|
|
Packit |
14c646 |
doing so: a serializing hook could keep only one attribute of an object,
|
|
Packit |
14c646 |
which is probably not what should happen during a deep cloning of that
|
|
Packit |
14c646 |
same object.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Here is the hooking interface:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over 4
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<STORABLE_freeze> I<obj>, I<cloning>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The serializing hook, called on the object during serialization. It can be
|
|
Packit |
14c646 |
inherited, or defined in the class itself, like any other method.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Arguments: I<obj> is the object to serialize, I<cloning> is a flag indicating
|
|
Packit |
14c646 |
whether we're in a dclone() or a regular serialization via store() or freeze().
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Returned value: A LIST C<($serialized, $ref1, $ref2, ...)> where $serialized
|
|
Packit |
14c646 |
is the serialized form to be used, and the optional $ref1, $ref2, etc... are
|
|
Packit |
14c646 |
extra references that you wish to let the Storable engine serialize.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
At deserialization time, you will be given back the same LIST, but all the
|
|
Packit |
14c646 |
extra references will be pointing into the deserialized structure.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The B<first time> the hook is hit in a serialization flow, you may have it
|
|
Packit |
14c646 |
return an empty list. That will signal the Storable engine to further
|
|
Packit |
14c646 |
discard that hook for this class and to therefore revert to the default
|
|
Packit |
14c646 |
serialization of the underlying Perl data. The hook will again be normally
|
|
Packit |
14c646 |
processed in the next serialization.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Unless you know better, serializing hook should always say:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
sub STORABLE_freeze {
|
|
Packit |
14c646 |
my ($self, $cloning) = @_;
|
|
Packit |
14c646 |
return if $cloning; # Regular default serialization
|
|
Packit |
14c646 |
....
|
|
Packit |
14c646 |
}
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
in order to keep reasonable dclone() semantics.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<STORABLE_thaw> I<obj>, I<cloning>, I<serialized>, ...
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The deserializing hook called on the object during deserialization.
|
|
Packit |
14c646 |
But wait: if we're deserializing, there's no object yet... right?
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Wrong: the Storable engine creates an empty one for you. If you know Eiffel,
|
|
Packit |
14c646 |
you can view C<STORABLE_thaw> as an alternate creation routine.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This means the hook can be inherited like any other method, and that
|
|
Packit |
14c646 |
I<obj> is your blessed reference for this particular instance.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The other arguments should look familiar if you know C<STORABLE_freeze>:
|
|
Packit |
14c646 |
I<cloning> is true when we're part of a deep clone operation, I<serialized>
|
|
Packit |
14c646 |
is the serialized string you returned to the engine in C<STORABLE_freeze>,
|
|
Packit |
14c646 |
and there may be an optional list of references, in the same order you gave
|
|
Packit |
14c646 |
them at serialization time, pointing to the deserialized objects (which
|
|
Packit |
14c646 |
have been processed courtesy of the Storable engine).
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
When the Storable engine does not find any C<STORABLE_thaw> hook routine,
|
|
Packit |
14c646 |
it tries to load the class by requiring the package dynamically (using
|
|
Packit |
14c646 |
the blessed package name), and then re-attempts the lookup. If at that
|
|
Packit |
14c646 |
time the hook cannot be located, the engine croaks. Note that this mechanism
|
|
Packit |
14c646 |
will fail if you define several classes in the same file, but L<perlmod>
|
|
Packit |
14c646 |
warned you.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
It is up to you to use this information to populate I<obj> the way you want.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Returned value: none.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<STORABLE_attach> I<class>, I<cloning>, I<serialized>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
While C<STORABLE_freeze> and C<STORABLE_thaw> are useful for classes where
|
|
Packit |
14c646 |
each instance is independent, this mechanism has difficulty (or is
|
|
Packit |
14c646 |
incompatible) with objects that exist as common process-level or
|
|
Packit |
14c646 |
system-level resources, such as singleton objects, database pools, caches
|
|
Packit |
14c646 |
or memoized objects.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The alternative C<STORABLE_attach> method provides a solution for these
|
|
Packit |
14c646 |
shared objects. Instead of C<STORABLE_freeze> --E<gt> C<STORABLE_thaw>,
|
|
Packit |
14c646 |
you implement C<STORABLE_freeze> --E<gt> C<STORABLE_attach> instead.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Arguments: I<class> is the class we are attaching to, I<cloning> is a flag
|
|
Packit |
14c646 |
indicating whether we're in a dclone() or a regular de-serialization via
|
|
Packit |
14c646 |
thaw(), and I<serialized> is the stored string for the resource object.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Because these resource objects are considered to be owned by the entire
|
|
Packit |
14c646 |
process/system, and not the "property" of whatever is being serialized,
|
|
Packit |
14c646 |
no references underneath the object should be included in the serialized
|
|
Packit |
14c646 |
string. Thus, in any class that implements C<STORABLE_attach>, the
|
|
Packit |
14c646 |
C<STORABLE_freeze> method cannot return any references, and C<Storable>
|
|
Packit |
14c646 |
will throw an error if C<STORABLE_freeze> tries to return references.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
All information required to "attach" back to the shared resource object
|
|
Packit |
14c646 |
B<must> be contained B<only> in the C<STORABLE_freeze> return string.
|
|
Packit |
14c646 |
Otherwise, C<STORABLE_freeze> behaves as normal for C<STORABLE_attach>
|
|
Packit |
14c646 |
classes.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Because C<STORABLE_attach> is passed the class (rather than an object),
|
|
Packit |
14c646 |
it also returns the object directly, rather than modifying the passed
|
|
Packit |
14c646 |
object.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Returned value: object of type C<class>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head2 Predicates
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Predicates are not exportable. They must be called by explicitly prefixing
|
|
Packit |
14c646 |
them with the Storable package name.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over 4
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<Storable::last_op_in_netorder>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The C<Storable::last_op_in_netorder()> predicate will tell you whether
|
|
Packit |
14c646 |
network order was used in the last store or retrieve operation. If you
|
|
Packit |
14c646 |
don't know how to use this, just forget about it.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<Storable::is_storing>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Returns true if within a store operation (via STORABLE_freeze hook).
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<Storable::is_retrieving>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Returns true if within a retrieve operation (via STORABLE_thaw hook).
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head2 Recursion
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
With hooks comes the ability to recurse back to the Storable engine.
|
|
Packit |
14c646 |
Indeed, hooks are regular Perl code, and Storable is convenient when
|
|
Packit |
14c646 |
it comes to serializing and deserializing things, so why not use it
|
|
Packit |
14c646 |
to handle the serialization string?
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
There are a few things you need to know, however:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over 4
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Since Storable 3.05 we probe for the stack recursion limit for references,
|
|
Packit |
14c646 |
arrays and hashes to a maximal depth of ~1200-35000, otherwise we might
|
|
Packit |
14c646 |
fall into a stack-overflow. On JSON::XS this limit is 512 btw. With
|
|
Packit |
14c646 |
references not immediately referencing each other there's no such
|
|
Packit |
14c646 |
limit yet, so you might fall into such a stack-overflow segfault.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This probing and the checks performed have some limitations:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
the stack size at build time might be different at run time, eg. the
|
|
Packit |
14c646 |
stack size may have been modified with ulimit(1). If it's larger at
|
|
Packit |
14c646 |
run time Storable may fail the freeze() or thaw() unnecessarily.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
the stack size might be different in a thread.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
array and hash recursion limits are checked separately against the
|
|
Packit |
14c646 |
same recursion depth, a frozen structure with a large sequence of
|
|
Packit |
14c646 |
nested arrays within many nested hashes may exhaust the processor
|
|
Packit |
14c646 |
stack without triggering Storable's recursion protection.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
You can control the maximum array and hash recursion depths by
|
|
Packit |
14c646 |
modifying C<$Storable::recursion_limit> and
|
|
Packit |
14c646 |
C<$Storable::recursion_limit_hash> respectively. Either can be set to
|
|
Packit |
14c646 |
C<-1> to prevent any depth checks, though this isn't recommended.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
You can create endless loops if the things you serialize via freeze()
|
|
Packit |
14c646 |
(for instance) point back to the object we're trying to serialize in
|
|
Packit |
14c646 |
the hook.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Shared references among objects will not stay shared: if we're serializing
|
|
Packit |
14c646 |
the list of object [A, C] where both object A and C refer to the SAME object
|
|
Packit |
14c646 |
B, and if there is a serializing hook in A that says freeze(B), then when
|
|
Packit |
14c646 |
deserializing, we'll get [A', C'] where A' refers to B', but C' refers to D,
|
|
Packit |
14c646 |
a deep clone of B'. The topology was not preserved.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The maximal stack recursion limit for your system is returned by
|
|
Packit |
14c646 |
C<stack_depth()> and C<stack_depth_hash()>. The hash limit is usually
|
|
Packit |
14c646 |
half the size of the array and ref limit, as the Perl hash API is not optimal.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
That's why C<STORABLE_freeze> lets you provide a list of references
|
|
Packit |
14c646 |
to serialize. The engine guarantees that those will be serialized in the
|
|
Packit |
14c646 |
same context as the other objects, and therefore that shared objects will
|
|
Packit |
14c646 |
stay shared.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
In the above [A, C] example, the C<STORABLE_freeze> hook could return:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
("something", $self->{B})
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
and the B part would be serialized by the engine. In C<STORABLE_thaw>, you
|
|
Packit |
14c646 |
would get back the reference to the B' object, deserialized for you.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Therefore, recursion should normally be avoided, but is nonetheless supported.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head2 Deep Cloning
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
There is a Clone module available on CPAN which implements deep cloning
|
|
Packit |
14c646 |
natively, i.e. without freezing to memory and thawing the result. It is
|
|
Packit |
14c646 |
aimed to replace Storable's dclone() some day. However, it does not currently
|
|
Packit |
14c646 |
support Storable hooks to redefine the way deep cloning is performed.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 Storable magic
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Yes, there's a lot of that :-) But more precisely, in UNIX systems
|
|
Packit |
14c646 |
there's a utility called C<file>, which recognizes data files based on
|
|
Packit |
14c646 |
their contents (usually their first few bytes). For this to work,
|
|
Packit |
14c646 |
a certain file called F<magic> needs to taught about the I<signature>
|
|
Packit |
14c646 |
of the data. Where that configuration file lives depends on the UNIX
|
|
Packit |
14c646 |
flavour; often it's something like F</usr/share/misc/magic> or
|
|
Packit |
14c646 |
F</etc/magic>. Your system administrator needs to do the updating of
|
|
Packit |
14c646 |
the F<magic> file. The necessary signature information is output to
|
|
Packit |
14c646 |
STDOUT by invoking Storable::show_file_magic(). Note that the GNU
|
|
Packit |
14c646 |
implementation of the C<file> utility, version 3.38 or later,
|
|
Packit |
14c646 |
is expected to contain support for recognising Storable files
|
|
Packit |
14c646 |
out-of-the-box, in addition to other kinds of Perl files.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
You can also use the following functions to extract the file header
|
|
Packit |
14c646 |
information from Storable images:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item $info = Storable::file_magic( $filename )
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
If the given file is a Storable image return a hash describing it. If
|
|
Packit |
14c646 |
the file is readable, but not a Storable image return C<undef>. If
|
|
Packit |
14c646 |
the file does not exist or is unreadable then croak.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The hash returned has the following elements:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<version>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This returns the file format version. It is a string like "2.7".
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Note that this version number is not the same as the version number of
|
|
Packit |
14c646 |
the Storable module itself. For instance Storable v0.7 create files
|
|
Packit |
14c646 |
in format v2.0 and Storable v2.15 create files in format v2.7. The
|
|
Packit |
14c646 |
file format version number only increment when additional features
|
|
Packit |
14c646 |
that would confuse older versions of the module are added.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Files older than v2.0 will have the one of the version numbers "-1",
|
|
Packit |
14c646 |
"0" or "1". No minor number was used at that time.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<version_nv>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This returns the file format version as number. It is a string like
|
|
Packit |
14c646 |
"2.007". This value is suitable for numeric comparisons.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The constant function C<Storable::BIN_VERSION_NV> returns a comparable
|
|
Packit |
14c646 |
number that represents the highest file version number that this
|
|
Packit |
14c646 |
version of Storable fully supports (but see discussion of
|
|
Packit |
14c646 |
C<$Storable::accept_future_minor> above). The constant
|
|
Packit |
14c646 |
C<Storable::BIN_WRITE_VERSION_NV> function returns what file version
|
|
Packit |
14c646 |
is written and might be less than C<Storable::BIN_VERSION_NV> in some
|
|
Packit |
14c646 |
configurations.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<major>, C<minor>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This also returns the file format version. If the version is "2.7"
|
|
Packit |
14c646 |
then major would be 2 and minor would be 7. The minor element is
|
|
Packit |
14c646 |
missing for when major is less than 2.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<hdrsize>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The is the number of bytes that the Storable header occupies.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<netorder>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This is TRUE if the image store data in network order. This means
|
|
Packit |
14c646 |
that it was created with nstore() or similar.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<byteorder>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This is only present when C<netorder> is FALSE. It is the
|
|
Packit |
14c646 |
$Config{byteorder} string of the perl that created this image. It is
|
|
Packit |
14c646 |
a string like "1234" (32 bit little endian) or "87654321" (64 bit big
|
|
Packit |
14c646 |
endian). This must match the current perl for the image to be
|
|
Packit |
14c646 |
readable by Storable.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<intsize>, C<longsize>, C<ptrsize>, C<nvsize>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
These are only present when C<netorder> is FALSE. These are the sizes of
|
|
Packit |
14c646 |
various C datatypes of the perl that created this image. These must
|
|
Packit |
14c646 |
match the current perl for the image to be readable by Storable.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The C<nvsize> element is only present for file format v2.2 and
|
|
Packit |
14c646 |
higher.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item C<file>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The name of the file.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item $info = Storable::read_magic( $buffer )
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item $info = Storable::read_magic( $buffer, $must_be_file )
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The $buffer should be a Storable image or the first few bytes of it.
|
|
Packit |
14c646 |
If $buffer starts with a Storable header, then a hash describing the
|
|
Packit |
14c646 |
image is returned, otherwise C<undef> is returned.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The hash has the same structure as the one returned by
|
|
Packit |
14c646 |
Storable::file_magic(). The C<file> element is true if the image is a
|
|
Packit |
14c646 |
file image.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
If the $must_be_file argument is provided and is TRUE, then return
|
|
Packit |
14c646 |
C<undef> unless the image looks like it belongs to a file dump.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The maximum size of a Storable header is currently 21 bytes. If the
|
|
Packit |
14c646 |
provided $buffer is only the first part of a Storable image it should
|
|
Packit |
14c646 |
at least be this long to ensure that read_magic() will recognize it as
|
|
Packit |
14c646 |
such.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 EXAMPLES
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Here are some code samples showing a possible usage of Storable:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
use Storable qw(store retrieve freeze thaw dclone);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
%color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$colref = retrieve('mycolors');
|
|
Packit |
14c646 |
die "Unable to retrieve from mycolors!\n" unless defined $colref;
|
|
Packit |
14c646 |
printf "Blue is still %lf\n", $colref->{'Blue'};
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$colref2 = dclone(\%color);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
$str = freeze(\%color);
|
|
Packit |
14c646 |
printf "Serialization of %%color is %d bytes long.\n", length($str);
|
|
Packit |
14c646 |
$colref3 = thaw($str);
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
which prints (on my machine):
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Blue is still 0.100000
|
|
Packit |
14c646 |
Serialization of %color is 102 bytes long.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Serialization of CODE references and deserialization in a safe
|
|
Packit |
14c646 |
compartment:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=for example begin
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
use Storable qw(freeze thaw);
|
|
Packit |
14c646 |
use Safe;
|
|
Packit |
14c646 |
use strict;
|
|
Packit |
14c646 |
my $safe = new Safe;
|
|
Packit |
14c646 |
# because of opcodes used in "use strict":
|
|
Packit |
14c646 |
$safe->permit(qw(:default require));
|
|
Packit |
14c646 |
local $Storable::Deparse = 1;
|
|
Packit |
14c646 |
local $Storable::Eval = sub { $safe->reval($_[0]) };
|
|
Packit |
14c646 |
my $serialized = freeze(sub { 42 });
|
|
Packit |
14c646 |
my $code = thaw($serialized);
|
|
Packit |
14c646 |
$code->() == 42;
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=for example end
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=for example_testing
|
|
Packit |
14c646 |
is( $code->(), 42 );
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 SECURITY WARNING
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
B<Do not accept Storable documents from untrusted sources!>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Some features of Storable can lead to security vulnerabilities if you
|
|
Packit |
14c646 |
accept Storable documents from untrusted sources with the default
|
|
Packit |
14c646 |
flags. Most obviously, the optional (off by default) CODE reference
|
|
Packit |
14c646 |
serialization feature allows transfer of code to the deserializing
|
|
Packit |
14c646 |
process. Furthermore, any serialized object will cause Storable to
|
|
Packit |
14c646 |
helpfully load the module corresponding to the class of the object in
|
|
Packit |
14c646 |
the deserializing module. For manipulated module names, this can load
|
|
Packit |
14c646 |
almost arbitrary code. Finally, the deserialized object's destructors
|
|
Packit |
14c646 |
will be invoked when the objects get destroyed in the deserializing
|
|
Packit |
14c646 |
process. Maliciously crafted Storable documents may put such objects
|
|
Packit |
14c646 |
in the value of a hash key that is overridden by another key/value
|
|
Packit |
14c646 |
pair in the same hash, thus causing immediate destructor execution.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
To disable blessing objects while thawing/retrieving remove the flag
|
|
Packit |
14c646 |
C<BLESS_OK> = 2 from C<$Storable::flags> or set the 2nd argument for
|
|
Packit |
14c646 |
thaw/retrieve to 0.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
To disable tieing data while thawing/retrieving remove the flag C<TIE_OK>
|
|
Packit |
14c646 |
= 4 from C<$Storable::flags> or set the 2nd argument for thaw/retrieve
|
|
Packit |
14c646 |
to 0.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
With the default setting of C<$Storable::flags> = 6, creating or destroying
|
|
Packit |
14c646 |
random objects, even renamed objects can be controlled by an attacker.
|
|
Packit |
14c646 |
See CVE-2015-1592 and its metasploit module.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
If your application requires accepting data from untrusted sources,
|
|
Packit |
14c646 |
you are best off with a less powerful and more-likely safe
|
|
Packit |
14c646 |
serialization format and implementation. If your data is sufficiently
|
|
Packit |
14c646 |
simple, Cpanel::JSON::XS, Data::MessagePack or Serial are the best
|
|
Packit |
14c646 |
choices and offers maximum interoperability, but note that Serial is
|
|
Packit |
14c646 |
unsafe by default.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 WARNING
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
If you're using references as keys within your hash tables, you're bound
|
|
Packit |
14c646 |
to be disappointed when retrieving your data. Indeed, Perl stringifies
|
|
Packit |
14c646 |
references used as hash table keys. If you later wish to access the
|
|
Packit |
14c646 |
items via another reference stringification (i.e. using the same
|
|
Packit |
14c646 |
reference that was used for the key originally to record the value into
|
|
Packit |
14c646 |
the hash table), it will work because both references stringify to the
|
|
Packit |
14c646 |
same string.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
It won't work across a sequence of C<store> and C<retrieve> operations,
|
|
Packit |
14c646 |
however, because the addresses in the retrieved objects, which are
|
|
Packit |
14c646 |
part of the stringified references, will probably differ from the
|
|
Packit |
14c646 |
original addresses. The topology of your structure is preserved,
|
|
Packit |
14c646 |
but not hidden semantics like those.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
On platforms where it matters, be sure to call C<binmode()> on the
|
|
Packit |
14c646 |
descriptors that you pass to Storable functions.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storing data canonically that contains large hashes can be
|
|
Packit |
14c646 |
significantly slower than storing the same data normally, as
|
|
Packit |
14c646 |
temporary arrays to hold the keys for each hash have to be allocated,
|
|
Packit |
14c646 |
populated, sorted and freed. Some tests have shown a halving of the
|
|
Packit |
14c646 |
speed of storing -- the exact penalty will depend on the complexity of
|
|
Packit |
14c646 |
your data. There is no slowdown on retrieval.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 REGULAR EXPRESSIONS
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable now has experimental support for storing regular expressions,
|
|
Packit |
14c646 |
but there are significant limitations:
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=over
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
perl 5.8 or later is required.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
regular expressions with code blocks, ie C</(?{ ... })/> or C</(??{
|
|
Packit |
14c646 |
... })/> will throw an exception when thawed.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
regular expression syntax and flags have changed over the history of
|
|
Packit |
14c646 |
perl, so a regular expression that you freeze in one version of perl
|
|
Packit |
14c646 |
may fail to thaw or behave differently in another version of perl.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=item *
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
depending on the version of perl, regular expressions can change in
|
|
Packit |
14c646 |
behaviour depending on the context, but later perls will bake that
|
|
Packit |
14c646 |
behaviour into the regexp.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=back
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable will throw an exception if a frozen regular expression cannot
|
|
Packit |
14c646 |
be thawed.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 BUGS
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
You can't store GLOB, FORMLINE, etc.... If you can define semantics
|
|
Packit |
14c646 |
for those operations, feel free to enhance Storable so that it can
|
|
Packit |
14c646 |
deal with them.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
The store functions will C<croak> if they run into such references
|
|
Packit |
14c646 |
unless you set C<$Storable::forgive_me> to some C<TRUE> value. In that
|
|
Packit |
14c646 |
case, the fatal message is converted to a warning and some meaningless
|
|
Packit |
14c646 |
string is stored instead.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Setting C<$Storable::canonical> may not yield frozen strings that
|
|
Packit |
14c646 |
compare equal due to possible stringification of numbers. When the
|
|
Packit |
14c646 |
string version of a scalar exists, it is the form stored; therefore,
|
|
Packit |
14c646 |
if you happen to use your numbers as strings between two freezing
|
|
Packit |
14c646 |
operations on the same data structures, you will get different
|
|
Packit |
14c646 |
results.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
When storing doubles in network order, their value is stored as text.
|
|
Packit |
14c646 |
However, you should also not expect non-numeric floating-point values
|
|
Packit |
14c646 |
such as infinity and "not a number" to pass successfully through a
|
|
Packit |
14c646 |
nstore()/retrieve() pair.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
As Storable neither knows nor cares about character sets (although it
|
|
Packit |
14c646 |
does know that characters may be more than eight bits wide), any difference
|
|
Packit |
14c646 |
in the interpretation of character codes between a host and a target
|
|
Packit |
14c646 |
system is your problem. In particular, if host and target use different
|
|
Packit |
14c646 |
code points to represent the characters used in the text representation
|
|
Packit |
14c646 |
of floating-point numbers, you will not be able be able to exchange
|
|
Packit |
14c646 |
floating-point data, even with nstore().
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
C<Storable::drop_utf8> is a blunt tool. There is no facility either to
|
|
Packit |
14c646 |
return B<all> strings as utf8 sequences, or to attempt to convert utf8
|
|
Packit |
14c646 |
data back to 8 bit and C<croak()> if the conversion fails.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Prior to Storable 2.01, no distinction was made between signed and
|
|
Packit |
14c646 |
unsigned integers on storing. By default Storable prefers to store a
|
|
Packit |
14c646 |
scalars string representation (if it has one) so this would only cause
|
|
Packit |
14c646 |
problems when storing large unsigned integers that had never been converted
|
|
Packit |
14c646 |
to string or floating point. In other words values that had been generated
|
|
Packit |
14c646 |
by integer operations such as logic ops and then not used in any string or
|
|
Packit |
14c646 |
arithmetic context before storing.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head2 64 bit data in perl 5.6.0 and 5.6.1
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
This section only applies to you if you have existing data written out
|
|
Packit |
14c646 |
by Storable 2.02 or earlier on perl 5.6.0 or 5.6.1 on Unix or Linux which
|
|
Packit |
14c646 |
has been configured with 64 bit integer support (not the default)
|
|
Packit |
14c646 |
If you got a precompiled perl, rather than running Configure to build
|
|
Packit |
14c646 |
your own perl from source, then it almost certainly does not affect you,
|
|
Packit |
14c646 |
and you can stop reading now (unless you're curious). If you're using perl
|
|
Packit |
14c646 |
on Windows it does not affect you.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable writes a file header which contains the sizes of various C
|
|
Packit |
14c646 |
language types for the C compiler that built Storable (when not writing in
|
|
Packit |
14c646 |
network order), and will refuse to load files written by a Storable not
|
|
Packit |
14c646 |
on the same (or compatible) architecture. This check and a check on
|
|
Packit |
14c646 |
machine byteorder is needed because the size of various fields in the file
|
|
Packit |
14c646 |
are given by the sizes of the C language types, and so files written on
|
|
Packit |
14c646 |
different architectures are incompatible. This is done for increased speed.
|
|
Packit |
14c646 |
(When writing in network order, all fields are written out as standard
|
|
Packit |
14c646 |
lengths, which allows full interworking, but takes longer to read and write)
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Perl 5.6.x introduced the ability to optional configure the perl interpreter
|
|
Packit |
14c646 |
to use C's C<long long> type to allow scalars to store 64 bit integers on 32
|
|
Packit |
14c646 |
bit systems. However, due to the way the Perl configuration system
|
|
Packit |
14c646 |
generated the C configuration files on non-Windows platforms, and the way
|
|
Packit |
14c646 |
Storable generates its header, nothing in the Storable file header reflected
|
|
Packit |
14c646 |
whether the perl writing was using 32 or 64 bit integers, despite the fact
|
|
Packit |
14c646 |
that Storable was storing some data differently in the file. Hence Storable
|
|
Packit |
14c646 |
running on perl with 64 bit integers will read the header from a file
|
|
Packit |
14c646 |
written by a 32 bit perl, not realise that the data is actually in a subtly
|
|
Packit |
14c646 |
incompatible format, and then go horribly wrong (possibly crashing) if it
|
|
Packit |
14c646 |
encountered a stored integer. This is a design failure.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable has now been changed to write out and read in a file header with
|
|
Packit |
14c646 |
information about the size of integers. It's impossible to detect whether
|
|
Packit |
14c646 |
an old file being read in was written with 32 or 64 bit integers (they have
|
|
Packit |
14c646 |
the same header) so it's impossible to automatically switch to a correct
|
|
Packit |
14c646 |
backwards compatibility mode. Hence this Storable defaults to the new,
|
|
Packit |
14c646 |
correct behaviour.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
What this means is that if you have data written by Storable 1.x running
|
|
Packit |
14c646 |
on perl 5.6.0 or 5.6.1 configured with 64 bit integers on Unix or Linux
|
|
Packit |
14c646 |
then by default this Storable will refuse to read it, giving the error
|
|
Packit |
14c646 |
I<Byte order is not compatible>. If you have such data then you
|
|
Packit |
14c646 |
should set C<$Storable::interwork_56_64bit> to a true value to make this
|
|
Packit |
14c646 |
Storable read and write files with the old header. You should also
|
|
Packit |
14c646 |
migrate your data, or any older perl you are communicating with, to this
|
|
Packit |
14c646 |
current version of Storable.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
If you don't have data written with specific configuration of perl described
|
|
Packit |
14c646 |
above, then you do not and should not do anything. Don't set the flag -
|
|
Packit |
14c646 |
not only will Storable on an identically configured perl refuse to load them,
|
|
Packit |
14c646 |
but Storable a differently configured perl will load them believing them
|
|
Packit |
14c646 |
to be correct for it, and then may well fail or crash part way through
|
|
Packit |
14c646 |
reading them.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 CREDITS
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Thank you to (in chronological order):
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Jarkko Hietaniemi <jhi@iki.fi>
|
|
Packit |
14c646 |
Ulrich Pfeifer <pfeifer@charly.informatik.uni-dortmund.de>
|
|
Packit |
14c646 |
Benjamin A. Holzman <bholzman@earthlink.net>
|
|
Packit |
14c646 |
Andrew Ford <A.Ford@ford-mason.co.uk>
|
|
Packit |
14c646 |
Gisle Aas <gisle@aas.no>
|
|
Packit |
14c646 |
Jeff Gresham <gresham_jeffrey@jpmorgan.com>
|
|
Packit |
14c646 |
Murray Nesbitt <murray@activestate.com>
|
|
Packit |
14c646 |
Marc Lehmann <pcg@opengroup.org>
|
|
Packit |
14c646 |
Justin Banks <justinb@wamnet.com>
|
|
Packit |
14c646 |
Jarkko Hietaniemi <jhi@iki.fi> (AGAIN, as perl 5.7.0 Pumpkin!)
|
|
Packit |
14c646 |
Salvador Ortiz Garcia <sog@msg.com.mx>
|
|
Packit |
14c646 |
Dominic Dunlop <domo@computer.org>
|
|
Packit |
14c646 |
Erik Haugan <erik@solbors.no>
|
|
Packit |
14c646 |
Benjamin A. Holzman <ben.holzman@grantstreet.com>
|
|
Packit |
14c646 |
Reini Urban <rurban@cpan.org>
|
|
Packit |
14c646 |
Todd Rinaldo <toddr@cpanel.net>
|
|
Packit |
14c646 |
Aaron Crane <arc@cpan.org>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
for their bug reports, suggestions and contributions.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Benjamin Holzman contributed the tied variable support, Andrew Ford
|
|
Packit |
14c646 |
contributed the canonical order for hashes, and Gisle Aas fixed
|
|
Packit |
14c646 |
a few misunderstandings of mine regarding the perl internals,
|
|
Packit |
14c646 |
and optimized the emission of "tags" in the output streams by
|
|
Packit |
14c646 |
simply counting the objects instead of tagging them (leading to
|
|
Packit |
14c646 |
a binary incompatibility for the Storable image starting at version
|
|
Packit |
14c646 |
0.6--older images are, of course, still properly understood).
|
|
Packit |
14c646 |
Murray Nesbitt made Storable thread-safe. Marc Lehmann added overloading
|
|
Packit |
14c646 |
and references to tied items support. Benjamin Holzman added a performance
|
|
Packit |
14c646 |
improvement for overloaded classes; thanks to Grant Street Group for footing
|
|
Packit |
14c646 |
the bill.
|
|
Packit |
14c646 |
Reini Urban took over maintainance from p5p, and added security fixes
|
|
Packit |
14c646 |
and huge object support.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 AUTHOR
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Storable was written by Raphael Manfredi
|
|
Packit |
14c646 |
F<E<lt>Raphael_Manfredi@pobox.comE<gt>>
|
|
Packit |
14c646 |
Maintenance is now done by cperl L<http://perl11.org/cperl>
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
Please e-mail us with problems, bug fixes, comments and complaints,
|
|
Packit |
14c646 |
although if you have compliments you should send them to Raphael.
|
|
Packit |
14c646 |
Please don't e-mail Raphael with problems, as he no longer works on
|
|
Packit |
14c646 |
Storable, and your message will be delayed while he forwards it to us.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=head1 SEE ALSO
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
L<Clone>.
|
|
Packit |
14c646 |
|
|
Packit |
14c646 |
=cut
|