Implement rm and rmvault

* glacier: Register the rmvault and rm commands
* lib/App/Glacier/Command/DeleteFile.pm: New file.
* lib/App/Glacier/Command/DeleteVault.pm: New file.
* lib/App/Glacier/Command/ListVault.pm: New option --cached
* lib/App/Glacier/Command/Sync.pm: New options --delete and --force
(_sync): Don't delete records without matching inventory entry, unless
--delete is requested.
* lib/App/Glacier/DB/GDBM.pm (drop): Delete the %dbtab entry.
* lib/App/Glacier/Directory.pm (add_version): Return assigned version
number.
* lib/App/Glacier/Job.pm: Minor change

7 files changed, 143 insertions, 24 deletions

diff --git a/lib/App/Glacier/Command/DeleteFile.pm b/lib/App/Glacier/Command/DeleteFile.pm
new file mode 100644
index 0000000..97bcc8c
--- /dev/null
+++ b/lib/App/Glacier/Command/DeleteFile.pm
@@ -0,0 +1,47 @@
+package App::Glacier::Command::DeleteFile;
+
+use strict;
+use warnings;
+use App::Glacier::Command::ListVault;
+use parent qw(App::Glacier::Command::ListVault);
+use App::Glacier::Command;
+use App::Glacier::HttpCatch;
+
+=head1 NAME
+
+glacier rm - remove file from a vault
+
+=head1 SYNOPSIS
+
+B<glacier rm>
+I<VAULT>
+I<FILE>...    
+
+=cut
+
+sub run {
+    my $self = shift;
+
+    $self->abend(EX_USAGE, "at least two arguments expected") unless @_ >= 2;
+    my $vault_name = shift;
+    my $dir = $self->directory($vault_name);
+    my $error = 0;
+    my $success = 0;
+    foreach my $ref (@{$self->get_vault_inventory($vault_name, @_)}) {
+	$self->glacier_eval('delete_archive', $vault_name, $ref->{ArchiveId});
+	if ($self->lasterr) {
+	    $self->error(EX_FAILURE,
+		  "can't remove file \"$ref->{FileName};$ref->FileVersion}\":",
+			 $self->last_error_message);
+	    $error++;
+	} else {
+	    $dir->delete_version($ref->{FileName}, $ref->{FileVersion});
+	    $success++;
+	}
+    }
+    $dir->invalidate if $success; # FIXME: See Put.pm:run
+    exit(EX_TEMPFAIL) if $error;
+}
+	
+1;
+    
diff --git a/lib/App/Glacier/Command/DeleteVault.pm b/lib/App/Glacier/Command/DeleteVault.pm
new file mode 100644
index 0000000..46f5e59
--- /dev/null
+++ b/lib/App/Glacier/Command/DeleteVault.pm
@@ -0,0 +1,33 @@
+package App::Glacier::Command::DeleteVault;
+
+use strict;
+use warnings;
+use App::Glacier::Command;
+use parent qw(App::Glacier::Command);
+use App::Glacier::HttpCatch;
+
+=head1 NAME
+
+glacier rmvault - delete a Glacier vault
+
+=head1 SYNOPSIS
+
+B<glacier rmvault> I<NAME>
+
+=cut    
+
+sub run {
+    my $self = shift;
+
+    $self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
+    my $vault_name = shift;
+    $self->glacier_eval('delete_vault', $vault_name);
+    if ($self->lasterr) {
+	$self->abend(EX_FAILURE, "can't create: ", $self->last_error_message);
+    } else {
+	my $dir = $self->directory($vault_name);
+	$dir->drop
+    }
+}
+
+1;
diff --git a/lib/App/Glacier/Command/ListVault.pm b/lib/App/Glacier/Command/ListVault.pm
index a7202c8..ba47439 100644
--- a/lib/App/Glacier/Command/ListVault.pm
+++ b/lib/App/Glacier/Command/ListVault.pm
@@ -16,7 +16,8 @@ glacier list - list vaults or archives
 =head1 SYNOPSIS
 
 B<glacier list>
-[B<-SUdlhtr>]
+[B<-SUcdlhtr>]
+[B<--cached>]    
 [B<--human-readable>]
 [B<--sort=>B<none>|B<name>|B<time>|B<size>]
 [B<--reverse>]
@@ -69,6 +70,7 @@ sub getopt {
 	'human-readable|h' => \$self->{_options}{h},
 	'reverse|r' => \$self->{_options}{r},
 	'time-style=s' => \$self->{_options}{time_style},
+	'cached|c' => \$self->{_options}{cached},
 	%opts);
     return $rc unless $rc;
 
@@ -197,17 +199,21 @@ sub get_vault_inventory {
 	unless defined $dir;
 
     if ((my $status = $dir->status) != DIR_UPTODATE) {
-	require App::Glacier::Command::Sync;	
-	my $sync = new App::Glacier::Command::Sync;
-	unless ($sync->sync($vault_name)) {
-	    if ($status == DIR_OUTDATED) {
-		$self->error("using cached data");
-	    } else {
-		exit(EX_TEMPFAIL);
+	if ($self->{_options}{cached}) {
+	    $self->error("using cached data");
+	} else {
+	    require App::Glacier::Command::Sync;	
+	    my $sync = new App::Glacier::Command::Sync;
+	    unless ($sync->sync($vault_name)) {
+		if ($status == DIR_OUTDATED) {
+		    $self->error("using cached data");
+		} else {
+		    exit(EX_TEMPFAIL);
+		}
 	    }
 	}
     }
-
+    
     my @glob;
     if (@file_list) {
 	my %vtab;
diff --git a/lib/App/Glacier/Command/Sync.pm b/lib/App/Glacier/Command/Sync.pm
index 285bfa1..ccca322 100644
--- a/lib/App/Glacier/Command/Sync.pm
+++ b/lib/App/Glacier/Command/Sync.pm
@@ -15,23 +15,37 @@ glacier sync - synchronize vault inventory cache
 
 =head1 SYNOPSIS
 
-B<glacier sync> I<VAULT>
+B<glacier sync>
+[B<-df>]
+[B<--delete>]    
+[B<--force>]
+I<VAULT>
 
 =cut
 
+sub getopt {
+    my ($self, %opts) = @_;
+    return $self->SUPER::getopt('force|f' => \$self->{_options}{force},
+				'delete|d' => \$self->{_options}{delete},
+				%opts);
+}
+
 sub run {
     my $self = shift;
     $self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
-    unless ($self->sync(shift)) {
+    unless ($self->sync(shift, %{$self->{_options}})) {
 	exit(EX_TEMPFAIL);
     }
 }
 
 sub sync {
-    my ($self, $vault_name) = @_;
+    my ($self, $vault_name, %opts) = @_;
     
     my $dir = $self->directory($vault_name);
-    my $job = new App::Glacier::Job::InventoryRetrieval($self, $vault_name);
+    $dir->invalidate if $opts{force};
+    my $job = new App::Glacier::Job::InventoryRetrieval(
+	$self, $vault_name,
+	invalidate => $opts{force});
     if ($job->is_completed) {
 	my $res = $self->glacier_eval('get_job_output', $vault_name, $job->id);
 	if ($self->lasterr) {
@@ -40,7 +54,7 @@ sub sync {
 	}
 	$res = decode_json($res);
 	$self->_sync($dir, [map { timestamp_unserialize($_) }
-			        @{$res->{ArchiveList}}]);
+			        @{$res->{ArchiveList}}], $opts{delete});
 	return 1;
     } else {
 	$self->error("inventory retrieval job for $vault_name initiated at " .
@@ -51,9 +65,10 @@ sub sync {
 }
 
 sub _sync {
-    my ($self, $dir, $invref) = @_;
+    my ($self, $dir, $invref, $delete) = @_;
     my %arch;
 
+    $self->debug(1, "retrieved ".(@{$invref})." inventory records");
     @arch{map { $_->{ArchiveId} } @{$invref}} = @{$invref};
 
     # 1. Iterate over records in the invdb
@@ -67,14 +82,24 @@ sub _sync {
 	my ($key, $val) = @_;
 	for (my $i = 0; $i <= $#{$val}; ) {
 	    if (exists($arch{$val->[$i]{ArchiveId}})) {
+		$self->debug(1, "found $key;".($i+1));
+		while (my ($k,$v) = each %{$arch{$val->[$i]{ArchiveId}}}) {
+		    unless (exists($val->[$i]{$k})) {
+			$self->debug(1, "$key;".($i+1).": updating $k");
+			$val->[$i]{$k} = $v;
+		    }
+		}
 		delete $arch{$val->[$i]{ArchiveId}};
 		$i++
-	    } else {
+	    } elsif ($delete) {
+		$self->debug(1, "deleting $key;".($i+1));
 		splice(@{$val}, $i, 1);
 	    }
 	}
-#	print "Deleting $key\n";
-	$dir->delete($key) unless @{$val};
+	if ($delete && @{$val} == 0) {
+	    $self->debug(1, "deleting $key");
+	    $dir->delete($key);
+	}
 		  });
 
     while (my ($aid, $val) = each %arch) {
@@ -88,8 +113,8 @@ sub _sync {
 	if ($file_name eq '') {
 	    $file_name = $dir->tempname();
 	}
-#	print "Adding $file_name\n";	
-	$dir->add_version($file_name, $val);
+	my $ver = $dir->add_version($file_name, $val);
+	$self->debug(1, "incorporating $file_name;$ver");
     }
     $dir->update_sync_time;
 }
diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm
index fe5a8e2..2e75b59 100644
--- a/lib/App/Glacier/DB/GDBM.pm
+++ b/lib/App/Glacier/DB/GDBM.pm
@@ -17,7 +17,7 @@ sub new {
 	my %map;
 	tie %map, 'GDBM_File', $filename, GDBM_WRCREAT, $mode;
 	$dbtab{$filename} = \%map;
-    }
+    }	
     my $self = $class->SUPER::new(%_);
     $self->{_filename} = $filename;
     $self->{_map} = $dbtab{$filename};
@@ -29,6 +29,7 @@ sub drop {
     my $filename = $self->{_filename};
     unlink $filename or carp "can't unlink $filename: $!";
     untie %{$dbtab{$filename}};
+    delete $dbtab{$filename};
     delete $self->{_map};
 }
 
diff --git a/lib/App/Glacier/Directory.pm b/lib/App/Glacier/Directory.pm
index a9847ac..7076814 100644
--- a/lib/App/Glacier/Directory.pm
+++ b/lib/App/Glacier/Directory.pm
@@ -78,17 +78,19 @@ sub foreach {
 sub add_version {
     my ($self, $file_name, $val) = @_;
     my $rec = $self->retrieve($file_name);
+    my $i;
     if ($rec) {
 	my $t = $val->{CreationDate}->epoch;
-	my $i;
 	for ($i = 0; $i <= $#{$rec}; $i++) {
 	    last if $t >= $rec->[$i]{CreationDate}->epoch;
 	}
 	splice(@{$rec}, $i, 0, $val);
     } else {
+	$i = 0;
 	$rec = [ $val ];
     }
     $self->SUPER::store($file_name, $rec);
+    return $i + 1;
 }
 
 sub delete_version {
@@ -97,9 +99,14 @@ sub delete_version {
     my $rec = $self->retrieve($file_name);
     if ($rec && $ver <= $#{$rec}) {
 	splice(@{$rec}, $ver, 1);
-	if (@{$rec} == 0) {
+	if (@{$rec}) {
+	    $self->SUPER::store($file_name, $rec);
+	} else {
 	    $self->delete($file_name);
 	}
+    } else {
+	++$ver;
+	croak "can't remove $file_name;$ver: no such version";
     }
 }
 
diff --git a/lib/App/Glacier/Job.pm b/lib/App/Glacier/Job.pm
index 409b91b..bf1cc1e 100644
--- a/lib/App/Glacier/Job.pm
+++ b/lib/App/Glacier/Job.pm
@@ -55,7 +55,7 @@ sub _get_job {
 	    my $res = $self->{_cmd}->glacier_eval('describe_job',
 						  $self->{_vault},
 						  $job->{JobId});
-	    croak "describe_job returned wrong datatype for \"$job->{JobId}\""
+	    croak "describe_job returned wrong datatype (".ref($res).") for \"$job->{JobId}\""
 		unless ref($res) eq 'HASH';
 	    if ($self->{_cmd}->lasterr) {
 		if ($self->{_cmd}->lasterr('code') == 404) {