aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore13
-rw-r--r--MANIFEST.SKIP42
-rw-r--r--Makefile.PL32
-rw-r--r--lib/Config/Parser.pm116
-rw-r--r--lib/Config/Parser/Ini.pm96
-rw-r--r--t/ConfigSpec.pm25
-rw-r--r--t/TestConfig.pm130
-rw-r--r--t/conf00.t22
-rw-r--r--t/conf01.t17
-rw-r--r--t/conf02.t13
-rw-r--r--t/conf03.t16
-rw-r--r--t/conf04.t17
-rw-r--r--t/conf05.t14
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

Return to:

Send suggestions and report system problems to the System administrator.