-;# $Id: Storable.pm,v 0.7.1.2 2000/08/14 07:18:40 ram Exp $
+;# $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 terms of the Artistic License,
-;# as specified in the README file that comes with the distribution.
+;# 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 0.7.1.2 2000/08/14 07:18:40 ram
-;# patch2: increased version number
+;# 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 0.7.1.1 2000/08/13 20:08:58 ram
-;# patch1: mention new Clone(3) extension in SEE ALSO
-;# patch1: contributor Marc Lehmann added overloading and ref to tied items
-;# patch1: updated e-mail from Benjamin Holzman
+;# Revision 1.0.1.12 2001/08/28 21:51:51 ram
+;# patch13: fixed truncation race with lock_retrieve() in lock_store()
;#
-;# Revision 0.7 2000/08/03 22:04:44 ram
-;# Baseline for second beta release.
+;# 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.
;#
require DynaLoader;
@EXPORT = qw(store retrieve);
@EXPORT_OK = qw(
- nstore store_fd nstore_fd retrieve_fd
+ nstore store_fd nstore_fd fd_retrieve
freeze nfreeze thaw
dclone
+ retrieve_fd
+ lock_store lock_nstore lock_retrieve
);
use AutoLoader;
use vars qw($forgive_me $VERSION);
-$VERSION = '0.702';
+$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;
1;
__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$/,/;
}
#
-# retrieve_fd
+# fd_retrieve
#
# Same as retrieve, but perform from an already opened file descriptor instead.
#
-sub retrieve_fd {
+sub fd_retrieve {
my ($file) = @_;
my $fd = fileno($file);
logcroak "not a valid file descriptor" unless defined $fd;
# Storing to and retrieving from an already opened file
store_fd \@array, \*STDOUT;
nstore_fd \%table, \*STDOUT;
- $aryref = retrieve_fd(\*SOCKET);
- $hashref = retrieve_fd(\*SOCKET);
+ $aryref = fd_retrieve(\*SOCKET);
+ $hashref = fd_retrieve(\*SOCKET);
# Serializing to memory
$serialized = freeze \%table;
# 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
At the cost of a slight header overhead, you may store to an already
opened file descriptor using the C<store_fd> routine, and retrieve
-from a file via C<retrieve_fd>. Those names aren't imported by default,
+from a file via C<fd_retrieve>. Those names aren't imported by default,
so you will have to do that explicitely if you need those routines.
The file descriptor you supply must be already opened, for read
if you're going to retrieve and for write if you wish to store.
store_fd(\%table, *STDOUT) || die "can't store to stdout\n";
- $hashref = retrieve_fd(*STDIN);
+ $hashref = fd_retrieve(*STDIN);
You can also store data in network order to allow easy sharing across
multiple platforms, or when storing on a socket known to be remotely
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<retrieve_fd>, objects are retrieved in sequence, one
+When using C<fd_retrieve>, objects are retrieved in sequence, one
object (i.e. one recursive tree) per associated C<store_fd>.
If you're more from the object-oriented camp, you can inherit from
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.
-Due to the aforementionned optimizations, Storable is at the mercy
-of perl's internal redesign or structure changes. If that bothers
-you, you can try convincing Larry that what is used in Storable
-should be documented and consistently kept in future revisions.
+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
Jeff Gresham <gresham_jeffrey@jpmorgan.com>
Murray Nesbitt <murray@activestate.com>
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.
projects / p5sagit/p5-mst-13.2.git / blobdiff