7 files changed, 81 insertions, 75 deletions

diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index 7178a75..1f9a130 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -164,2 +164,10 @@ sub clone {
 
+sub option {
+    my ($self, $opt, $val) = @_;
+    if (defined($val)) {
+        $self->{_options}{$opt} = $val;
+    }
+    return $self->{_options}{$opt};
+}
+
 sub touchdir {
@@ -278,2 +286,37 @@ sub archive_cache_filename {
 
+sub check_job {
+    my ($self, $key, $descr, $vault) = @_;
+
+    $self->debug(2, "$descr->{JobId} $descr->{Action} $vault");
+    if ($descr->{StatusCode} eq 'Failed') {
+        $self->debug(1,
+                     "deleting failed $key $vault "
+                     . ($descr->{JobDescription} || $descr->{Action})
+                     . ' '
+                     . $descr->{JobId});
+        $self->jobdb()->delete($key) unless $self->dry_run;
+        return;
+    }
+
+    my $res = $self->glacier->Describe_job($vault, $descr->{JobId});
+    if ($self->glacier->lasterr) {
+        if ($self->glacier->lasterr('code') == 404) {
+            $self->debug(1,
+                         "deleting expired $key $vault "
+                         . ($descr->{JobDescription} || $descr->{Action})
+                         . ' '
+                         . $descr->{JobId});
+            App::Glacier::Job->fromdb($self, $vault, $key, $res)->delete()
+                unless $self->dry_run;
+        } else {
+            $self->error("can't describe job $descr->{JobId}: ",
+                         $self->glacier->last_error_message);
+        }
+        return;
+    } elsif (ref($res) ne 'HASH') {
+        croak "describe_job returned wrong datatype (".ref($res).") for \"$descr->{JobId}\"";
+    }
+    return $res;
+}
+
 1;
diff --git a/lib/App/Glacier/Command/Get.pm b/lib/App/Glacier/Command/Get.pm
index 0d17659..82b32c8 100644
--- a/lib/App/Glacier/Command/Get.pm
+++ b/lib/App/Glacier/Command/Get.pm
@@ -162,2 +162,4 @@ sub run {
         if (-f $cache_file) {
+            $self->debug(1, "$job: copying from $cache_file");
+            return if $self->dry_run;
             unless (copy($cache_file, $localname)) {
@@ -195,2 +197,3 @@ sub download {
     my ($self, $job, $localname) = @_;
+    
     my $archive_size = $job->get('ArchiveSizeInBytes');
@@ -216,5 +219,3 @@ sub _download_simple {
 
-    eval { # FIXME: file_name might be absent
-        $self->debug(1, "downloading", $job->file_name(1), "in single part");
-    };
+    $self->debug(1, "$job: downloading in single part");
     return if $self->dry_run;
@@ -258,4 +259,4 @@ sub _download_multipart {
 
-    $self->debug(1,
-                 "downloading", $job->file_name(1), "to $localname in chunks of $part_size bytes, in $njobs jobs, with $job_parts parts per job");
+    $self->debug(1, "$job: downloading in chunks of $part_size bytes, in $njobs jobs, with $job_parts parts per job");
+
     return if $self->dry_run;
diff --git a/lib/App/Glacier/Command/Jobs.pm b/lib/App/Glacier/Command/Jobs.pm
index 5a5f488..7dc5d06 100644
--- a/lib/App/Glacier/Command/Jobs.pm
+++ b/lib/App/Glacier/Command/Jobs.pm
@@ -118,5 +118,3 @@ sub list {
     $db->foreach(sub {
-        my ($key, $descr) = @_;
-        my $vault = $descr->{VaultARN};
-        $vault =~ s{.*:vaults/}{};
+        my ($key, $descr, $vault) = @_;
 
@@ -125,31 +123,8 @@ sub list {
         unless ($self->{_options}{cached}) {
-            if ($descr->{StatusCode} eq 'Failed') {
-                $self->debug(1, "deleting failed $key $vault " .
-                             ($descr->{JobDescription} || $descr->{Action}) .
-                             $descr->{JobId});
-                $db->delete($key) unless $self->dry_run;
-                return;
-            }
-            
-            my $res = $self->glacier->Describe_job($vault, $descr->{JobId});
-            if ($self->glacier->lasterr) {
-                if ($self->glacier->lasterr('code') == 404) {
-                    $self->debug(1, "deleting expired $key $vault " .
-                             ($descr->{JobDescription} || $descr->{Action}) .
-                                 $descr->{JobId});
-                    App::Glacier::Job->fromdb($self, $vault, $key, $res)->delete()
-                        unless $self->dry_run;
-                    return;
-                } else {
-                    $self->error("can't describe job $descr->{JobId}: ",
-                                 $self->glacier->last_error_message);
-                }
-            } elsif (ref($res) ne 'HASH') {
-                croak "describe_job returned wrong datatype (".ref($res).") for \"$descr->{JobId}\"";
-            } else {
-                $res = timestamp_deserialize($res);
-                $self->debug(2, $res->{StatusCode});
-                $db->store($key, $res) unless $self->dry_run;
-                $descr = $res;
-            }           
+            my $res = $self->check_job($key, $descr, $vault)
+                or return;
+            $res = timestamp_deserialize($res);
+            $self->debug(2, $res->{StatusCode});
+            $db->store($key, $res) unless $self->dry_run;
+            $descr = $res;
         }
diff --git a/lib/App/Glacier/Command/Periodic.pm b/lib/App/Glacier/Command/Periodic.pm
index 5a4dc2a..39a2d7a 100644
--- a/lib/App/Glacier/Command/Periodic.pm
+++ b/lib/App/Glacier/Command/Periodic.pm
@@ -9,2 +9,3 @@ use File::Basename;
 use App::Glacier::Job;
+use App::Glacier::Command::Get;
 
@@ -40,35 +41,6 @@ sub run {
     $db->foreach(sub {
-        my ($key, $descr) = @_;
-        my $vault = $descr->{VaultARN};
-        $vault =~ s{.*:vaults/}{};
+        my ($key, $descr, $vault) = @_;
 
-        my $completed = $descr->{Completed};
-        
-        $self->debug(2, "$descr->{JobId} $descr->{Action} $vault");
-        if ($descr->{StatusCode} eq 'Failed') {
-            $self->debug(1,
-                         "deleting failed $key $vault "
-                         . ($descr->{JobDescription} || $descr->{Action})
-                         . ' '
-                         . $descr->{JobId});
-            $db->delete($key) unless $self->dry_run;
-        }
-
-        my $res = $self->glacier->Describe_job($vault, $descr->{JobId});
-        if ($self->glacier->lasterr) {
-            if ($self->glacier->lasterr('code') == 404) {
-                $self->debug(1,
-                             "deleting expired $key $vault "
-                             . ($descr->{JobDescription} || $descr->{Action})
-                             . ' '
-                             . $descr->{JobId});
-                App::Glacier::Job->fromdb($self, $vault, $key, $res)->delete()
-                    unless $self->dry_run;
-            } else {
-                $self->error("can't describe job $descr->{JobId}: ",
-                             $self->glacier->last_error_message);
-            }
-        } elsif (ref($res) ne 'HASH') {
-            croak "describe_job returned wrong datatype (".ref($res).") for \"$descr->{JobId}\"";
-        } elsif ($res->{Completed} ne $completed) {
+        my $res = $self->check_job($key, $descr, $vault);
+        if ($res && $res->{Completed} ne $descr->{Completed}) {
             $self->debug(2, $res->{StatusCode});
@@ -88,4 +60,4 @@ sub run {
 
-                    require App::Glacier::Command::Get;
                     my $get = clone App::Glacier::Command::Get($self);
+                    $get->option(quiet => 1);
                     $get->download($job, $localname);
diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm
index 0e14a65..f7cc29a 100644
--- a/lib/App/Glacier/DB/GDBM.pm
+++ b/lib/App/Glacier/DB/GDBM.pm
@@ -8,2 +8,6 @@ use File::Path qw(make_path);
 
+# Avoid coredumps in threaded code.
+# See https://rt.perl.org/Public/Bug/Display.html?id=61912.
+sub CLONE_SKIP { 1 }
+
 sub new {
@@ -54,7 +58,4 @@ sub configtest {
 
-# 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->{_map} tied
-# to the DB.
+# Tie in the database, run $code, and untie it again. Correctly handle
+# nested invocations to avoid deadlocking.
 sub _tied {
diff --git a/lib/App/Glacier/Job.pm b/lib/App/Glacier/Job.pm
index ae12b22..9478b20 100644
--- a/lib/App/Glacier/Job.pm
+++ b/lib/App/Glacier/Job.pm
@@ -110,2 +110,7 @@ sub get {
 
+sub as_string { shift->get('JobDescription') }
+
+use overload
+    '""' => \&as_string;
+
 sub is_finished {
diff --git a/lib/App/Glacier/Roster.pm b/lib/App/Glacier/Roster.pm
index ee56ff5..32c2b08 100644
--- a/lib/App/Glacier/Roster.pm
+++ b/lib/App/Glacier/Roster.pm
@@ -3,2 +3,11 @@ use parent 'App::Glacier::DB';
 
+sub foreach {
+    my ($self, $fun) = @_;
+    $self->SUPER::foreach(sub {
+        my ($key, $descr) = @_;
+        (my $vault = $descr->{VaultARN}) =~ s{.*:vaults/}{};
+        &{$fun}($key, $descr, $vault);