aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-03-04 13:15:28 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2017-03-04 13:16:08 +0200
commit7f86dfc65aae2470dfdfbe4bef2a92161c35f193 (patch)
tree4c414e8ebb1971da2e46ec357115510980d8af65
parent14c6474d73fae6aeaa77dd19e10cf5615448aefb (diff)
downloadbeam-7f86dfc65aae2470dfdfbe4bef2a92161c35f193.tar.gz
beam-7f86dfc65aae2470dfdfbe4bef2a92161c35f193.tar.bz2
Always keep locus with each statement; phase out the locations keyword.
-rw-r--r--beam.conf10
-rw-r--r--lib/App/Beam.pm22
-rw-r--r--lib/App/Beam/Backup.pm16
-rw-r--r--lib/App/Beam/Config.pm78
-rw-r--r--t/conf01l.t20
-rw-r--r--t/conf02l.t45
-rw-r--r--t/conf03l.t32
-rw-r--r--t/conf04l.t40
-rw-r--r--t/conf05l.t30
-rw-r--r--t/conf06.t2
10 files changed, 73 insertions, 222 deletions
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<locations> => B<0> | B<1>
-
-Controls the I<locations> 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<parameters> => \%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 = (

Return to:

Send suggestions and report system problems to the System administrator.