diff options
-rw-r--r-- | .gitignore | 13 | ||||
-rw-r--r-- | MANIFEST.SKIP | 42 | ||||
-rw-r--r-- | Makefile.PL | 32 | ||||
-rw-r--r-- | lib/Config/Parser.pm | 116 | ||||
-rw-r--r-- | lib/Config/Parser/Ini.pm | 96 | ||||
-rw-r--r-- | t/ConfigSpec.pm | 25 | ||||
-rw-r--r-- | t/TestConfig.pm | 130 | ||||
-rw-r--r-- | t/conf00.t | 22 | ||||
-rw-r--r-- | t/conf01.t | 17 | ||||
-rw-r--r-- | t/conf02.t | 13 | ||||
-rw-r--r-- | t/conf03.t | 16 | ||||
-rw-r--r-- | t/conf04.t | 17 | ||||
-rw-r--r-- | t/conf05.t | 14 |
13 files changed, 553 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..143d05b --- /dev/null +++ b/.gitignore @@ -0,0 +1,13 @@ +.emacs* +*~ +*.bak +/MANIFEST +/MYMETA.json +/MYMETA.yml +Makefile +/*.tar.gz +/tmp +/blib +/pm_to_blib +/inc +/debug.sh diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..c309198 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,42 @@ +# Avoid git files. +\B\.git\b +\B\.gitignore\b +\B\.gitmodules\b + +# Avoid Makemaker generated and utility files. +\bMANIFEST\.bak +\bMakefile$ +\bblib/ +\bMakeMaker-\d +\bpm_to_blib\.ts$ +\bpm_to_blib$ +\bblibdirs\.ts$ # 6.18 through 6.25 generated this + +# Avoid temp and backup files. +~$ +\.old$ +\#$ +\b\.# +\.bak$ +\.tmp$ +\.# +\.rej$ + +# Avoid OS-specific files/dirs +# Mac OSX metadata +\B\.DS_Store +# Mac OSX SMB mount metadata files +\B\._ + +# Avoid MYMETA files +^MYMETA\. + +# Debug settings +^debug.sh + +# Avoid Emacs settings, temporary directories and tar archives. +\B\.emacs.* +tmp/ +\.tar +\.tar\..* +\.tmp diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..8ff01ae --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,32 @@ +# -*- perl -*- +use strict; +use warnings; +use ExtUtils::MakeMaker; +use Module::Metadata; + +WriteMakefile(NAME => 'Config::Parser', + ABSTRACT_FROM => 'lib/Config/Parser.pm', + VERSION_FROM => 'lib/Config/Parser.pm', + AUTHOR => 'Sergey Poznyakoff <gray@gnu.org>', + LICENSE => 'gpl_3', + MIN_PERL_VERSION => 5.016001, + PREREQ_PM => { + 'Carp' => 0, + 'Text::ParseWords' => 0, + 'Class::Inspector' => 0, + 'Data::Dumper' => '2.135_06', + 'File::Temp' => '0.22', + }, + META_MERGE => { + 'meta-spec' => { version => 2 }, + resources => { + repository => { + type => 'git', + url => 'git://git.gnu.org.ua/config-td.git', + web => 'http://git.gnu.org.ua/cgit/config-td.git/', + }, + }, + provides => Module::Metadata->provides(version => '1.4', + dir => 'lib') + } +); diff --git a/lib/Config/Parser.pm b/lib/Config/Parser.pm new file mode 100644 index 0000000..c0a2179 --- /dev/null +++ b/lib/Config/Parser.pm @@ -0,0 +1,116 @@ +package Config::Parser; +use strict; +use warnings; +use parent 'Config::Tree'; +use Carp; +use Cwd qw(abs_path); +use Text::ParseWords; +use Class::Inspector; + +our $VERSION = "1.00"; + +sub new { + my $class = shift; + local %_ = @_; + + my @parseargs; + if (my $filename = delete $_{filename}) { + push @parseargs, $filename; + foreach my $k (qw(fh line)) { + if (my $v = delete $_{$k}) { + push @parseargs, ($k, $v); + } + } + } + + unless ($_{parameters}) { + my $subs = Class::Inspector->subclasses(__PACKAGE__); + if ($subs) { + $_{parameters} = {}; + foreach my $c (@$subs) { +# print "LOADING FROM $c\n"; + if (my $s = loadsynt($c)) { + $_{parameters} = { %{$_{parameters}}, %$s }; + } + last if $c eq $class; + } + delete $_{parameters} unless keys %{$_{parameters}}; + } + } + + my $self = $class->SUPER::new(%_); + + if (@parseargs) { + $self->parse(@parseargs); + $self->commit or croak "configuration failed"; + } + + return $self; +} + +sub findsynt { + my $class = shift; + my $file = $class; + $file =~ s{::}{/}g; + $file .= '.pm'; + $file = abs_path($INC{$file}) + or croak "can't find module file for $class"; + local ($/, *FILE); + open FILE, $file or croak "Can't open $file"; + my ($text, $data) = split /(?m)^__DATA__$/, <FILE>, 2; + close FILE; + + return () unless $data; + return ($file, 1+($text =~ tr/\n//), $data); +} + +sub loadsynt { + my ($class) = @_; + if (my ($file, $line, $data) = findsynt($class)) { + open(my $fh, '<', \$data); + my $d = $class->new(filename => $file, + fh => $fh, + line => $line, + parameters => { '*' => '*' }) + or croak "Failed to parse template at $file:$line"; + close $fh; + $d->as_hash(sub { + my ($what, $name, $val) = @_; + $name = '*' if $name eq 'ANY'; + if ($what eq 'section') { + $val->{section} = {}; + if ($name =~ s/:mandatory$//) { + $val->{mandatory} = 1; + } + ($name, $val->{section}); + } else { + my @words = parse_line('\s+', 0, $val); + my $ret = {}; + $val = shift @words; + + if ($val eq 'STRING') { + # nothing + } elsif ($val eq 'NUMBER') { + $ret->{re} = '\d+'; + } elsif ($val eq 'OCTAL') { + $ret->{re} = '[0-7]+'; + } elsif ($val eq 'HEX') { + $ret->{re} = '([0-9][A-Fa-f])+'; + } else { + unshift @words, $val; + } + + while (($val = shift @words) + && $val =~ /^:(?<kw>.+?)(?:\s*=\s*(?<val>.*))?$/) { + $ret->{$+{kw}} = $+{val} // 1; + } + $ret->{default} = $val if $val; + ($name, $ret); + } + })->{section}; + } +} + +1; + + diff --git a/lib/Config/Parser/Ini.pm b/lib/Config/Parser/Ini.pm new file mode 100644 index 0000000..b3a1ef9 --- /dev/null +++ b/lib/Config/Parser/Ini.pm @@ -0,0 +1,96 @@ +package Config::Parser::Ini; +use strict; +use warnings; +use parent 'Config::Parser'; +use Carp; +use Text::ParseWords; + +sub parse { + my $self = shift; + $self->{_filename} = shift // confess "No filename given"; + local %_ = @_; + $self->debug(1, "parsing $self->{_filename}"); + $self->_readconfig($self->{_filename}, %_); + return $self; +} + +sub filename { shift->{_filename} } + +# _readconfig(FILE) +sub _readconfig { + my $self = shift; + my $file = shift; + local %_ = @_; + my $fh = delete $_{fh}; + my $need_close; + + $self->debug(1, "reading file $file"); + unless ($fh) { + open($fh, "<", $file) + or do { + $self->error("can't open configuration file $file: $!"); + $self->{_error_count}++; + return 0; + }; + $need_close = 1; + } + + my $line = delete $_{line} // 0; + my @path; + my $include; + + while (<$fh>) { + ++$line; + chomp; + if (/\\$/) { + chop; + $_ .= <$fh>; + redo; + } + + s/^\s+//; + s/\s+$//; + s/#.*//; + next if ($_ eq ""); + + my $locus = new Config::Tree::Locus($file, $line); + + if (/^\[(.+?)\]$/) { + @path = parse_line('\s+', 0, $1); + if (@path == 1 && $path[0] eq 'include') { + $include = 1; + } else { + $include = 0; + $self->add_node(\@path, + new Config::Tree::Node::Section(locus => $locus)); + } + } elsif (/([\w_-]+)\s*=\s*(.*)/) { + my ($k, $v) = ($1, $2); + $k = lc($k) if $self->{_ci}; #FIXME:private member + + if ($include) { + if ($k eq 'path') { + $self->_readconfig($v); + } elsif ($k eq 'pathopt') { + $self->_readconfig($v) if -f $v; + } elsif ($k eq 'glob') { + foreach my $file (bsd_glob($v, 0)) { + $self->_readconfig($file); + } + } else { + $self->error("keyword \"$k\" is unknown", locus => $locus); + $self->{_error_count}++; + } + } else { + $self->add_value([@path, $k], $v, $locus); + } + } else { + $self->error("malformed line", locus => $locus); + $self->{_error_count}++; + } + } + close $fh if $need_close; +} + +1; + diff --git a/t/ConfigSpec.pm b/t/ConfigSpec.pm new file mode 100644 index 0000000..3963d83 --- /dev/null +++ b/t/ConfigSpec.pm @@ -0,0 +1,25 @@ +package ConfigSpec; +use parent 'TestConfig'; + +sub _check_abs_name { + my ($self, $valref, $prev_value, $locus) = @_; + unless ($$valref =~ m{^/}) { + $self->error("not an absolute pathname", locus => $locus); + return 0; + } + 1; +} + +1; +__DATA__ +[core] + base = STRING :mandatory null + number = NUMBER :array + size = STRING :re='\d+(?:(?i) *[kmg])' +[load] + file = STRING :check=_check_abs_name :mandatory +[load ANY param:mandatory] + mode = OCTAL + owner = STRING + + diff --git a/t/TestConfig.pm b/t/TestConfig.pm new file mode 100644 index 0000000..886e66b --- /dev/null +++ b/t/TestConfig.pm @@ -0,0 +1,130 @@ +package TestConfig; + +use strict; +use warnings; +use Carp; + +use Config::Tree qw(:sort); +use parent 'Config::Parser::Ini'; +use Data::Dumper; +use File::Temp; + +=head1 CONSTRUCTOR + + $obj = new TestConfig(KW => VAL, ...) + +Key arguments: + +=over 4 + +=item B<text> + + Text of the configuration file + +=item expect + + Reference to the list of expected errors + +=back + +=cut + +sub new { + my $class = shift; + local %_ = @_; + + my $file = new File::Temp(UNLINK => 1); + if (defined(my $text = delete $_{text})) { + print $file $text; + } else { + while (<main::DATA>) { + print $file $_; + } + } + close $file; + + my $exp = delete $_{expect}; + # FIXME: Filter out fh and line keywords? + my $self = $class->SUPER::new(%_); + $self->{_expected_errors} = $exp if $exp; + $self->parse($file->filename); + $self->{_status} = $self->commit; + + 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 %_ = @_; + carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_)); + return join $_{delim} // " ", map { + join('.', @{$_->[0]}) + . "=" + . Data::Dumper->new([$_->[1]->value]) + ->Useqq(1) + ->Terse(1) + ->Indent(0) + ->Dump + } $self->flatten(sort => SORT_PATH); +} + +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 = shift; + my $err = shift; + local %_ = @_; + push @{$self->{_errors}}, { message => $err }; + unless ($self->expected_error($err)) { + print STDERR "$_{locus}: " if $_{locus}; + print STDERR "$err\n"; + } +} + +sub errors { + my $self = shift; + return 0+@{$self->{_errors}}; +} + +sub report { + my ($self, $err) = @_; + print STDERR "$err\n" +} + +sub lint { + my $self = shift; + my $synt = shift; + local %_ = @_; + my $exp = $self->{_expected_errors} = delete $_{expect}; + carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_)); + + my $ret = $self->SUPER::lint($synt); + + if ($exp && @{$self->{_expected_errors}}) { + $self->{_status} = 0; + $self->report("not all expected errors reported: @{$self->{_expected_errors}}"); + } + return $ret; +} + +1; diff --git a/t/conf00.t b/t/conf00.t new file mode 100644 index 0000000..b497c86 --- /dev/null +++ b/t/conf00.t @@ -0,0 +1,22 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use Test; +use ConfigSpec; + +plan(tests => 1); + +my $c = new ConfigSpec; +ok($c->canonical, + q{core.base=4 core.number=[5,10] core.size="10 k" load.file="/etc/passwd" load.foobar="baz"}); + +__DATA__ +[core] + number = 5 + base = 4 + size = 10 k + number = 10 +[load] + file = /etc/passwd + foobar = baz + diff --git a/t/conf01.t b/t/conf01.t new file mode 100644 index 0000000..36b1f65 --- /dev/null +++ b/t/conf01.t @@ -0,0 +1,17 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use Test; +use ConfigSpec; + +plan(tests => 1); + +my $c = new ConfigSpec(expect => ['keyword "output" is unknown']); +ok($c->errors() == 1); + +__DATA__ +[core] + number = 5 + output = file; +[load] + file = /etc/passwd diff --git a/t/conf02.t b/t/conf02.t new file mode 100644 index 0000000..da0dc07 --- /dev/null +++ b/t/conf02.t @@ -0,0 +1,13 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use Test; +use ConfigSpec; + +plan(tests => 1); + +my $c = new ConfigSpec(expect => ['mandatory variable "load.file" not set']); +ok($c->errors() == 1); +__DATA__ +[core] + number = 5 diff --git a/t/conf03.t b/t/conf03.t new file mode 100644 index 0000000..5b49347 --- /dev/null +++ b/t/conf03.t @@ -0,0 +1,16 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use Test; +use ConfigSpec; + +plan(tests => 1); + +my $c = new ConfigSpec(expect => ['invalid value for size']); +ok($c->errors() == 1); + +__DATA__ +[core] + size = 11 +[load] + file = /etc/passwd diff --git a/t/conf04.t b/t/conf04.t new file mode 100644 index 0000000..ab4c12a --- /dev/null +++ b/t/conf04.t @@ -0,0 +1,17 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use Test; +use ConfigSpec; + +plan(tests => 1); + +my $c = new ConfigSpec(expect => ['not an absolute pathname', + 'mandatory variable "load.file" not set']); +ok($c->errors() == 2); + +__DATA__ +[core] + +[load] + file = test diff --git a/t/conf05.t b/t/conf05.t new file mode 100644 index 0000000..aaec270 --- /dev/null +++ b/t/conf05.t @@ -0,0 +1,14 @@ +# -*- perl -*- +use lib qw(t lib); +use strict; +use Test; +use ConfigSpec; + +plan(tests => 1); + +my $c = new ConfigSpec; +ok($c->canonical, q{core.base="null" load.file="/test"}); + +__DATA__ +[load] + file = /test |