aboutsummaryrefslogtreecommitdiff
path: root/lib/App
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2018-12-12 15:45:51 +0200
committerSergey Poznyakoff <gray@gnu.org>2018-12-12 15:45:51 +0200
commit2d59fb4cbcfa3b6e14e236b501f5efdd8b32761d (patch)
treea2b6da1daec565ed2748df6ae82552b60a6aa763 /lib/App
parent6c6dab5d1784a57a22600af4fd7202293df18fa7 (diff)
downloadglacier-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.pm6
-rw-r--r--lib/App/Glacier/DB/GDBM.pm2
-rw-r--r--lib/App/Glacier/Timestamp.pm25
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;
}

Return to:

Send suggestions and report system problems to the System administrator.