From 7f86dfc65aae2470dfdfbe4bef2a92161c35f193 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Sat, 4 Mar 2017 13:15:28 +0200 Subject: Always keep locus with each statement; phase out the locations keyword. --- beam.conf | 10 +++---- lib/App/Beam.pm | 22 ++++++++++---- lib/App/Beam/Backup.pm | 16 +++++------ lib/App/Beam/Config.pm | 78 ++++++++++++++++++++++++++++---------------------- t/conf01l.t | 20 ------------- t/conf02l.t | 45 ----------------------------- t/conf03l.t | 32 --------------------- t/conf04l.t | 40 -------------------------- t/conf05l.t | 30 ------------------- t/conf06.t | 2 +- 10 files changed, 73 insertions(+), 222 deletions(-) delete mode 100644 t/conf01l.t delete mode 100644 t/conf02l.t delete mode 100644 t/conf03l.t delete mode 100644 t/conf04l.t delete mode 100644 t/conf05l.t diff --git a/beam.conf b/beam.conf index af3a047..6009e9a 100644 --- a/beam.conf +++ b/beam.conf @@ -66,13 +66,13 @@ # This variable must be set snapshot-dir = /var/lib/backups -[item system] - backend = tar - directory = / - file = etc var/spool/cron +# [item system] +# backend = tar +# directory = / +# file = etc var/spool/cron [item databases] -# backend = mysql + backend = mysql databases = a b c individual = On diff --git a/lib/App/Beam.pm b/lib/App/Beam.pm index ff4f414..84eb4cc 100644 --- a/lib/App/Beam.pm +++ b/lib/App/Beam.pm @@ -142,7 +142,6 @@ sub new { $_{parameters} = \%parameters; # $_{debug} = sub { print "D @_\n"; }; - $_{locations} = 1; my $self = $class->SUPER::new($filename, %_); @@ -155,7 +154,11 @@ sub new { sub get { my $self = shift; - return $self->SUPER::get(map { split /\./ } @_); + if (ref($_[0]) eq 'HASH') { + return $self->SUPER::get(@_); + } else { + return $self->SUPER::get(map { split /\./ } @_); + } } sub isset { @@ -217,11 +220,17 @@ sub error { my $self = shift; my $err = shift; local %_ = @_; - $err = $_{locus}->format($err) if exists($_{locus}); $self->logger('err', $err); } +sub debug { + my $self = shift; + my $lev = shift; + return unless $self->{debug} >= $lev; + $self->logger('DEBUG', @_); +} + sub abend { my $self = shift; my $code = shift; @@ -296,7 +305,6 @@ sub load_backends { map { if ($self->isset("item.$_")) { my $backend = $self->get("item.$_.backend"); - print "V $_ $backend\n"; if (exists($h{$backend})) { (); } else { @@ -314,13 +322,15 @@ sub load_backends { } split(/\s+/, $self->get('core.items'))) { my $pack = "App::Beam::Backend::" . ucfirst($be); $self->debug(1, "loading $pack"); - my $cfg = $self->get("backend.$be"); - my $obj = eval "use $pack; new $pack(\$cfg);"; + my $obj = eval "use $pack; new $pack(\$self);"; if ($@) { $self->logger('crit', $@); ++$err; + } else { + $self->{backend}{$be} = $obj; } } + $err += $self->{error_count}; exit(EX_UNAVAILABLE) if $err; } diff --git a/lib/App/Beam/Backup.pm b/lib/App/Beam/Backup.pm index 8f8c07b..3243513 100644 --- a/lib/App/Beam/Backup.pm +++ b/lib/App/Beam/Backup.pm @@ -8,13 +8,11 @@ our @ISA = qw(App::Beam); sub run { my $self = shift; - use Data::Dumper; - # $self->lock(); - # print Dumper([$self->{status}]); - # $self->status('round', $self->status('round') + 1); - # $self->status('timestamp', time()); - # $self->unlock(); - $self->set('a.b.c.d.e', 110); - print Dumper([$self->{conf}]); - print $self->get('logger.file.timestamp')."\n"; + + $self->lock(); + foreach my $item (split /\s+/, $self->get('core.items')) { + my $backend = $self->{backend}{$self->get("item.$item.backend")}; + $backend->backup($item); + } + $self->unlock(); } diff --git a/lib/App/Beam/Config.pm b/lib/App/Beam/Config.pm index 47a846e..d3ff4f7 100644 --- a/lib/App/Beam/Config.pm +++ b/lib/App/Beam/Config.pm @@ -69,12 +69,6 @@ Sets debug verbosity level. If B<1>, enables case-insensitive keyword matching. Default is B<0>, i.e. the keywords are case-sensitive. -=item B => B<0> | B<1> - -Controls the I mode. When locations mode is enabled. the -resulting object will store, along with each configuration setting, the -location in the source file where it was set. - =item B => \%hash Defines the syntax table. See below for a description of B<%hash>. @@ -193,10 +187,6 @@ sub new { $self->{ci} = $v; } - if (defined($v = delete $_{locations})) { - $self->{locations} = $v; - } - if (defined($v = delete $_{parameters})) { if (ref($v) eq 'HASH') { $self->{parameters} = $v; @@ -423,11 +413,9 @@ sub readconfig { locus => new App::Beam::Config::Locus($file, $line)); $self->{error_count}++; } - if ($self->{locations}) { - $section->{-locus} = + $section->{-locus} = new App::Beam::Config::Locus($file, $line) unless exists $section->{-locus}; - } $section->{-order} = $self->{order}++; } } elsif (/([\w_-]+)\s*=\s*(.*)/) { @@ -495,14 +483,12 @@ sub readconfig { } } } - if ($self->{locations}) { - $section->{-locus}->add($file, $line); - unless (exists($section->{$k})) { - $section->{$k}{-locus} = - new App::Beam::Config::Locus(); - } - $section->{$k}{-locus}->add($file, $line); + + $section->{-locus}->add($file, $line); + unless (exists($section->{$k})) { + $section->{$k}{-locus} = new App::Beam::Config::Locus(); } + $section->{$k}{-locus}->add($file, $line); $section->{$k}{-order} = $self->{order}++; $section->{$k}{-value} = $v; } else { @@ -919,9 +905,16 @@ sub flatten { if (ref($sort) eq 'CODE') { $sort = sub { sort $sort @_ }; } elsif ($sort == SORT_PATH) { - $sort = sub { sort { join('.',@{$a->[0]}) cmp join('.', @{$b->[0]}) } @_ }; + $sort = sub { + sort { + join('.',@{$a->[0]}) cmp join('.', @{$b->[0]}) + } @_ + }; } elsif ($sort == SORT_NATURAL) { - $sort = sub { sort { $a->[1]{-order} <=> $b->[1]{-order} } @_ }; + $sort = sub { + sort { + $a->[1]{-order} <=> $b->[1]{-order} } @_ + }; } elsif ($sort == NO_SORT) { $sort = sub { @_ }; } else { @@ -962,14 +955,9 @@ sub lint { my $sref = $synt; my @domain; for (my $i = 0; $i <= $#{$dump->[0]}; $i++) { - my $k = $dump->[0][$i]; - $k = lc($k) if $self->{ci}; - if (exists($sref->{$k})) { - push @domain, $k; - $sref = $sref->{$k}; - } elsif (exists($sref->{'*'})) { - push @domain, $k; - $sref = $sref->{'*'}; + $sref = $self->descend_synt($sref, $dump->[0][$i]); + if (defined($sref)) { + push @domain, $dump->[0][$i]; } else { if (@domain) { my %opts; @@ -980,17 +968,22 @@ sub lint { $self->{error_count}++; @skip = @domain; } else { - $self->error("keyword \"$k\" is unknown", %opts); + $self->error("keyword \"$dump->[0][$i]\" is unknown", + %opts); $self->{error_count}++; } } next outer; } - if (ref($sref) ne 'HASH') { - $sref = {}; - } elsif (exists($sref->{section})) { + if (exists($sref->{select}) && !&{$sref->{select}}(@$dump)) { + next outer; + } + + if (exists($sref->{section})) { $sref = $sref->{section}; + } elsif ($i < $#{$dump->[0]}) { + next outer; } } @@ -1051,3 +1044,20 @@ sub lint { $self->fixup($synt); return !$self->{error_count}; } + +sub descend_synt { + my ($self, $sref, $k) = @_; + $k = lc($k) if $self->{ci}; + + if (exists($sref->{$k})) { + $sref = $sref->{$k}; + } elsif (exists($sref->{'*'})) { + $sref = $sref->{'*'}; + } else { + return undef; + } + + return {} unless ref($sref) eq 'HASH'; + + return $sref; +} diff --git a/t/conf01l.t b/t/conf01l.t deleted file mode 100644 index 0436df0..0000000 --- a/t/conf01l.t +++ /dev/null @@ -1,20 +0,0 @@ -# -*- perl -*- -use lib 't'; -use strict; -use Test; -use TestConfig; - -plan(tests => 1); - -my $cfg = new TestConfig(locations => 1); -ok($cfg->canonical, 'backend.foo.file="a" core.retain-interval=10 core.tempdir="/tmp"'); - -__DATA__ -# This is a sample configuration file -[core] - retain-interval = 10 - tempdir = /tmp -[backend foo] - file = a - - diff --git a/t/conf02l.t b/t/conf02l.t deleted file mode 100644 index da4920a..0000000 --- a/t/conf02l.t +++ /dev/null @@ -1,45 +0,0 @@ -# -*- perl -*- -use lib 't'; -use strict; -use Test; -use TestConfig; - -plan(tests => 7); - -my %keywords = ( - core => { - section => { - 'retain-interval' => { mandatory => 1 }, - 'tempdir' => 1, - 'verbose' => 1, - } - }, - backend => { - section => { - file => 1 - } - } -); - -my $cfg = new TestConfig(parameters => \%keywords, locations => 1); -ok($cfg->isset('backend','foo','file')); -ok($cfg->isvariable('backend','foo','file')); -ok($cfg->get('backend','foo','file'), 'foo'); - -ok($cfg->isset('core', 'verbose') == 0); - -ok($cfg->issection('backend','foo')); - -$cfg->set('core','verbose','On'); -ok($cfg->get('core','verbose'),'On'); - -$cfg->unset('core','tmpdir'); -ok($cfg->isset('core','tmpdir') == 0); - -__DATA__ -# This is a sample configuration file -[core] - retain-interval = 10 - tempdir = /tmp -[backend foo] - file = foo diff --git a/t/conf03l.t b/t/conf03l.t deleted file mode 100644 index ff14596..0000000 --- a/t/conf03l.t +++ /dev/null @@ -1,32 +0,0 @@ -# -*- perl -*- - -use lib 't'; -use strict; -use Test; -use TestConfig; - -plan(tests => 1); - -my %keywords = ( - core => { - section => { - 'tempdir' => 1, - 'verbose' => 1, - } - }, - backend => { - section => { - file => 1 - } - } -); -my $cfg = new TestConfig(parameters => \%keywords, - locations => 1, - expect => [ 'keyword "output" is unknown' ]); -ok($cfg->errors() == 1); -__DATA__ -# This is a sample configuration file -[core] - tempdir = /tmp - output = file - diff --git a/t/conf04l.t b/t/conf04l.t deleted file mode 100644 index 1ea5477..0000000 --- a/t/conf04l.t +++ /dev/null @@ -1,40 +0,0 @@ -# -*- perl -*- -use lib 't'; -use strict; -use Test; -use TestConfig; - -plan(tests => 1); - -my %keywords = ( - core => { - section => { - 'retain-interval' => { mandatory => 1 }, - 'tempdir' => 1, - 'verbose' => 1, - } - }, - backend => { - section => { - file => { - section => { - name => { mandatory => 1 }, - local => 1 - } - } - } - } -); - -my $cfg = new TestConfig(parameters => \%keywords, - locations => 1, - expect => [ 'mandatory variable "core.retain-interval" not set', - 'mandatory variable "backend.file.name" not set' ]); -ok($cfg->errors()==2); - -__DATA__ -# This is a sample configuration file -[core] - tempdir = /tmp -[backend file] - local = 1 diff --git a/t/conf05l.t b/t/conf05l.t deleted file mode 100644 index 11f9cb1..0000000 --- a/t/conf05l.t +++ /dev/null @@ -1,30 +0,0 @@ -# -*- perl -*- -use lib 't'; -use strict; -use Test; -use TestConfig; - -plan(tests => 1); - -my %keywords = ( - core => { - section => { - list => { - array => 1 - }, - pidfile => 1 - } - } -); - -my $cfg = new TestConfig(parameters => \%keywords, locations => 1); -ok($cfg->canonical(),'core.list=["en","to",5] core.pidfile="file2"'); - -__END__ -[core] - list = en - list = to - list = 5 - - pidfile = file1 - pidfile = file2 diff --git a/t/conf06.t b/t/conf06.t index 219a5e4..af40c24 100644 --- a/t/conf06.t +++ b/t/conf06.t @@ -18,7 +18,7 @@ my %keywords = ( '*' => 1 ); -my $cfg = new TestConfig(locations => 1, parameters => \%keywords); +my $cfg = new TestConfig(parameters => \%keywords); ok($cfg->canonical, 'backend.file.level=3 backend.file.local=1 core.retain-interval=10 core.tempdir="/tmp"'); my %subkw = ( -- cgit v1.2.1