aboutsummaryrefslogtreecommitdiff
path: root/lib/App
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-02-16 14:28:01 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2017-02-16 16:08:43 +0200
commite547b7507e6878efdccb744b7d6cd5250c6c69b9 (patch)
tree89bba96184b32d831e06bafb8ed38bd376cb92e7 /lib/App
parent0cd31637a354ba5c0171a5f4ce8243f12739fda4 (diff)
downloadbeam-e547b7507e6878efdccb744b7d6cd5250c6c69b9.tar.gz
beam-e547b7507e6878efdccb744b7d6cd5250c6c69b9.tar.bz2
Improve config parser. Add more tests.
* MANIFEST: Update. * lib/App/Beam/Config.pm: Rewrite 'error' as method. Check for missing mandatory statements. * t/TestConfig.pm: New file. * t/conf01.t: New file. * t/conf02.t: New file. * t/conf03.t: New file. * t/config.t: Remove. * t/f.conf: Remove.
Diffstat (limited to 'lib/App')
-rw-r--r--lib/App/Beam/Config.pm69
1 files changed, 35 insertions, 34 deletions
diff --git a/lib/App/Beam/Config.pm b/lib/App/Beam/Config.pm
index dcc6137..d9899a7 100644
--- a/lib/App/Beam/Config.pm
+++ b/lib/App/Beam/Config.pm
@@ -27,9 +27,9 @@ our @ISA = qw(Exporter);
our $VERSION = "1.00";
-sub deferror {
- my ($err) = @_;
- carp "$err";
+sub error {
+ my ($self, $err) = @_;
+ print STDERR "$err\n";
}
sub new {
@@ -40,17 +40,6 @@ sub new {
my $v;
my $err;
- if (defined($v = delete $_{error})) {
- if (ref($v) eq 'CODE') {
- $self->{error} = $v;
- } else {
- carp "error must refer to a CODE";
- ++$err;
- }
- } else {
- $self->{error} = \&deferror;
- }
-
if (defined($v = delete $_{debug})) {
if (ref($v) eq 'CODE') {
$self->{debug} = $v;
@@ -166,20 +155,29 @@ sub parse_section {
}
sub check_mandatory {
- my ($self, $section, $kw, $loc, $s) = @_;
+ my $self = shift;
+ my $kw = shift;
+ my $section = shift;
+ my $loc = shift;
+
my $err = 0;
while (my ($k, $d) = each %{$kw}) {
- if (ref($d) eq 'HASH'
- and $d->{mandatory}
- and !exists($section->{$k})) {
- if (exists($d->{section})) {
- if ($s) {
- $self->{error}("$loc: mandatory section [$k] not present");
+ if (ref($d) eq 'HASH') {
+ if ($d->{mandatory} && !exists($section->{$k})) {
+ if (exists($d->{section})) {
+ $self->error("$loc: mandatory section ["
+ . join(' ', @_, $k)
+ . "] not present");
+ ++$err;
+ } else {
+ $self->error("$loc: mandatory variable \""
+ . join('.', @_, $k)
+ . "\" not set");
++$err;
}
- } else {
- $self->{error}("$loc: mandatory variable \"$k\" not set");
- ++$err;
+ }
+ if (exists($d->{section}) && exists($section->{$k})) {
+ $err += $self->check_mandatory($d->{section}, $section->{$k}, $loc, @_, $k);
}
}
}
@@ -190,11 +188,12 @@ sub readconfig {
my $self = shift;
my $file = shift;
my $conf = shift;
-
+ local %_ = @_;
+
&{$self->{debug}}("reading file $file") if exists $self->{debug};
open(my $fd, "<", $file)
or do {
- $self->{error}("can't open configuration file $file: $!");
+ $self->error("can't open configuration file $file: $!");
return 1;
};
@@ -228,7 +227,7 @@ sub readconfig {
$include = 1;
} else {
($section, $rootname, $kw) = $self->parse_section($conf, $1);
- $self->{error}("$file:$line: unknown section")
+ $self->error("$file:$line: unknown section")
if (exists($self->{parameters}) and !defined($kw));
}
} elsif (/([\w_-]+)\s*=\s*(.*)/) {
@@ -246,7 +245,7 @@ sub readconfig {
$err += $self->readconfig($file, $conf, include => 1);
}
} else {
- $self->{error}("$file:$line: unknown keyword");
+ $self->error("$file:$line: keyword \"$k\" is unknown");
++$err;
}
next;
@@ -256,7 +255,7 @@ sub readconfig {
my $x = $kw->{$k};
$x = $kw->{'*'} unless defined $x;
if (!defined($x)) {
- $self->{error}("$file:$line: unknown keyword $k");
+ $self->error("$file:$line: keyword \"$k\" is unknown");
++$err;
next;
} elsif (ref($x) eq 'HASH') {
@@ -264,19 +263,19 @@ sub readconfig {
my $prev_val = $section->{$k} if exists $section->{$k};
if (exists($x->{re})) {
if ($v !~ /$x->{re}/) {
- $self->{error}("$file:$line: invalid value for $k");
+ $self->error("$file:$line: invalid value for $k");
++$err;
next;
}
if (exists($x->{check})
and defined($errstr = &{$x->{check}}(\$v, $prev_val))) {
- $self->{error}("$file:$line: $errstr");
+ $self->error("$file:$line: $errstr");
++$err;
next;
}
} elsif (exists($x->{check})) {
if (defined($errstr = &{$x->{check}}(\$v, $prev_val))) {
- $self->{error}("$file:$line: $errstr");
+ $self->error("$file:$line: $errstr");
++$err;
next;
}
@@ -286,12 +285,14 @@ sub readconfig {
$section->{$k} = $v;
} else {
- $self->{error}("$file:$line: malformed line");
+ $self->error("$file:$line: malformed line");
++$err;
next;
}
}
close $fd;
+ $err += $self->check_mandatory($self->{parameters}, $conf, "$file:$line")
+ unless $_{include};
return $err;
}
@@ -318,7 +319,7 @@ sub parse {
$self->{updated} = $self->{rw};
return 1;
} elsif ($@) {
- $self->{error}("warning: unable to load configuration cache: $@");
+ $self->error("warning: unable to load configuration cache: $@");
}
}
unlink $self->{cachefile};

Return to:

Send suggestions and report system problems to the System administrator.