Implement listing files

* lib/App/Glacier/Command.pm: Avoid calling describe_vault if db
file already exists.
* lib/App/Glacier/Command/ListVault.pm: Implement listing files
* lib/App/Glacier/Command/Sync.pm (sync): New method
* lib/App/Glacier/DB/GDBM.pm: Use static variable to keep existing
mappings.  This avoids locking problems if the same database is
opened several times.
* lib/App/Glacier/Directory.pm (update_sync_time): New method.
* lib/App/Glacier/Glob.pm (glob2pat): Bugfix: don't modify
arguments

6 files changed, 163 insertions, 51 deletions

diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index b669b67..b356cb3 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -229,14 +229,13 @@ sub _filename {
 
 sub directory {
     my ($self, $vault_name) = @_;
-    unless ($self->{_dir}{$vault_name}) {
-	my $vault = $self->describe_vault($vault_name);
-	return undef unless $vault;
-
-	my $file = $self->{_config}->get(qw(database inv directory));
-	$self->touchdir($file);
-	$file .= '/' . $self->_filename($vault_name) . '.db';
-
+    unless (exists($self->{_dir}{$vault_name})) {
+	my $file = $self->{_config}->get(qw(database inv directory))
+	           . '/' . $self->_filename($vault_name) . '.db';
+	unless (-e $file) {
+	    return undef unless $self->describe_vault($vault_name);
+	}
+	$self->touchdir($self->{_config}->get(qw(database inv directory)));
 	$self->{_dir}{$vault_name} =
 	    new App::Glacier::Directory(
 		$file,
diff --git a/lib/App/Glacier/Command/ListVault.pm b/lib/App/Glacier/Command/ListVault.pm
index b381d0c..a0cd2c4 100644
--- a/lib/App/Glacier/Command/ListVault.pm
+++ b/lib/App/Glacier/Command/ListVault.pm
@@ -23,7 +23,7 @@ B<glacier list>
 
 sub getopt {
     my ($self, %opts) = @_;
-    my %sortf = (
+    my %sort_vaults = (
 	none => undef,
 	name => sub {
 	    my ($a, $b) = @_;
@@ -38,6 +38,21 @@ sub getopt {
 	    $a->{SizeInBytes} <=> $b->{SizeInBytes}
 	}
     );
+    my %sort_archives = (
+	none => undef,
+	name => sub {
+	    my ($a, $b) = @_;
+	    $a->{FileName} cmp $b->{FileName}
+	},
+	time => sub {
+	    my ($a, $b) = @_;
+	    $a->{CreationDate}->epoch <=> $b->{CreationDate}->epoch;
+	},
+	size => sub {
+	    my ($a, $b) = @_;
+	    $a->{Size} <=> $b->{Size}
+	}
+    );
     $self->{_options}{sort} = 'name';
     my $rc = $self->SUPER::getopt(
 	'd' => \$self->{_options}{d},
@@ -50,10 +65,15 @@ sub getopt {
 	'time-style=s' => \$self->{_options}{time_style},
 	%opts);
     return $rc unless $rc;
+
+    $self->{_options}{d} = 1 if (@ARGV == 0);
+
     if (defined($self->{_options}{sort})) {
+	my $sortfun = $self->{_options}{d}
+	                ? \%sort_vaults : \%sort_archives;
 	$self->abend(EX_USAGE, "unknowns sort field")
-	    unless exists($sortf{$self->{_options}{sort}});
-	$self->{_options}{sort} = $sortf{$self->{_options}{sort}};
+	    unless exists($sortfun->{$self->{_options}{sort}});
+	$self->{_options}{sort} = $sortfun->{$self->{_options}{sort}};
     }
     if (defined($self->{_options}{time_style})) {
 	eval {
@@ -65,7 +85,6 @@ sub getopt {
 	    $self->abend(EX_USAGE, "unrecognized time style: $self->{_options}{time_style}");
 	}
     }
-    $self->{_options}{d} = 1 if (@ARGV == 0);
 }
     
 sub run {
@@ -83,30 +102,30 @@ sub get_vault_list {
 
     my $glob = new App::Glacier::Glob(@_);
     if ($glob->is_literal) {
-	return ($self->describe_vault(@_));
+	return [$self->describe_vault(@_)];
     } else {
 	my $res = $self->glacier_eval('list_vaults');
 	if ($self->lasterr) {
 	    $self->abend(EX_FAILURE, "can't list vaults: ",
 			 $self->last_error_message);
 	}
-	return map { timestamp_unserialize($_) }
+	return [map { timestamp_unserialize($_) }
 	           $glob->filter(sub {
 		                    my ($x) = @_;
 				    return $x->{VaultName}
-				 }, @$res);
+				 }, @$res)];
     }
 }
 
 sub list_vaults {
-    my $self = shift;
+    my ($self, $ref) = @_;
 
     foreach my $v (defined($self->{_options}{sort}) ?
 		        sort {
 			    &{$self->{_options}{sort}} 
 			      ($self->{_options}{r} ? ($b, $a) : ($a, $b))
-		        } @_
-		      : @_) {
+		        } @$ref
+		      : @$ref) {
 	$self->show_vault($v);
     }
 }
@@ -138,32 +157,104 @@ sub show_vault {
 }
 
 sub list_archives {
-    my $self = shift;
+    my ($self, $ref) = @_;
+
+    foreach my $v (defined($self->{_options}{sort}) ?
+		        sort {
+			    &{$self->{_options}{sort}} 
+			      ($self->{_options}{r} ? ($b, $a) : ($a, $b))
+		        } @$ref
+		      : @$ref) {
+	$self->show_archive($v);
+    }
+}
+
+sub show_archive {
+    my ($self, $arch) = @_;
+
+    if ($self->{_options}{l}) {
+	printf("%8s % 8d %s %-24s\n",
+	       $self->format_size($arch->{Size}),
+	       $arch->{FileVersions},
+	       $arch->{CreationDate}->canned_format($self->{_options}{time_style}),
+	       $arch->{FileName});
+	
+    } else {
+	print "$arch->{FileName}\n";
+    }
+}
+
+use constant {
+    CACHE_OK => 0,
+    CACHE_INIT => 1,
+    CACHE_UPDATE => 2
+};
+
+sub _check_dir {
+    my ($self, $dir) = @_;
+    
+    if (defined($dir->last_sync_time)) {
+	if (time - $dir->last_sync_time >
+	    $self->{_config}->get(qw(database inv ttl))) {
+	    return CACHE_UPDATE;
+	}
+    } else {
+	return CACHE_INIT;
+    }
+    return CACHE_OK;
 }
 
 sub get_vault_inventory {
-    my ($self, $vault_name) = @_;
+    my ($self, $vault_name, @file_list) = @_;
     my $dir = $self->directory($vault_name);
     $self->abend(EX_FAILURE, "no such vault: $vault_name")
 	unless defined $dir;
-    if (time - ($dir->last_sync_time || 0) >
-	$self->{_config}->get(qw(database inv ttl))) {
-	my $job = new App::Glacier::Job::InventoryRetrieval($self, $vault_name);
-	if ($job->is_completed) {
-	    my $res = $self->glacier_eval('get_job_output', $job->id);
-	    if ($self->lasterr) {
-		$self->abend(EX_FAILURE, "can't list vault $vault_name: ",
-			     $self->last_error_message);
+
+    if ((my $ck = $self->_check_dir($dir)) != CACHE_OK) {
+	require App::Glacier::Command::Sync;	
+	my $sync = new App::Glacier::Command::Sync;
+	unless ($sync->sync($vault_name)) {
+	    if ($ck == CACHE_UPDATE) {
+		$self->error("using cached data");
+	    } else {
+		exit(EX_TEMPFAIL);
 	    }
-#	    FIXME
-	    #$job->store([map { timestamp_unserialize($_) } @$res]);
-	} else {
-	    $self->abend(EX_TEMPFAIL, "inventory retrieval job for $vault_name initiated at " . $job->get('Created')->canned_format
-			 . "; please retry later to get the listing")
-		unless $dir->last_sync_time;
 	}
-	
     }
+
+    my @glob;
+    if (@file_list) {
+	my %vtab;
+	my @unversioned;
+	foreach my $f (@file_list) {
+	    if ($f =~ /^(?<pat>.+?)(?<!\\);(?<ver>\d+)$/) {
+		push @{$vtab{$+{ver}}}, $+{pat};
+	    } else {
+		push @unversioned, $f;
+	    }
+	}
+
+	push @glob, [ new App::Glacier::Glob(@unversioned), 1 ]
+	    if @unversioned;
+	while (my ($ver, $pat) = each %vtab) {
+	    push @glob, [ new App::Glacier::Glob(@$pat), $ver ];
+	}
+    } else {
+	push @glob, [ new App::Glacier::Glob, 1 ];
+    }
+    
+    my @result;
+    $dir->foreach(sub {
+	my ($file, $info) = @_;
+	foreach my $ver (map { $_->[0]->match($file) ? $_->[1] : () } @glob) {
+	    next unless $ver <= @$info;
+	    push @result, {@{[ %{$info->[$ver-1]},
+                               ( 'FileName' => $file,
+				 'FileVersions' => $#{$info} + 1 ) ]}};
+	}
+		  });
+    
+    return \@result;
 }
 
 1;
diff --git a/lib/App/Glacier/Command/Sync.pm b/lib/App/Glacier/Command/Sync.pm
index bb9af9b..4603c34 100644
--- a/lib/App/Glacier/Command/Sync.pm
+++ b/lib/App/Glacier/Command/Sync.pm
@@ -22,7 +22,13 @@ B<glacier sync> I<VAULT>
 sub run {
     my $self = shift;
     $self->abend(EX_USAGE, "one argument expected") unless $#_ == 0;
-    my $vault_name = shift;
+    unless ($self->sync(shift)) {
+	exit(EX_TEMPFAIL);
+    }
+}
+
+sub sync {
+    my ($self, $vault_name) = @_;
 
     my $dir = $self->directory($vault_name);
     my $job = new App::Glacier::Job::InventoryRetrieval($self, $vault_name);
@@ -35,13 +41,13 @@ sub run {
 	$res = decode_json($res);
 	$self->_sync($dir, [map { timestamp_unserialize($_) }
 			        @{$res->{ArchiveList}}]);
+	return 1;
     } else {
-	$self->abend(EX_TEMPFAIL,
-		     "inventory retrieval job for $vault_name initiated at " .
+	$self->error("inventory retrieval job for $vault_name initiated at " .
 		     $job->get('CreationDate')->canned_format
-			 . "; please retry later to get the listing")
-	    unless $dir->last_sync_time;
-    }
+		     . "; please retry later to get the listing");
+	return 0;
+    }	
 }
 
 sub _sync {
@@ -49,7 +55,7 @@ sub _sync {
     my %arch;
 
     @arch{map { $_->{ArchiveId} } @{$invref}} = @{$invref};
-	  
+
     # 1. Iterate over records in the invdb
     # 2. For each record, see if its ArchiveID is present in the input array
     # 2.1. If so, retain it, and remove the item from the input
@@ -67,6 +73,7 @@ sub _sync {
 		splice(@{$val}, $i, 1);
 	    }
 	}
+#	print "Deleting $key\n";
 	$dir->delete($key) unless @{$val};
 		  });
 
@@ -81,9 +88,10 @@ sub _sync {
 	if ($file_name eq '') {
 	    $file_name = $dir->tempname();
 	}
-
+#	print "Adding $file_name\n";	
 	$dir->add_version($file_name, $val);
     }
+    $dir->update_sync_time;
 }
     
 1;
diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm
index 6110ab7..b78005c 100644
--- a/lib/App/Glacier/DB/GDBM.pm
+++ b/lib/App/Glacier/DB/GDBM.pm
@@ -6,15 +6,20 @@ use parent qw(App::Glacier::DB);
 use GDBM_File;
 use Carp;
 
+my %dbtab;
+
 sub new {
     my $class = shift;
     my $filename = shift;
     local %_ = @_;
-    my %map;
     my $mode = delete $_{mode} || 0644;
-    tie %map, 'GDBM_File', $filename, GDBM_WRCREAT, $mode;
+    unless (exists($dbtab{$filename})) {
+	my %map;
+	tie %map, 'GDBM_File', $filename, GDBM_WRCREAT, $mode;
+	$dbtab{$filename} = \%map;
+    }
     my $self = $class->SUPER::new(%_);
-    $self->{_map} = \%map;
+    $self->{_map} = $dbtab{$filename};
     return $self;
 }
 
@@ -32,6 +37,8 @@ sub retrieve {
 sub store {
     my ($self, $key, $val) = @_;
     $self->{_map}{$key} = $self->encode($val);
+#    use Data::Dumper;
+#    print "stored $key", Dumper([$self->{_map}{$key}]);
 }
 
 sub delete {
diff --git a/lib/App/Glacier/Directory.pm b/lib/App/Glacier/Directory.pm
index c16f8df..986236b 100644
--- a/lib/App/Glacier/Directory.pm
+++ b/lib/App/Glacier/Directory.pm
@@ -20,6 +20,7 @@ sub info {
     my ($self, $key, $val) = @_;
     my $rec = $self->retrieve(DB_INFO_KEY);
     if ($val) {
+	$rec = {} unless defined($rec);
 	$rec->{$key} = $val;
 	$self->SUPER::store(DB_INFO_KEY, $rec);
     } elsif (!defined($rec)) {
@@ -33,6 +34,11 @@ sub last_sync_time {
     return $self->info('SyncTimeStamp');
 }
 
+sub update_sync_time {
+    my ($self) = @_;
+    return $self->info('SyncTimeStamp', time);
+}
+
 sub foreach {
     my ($self, $code) = @_;
     $self->SUPER::foreach(sub {
@@ -48,7 +54,7 @@ sub add_version {
 	my $t = $val->{CreationDate}->epoch;
 	my $i;
 	for ($i = 0; $i <= $#{$rec}; $i++) {
-	    last if $t <= $rec->[$i]{CreationDate}->epoch;
+	    last if $t >= $rec->[$i]{CreationDate}->epoch;
 	}
 	splice(@{$rec}, $i, 0, $val);
     } else {
diff --git a/lib/App/Glacier/Glob.pm b/lib/App/Glacier/Glob.pm
index ac6a359..4079404 100644
--- a/lib/App/Glacier/Glob.pm
+++ b/lib/App/Glacier/Glob.pm
@@ -5,8 +5,9 @@ use Exporter;
 use parent 'Exporter';
 use Carp;
 
-sub glob2pat {
-    return undef unless @_;
+sub glob2regex {
+    my @glob = @_;
+    return undef unless @glob;
     my %patmap = (
 	'*' => '.*',
 	'?' => '.',
@@ -14,13 +15,13 @@ sub glob2pat {
 	']' => ']',
     );
     return '^'
-	. join('|', map { s{(.)} { $patmap{$1} || "\Q$1\E" }gex; "(?:$_)" } @_)
+	. join('|', map { s{(.)} { $patmap{$1} || "\Q$1\E" }gex; "(?:$_)" } @glob)
 	. '$';
 }
 
 sub new {
     my $class = shift;
-    my $rx = glob2pat(@_);
+    my $rx = glob2regex(@_);
     my $self = bless { }, $class;
     if (@_ == 1 && $_[0] !~ /[][*?]/) {
 	$self->{_rx} = $_[0];