aboutsummaryrefslogtreecommitdiff
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
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.
-rw-r--r--MANIFEST3
-rw-r--r--lib/App/Beam/Config.pm69
-rw-r--r--t/TestConfig.pm102
-rw-r--r--t/conf01.t20
-rw-r--r--t/conf02.t45
-rw-r--r--t/conf03.t31
-rw-r--r--t/conf04.t39
-rw-r--r--t/config.t12
-rw-r--r--t/f.conf6
9 files changed, 274 insertions, 53 deletions
diff --git a/MANIFEST b/MANIFEST
index 211c165..2072dc4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4,4 +4,5 @@ MANIFEST
Makefile.PL
README
lib/App/Beam/Config.pm
-
+t/TestConfig.pm
+t/conf01.t
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};
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
new file mode 100644
index 0000000..ef5ce1d
--- /dev/null
+++ b/t/TestConfig.pm
@@ -0,0 +1,102 @@
+package TestConfig;
+
+use strict;
+use Carp;
+use File::Temp;
+
+require App::Beam::Config;
+our @ISA = qw(App::Beam::Config);
+
+sub new {
+ my $class = shift;
+ my $text;
+ local %_ = @_;
+
+ my $file = new File::Temp(UNLINK => 1);
+ if (defined($text = delete $_{text})) {
+ print $file $text;
+ } else {
+ while (<main::DATA>) {
+ print $file $_;
+ }
+ }
+ close $file;
+
+ my $exp = delete $_{expect};
+ my $self = $class->SUPER::new($file->filename, %_);
+ $self->{expected_errors} = $exp if $exp;
+ $self->{status} = $self->parse();
+ if ($exp && @{$self->{expected_errors}}) {
+ $self->{status} = 0;
+ $self->error("not all expected errors reported");
+ }
+ return $self;
+}
+
+sub success {
+ my ($self) = @_;
+ return $self->{status};
+}
+
+sub canonical {
+ my $self = shift;
+ local %_ = @_;
+ my $delim;
+ unless (defined($delim = delete $_{delim})) {
+ $delim = " ";
+ }
+ carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
+ return undef unless $self->success;
+
+ return join $delim, map {
+ local $Data::Dumper::Useqq = 1;
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Indent = 0;
+ $_->[0] . "=" . Data::Dumper->Dump([$_->[1]]);
+ } $self->flatten();
+}
+
+sub expected_error {
+ my ($self, $msg) = @_;
+ if (exists($self->{expected_errors})) {
+ my ($i) = grep { ${$self->{expected_errors}}[$_] eq $msg }
+ 0..$#{$self->{expected_errors}};
+ if (defined($i)) {
+ splice(@{$self->{expected_errors}}, $i, 1);
+ return 1;
+ }
+ }
+}
+
+sub error {
+ my ($self, $err) = @_;
+ if ($err =~ /^(.+?):(.+?): (.+)/) {
+ unless (exists($self->{first_line})) {
+ if (open(my $fd, '<', $0)) {
+ $self->{first_line} = 0;
+ while (<$fd>) {
+ $self->{first_line}++;
+ chomp;
+ last if /^__DATA__$/;
+ }
+ close $fd;
+ }
+ }
+ my $line = $2 + $self->{first_line};
+ push @{$self->{errors}}, { file => $0,
+ orig => $1,
+ line => $line,
+ message => $3 };
+ print STDERR "$0:$line: $3\n"
+ unless $self->expected_error($3);
+ } else {
+ push @{$self->{errors}}, { message => $err };
+ print STDERR "$err\n"
+ }
+}
+
+sub errors {
+ my $self = shift;
+ return undef if $self->success;
+ return @{$self->{errors}};
+}
diff --git a/t/conf01.t b/t/conf01.t
new file mode 100644
index 0000000..f1d1476
--- /dev/null
+++ b/t/conf01.t
@@ -0,0 +1,20 @@
+# -*- perl -*-
+use lib 't';
+use strict;
+use Test;
+use TestConfig;
+
+plan(tests => 1);
+
+my $cfg = new TestConfig;
+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/conf02.t b/t/conf02.t
new file mode 100644
index 0000000..9447060
--- /dev/null
+++ b/t/conf02.t
@@ -0,0 +1,45 @@
+# -*- 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);
+ok($cfg->isset('backend','foo','file'));
+ok($cfg->isscalar('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/conf03.t b/t/conf03.t
new file mode 100644
index 0000000..5aa8313
--- /dev/null
+++ b/t/conf03.t
@@ -0,0 +1,31 @@
+# -*- 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,
+ 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/conf04.t b/t/conf04.t
new file mode 100644
index 0000000..2f1d8d1
--- /dev/null
+++ b/t/conf04.t
@@ -0,0 +1,39 @@
+# -*- 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,
+ 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/config.t b/t/config.t
deleted file mode 100644
index d965844..0000000
--- a/t/config.t
+++ /dev/null
@@ -1,12 +0,0 @@
-# -*- perl -*-
-use lib 't';
-use strict;
-use App::Beam::Config;
-use Test;
-
-plan(tests => 2);
-
-my $cfg = new App::Beam::Config('t/f.conf');
-ok($cfg->parse() && 1);
-my $s = join " ", map { $_->[0] . "=" . $_->[1] } $cfg->flatten();
-ok($s, 'backend.foo.file=a core.retain-interval=10 core.tempdir=/tmp');
diff --git a/t/f.conf b/t/f.conf
deleted file mode 100644
index 17234a1..0000000
--- a/t/f.conf
+++ /dev/null
@@ -1,6 +0,0 @@
-[core]
- retain-interval = 10
- tempdir = /tmp
-[backend foo]
- file = a
-

Return to:

Send suggestions and report system problems to the System administrator.