diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2018-12-14 10:24:31 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2018-12-14 11:10:27 +0200 |
commit | 441dccad18df38dae1623b567f1910ec6ffcc161 (patch) | |
tree | cad182f9895b12b44f117ca049a130c62e4a1f83 | |
parent | 820419c1cc238a86caf4e1955446700895201ac1 (diff) | |
download | glacier-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.pm | 53 | ||||
-rw-r--r-- | lib/App/Glacier/Config.pm | 16 | ||||
-rw-r--r-- | lib/App/Glacier/DB.pm | 41 | ||||
-rw-r--r-- | lib/App/Glacier/DB/GDBM.pm | 35 | ||||
-rw-r--r-- | lib/App/Glacier/Directory.pm | 8 | ||||
-rw-r--r-- | lib/App/Glacier/Directory/GDBM.pm | 12 | ||||
-rw-r--r-- | lib/App/Glacier/Job.pm | 3 | ||||
-rw-r--r-- | lib/App/Glacier/Roster.pm | 4 | ||||
-rw-r--r-- | lib/App/Glacier/Roster/GDBM.pm | 12 |
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; |