-;# $Id: Storable.pm,v 0.7.1.2 2000/08/14 07:18:40 ram Exp $
+;# $Id: Storable.pm,v 1.0 2000/09/01 19:40:41 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 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 0.7 2000/08/03 22:04:44 ram
-;# Baseline for second beta release.
+;# 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.003';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
};
}
+#
+# They might miss :flock in Fcntl
+#
+
+BEGIN {
+ require Fcntl;
+ if (exists $Fcntl::EXPORT_TAGS{'flock'}) {
+ Fcntl->import(':flock');
+ } else {
+ eval q{
+ sub LOCK_SH () {1}
+ sub LOCK_EX () {2}
+ };
+ }
+}
+
sub logcroak;
+sub retrieve_fd { &fd_retrieve } # Backward compatibility
+
bootstrap Storable;
1;
__END__
# 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 "too many arguments" unless @_ == 2; # No @foo in arglist
local *FILE;
open(FILE, ">$file") || logcroak "can't create $file: $!";
binmode FILE; # Archaic systems...
+ if ($use_locking) {
+ flock(FILE, LOCK_EX) ||
+ logcroak "can't get exclusive lock on $file: $!";
+ truncate FILE, 0;
+ # Unlocking will happen when FILE is closed
+ }
my $da = $@; # Don't mess if called from exception handler
my $ret;
# Call C routine nstore or pstore, depending on network order
# 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) {
+ 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
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