X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FStorable%2FStorable.pm;h=dd02fe64fe120c6fce805612f4494a0915f085d9;hb=2018a5c31a07546d28320839d66a2fd3f203fa85;hp=50fc105ad92f28a5a9c15d41cdd3fdb9487839e2;hpb=a453040451be73589741d2ad8853174873ef7060;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm index 50fc105..dd02fe6 100644 --- a/ext/Storable/Storable.pm +++ b/ext/Storable/Storable.pm @@ -1,58 +1,9 @@ -;# $Id: Storable.pm,v 1.0.1.13 2001/12/01 13:34:49 ram Exp $ -;# -;# Copyright (c) 1995-2000, Raphael Manfredi -;# -;# You may redistribute only under the same terms as Perl 5, as specified -;# in the README file that comes with the distribution. -;# -;# $Log: Storable.pm,v $ -;# Revision 1.0.1.13 2001/12/01 13:34:49 ram -;# patch14: avoid requiring Fcntl upfront, useful to embedded runtimes -;# patch14: store_fd() will now correctly autoflush file if needed -;# -;# Revision 1.0.1.12 2001/08/28 21:51:51 ram -;# patch13: fixed truncation race with lock_retrieve() in lock_store() -;# -;# Revision 1.0.1.11 2001/07/01 11:22:14 ram -;# patch12: systematically use "=over 4" for POD linters -;# patch12: updated version number -;# -;# Revision 1.0.1.10 2001/03/15 00:20:25 ram -;# patch11: updated version number -;# -;# Revision 1.0.1.9 2001/02/17 12:37:32 ram -;# patch10: forgot to increase version number at previous patch -;# -;# Revision 1.0.1.8 2001/02/17 12:24:37 ram -;# patch8: fixed incorrect error message -;# -;# Revision 1.0.1.7 2001/01/03 09:39:02 ram -;# patch7: added CAN_FLOCK to determine whether we can flock() or not -;# -;# Revision 1.0.1.6 2000/11/05 17:20:25 ram -;# patch6: increased version number -;# -;# Revision 1.0.1.5 2000/10/26 17:10:18 ram -;# patch5: documented that store() and retrieve() can return undef -;# patch5: added paragraph explaining the auto require for thaw hooks -;# -;# Revision 1.0.1.4 2000/10/23 18:02:57 ram -;# patch4: protected calls to flock() for dos platform -;# patch4: added logcarp emulation if they don't have Log::Agent -;# -;# Revision 1.0.1.3 2000/09/29 19:49:01 ram -;# patch3: updated version number -;# -;# Revision 1.0.1.2 2000/09/28 21:42:51 ram -;# patch2: added lock_store lock_nstore lock_retrieve -;# -;# Revision 1.0.1.1 2000/09/17 16:46:21 ram -;# patch1: documented that doubles are stringified by nstore() -;# patch1: added Salvador Ortiz Garcia in CREDITS section -;# -;# Revision 1.0 2000/09/01 19:40:41 ram -;# Baseline for first official release. -;# +# +# Copyright (c) 1995-2000, Raphael Manfredi +# +# You may redistribute only under the same terms as Perl 5, as specified +# in the README file that comes with the distribution. +# require DynaLoader; require Exporter; @@ -65,19 +16,23 @@ package Storable; @ISA = qw(Exporter DynaLoader); dclone retrieve_fd lock_store lock_nstore lock_retrieve + file_magic read_magic ); use AutoLoader; -use vars qw($forgive_me $VERSION); +use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.00'; +$VERSION = '2.15_02'; *AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr... # # Use of Log::Agent is optional # -eval "use Log::Agent"; +{ + local $SIG{__DIE__}; + eval "use Log::Agent"; +} require Carp; @@ -96,6 +51,11 @@ BEGIN { } } +sub CLONE { + # clone context under threads + Storable::init_perinterp(); +} + # Can't Autoload cleanly as this clashes 8.3 with &retrieve sub retrieve_fd { &fd_retrieve } # Backward compatibility @@ -154,39 +114,85 @@ sub show_file_magic { EOM } +sub file_magic { + my $file = shift; + open(my $fh, "<", $file) || die "Can't open '$file': $!"; + binmode($fh); + defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!"; + close($fh); + + $file = "./$file" unless $file; # ensure TRUE value + + return read_magic($buf, $file); +} + sub read_magic { - my $header = shift; - return unless defined $header and length $header > 11; - my $result; - if ($header =~ s/^perl-store//) { - die "Can't deal with version 0 headers"; - } elsif ($header =~ s/^pst0//) { - $result->{file} = 1; - } - # Assume it's a string. - my ($major, $minor, $bytelen) = unpack "C3", $header; - - my $net_order = $major & 1; - $major >>= 1; - @$result{qw(major minor netorder)} = ($major, $minor, $net_order); - - return $result if $net_order; - - # I assume that it is rare to find v1 files, so this is an intentionally - # inefficient way of doing it, to make the rest of the code constant. - if ($major < 2) { - delete $result->{minor}; - $header = '.' . $header; - $bytelen = $minor; - } - - @$result{qw(byteorder intsize longsize ptrsize)} = - unpack "x3 A$bytelen C3", $header; - - if ($major >= 2 and $minor >= 2) { - $result->{nvsize} = unpack "x6 x$bytelen C", $header; - } - $result; + my($buf, $file) = @_; + my %info; + + my $buflen = length($buf); + my $magic; + if ($buf =~ s/^(pst0|perl-store)//) { + $magic = $1; + $info{file} = $file || 1; + } + else { + return undef if $file; + $magic = ""; + } + + return undef unless length($buf); + + my $net_order; + if ($magic eq "perl-store" && ord(substr($buf, 0, 1)) > 1) { + $info{version} = -1; + $net_order = 0; + } + else { + $net_order = ord(substr($buf, 0, 1, "")); + my $major = $net_order >> 1; + return undef if $major > 4; # sanity (assuming we never go that high) + $info{major} = $major; + $net_order &= 0x01; + if ($major > 1) { + return undef unless length($buf); + my $minor = ord(substr($buf, 0, 1, "")); + $info{minor} = $minor; + $info{version} = "$major.$minor"; + $info{version_nv} = sprintf "%d.%03d", $major, $minor; + } + else { + $info{version} = $major; + } + } + $info{version_nv} ||= $info{version}; + $info{netorder} = $net_order; + + unless ($net_order) { + return undef unless length($buf); + my $len = ord(substr($buf, 0, 1, "")); + return undef unless length($buf) >= $len; + return undef unless $len == 4 || $len == 8; # sanity + $info{byteorder} = substr($buf, 0, $len, ""); + $info{intsize} = ord(substr($buf, 0, 1, "")); + $info{longsize} = ord(substr($buf, 0, 1, "")); + $info{ptrsize} = ord(substr($buf, 0, 1, "")); + if ($info{version_nv} >= 2.002) { + return undef unless length($buf); + $info{nvsize} = ord(substr($buf, 0, 1, "")); + } + } + $info{hdrsize} = $buflen - length($buf); + + return \%info; +} + +sub BIN_VERSION_NV { + sprintf "%d.%03d", BIN_MAJOR(), BIN_MINOR(); +} + +sub BIN_WRITE_VERSION_NV { + sprintf "%d.%03d", BIN_MAJOR(), BIN_WRITE_MINOR(); } # @@ -410,6 +416,9 @@ sub thaw { return $self; } +1; +__END__ + =head1 NAME Storable - persistence for Perl data structures @@ -558,6 +567,22 @@ creating lookup tables for complicated queries. Canonical order does not imply network order; those are two orthogonal settings. +=head1 CODE REFERENCES + +Since Storable version 2.05, CODE references may be serialized with +the help of L. To enable this feature, set +C<$Storable::Deparse> to a true value. To enable deserialization, +C<$Storable::Eval> should be set to a true value. Be aware that +deserialization is done through C, which is dangerous if the +Storable file contains malicious data. You can set C<$Storable::Eval> +to a subroutine reference which would be used instead of C. See +below for an example using a L compartment for deserialization +of CODE references. + +If C<$Storable::Deparse> and/or C<$Storable::Eval> are set to false +values, then the value of C<$Storable::forgive_me> (see below) is +respected while serializing and deserializing. + =head1 FORWARD COMPATIBILITY This release of Storable can be used on a newer version of Perl to @@ -720,6 +745,40 @@ It is up to you to use this information to populate I the way you want. Returned value: none. +=item C I, I, I + +While C and C are useful for classes where +each instance is independent, this mechanism has difficulty (or is +incompatible) with objects that exist as common process-level or +system-level resources, such as singleton objects, database pools, caches +or memoized objects. + +The alternative C method provides a solution for these +shared objects. Instead of C --E C, +you implement C --E C instead. + +Arguments: I is the class we are attaching to, I is a flag +indicating whether we're in a dclone() or a regular de-serialization via +thaw(), and I is the stored string for the resource object. + +Because these resource objects are considered to be owned by the entire +process/system, and not the "property" of whatever is being serialized, +no references underneath the object should be included in the serialized +string. Thus, in any class that implements C, the +C method cannot return any references, and C +will throw an error if C tries to return references. + +All information required to "attach" back to the shared resource object +B be contained B in the C return string. +Otherwise, C behaves as normal for C +classes. + +Because C is passed the class (rather than an object), +it also returns the object directly, rather than modifying the passed +object. + +Returned value: object of type C + =back =head2 Predicates @@ -808,6 +867,107 @@ implementation of the C utility, version 3.38 or later, is expected to contain support for recognising Storable files out-of-the-box, in addition to other kinds of Perl files. +You can also use the following functions to extract the file header +information from Storable images: + +=over + +=item $info = Storable::file_magic( $filename ) + +If the given file is a Storable image return a hash describing it. If +the file is readable, but not a Storable image return C. If +the file does not exist or is unreadable then croak. + +The hash returned has the following elements: + +=over + +=item C + +This returns the file format version. It is a string like "2.7". + +Note that this version number is not the same as the version number of +the Storable module itself. For instance Storable v0.7 create files +in format v2.0 and Storable v2.15 create files in format v2.7. The +file format version number only increment when additional features +that would confuse older versions of the module are added. + +Files older than v2.0 will have the one of the version numbers "-1", +"0" or "1". No minor number was used at that time. + +=item C + +This returns the file format version as number. It is a string like +"2.007". This value is suitable for numeric comparisons. + +The constant function C returns a comparable +number that represent the highest file version number that this +version of Storable fully support (but see discussion of +C<$Storable::accept_future_minor> above). The constant +C function returns what file version +is written and might be less than C in some +configuations. + +=item C, C + +This also returns the file format version. If the version is "2.7" +then major would be 2 and minor would be 7. The minor element is +missing for when major is less than 2. + +=item C + +The is the number of bytes that the Storable header occupies. + +=item C + +This is TRUE if the image store data in network order. This means +that it was created with nstore() or similar. + +=item C + +This is only present when C is FALSE. It is the +$Config{byteorder} string of the perl that created this image. It is +a string like "1234" (32 bit little endian) or "87654321" (64 bit big +endian). This must match the current perl for the image to be +readable by Storable. + +=item C, C, C, C + +These are only present when C is FALSE. These are the sizes of +various C datatypes of the perl that created this image. These must +match the current perl for the image to be readable by Storable. + +The C element is only present for file format v2.2 and +higher. + +=item C + +The name of the file. + +=back + +=item $info = Storable::read_magic( $buffer ) + +=item $info = Storable::read_magic( $buffer, $must_be_file ) + +The $buffer should be a Storable image or the first few bytes of it. +If $buffer starts with a Storable header, then a hash describing the +image is returned, otherwise C is returned. + +The hash has the same structure as the one returned by +Storable::file_magic(). The C element is true if the image is a +file image. + +If the $must_be_file argument is provided and is TRUE, then return +C unless the image looks like it belongs to a file dump. + +The maximum size of a Storable header is currently 21 bytes. If the +provided $buffer is only the first part of a Storable image it should +at least be this long to ensure that read_magic() will recognize it as +such. + +=back + =head1 EXAMPLES Here are some code samples showing a possible usage of Storable: @@ -816,10 +976,10 @@ Here are some code samples showing a possible usage of Storable: %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1); - store(\%color, '/tmp/colors') or die "Can't store %a in /tmp/colors!\n"; + store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n"; - $colref = retrieve('/tmp/colors'); - die "Unable to retrieve from /tmp/colors!\n" unless defined $colref; + $colref = retrieve('mycolors'); + die "Unable to retrieve from mycolors!\n" unless defined $colref; printf "Blue is still %lf\n", $colref->{'Blue'}; $colref2 = dclone(\%color); @@ -833,6 +993,28 @@ which prints (on my machine): Blue is still 0.100000 Serialization of %color is 102 bytes long. +Serialization of CODE references and deserialization in a safe +compartment: + +=for example begin + + use Storable qw(freeze thaw); + use Safe; + use strict; + my $safe = new Safe; + # because of opcodes used in "use strict": + $safe->permit(qw(:default require)); + local $Storable::Deparse = 1; + local $Storable::Eval = sub { $safe->reval($_[0]) }; + my $serialized = freeze(sub { 42 }); + my $code = thaw($serialized); + $code->() == 42; + +=for example end + +=for example_testing + is( $code->(), 42 ); + =head1 WARNING If you're using references as keys within your hash tables, you're bound @@ -861,9 +1043,9 @@ your data. There is no slowdown on retrieval. =head1 BUGS -You can't store GLOB, CODE, FORMLINE, etc.... If you can define -semantics for those operations, feel free to enhance Storable so that -it can deal with them. +You can't store GLOB, FORMLINE, etc.... If you can define semantics +for those operations, feel free to enhance Storable so that it can +deal with them. The store functions will C if they run into such references unless you set C<$Storable::forgive_me> to some C value. In that @@ -894,6 +1076,69 @@ C is a blunt tool. There is no facility either to return B strings as utf8 sequences, or to attempt to convert utf8 data back to 8 bit and C if the conversion fails. +Prior to Storable 2.01, no distinction was made between signed and +unsigned integers on storing. By default Storable prefers to store a +scalars string representation (if it has one) so this would only cause +problems when storing large unsigned integers that had never been converted +to string or floating point. In other words values that had been generated +by integer operations such as logic ops and then not used in any string or +arithmetic context before storing. + +=head2 64 bit data in perl 5.6.0 and 5.6.1 + +This section only applies to you if you have existing data written out +by Storable 2.02 or earlier on perl 5.6.0 or 5.6.1 on Unix or Linux which +has been configured with 64 bit integer support (not the default) +If you got a precompiled perl, rather than running Configure to build +your own perl from source, then it almost certainly does not affect you, +and you can stop reading now (unless you're curious). If you're using perl +on Windows it does not affect you. + +Storable writes a file header which contains the sizes of various C +language types for the C compiler that built Storable (when not writing in +network order), and will refuse to load files written by a Storable not +on the same (or compatible) architecture. This check and a check on +machine byteorder is needed because the size of various fields in the file +are given by the sizes of the C language types, and so files written on +different architectures are incompatible. This is done for increased speed. +(When writing in network order, all fields are written out as standard +lengths, which allows full interworking, but takes longer to read and write) + +Perl 5.6.x introduced the ability to optional configure the perl interpreter +to use C's C type to allow scalars to store 64 bit integers on 32 +bit systems. However, due to the way the Perl configuration system +generated the C configuration files on non-Windows platforms, and the way +Storable generates its header, nothing in the Storable file header reflected +whether the perl writing was using 32 or 64 bit integers, despite the fact +that Storable was storing some data differently in the file. Hence Storable +running on perl with 64 bit integers will read the header from a file +written by a 32 bit perl, not realise that the data is actually in a subtly +incompatible format, and then go horribly wrong (possibly crashing) if it +encountered a stored integer. This is a design failure. + +Storable has now been changed to write out and read in a file header with +information about the size of integers. It's impossible to detect whether +an old file being read in was written with 32 or 64 bit integers (they have +the same header) so it's impossible to automatically switch to a correct +backwards compatibility mode. Hence this Storable defaults to the new, +correct behaviour. + +What this means is that if you have data written by Storable 1.x running +on perl 5.6.0 or 5.6.1 configured with 64 bit integers on Unix or Linux +then by default this Storable will refuse to read it, giving the error +I. If you have such data then you you +should set C<$Storable::interwork_56_64bit> to a true value to make this +Storable read and write files with the old header. You should also +migrate your data, or any older perl you are communicating with, to this +current version of Storable. + +If you don't have data written with specific configuration of perl described +above, then you do not and should not do anything. Don't set the flag - +not only will Storable on an identically configured perl refuse to load them, +but Storable a differently configured perl will load them believing them +to be correct for it, and then may well fail or crash part way through +reading them. + =head1 CREDITS Thank you to (in chronological order): @@ -939,4 +1184,3 @@ Storable, and your message will be delayed while he forwards it to us. L. =cut -