Skip to content
This repository has been archived by the owner on Jun 1, 2023. It is now read-only.

Commit

Permalink
Storable 3.00: u64 strings, arrays and hashes >2G
Browse files Browse the repository at this point in the history
via a new LOBJECT tag. This is for 32bit systems and lengths
between 2GB and 4GB (I32-U32), and 64bit (>I32).
Use SSize_t array and hash lengths, see [cperl #123].

Even for hashes, which we cannot iterate over.
This is a upstream limitation in the HvAUX struct and API.
We can store >2G keys though, which is fully supported
in subsequent cperl commits for #123, but not perl5 upstream.

Add several helper functions for strings and hash entries,
removed a lot of duplicate code.

Reformat consistently (tabs: 8)

Modernize:
* get rid of main'dump
* get rid of *FILE typeglob, replace with lexical filehandle
* fix parallel tests, use unique filenames.
* fixed many instances of 2arg open,
* keep backcompat default handling for XS functions, handle the flag
  default there.
* remove default $Storable::flags settings in the tests
* fix some too short I32 len types in the XS
  • Loading branch information
Reini Urban committed Apr 5, 2016
1 parent f393bfc commit 67a5186
Show file tree
Hide file tree
Showing 20 changed files with 1,816 additions and 1,442 deletions.
17 changes: 17 additions & 0 deletions dist/Storable/ChangeLog
Original file line number Diff line number Diff line change
@@ -1,3 +1,20 @@
Thu Mar 31 17:10:27 2016 +0200 Reini Urban <[email protected]>
Version 3.00c

* Added support for u64 strings, arrays and hashes >2G
via a new LOBJECT tag. This is for 32bit systems and lengths
between 2GB and 4GB (I32-U32), and 64bit (>I32).
* Bumped STORABLE_BIN_MINOR and STORABLE_BIN_WRITE_MINOR from 10 to 11
* fix parallel tests, use unique filenames.
* fixed 2 instances of 2arg open,
* added optional flag arguments to skip tie and bless on retrieve/thaw,
* added SECURITY WARNING and Large data support to docs
* compute CAN_FLOCK at compile-time
* reformat everything consistently
* enable DEBUGME tracing and asserts with -DDEBUGGING
* fix all 64 bit compiler warnings
* added some abstraction methods to avoid code duplication

Wed Jul 2 16:25:25 IST 2014 Abhijit Menon-Sen <[email protected]>
Version 2.51

Expand Down
10 changes: 7 additions & 3 deletions dist/Storable/README
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
Storable 2.14
Storable 3.00
Copyright (c) 1995-2000, Raphael Manfredi
Copyright (c) 2001-2004, Larry Wall
Copyright (c) 2016, cPanel Inc

------------------------------------------------------------------------
This program is free software; you can redistribute it and/or modify
Expand All @@ -15,8 +16,8 @@
+=======================================================================
| Storable is distributed as a module, but is also part of the official
| Perl core distribution, as of perl 5.8.
| Maintenance is now done by the perl5-porters. We thank Raphael
| Manfredi for providing us with this very useful module.
| Maintenance is partially done by the perl5-porters, and for cperl by cPanel.
| We thank Raphael Manfredi for providing us with this very useful module.
+=======================================================================

The Storable extension brings persistence to your data.
Expand Down Expand Up @@ -68,6 +69,9 @@ Thanks to (in chronological order):
Marc Lehmann <[email protected]>
Justin Banks <[email protected]>
Jarkko Hietaniemi <[email protected]> (AGAIN, as perl 5.7.0 Pumpkin!)
Todd Rinaldo <[email protected]>, JD Lightsey <[email protected]>
for optional disabling tie and bless for increased security
Reini Urban <[email protected]> for the 3.00 >2G support and rewrite

for their contributions.

Expand Down
40 changes: 17 additions & 23 deletions dist/Storable/Storable.pm
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,9 @@ package Storable; @ISA = qw(Exporter);

use vars qw($canonical $forgive_me $VERSION);

$VERSION = '2.57_01';
$VERSION = '3.00c';
$VERSION =~ s/c$//;
$VERSION = eval $VERSION;

BEGIN {
if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
Expand Down Expand Up @@ -68,21 +70,13 @@ sub CLONE {
Storable::init_perinterp();
}

sub BLESS_OK {
return 2;
}

sub TIE_OK {
return 4;
}

sub FLAGS_COMPAT {
return BLESS_OK | TIE_OK;
}
sub BLESS_OK () { 2 }
sub TIE_OK () { 4 }
sub FLAGS_COMPAT () { BLESS_OK | TIE_OK }

# By default restricted hashes are downgraded on earlier perls.

$Storable::flags = 6;
$Storable::flags = FLAGS_COMPAT;
$Storable::downgrade_restricted = 1;
$Storable::accept_future_minor = 1;

Expand Down Expand Up @@ -129,7 +123,7 @@ sub file_magic {

my $file = shift;
my $fh = IO::File->new;
open($fh, "<". $file) || die "Can't open '$file': $!";
open($fh, "<", $file) || die "Can't open '$file': $!";
binmode($fh);
defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!";
close($fh);
Expand Down Expand Up @@ -372,7 +366,7 @@ sub _freeze {
# will be blessed nor tied.
#
sub retrieve {
_retrieve($_[0], $_[1], 0);
_retrieve(shift, 0, @_);
}

#
Expand All @@ -381,16 +375,16 @@ sub retrieve {
# Same as retrieve, but with advisory locking.
#
sub lock_retrieve {
_retrieve($_[0], $_[1], 1);
_retrieve(shift, 1, @_);
}

# Internal retrieve routine
sub _retrieve {
my ($file, $flags, $use_locking) = @_;
my ($file, $use_locking, $flags) = @_;
$flags = $Storable::flags unless defined $flags;
local *FILE;
open(FILE, "<", $file) || logcroak "can't open $file: $!";
binmode FILE; # Archaic systems...
my $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) {
Expand All @@ -399,11 +393,11 @@ sub _retrieve {
"Storable::lock_store: fcntl/flock emulation broken on $^O";
return undef;
}
flock(FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
flock($FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
# Unlocking will happen when FILE is closed
}
eval { $self = pretrieve(*FILE, $flags) }; # Call C routine
close(FILE);
eval { $self = pretrieve($FILE, $flags) }; # Call C routine
close($FILE);
logcroak $@ if $@ =~ s/\.?\n$/,/;
$@ = $da;
return $self;
Expand Down
Loading

0 comments on commit 67a5186

Please sign in to comment.