aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2018-12-14 10:24:31 +0200
committerSergey Poznyakoff <gray@gnu.org>2018-12-14 11:10:27 +0200
commit441dccad18df38dae1623b567f1910ec6ffcc161 (patch)
treecad182f9895b12b44f117ca049a130c62e4a1f83
parent820419c1cc238a86caf4e1955446700895201ac1 (diff)
downloadglacier-441dccad18df38dae1623b567f1910ec6ffcc161.tar.gz
glacier-441dccad18df38dae1623b567f1910ec6ffcc161.tar.bz2
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.
-rw-r--r--lib/App/Glacier/Command.pm53
-rw-r--r--lib/App/Glacier/Config.pm16
-rw-r--r--lib/App/Glacier/DB.pm41
-rw-r--r--lib/App/Glacier/DB/GDBM.pm35
-rw-r--r--lib/App/Glacier/Directory.pm8
-rw-r--r--lib/App/Glacier/Directory/GDBM.pm12
-rw-r--r--lib/App/Glacier/Job.pm3
-rw-r--r--lib/App/Glacier/Roster.pm4
-rw-r--r--lib/App/Glacier/Roster/GDBM.pm12
9 files changed, 130 insertions, 54 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,13 +190,10 @@ 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)
@@ -748,6 +748,7 @@ sub as_hash {
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 {
my ($class, $backend, %opts) = @_;
my $v;
@@ -41,25 +51,36 @@ sub new {
$self->{_decode} = $transcode{$v}[DECODE];
}
- my $modname = __PACKAGE__ . '::' . $backend;
- my $modpath = $modname;
- $modpath =~ s{::}{/}g;
- $modpath .= '.pm';
-
eval {
- require $modpath;
- $self->{_backend} = $modname->new(%opts);
+ $class->mod_call($backend, sub { $self->{_backend} = shift->new(%opts) })
};
if ($@) {
- if ($@ =~ /Can't locate $modpath/) {
- croak "unknown backend: $backend";
- }
+ # if ($@ =~ /Can't locate/) {
+ # croak "unknown backend: $backend";
+ # }
croak $@;
}
+ return undef unless $self->{_backend};
+
return $self;
}
+sub configtest {
+ my ($class, $backend, $cfg, @path) = @_;
+ my $res;
+ eval {
+ $res = $class->mod_call($backend,
+ sub {
+ shift->configtest($cfg, @path)
+ });
+ };
+ if ($@) {
+ croak $@;
+ }
+ return $res;
+}
+
sub backend { shift->{_backend} }
sub decode {
diff --git a/lib/App/Glacier/DB/GDBM.pm b/lib/App/Glacier/DB/GDBM.pm
index d485ce3..d375e0d 100644
--- a/lib/App/Glacier/DB/GDBM.pm
+++ b/lib/App/Glacier/DB/GDBM.pm
@@ -3,12 +3,32 @@ use strict;
use warnings;
use GDBM_File;
use Carp;
+use File::Basename;
sub new {
my $class = shift;
local %_ = @_;
+ my $file = delete $_{file} // croak "filename is required";
+ unless (-f $file) {
+ if (defined(my $create = delete $_{create})) {
+ if (ref($create) eq 'CODE') {
+ $create = &{$create}();
+ }
+ return undef unless $create;
+ }
+ my $dir = dirname($file);
+ unless (-d $dir) {
+ make_path($dir, {error=>\my $err});
+ for my $diag (@$err) {
+ my ($filename, $message) = %$diag;
+ $filename = $dir if ($filename eq '');
+ carp("error creating $filename: $message");
+ }
+ croak("failed to create $dir");
+ }
+ }
my $self = bless {}, $class;
- $self->{_filename} = delete $_{filename} // croak "filename is required";
+ $self->{_filename} = $file;
$self->{_mode} = delete $_{mode} || 0644;
$self->{_retries} = delete $_{retries} || 10;
$self->{_nref} = 0;
@@ -16,6 +36,19 @@ sub new {
return $self;
}
+my %lexicon = (
+ backend => 1,
+ file => { mandatory => 1 },
+ mode => { default => 0644 },
+ ttl => { default => 72000, check => \&App::Glacier::Command::ck_number },
+ encoding => { default => 'json' }
+);
+
+sub configtest {
+ my ($class, $cfg, @path) = @_;
+ $cfg->lint(\%lexicon, @path);
+}
+
# 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
diff --git a/lib/App/Glacier/Directory.pm b/lib/App/Glacier/Directory.pm
index 03b9847..d2b4571 100644
--- a/lib/App/Glacier/Directory.pm
+++ b/lib/App/Glacier/Directory.pm
@@ -10,10 +10,16 @@ our %EXPORT_TAGS = ( status => [ qw(DIR_UPTODATE DIR_PENDING DIR_OUTDATED) ] );
use constant DB_INFO_KEY => ';00INFO';
sub new {
- my ($class, $backend, %opts) = @_;
+ my ($class, $backend, $vault, %opts) = @_;
my $ttl = delete $opts{ttl};
+ # my $test = delete $opts{test};
+ (my $vault_name = $vault) =~
+ s/([^A-Za-z_0-9\.-])/sprintf("%%%02X", ord($1))/gex;
+ map { $opts{$_} =~ s/\$(?:vault|\{vault\})/$vault_name/g } keys %opts;
my $self = $class->SUPER::new($backend, %opts);
+ if ($self) {
$self->{_ttl} = $ttl;
+ }
return $self;
}
diff --git a/lib/App/Glacier/Directory/GDBM.pm b/lib/App/Glacier/Directory/GDBM.pm
new file mode 100644
index 0000000..71c36c4
--- /dev/null
+++ b/lib/App/Glacier/Directory/GDBM.pm
@@ -0,0 +1,12 @@
+package App::Glacier::Directory::GDBM;
+use parent 'App::Glacier::DB::GDBM';
+
+sub configtest {
+ my ($class, $cfg, @path) = @_;
+ unless ($cfg->isset(@path, 'file')) {
+ $cfg->set(@path, 'file', '/var/lib/glacier/inv/$vault.db');
+ }
+ $class->SUPER::configtest($cfg, @path);
+}
+
+1;
diff --git a/lib/App/Glacier/Job.pm b/lib/App/Glacier/Job.pm
index 38de5f0..d6b6820 100644
--- a/lib/App/Glacier/Job.pm
+++ b/lib/App/Glacier/Job.pm
@@ -125,19 +125,16 @@ sub get {
sub is_finished {
my $self = shift;
- my $db = $self->_get_db;
return defined($self->get('StatusCode'));
}
sub is_completed {
my $self = shift;
- my $db = $self->_get_db;
return ($self->get('StatusCode') || '') eq 'Succeeded';
}
sub status {
my $self = shift;
- my $db = $self->_get_db;
my $status = $self->get('StatusCode');
return undef unless defined $status;
return wantarray ? ($status, $self->get('StatusMessage')) : $status;
diff --git a/lib/App/Glacier/Roster.pm b/lib/App/Glacier/Roster.pm
new file mode 100644
index 0000000..ee56ff5
--- /dev/null
+++ b/lib/App/Glacier/Roster.pm
@@ -0,0 +1,4 @@
+package App::Glacier::Roster;
+use parent 'App::Glacier::DB';
+
+1;
diff --git a/lib/App/Glacier/Roster/GDBM.pm b/lib/App/Glacier/Roster/GDBM.pm
new file mode 100644
index 0000000..58ef35c
--- /dev/null
+++ b/lib/App/Glacier/Roster/GDBM.pm
@@ -0,0 +1,12 @@
+package App::Glacier::Roster::GDBM;
+use parent 'App::Glacier::DB::GDBM';
+
+sub configtest {
+ my ($class, $cfg, @path) = @_;
+ unless ($cfg->isset(@path, 'file')) {
+ $cfg->set(@path, 'file', '/var/lib/glacier/job.db');
+ }
+ $class->SUPER::configtest($cfg, @path);
+}
+
+1;

Return to:

Send suggestions and report system problems to the System administrator.