diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-02-16 14:28:01 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-02-16 16:08:43 +0200 |
commit | e547b7507e6878efdccb744b7d6cd5250c6c69b9 (patch) | |
tree | 89bba96184b32d831e06bafb8ed38bd376cb92e7 /lib/App | |
parent | 0cd31637a354ba5c0171a5f4ce8243f12739fda4 (diff) | |
download | beam-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.pm | 69 |
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}; |