Re: perl@16083

[p5sagit/p5-mst-13.2.git] / ext / Storable / Storable.pm

diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm
index d72b71d..2f352f3 100644 (file)
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -70,7 +70,7 @@ package Storable; @ISA = qw(Exporter DynaLoader);
 use AutoLoader;
 use vars qw($forgive_me $VERSION);
 
-$VERSION = '1.014';
+$VERSION = '1.015';
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;            # Grrr...
 
 #
@@ -110,15 +110,19 @@ BEGIN {
 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.
 #
 
-my $CAN_FLOCK;
-
 sub CAN_FLOCK {
+       my $CAN_FLOCK if 0;
        return $CAN_FLOCK if defined $CAN_FLOCK;
        require Config; import Config;
        return $CAN_FLOCK =
@@ -127,9 +131,62 @@ sub CAN_FLOCK {
                $Config{'d_lockf'};
 }
 
-bootstrap Storable;
-1;
-__END__
+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
@@ -674,6 +731,21 @@ natively, i.e. without freezing to memory and thawing the result.  It is
 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: