diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2018-12-12 15:45:51 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2018-12-12 15:45:51 +0200 |
commit | 2d59fb4cbcfa3b6e14e236b501f5efdd8b32761d (patch) | |
tree | a2b6da1daec565ed2748df6ae82552b60a6aa763 /lib/App | |
parent | 6c6dab5d1784a57a22600af4fd7202293df18fa7 (diff) | |
download | glacier-2d59fb4cbcfa3b6e14e236b501f5efdd8b32761d.tar.gz glacier-2d59fb4cbcfa3b6e14e236b501f5efdd8b32761d.tar.bz2 |
Bugfix
* lib/App/Glacier/DB.pm (decode): use extra assignment to avoid the
"attempt to copy freed scalar" panic.
* lib/App/Glacier/Timestamp.pm (_to_timestamp): Rewrite the HASH part.
* lib/App/Glacier/DB/GDBM.pm: Minor changes.
Diffstat (limited to 'lib/App')
-rw-r--r-- | lib/App/Glacier/DB.pm | 6 | ||||
-rw-r--r-- | lib/App/Glacier/DB/GDBM.pm | 2 | ||||
-rw-r--r-- | lib/App/Glacier/Timestamp.pm | 25 |
3 files changed, 19 insertions, 14 deletions
diff --git a/lib/App/Glacier/DB.pm b/lib/App/Glacier/DB.pm index 6e40a8b..3f16280 100644 --- a/lib/App/Glacier/DB.pm +++ b/lib/App/Glacier/DB.pm @@ -54,7 +54,11 @@ sub new { sub decode { my ($self, $val) = @_; return $val unless defined($self->{_decode}); - return &{$self->{_decode}}($val); + # This extra assignment is necessary to avoid the + # "attempt to copy freed scalar" panic (reported at least for Perl + # 5.18.2), which is apparently due to context mismatch. + my $rv = &{$self->{_decode}}($val); + return $rv; } sub encode { diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm index 075dc0c..24a4057 100644 --- a/lib/App/Glacier/DB/GDBM.pm +++ b/lib/App/Glacier/DB/GDBM.pm @@ -24,7 +24,7 @@ sub new { # We can't tie the DB to $self->{_map} at once, in the new method, because # this will cause coredumps in threaded code (see # https://rt.perl.org/Public/Bug/Display.html?id=61912). So, the following -# auxiliary method is used, which calls &$code with $self->{_mode} tied +# auxiliary method is used, which calls &$code with $self->{_map} tied # to the DB. sub _tied { my ($self, $code) = @_; diff --git a/lib/App/Glacier/Timestamp.pm b/lib/App/Glacier/Timestamp.pm index 00972d3..0abf391 100644 --- a/lib/App/Glacier/Timestamp.pm +++ b/lib/App/Glacier/Timestamp.pm @@ -12,21 +12,22 @@ sub _to_timestamp { my $ret; if (ref($obj) eq 'ARRAY') { - $ret = [ map { _to_timestamp($_) } @{$obj} ]; + $ret = [ map { _to_timestamp($_) } @{$obj} ]; } elsif (ref($obj) eq 'HASH') { - $ret = {}; - while (my ($k, $val) = each %{$obj}) { - if ($k =~ /Date$/ && $val) { - $ret->{$k} = bless DateTime::Format::ISO8601-> - parse_datetime($val), - 'App::Glacier::DateTime'; - } else { - $ret->{$k} = _to_timestamp($val); - } - } + $ret = {map { + my $v = $obj->{$_}; + if (/Date$/ && defined($v)) { + $_ => bless DateTime::Format::ISO8601-> + parse_datetime($v), + 'App::Glacier::DateTime'; + } else { + $_ => _to_timestamp($v); + } + } keys %$obj}; } else { - $ret = $obj; + $ret = $obj; } + return $ret; } |