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 /lib/App/Glacier/DB/GDBM.pm | |
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.
Diffstat (limited to 'lib/App/Glacier/DB/GDBM.pm')
-rw-r--r-- | lib/App/Glacier/DB/GDBM.pm | 35 |
1 files changed, 34 insertions, 1 deletions
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 |