-;# $Id: Storable.pm,v 1.0 2000/09/01 19:40:41 ram Exp $
+;# $Id: Storable.pm,v 1.0.1.13 2001/12/01 13:34:49 ram Exp $
;#
;# Copyright (c) 1995-2000, Raphael Manfredi
;#
;# 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.
;#
freeze nfreeze thaw
dclone
retrieve_fd
+ lock_store lock_nstore lock_retrieve
);
use AutoLoader;
use vars qw($forgive_me $VERSION);
-$VERSION = '1.000';
+$VERSION = '1.015';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
require Carp;
Carp::croak(@_);
}
+ sub logcarp {
+ require Carp;
+ Carp::carp(@_);
+ }
};
}
+#
+# They might miss :flock in Fcntl
+#
+
+BEGIN {
+ if (eval { require Fcntl; 1 } && exists $Fcntl::EXPORT_TAGS{'flock'}) {
+ Fcntl->import(':flock');
+ } else {
+ eval q{
+ sub LOCK_SH () {1}
+ sub LOCK_EX () {2}
+ };
+ }
+}
+
sub logcroak;
+sub logcarp;
+# Can't Autoload cleanly as this clashes 8.3 with &retrieve
sub retrieve_fd { &fd_retrieve } # Backward compatibility
bootstrap Storable;
__END__
#
+# Determine whether locking is possible, but only when needed.
+#
+
+sub CAN_FLOCK {
+ my $CAN_FLOCK if 0;
+ return $CAN_FLOCK if defined $CAN_FLOCK;
+ require Config; import Config;
+ return $CAN_FLOCK =
+ $Config{'d_flock'} ||
+ $Config{'d_fcntl_can_lock'} ||
+ $Config{'d_lockf'};
+}
+
+sub show_file_magic {
+ print <<EOM;
+#
+# To recognize the data files of the Perl module Storable,
+# the following lines need to be added to the local magic(5) file,
+# usually either /usr/share/misc/magic or /etc/magic.
+#
+0 string perl-store perl Storable(v0.6) data
+>4 byte >0 (net-order %d)
+>>4 byte &01 (network-ordered)
+>>4 byte =3 (major 1)
+>>4 byte =2 (major 1)
+
+0 string pst0 perl Storable(v0.7) data
+>4 byte >0
+>>4 byte &01 (network-ordered)
+>>4 byte =5 (major 2)
+>>4 byte =4 (major 2)
+>>5 byte >0 (minor %d)
+EOM
+}
+
+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;
+}
+
+#
# store
#
# Store target object hierarchy, identified by a reference to its root.
# removed.
#
sub store {
- return _store(\&pstore, @_);
+ return _store(\&pstore, @_, 0);
}
#
# Same as store, but in network order.
#
sub nstore {
- return _store(\&net_pstore, @_);
+ return _store(\&net_pstore, @_, 0);
+}
+
+#
+# lock_store
+#
+# Same as store, but flock the file first (advisory locking).
+#
+sub lock_store {
+ return _store(\&pstore, @_, 1);
+}
+
+#
+# lock_nstore
+#
+# Same as nstore, but flock the file first (advisory locking).
+#
+sub lock_nstore {
+ return _store(\&net_pstore, @_, 1);
}
# Internal store to file routine
sub _store {
my $xsptr = shift;
my $self = shift;
- my ($file) = @_;
+ my ($file, $use_locking) = @_;
logcroak "not a reference" unless ref($self);
- logcroak "too many arguments" unless @_ == 1; # No @foo in arglist
+ logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist
local *FILE;
- open(FILE, ">$file") || logcroak "can't create $file: $!";
+ if ($use_locking) {
+ open(FILE, ">>$file") || logcroak "can't write into $file: $!";
+ unless (&CAN_FLOCK) {
+ logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
+ return undef;
+ }
+ flock(FILE, LOCK_EX) ||
+ logcroak "can't get exclusive lock on $file: $!";
+ truncate FILE, 0;
+ # Unlocking will happen when FILE is closed
+ } else {
+ open(FILE, ">$file") || logcroak "can't create $file: $!";
+ }
binmode FILE; # Archaic systems...
my $da = $@; # Don't mess if called from exception handler
my $ret;
# Call C routine nstore or pstore, depending on network order
eval { $ret = &$xsptr($file, $self) };
logcroak $@ if $@ =~ s/\.?\n$/,/;
+ local $\; print $file ''; # Autoflush the file if wanted
$@ = $da;
return $ret ? $ret : undef;
}
# object of that tree.
#
sub retrieve {
- my ($file) = @_;
+ _retrieve($_[0], 0);
+}
+
+#
+# lock_retrieve
+#
+# Same as retrieve, but with advisory locking.
+#
+sub lock_retrieve {
+ _retrieve($_[0], 1);
+}
+
+# Internal retrieve routine
+sub _retrieve {
+ my ($file, $use_locking) = @_;
local *FILE;
- open(FILE, "$file") || logcroak "can't open $file: $!";
+ open(FILE, $file) || logcroak "can't open $file: $!";
binmode FILE; # Archaic systems...
my $self;
my $da = $@; # Could be from exception handler
+ if ($use_locking) {
+ unless (&CAN_FLOCK) {
+ logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
+ return undef;
+ }
+ flock(FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
+ # Unlocking will happen when FILE is closed
+ }
eval { $self = pretrieve(*FILE) }; # Call C routine
close(FILE);
logcroak $@ if $@ =~ s/\.?\n$/,/;
# Deep (recursive) cloning
$cloneref = dclone($ref);
+ # Advisory locking
+ use Storable qw(lock_store lock_nstore lock_retrieve)
+ lock_store \%table, 'file';
+ lock_nstore \%table, 'file';
+ $hashref = lock_retrieve('file');
+
=head1 DESCRIPTION
The Storable package brings persistency to your perl data structures
connected. The routines to call have an initial C<n> prefix for I<network>,
as in C<nstore> and C<nstore_fd>. At retrieval time, your data will be
correctly restored so you don't have to know whether you're restoring
-from native or network ordered data.
+from native or network ordered data. Double values are stored stringified
+to ensure portability as well, at the slight risk of loosing some precision
+in the last decimals.
When using C<fd_retrieve>, objects are retrieved in sequence, one
object (i.e. one recursive tree) per associated C<store_fd>.
that intermediary scalar but instead freezes the structure in some
internal memory space and then immediatly thaws it out.
+=head1 ADVISORY LOCKING
+
+The C<lock_store> and C<lock_nstore> routine are equivalent to C<store>
+and C<nstore>, only they get an exclusive lock on the file before
+writing. Likewise, C<lock_retrieve> performs as C<retrieve>, but also
+gets a shared lock on the file before reading.
+
+Like with any advisory locking scheme, the protection only works if
+you systematically use C<lock_store> and C<lock_retrieve>. If one
+side of your application uses C<store> whilst the other uses C<lock_retrieve>,
+you will get no protection at all.
+
+The internal advisory locking is implemented using Perl's flock() routine.
+If your system does not support any form of flock(), or if you share
+your files across NFS, you might wish to use other forms of locking by
+using modules like LockFile::Simple which lock a file using a filesystem
+entry, instead of locking the file descriptor.
+
=head1 SPEED
The heart of Storable is written in C for decent speed. Extra low-level
When Storable croaks, it tries to report the error via the C<logcroak()>
routine from the C<Log::Agent> package, if it is available.
+Normal errors are reported by having store() or retrieve() return C<undef>.
+Such errors are usually I/O errors (or truncated stream errors at retrieval).
+
=head1 WIZARDS ONLY
=head2 Hooks
Here is the hooking interface:
-=over
+=over 4
=item C<STORABLE_freeze> I<obj>, I<cloning>
them at serialization time, pointing to the deserialized objects (which
have been processed courtesy of the Storable engine).
+When the Storable engine does not find any C<STORABLE_thaw> hook routine,
+it tries to load the class by requiring the package dynamically (using
+the blessed package name), and then re-attempts the lookup. If at that
+time the hook cannot be located, the engine croaks. Note that this mechanism
+will fail if you define several classes in the same file, but perlmod(1)
+warned you.
+
It is up to you to use these information to populate I<obj> the way you want.
Returned value: none.
Predicates are not exportable. They must be called by explicitely prefixing
them with the Storable package name.
-=over
+=over 4
=item C<Storable::last_op_in_netorder>
There are a few things you need to know however:
-=over
+=over 4
=item *
aimed to replace Storable's dclone() some day. However, it does not currently
support Storable hooks to redefine the way deep cloning is performed.
+=head1 Storable magic
+
+Yes, there's a lot of that :-) But more precisely, in UNIX systems
+there's a utility called C<file>, which recognizes data files based on
+their contents (usually their first few bytes). For this to work,
+a certain file called F<magic> needs to taught about the I<signature>
+of the data. Where that configuration file lives depends on the UNIX
+flavour, often it's something like F</usr/share/misc/magic> or
+F</etc/magic>. Your system administrator needs to do the updating of
+the F<magic> file. The necessary signature information is output to
+stdout by invoking Storable::show_file_magic(). Note that the open
+source implementation of the C<file> utility 3.38 (or later)
+is expected to contain the support for recognising Storable files,
+in addition to other kinds of Perl files.
+
=head1 EXAMPLES
Here are some code samples showing a possible usage of Storable:
operations on the same data structures, you will get different
results.
+When storing doubles in network order, their value is stored as text.
+However, you should also not expect non-numeric floating-point values
+such as infinity and "not a number" to pass successfully through a
+nstore()/retrieve() pair.
+
+As Storable neither knows nor cares about character sets (although it
+does know that characters may be more than eight bits wide), any difference
+in the interpretation of character codes between a host and a target
+system is your problem. In particular, if host and target use different
+code points to represent the characters used in the text representation
+of floating-point numbers, you will not be able be able to exchange
+floating-point data, even with nstore().
+
=head1 CREDITS
Thank you to (in chronological order):
Marc Lehmann <pcg@opengroup.org>
Justin Banks <justinb@wamnet.com>
Jarkko Hietaniemi <jhi@iki.fi> (AGAIN, as perl 5.7.0 Pumpkin!)
+ Salvador Ortiz Garcia <sog@msg.com.mx>
+ Dominic Dunlop <domo@computer.org>
+ Erik Haugan <erik@solbors.no>
for their bug reports, suggestions and contributions.