Rework the DB class system in order to facilitate backend implementation.

* lib/App/Glacier/Command.pm: Use configtest methods for
database configuration.
* lib/App/Glacier/Config.pm (as_hash): ignore special keys
(_lint): Increase error count if unknown keyword is encountered.
(lint): Optional arguments specify path to the statement from which
to start linting.
* lib/App/Glacier/DB.pm: Provide the configtest method.
* lib/App/Glacier/DB/GDBM.pm (new): Use the optional 'create'
keyword for testing whether to create the directory.
Implement the configtest method.
* lib/App/Glacier/Directory/GDBM.pm: Provide defaults for configtest.
* lib/App/Glacier/Directory.pm (new): Expand $vault in the actual
parameter values to the vault name.
* lib/App/Glacier/Job.pm: Remove unused variables.
* lib/App/Glacier/Roster.pm: New file.
* lib/App/Glacier/Roster/GDBM.pm: New file.

9 files changed, 133 insertions, 57 deletions

diff --git a/lib/App/Glacier/Command.pm b/lib/App/Glacier/Command.pm
index 0888b4b..47bfce6 100644
--- a/lib/App/Glacier/Command.pm
+++ b/lib/App/Glacier/Command.pm
@@ -11,9 +11,9 @@ use App::Glacier::EclatCreds;
 use App::Glacier::Config;
 use Net::Amazon::Glacier;
 use App::Glacier::HttpCatch;
-use App::Glacier::DB;
 use App::Glacier::Timestamp;
 use App::Glacier::Directory;
+use App::Glacier::Roster;
 
 use Digest::SHA qw(sha256_hex);
 use File::Path qw(make_path);
@@ -79,16 +79,14 @@ my %parameters = (
         section => {
             job => {
                 section => {
-                    file => { default => '/var/lib/glacier/job.db' },
-                    mode => { default => 0644 },
-                    ttl => { default => 72000, check => \&ck_number },
+                    backend => { default => 'GDBM' },
+                    '*' => '*'
                 },
             },
             inv => {
                 section => {
-                    directory => { default => '/var/lib/glacier/inv' },
-                    mode => { default => 0644 },
-                    ttl => { default => 72000, check => \&ck_number },
+                    backend => { default => 'GDBM' },
+                    '*' => '*'
                 }
             }
         }
@@ -121,6 +119,13 @@ sub new {
                                                 parameters => \%parameters);
     exit(EX_CONFIG) unless $self->{_config}->parse();
 
+    App::Glacier::Roster->configtest($self->cfget(qw(database job backend)),
+                                     $self->config, 'database', 'job')
+        or exit(EX_CONFIG);
+    App::Glacier::Directory->configtest($self->cfget(qw(database inv backend)),
+                                        $self->config, 'database', 'inv')
+        or exit(EX_CONFIG);
+
     unless ($self->{_config}->isset(qw(glacier access))
             && $self->{_config}->isset(qw(glacier secret))) {
         if ($self->{_config}->isset(qw(glacier credentials))) {
@@ -185,14 +190,11 @@ sub touchdir {
 sub jobdb {
     my $self = shift;
     unless ($self->{_jobdb}) {
-        my $file = $self->cfget(qw(database job file));
-        $self->touchdir(dirname($file));
-        $self->{_jobdb} = new App::Glacier::DB(
-            'GDBM',
-            filename => $file,
-            encoding => 'json',
-            mode => $self->cfget(qw(database job mode))
-        );
+        my $be = $self->cfget(qw(database job backend));
+        $self->{_jobdb} = new App::Glacier::Roster(
+            $be,
+            %{$self->config->as_hash(qw(database job)) // {}}
+        );
     }
     return $self->{_jobdb};
 }
@@ -211,29 +213,16 @@ sub describe_vault {
     return timestamp_deserialize($res);
 }
 
-sub _filename {
-    my ($self, $name) = @_;
-    $name =~ s/([^A-Za-z_0-9\.-])/sprintf("%%%02X", ord($1))/gex;
-    return $name;
-}
-
 sub directory {
     my ($self, $vault_name) = @_;
     unless (exists($self->{_dir}{$vault_name})) {
-        my $file = $self->cfget(qw(database inv directory))
-                   . '/' . $self->_filename($vault_name) . '.db';
-        unless (-e $file) {
-            return undef unless $self->describe_vault($vault_name);
-        }
-        $self->touchdir($self->cfget(qw(database inv directory)));
+        my $be = $self->cfget(qw(database inv backend));
         $self->{_dir}{$vault_name} =
             new App::Glacier::Directory(
-                'GDBM',
-                filename => $file,
-                encoding => 'json',
-                mode => $self->cfget(qw(database inv mode)),
-                ttl => $self->cfget(qw(database inv ttl))
-            );
+                $be,
+                $vault_name,
+                create => sub { $self->describe_vault($vault_name) },
+                %{$self->config->as_hash(qw(database inv)) // {}});
     }
     return $self->{_dir}{$vault_name};
 }
diff --git a/lib/App/Glacier/Config.pm b/lib/App/Glacier/Config.pm
index f5232d6..33d54d2 100644
--- a/lib/App/Glacier/Config.pm
+++ b/lib/App/Glacier/Config.pm
@@ -272,7 +272,7 @@ sub error {
     my $self = shift;
     my $err = shift;
     local %_ = @_;
-    $err = "$_{locus}: $err" if exists $_{locus};
+    $err = "$_{locus}: $err" if $_{locus};
     print STDERR "$err\n";
 }
 
@@ -378,7 +378,7 @@ sub check_mandatory {
     while (my ($k, $d) = each %{$kw}) {
         if (ref($d) eq 'HASH') {        
             if ($d->{mandatory} && !exists($section->{$k})) {
-                $loc = $section->{-locus} if exists($section->{-locus});
+                $loc = $section->{-locus} if $section->{-locus};
                 $self->error(exists($d->{section})
                              ? "mandatory section ["
                                 . join(' ', @_, $k)
@@ -742,12 +742,13 @@ sub as_hash {
     my $ref = $self->getref(@_);
     my $hroot = {};
     my @ar;
-        
+
     push @ar, [ '', $ref, $hroot ];
     while (my $elt = shift @ar) {
         if (is_section_ref($elt->[1])) {
             my $hr = $elt->[2]{$elt->[0]} = {};
             while (my ($kw, $val) = each %{$elt->[1]}) {
+                next if $kw =~ /^-/;
                 push @ar, [ $kw, $val, $hr ];
             }
         } else {
@@ -1077,6 +1078,7 @@ sub _lint {
         } else {
             $self->error("keyword \"$var\" is unknown",
                          locus => $value->{-locus});
+            $self->{error_count}++;
         }
     }
 }
@@ -1094,13 +1096,13 @@ after calling B<parse>.
 =cut
 
 sub lint {
-    my ($self, $synt) = @_;
-
+    my ($self, $synt, @path) = @_;
+    my $subtree = $self->getref(@path);
 #    $synt->{'*'} = { section => { '*' => 1 }} ;
-    $self->_lint($synt, $self->{conf});
-    $self->check_mandatory($synt, $self->{conf});
+    $self->_lint($synt, $subtree);
+    $self->check_mandatory($synt, $subtree);
     return 0 if $self->{error_count};
-    $self->fixup($synt);
+    $self->fixup($synt, @path);
     return $self->{error_count} == 0;
 }
 
diff --git a/lib/App/Glacier/DB.pm b/lib/App/Glacier/DB.pm
index 536ef81..aec3e04 100644
--- a/lib/App/Glacier/DB.pm
+++ b/lib/App/Glacier/DB.pm
@@ -29,6 +29,16 @@ my %transcode = (
     ]
 );
 
+sub mod_call {
+    my ($class, $backend, $code) = @_;
+    my $modname = $class . '::' . $backend;
+    my $modpath = $modname;
+    $modpath =~ s{::}{/}g;
+    $modpath .= '.pm';
+    require $modpath;
+    return &{$code}($modname);
+};
+
 sub new {