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 353c999..2f352f3 100644 (file)
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -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 =
@@ -133,28 +137,56 @@ sub show_file_magic {
 # 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.
-# Note the couple of unportable lines, consult your operating
-# system's documentation whether you can use those lines.
 #
 0      string  perl-store      perl Storable(v0.6) data
->1     byte    &01     (network-ordered)
+>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
-# byte&04 unportable syntax
->4     byte&04 =4
->>5    byte    >0      v2.%d
->4     byte    &01     (network-ordered)
-# byte&01 unportable syntax
->4     byte&01 =0      (local-ordered)
->>6    byte    >0      (sizeof int %d)
->>7    byte    >0      (sizeof long %d)
->>8    byte    >0      (sizeof ptr %d)
->>9    byte    >0      (sizeof NV %d)
+>4     byte    >0
+>>4    byte    &01     (network-ordered)
+>>4    byte    =5      (major 2)
+>>4    byte    =4      (major 2)
+>>5    byte    >0      (minor %d)
 EOM
 }
 
-bootstrap Storable;
-1;
-__END__
+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
@@ -704,12 +736,15 @@ support Storable hooks to redefine the way deep cloning is performed.
 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 "magic" needs to taught about the "signature"
+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.
-The necessary signature information is output to stdout by
-invoking Storable::show_file_magic().
+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