|
|
1a4ac9 |
diff --git a/Storable.pm b/Storable.pm
|
|
|
1a4ac9 |
index 9d8b621..c8f6db1 100644
|
|
|
1a4ac9 |
--- a/Storable.pm
|
|
|
1a4ac9 |
+++ b/Storable.pm
|
|
|
1a4ac9 |
@@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter);
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
use vars qw($canonical $forgive_me $VERSION);
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
-$VERSION = '2.53';
|
|
|
1a4ac9 |
+$VERSION = '2.56';
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
BEGIN {
|
|
|
1a4ac9 |
if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
|
|
|
1a4ac9 |
@@ -979,43 +979,43 @@ such.
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
Here are some code samples showing a possible usage of Storable:
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- use Storable qw(store retrieve freeze thaw dclone);
|
|
|
1a4ac9 |
+ use Storable qw(store retrieve freeze thaw dclone);
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
|
|
|
1a4ac9 |
+ %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
|
|
|
1a4ac9 |
+ store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- $colref = retrieve('mycolors');
|
|
|
1a4ac9 |
- die "Unable to retrieve from mycolors!\n" unless defined $colref;
|
|
|
1a4ac9 |
- printf "Blue is still %lf\n", $colref->{'Blue'};
|
|
|
1a4ac9 |
+ $colref = retrieve('mycolors');
|
|
|
1a4ac9 |
+ die "Unable to retrieve from mycolors!\n" unless defined $colref;
|
|
|
1a4ac9 |
+ printf "Blue is still %lf\n", $colref->{'Blue'};
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- $colref2 = dclone(\%color);
|
|
|
1a4ac9 |
+ $colref2 = dclone(\%color);
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- $str = freeze(\%color);
|
|
|
1a4ac9 |
- printf "Serialization of %%color is %d bytes long.\n", length($str);
|
|
|
1a4ac9 |
- $colref3 = thaw($str);
|
|
|
1a4ac9 |
+ $str = freeze(\%color);
|
|
|
1a4ac9 |
+ printf "Serialization of %%color is %d bytes long.\n", length($str);
|
|
|
1a4ac9 |
+ $colref3 = thaw($str);
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
which prints (on my machine):
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- Blue is still 0.100000
|
|
|
1a4ac9 |
- Serialization of %color is 102 bytes long.
|
|
|
1a4ac9 |
+ Blue is still 0.100000
|
|
|
1a4ac9 |
+ Serialization of %color is 102 bytes long.
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
Serialization of CODE references and deserialization in a safe
|
|
|
1a4ac9 |
compartment:
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
=for example begin
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
- use Storable qw(freeze thaw);
|
|
|
1a4ac9 |
- use Safe;
|
|
|
1a4ac9 |
- use strict;
|
|
|
1a4ac9 |
- my $safe = new Safe;
|
|
|
1a4ac9 |
+ use Storable qw(freeze thaw);
|
|
|
1a4ac9 |
+ use Safe;
|
|
|
1a4ac9 |
+ use strict;
|
|
|
1a4ac9 |
+ my $safe = new Safe;
|
|
|
1a4ac9 |
# because of opcodes used in "use strict":
|
|
|
1a4ac9 |
- $safe->permit(qw(:default require));
|
|
|
1a4ac9 |
- local $Storable::Deparse = 1;
|
|
|
1a4ac9 |
- local $Storable::Eval = sub { $safe->reval($_[0]) };
|
|
|
1a4ac9 |
- my $serialized = freeze(sub { 42 });
|
|
|
1a4ac9 |
- my $code = thaw($serialized);
|
|
|
1a4ac9 |
- $code->() == 42;
|
|
|
1a4ac9 |
+ $safe->permit(qw(:default require));
|
|
|
1a4ac9 |
+ local $Storable::Deparse = 1;
|
|
|
1a4ac9 |
+ local $Storable::Eval = sub { $safe->reval($_[0]) };
|
|
|
1a4ac9 |
+ my $serialized = freeze(sub { 42 });
|
|
|
1a4ac9 |
+ my $code = thaw($serialized);
|
|
|
1a4ac9 |
+ $code->() == 42;
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
=for example end
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
diff --git a/Storable.xs b/Storable.xs
|
|
|
1a4ac9 |
index e7d0329..83cd001 100644
|
|
|
1a4ac9 |
--- a/Storable.xs
|
|
|
1a4ac9 |
+++ b/Storable.xs
|
|
|
1a4ac9 |
@@ -1667,6 +1667,7 @@ static void free_context(pTHX_ stcxt_t *cxt)
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
ASSERT(!cxt->s_dirty, ("clean context"));
|
|
|
1a4ac9 |
ASSERT(prev, ("not freeing root context"));
|
|
|
1a4ac9 |
+ assert(prev);
|
|
|
1a4ac9 |
|
|
|
1a4ac9 |
SvREFCNT_dec(cxt->my_sv);
|
|
|
1a4ac9 |
SET_STCXT(prev);
|
|
|
1a4ac9 |
@@ -6677,6 +6678,7 @@ SV * obj
|
|
|
1a4ac9 |
ALIAS:
|
|
|
1a4ac9 |
net_mstore = 1
|
|
|
1a4ac9 |
CODE:
|
|
|
1a4ac9 |
+ RETVAL = &PL_sv_undef;
|
|
|
1a4ac9 |
if (!do_store(aTHX_ (PerlIO*) 0, obj, 0, ix, &RETVAL))
|
|
|
1a4ac9 |
RETVAL = &PL_sv_undef;
|
|
|
1a4ac9 |
OUTPUT:
|