-;# $Id: Storable.pm,v 1.0.1.5 2000/10/26 17:10:18 ram Exp ram $
+;# $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
;# patch4: protected calls to flock() for dos platform
;# patch4: added logcarp emulation if they don't have Log::Agent
;#
-;# $Log: Storable.pm,v $
+;# 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.
;#
use AutoLoader;
use vars qw($forgive_me $VERSION);
-$VERSION = '1.005';
+$VERSION = '1.015';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
#
BEGIN {
- require Fcntl;
- if (exists $Fcntl::EXPORT_TAGS{'flock'}) {
+ if (eval { require Fcntl; 1 } && exists $Fcntl::EXPORT_TAGS{'flock'}) {
Fcntl->import(':flock');
} else {
eval q{
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.
my $self = shift;
my ($file, $use_locking) = @_;
logcroak "not a reference" unless ref($self);
- logcroak "too many arguments" unless @_ == 2; # No @foo in arglist
+ logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist
local *FILE;
- open(FILE, ">$file") || logcroak "can't create $file: $!";
- binmode FILE; # Archaic systems...
if ($use_locking) {
- if ($^O eq 'dos') {
+ open(FILE, ">>$file") || logcroak "can't write into $file: $!";
+ unless (&CAN_FLOCK) {
logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
return undef;
}
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
# 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;
}
my $self;
my $da = $@; # Could be from exception handler
if ($use_locking) {
- if ($^O eq 'dos') {
+ unless (&CAN_FLOCK) {
logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
return undef;
}
Here is the hooking interface:
-=over
+=over 4
=item C<STORABLE_freeze> I<obj>, I<cloning>
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:
projects / p5sagit/p5-mst-13.2.git / blobdiff