Error checking when opening gdbm

* lib/App/Glacier/DB/GDBM.pm (new): New keyword argument "retries".
Set the _retries attribute.
(_tied): Check return value from tie.  In case of failure, retry at
most _retries times, with one second interval between retries

1 files changed, 10 insertions, 1 deletions

diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm
index f213e5d..075dc0c 100644
--- a/lib/App/Glacier/DB/GDBM.pm
+++ b/lib/App/Glacier/DB/GDBM.pm
@@ -11,10 +11,12 @@ sub new {
     my $filename = shift;
     local %_ = @_;
     my $mode = delete $_{mode} || 0644;
+    my $retries = delete $_{retries} || 10;
     my $self = $class->SUPER::new(%_);
     $self->{_filename} = $filename;
     $self->{_mode} = $mode;
     $self->{_nref} = 0;
+    $self->{_retries} = $retries;
     $self->{_deleted} = [];
     return $self;
 }
@@ -28,7 +30,14 @@ sub _tied {
     my ($self, $code) = @_;
     croak "argument must be a CODE ref" unless ref($code) eq 'CODE';
     if ($self->{_nref}++ == 0) {
-	tie %{$self->{_map}}, 'GDBM_File', $self->{_filename}, GDBM_WRCREAT, $self->{_mode};
+	my $n = 0;
+	while (! tie %{$self->{_map}}, 'GDBM_File', $self->{_filename},
+	             GDBM_WRCREAT, $self->{_mode}) {
+	    if ($n++ > $self->{_retries}) {
+		croak "can't open file $self->{_filename}: $!";
+	    }
+	    sleep(1);
+	}
     }
     my $ret = wantarray ? [ &{$code}() ] : &{$code}();
     if (--$self->{_nref} == 0) {