summaryrefslogtreecommitdiffabout
Unidiff
Diffstat (more/less context) (show whitespace changes)
-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
--- a/dev/null
+++ b/.gitignore
@@ -0,0 +1,13 @@
1.emacs*
2*~
3*.bak
4/MANIFEST
5/MYMETA.json
6/MYMETA.yml
7Makefile
8/*.tar.gz
9/tmp
10/blib
11/pm_to_blib
12/inc
13/debug.sh
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..c309198
--- a/dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,42 @@
1# Avoid git files.
2\B\.git\b
3\B\.gitignore\b
4\B\.gitmodules\b
5
6# Avoid Makemaker generated and utility files.
7\bMANIFEST\.bak
8\bMakefile$
9\bblib/
10\bMakeMaker-\d
11\bpm_to_blib\.ts$
12\bpm_to_blib$
13\bblibdirs\.ts$ # 6.18 through 6.25 generated this
14
15# Avoid temp and backup files.
16~$
17\.old$
18\#$
19\b\.#
20\.bak$
21\.tmp$
22\.#
23\.rej$
24
25# Avoid OS-specific files/dirs
26# Mac OSX metadata
27\B\.DS_Store
28# Mac OSX SMB mount metadata files
29\B\._
30
31# Avoid MYMETA files
32^MYMETA\.
33
34# Debug settings
35^debug.sh
36
37# Avoid Emacs settings, temporary directories and tar archives.
38\B\.emacs.*
39tmp/
40\.tar
41\.tar\..*
42\.tmp
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..8ff01ae
--- a/dev/null
+++ b/Makefile.PL
@@ -0,0 +1,32 @@
1# -*- perl -*-
2use strict;
3use warnings;
4use ExtUtils::MakeMaker;
5use Module::Metadata;
6
7WriteMakefile(NAME => 'Config::Parser',
8 ABSTRACT_FROM => 'lib/Config/Parser.pm',
9 VERSION_FROM => 'lib/Config/Parser.pm',
10 AUTHOR => 'Sergey Poznyakoff <gray@gnu.org>',
11 LICENSE => 'gpl_3',
12 MIN_PERL_VERSION => 5.016001,
13 PREREQ_PM => {
14 'Carp' => 0,
15 'Text::ParseWords' => 0,
16 'Class::Inspector' => 0,
17 'Data::Dumper' => '2.135_06',
18 'File::Temp' => '0.22',
19 },
20 META_MERGE => {
21 'meta-spec' => { version => 2 },
22 resources => {
23 repository => {
24 type => 'git',
25 url => 'git://git.gnu.org.ua/config-td.git',
26 web => 'http://git.gnu.org.ua/cgit/config-td.git/',
27 },
28 },
29 provides => Module::Metadata->provides(version => '1.4',
30 dir => 'lib')
31 }
32);
diff --git a/lib/Config/Parser.pm b/lib/Config/Parser.pm
new file mode 100644
index 0000000..c0a2179
--- a/dev/null
+++ b/lib/Config/Parser.pm
@@ -0,0 +1,116 @@
1package Config::Parser;
2use strict;
3use warnings;
4use parent 'Config::Tree';
5use Carp;
6use Cwd qw(abs_path);
7use Text::ParseWords;
8use Class::Inspector;
9
10our $VERSION = "1.00";
11
12sub new {
13 my $class = shift;
14 local %_ = @_;
15
16 my @parseargs;
17 if (my $filename = delete $_{filename}) {
18 push @parseargs, $filename;
19 foreach my $k (qw(fh line)) {
20 if (my $v = delete $_{$k}) {
21 push @parseargs, ($k, $v);
22 }
23 }
24 }
25
26 unless ($_{parameters}) {
27 my $subs = Class::Inspector->subclasses(__PACKAGE__);
28 if ($subs) {
29 $_{parameters} = {};
30 foreach my $c (@$subs) {
31 # print "LOADING FROM $c\n";
32 if (my $s = loadsynt($c)) {
33 $_{parameters} = { %{$_{parameters}}, %$s };
34 }
35 last if $c eq $class;
36 }
37 delete $_{parameters} unless keys %{$_{parameters}};
38 }
39 }
40
41 my $self = $class->SUPER::new(%_);
42
43 if (@parseargs) {
44 $self->parse(@parseargs);
45 $self->commit or croak "configuration failed";
46 }
47
48 return $self;
49}
50
51sub findsynt {
52 my $class = shift;
53 my $file = $class;
54 $file =~ s{::}{/}g;
55 $file .= '.pm';
56 $file = abs_path($INC{$file})
57 or croak "can't find module file for $class";
58 local ($/, *FILE);
59 open FILE, $file or croak "Can't open $file";
60 my ($text, $data) = split /(?m)^__DATA__$/, <FILE>, 2;
61 close FILE;
62
63 return () unless $data;
64 return ($file, 1+($text =~ tr/\n//), $data);
65}
66
67sub loadsynt {
68 my ($class) = @_;
69 if (my ($file, $line, $data) = findsynt($class)) {
70 open(my $fh, '<', \$data);
71 my $d = $class->new(filename => $file,
72 fh => $fh,
73 line => $line,
74 parameters => { '*' => '*' })
75 or croak "Failed to parse template at $file:$line";
76 close $fh;
77 $d->as_hash(sub {
78 my ($what, $name, $val) = @_;
79 $name = '*' if $name eq 'ANY';
80 if ($what eq 'section') {
81 $val->{section} = {};
82 if ($name =~ s/:mandatory$//) {
83 $val->{mandatory} = 1;
84 }
85 ($name, $val->{section});
86 } else {
87 my @words = parse_line('\s+', 0, $val);
88 my $ret = {};
89 $val = shift @words;
90
91 if ($val eq 'STRING') {
92 # nothing
93 } elsif ($val eq 'NUMBER') {
94 $ret->{re} = '\d+';
95 } elsif ($val eq 'OCTAL') {
96 $ret->{re} = '[0-7]+';
97 } elsif ($val eq 'HEX') {
98 $ret->{re} = '([0-9][A-Fa-f])+';
99 } else {
100 unshift @words, $val;
101 }
102
103 while (($val = shift @words)
104 && $val =~ /^:(?<kw>.+?)(?:\s*=\s*(?<val>.*))?$/) {
105 $ret->{$+{kw}} = $+{val} // 1;
106 }
107 $ret->{default} = $val if $val;
108 ($name, $ret);
109 }
110 })->{section};
111 }
112}
113
1141;
115
116
diff --git a/lib/Config/Parser/Ini.pm b/lib/Config/Parser/Ini.pm
new file mode 100644
index 0000000..b3a1ef9
--- a/dev/null
+++ b/lib/Config/Parser/Ini.pm
@@ -0,0 +1,96 @@
1package Config::Parser::Ini;
2use strict;
3use warnings;
4use parent 'Config::Parser';
5use Carp;
6use Text::ParseWords;
7
8sub parse {
9 my $self = shift;
10 $self->{_filename} = shift // confess "No filename given";
11 local %_ = @_;
12 $self->debug(1, "parsing $self->{_filename}");
13 $self->_readconfig($self->{_filename}, %_);
14 return $self;
15}
16
17sub filename { shift->{_filename} }
18
19# _readconfig(FILE)
20sub _readconfig {
21 my $self = shift;
22 my $file = shift;
23 local %_ = @_;
24 my $fh = delete $_{fh};
25 my $need_close;
26
27 $self->debug(1, "reading file $file");
28 unless ($fh) {
29 open($fh, "<", $file)
30 or do {
31 $self->error("can't open configuration file $file: $!");
32 $self->{_error_count}++;
33 return 0;
34 };
35 $need_close = 1;
36 }
37
38 my $line = delete $_{line} // 0;
39 my @path;
40 my $include;
41
42 while (<$fh>) {
43 ++$line;
44 chomp;
45 if (/\\$/) {
46 chop;
47 $_ .= <$fh>;
48 redo;
49 }
50
51 s/^\s+//;
52 s/\s+$//;
53 s/#.*//;
54 next if ($_ eq "");
55
56 my $locus = new Config::Tree::Locus($file, $line);
57
58 if (/^\[(.+?)\]$/) {
59 @path = parse_line('\s+', 0, $1);
60 if (@path == 1 && $path[0] eq 'include') {
61 $include = 1;
62 } else {
63 $include = 0;
64 $self->add_node(\@path,
65 new Config::Tree::Node::Section(locus => $locus));
66 }
67 } elsif (/([\w_-]+)\s*=\s*(.*)/) {
68 my ($k, $v) = ($1, $2);
69 $k = lc($k) if $self->{_ci}; #FIXME:private member
70
71 if ($include) {
72 if ($k eq 'path') {
73 $self->_readconfig($v);
74 } elsif ($k eq 'pathopt') {
75 $self->_readconfig($v) if -f $v;
76 } elsif ($k eq 'glob') {
77 foreach my $file (bsd_glob($v, 0)) {
78 $self->_readconfig($file);
79 }
80 } else {
81 $self->error("keyword \"$k\" is unknown", locus => $locus);
82 $self->{_error_count}++;
83 }
84 } else {
85 $self->add_value([@path, $k], $v, $locus);
86 }
87 } else {
88 $self->error("malformed line", locus => $locus);
89 $self->{_error_count}++;
90 }
91 }
92 close $fh if $need_close;
93}
94
951;
96
diff --git a/t/ConfigSpec.pm b/t/ConfigSpec.pm
new file mode 100644
index 0000000..3963d83
--- a/dev/null
+++ b/t/ConfigSpec.pm
@@ -0,0 +1,25 @@
1package ConfigSpec;
2use parent 'TestConfig';
3
4sub _check_abs_name {
5 my ($self, $valref, $prev_value, $locus) = @_;
6 unless ($$valref =~ m{^/}) {
7 $self->error("not an absolute pathname", locus => $locus);
8 return 0;
9 }
10 1;
11}
12
131;
14__DATA__
15[core]
16 base = STRING :mandatory null
17 number = NUMBER :array
18 size = STRING :re='\d+(?:(?i) *[kmg])'
19[load]
20 file = STRING :check=_check_abs_name :mandatory
21[load ANY param:mandatory]
22 mode = OCTAL
23 owner = STRING
24
25
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
new file mode 100644
index 0000000..886e66b
--- a/dev/null
+++ b/t/TestConfig.pm
@@ -0,0 +1,130 @@
1package TestConfig;
2
3use strict;
4use warnings;
5use Carp;
6
7use Config::Tree qw(:sort);
8use parent 'Config::Parser::Ini';
9use Data::Dumper;
10use File::Temp;
11
12=head1 CONSTRUCTOR
13
14 $obj = new TestConfig(KW => VAL, ...)
15
16Key arguments:
17
18=over 4
19
20=item B<text>
21
22 Text of the configuration file
23
24=item expect
25
26 Reference to the list of expected errors
27
28=back
29
30=cut
31
32sub new {
33 my $class = shift;
34 local %_ = @_;
35
36 my $file = new File::Temp(UNLINK => 1);
37 if (defined(my $text = delete $_{text})) {
38 print $file $text;
39 } else {
40 while (<main::DATA>) {
41 print $file $_;
42 }
43 }
44 close $file;
45
46 my $exp = delete $_{expect};
47 # FIXME: Filter out fh and line keywords?
48 my $self = $class->SUPER::new(%_);
49 $self->{_expected_errors} = $exp if $exp;
50 $self->parse($file->filename);
51 $self->{_status} = $self->commit;
52
53 if ($exp && @{$self->{_expected_errors}}) {
54 $self->{_status} = 0;
55 $self->error("not all expected errors reported");
56 }
57 return $self;
58}
59
60sub success {
61 my ($self) = @_;
62 return $self->{_status};
63}
64
65sub canonical {
66 my $self = shift;
67 local %_ = @_;
68 carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
69 return join $_{delim} // " ", map {
70 join('.', @{$_->[0]})
71 . "="
72 . Data::Dumper->new([$_->[1]->value])
73 ->Useqq(1)
74 ->Terse(1)
75 ->Indent(0)
76 ->Dump
77 } $self->flatten(sort => SORT_PATH);
78}
79
80sub expected_error {
81 my ($self, $msg) = @_;
82
83 if (exists($self->{_expected_errors})) {
84 my ($i) = grep { ${$self->{_expected_errors}}[$_] eq $msg }
85 0..$#{$self->{_expected_errors}};
86 if (defined($i)) {
87 splice(@{$self->{_expected_errors}}, $i, 1);
88 return 1;
89 }
90 }
91}
92
93sub error {
94 my $self = shift;
95 my $err = shift;
96 local %_ = @_;
97 push @{$self->{_errors}}, { message => $err };
98 unless ($self->expected_error($err)) {
99 print STDERR "$_{locus}: " if $_{locus};
100 print STDERR "$err\n";
101 }
102}
103
104sub errors {
105 my $self = shift;
106 return 0+@{$self->{_errors}};
107}
108
109sub report {
110 my ($self, $err) = @_;
111 print STDERR "$err\n"
112}
113
114sub lint {
115 my $self = shift;
116 my $synt = shift;
117 local %_ = @_;
118 my $exp = $self->{_expected_errors} = delete $_{expect};
119 carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
120
121 my $ret = $self->SUPER::lint($synt);
122
123 if ($exp && @{$self->{_expected_errors}}) {
124 $self->{_status} = 0;
125 $self->report("not all expected errors reported: @{$self->{_expected_errors}}");
126 }
127 return $ret;
128}
129
1301;
diff --git a/t/conf00.t b/t/conf00.t
new file mode 100644
index 0000000..b497c86
--- a/dev/null
+++ b/t/conf00.t
@@ -0,0 +1,22 @@
1# -*- perl -*-
2use lib qw(t lib);
3use strict;
4use Test;
5use ConfigSpec;
6
7plan(tests => 1);
8
9my $c = new ConfigSpec;
10ok($c->canonical,
11 q{core.base=4 core.number=[5,10] core.size="10 k" load.file="/etc/passwd" load.foobar="baz"});
12
13__DATA__
14[core]
15 number = 5
16 base = 4
17 size = 10 k
18 number = 10
19[load]
20 file = /etc/passwd
21 foobar = baz
22
diff --git a/t/conf01.t b/t/conf01.t
new file mode 100644
index 0000000..36b1f65
--- a/dev/null
+++ b/t/conf01.t
@@ -0,0 +1,17 @@
1# -*- perl -*-
2use lib qw(t lib);
3use strict;
4use Test;
5use ConfigSpec;
6
7plan(tests => 1);
8
9my $c = new ConfigSpec(expect => ['keyword "output" is unknown']);
10ok($c->errors() == 1);
11
12__DATA__
13[core]
14 number = 5
15 output = file;
16[load]
17 file = /etc/passwd
diff --git a/t/conf02.t b/t/conf02.t
new file mode 100644
index 0000000..da0dc07
--- a/dev/null
+++ b/t/conf02.t
@@ -0,0 +1,13 @@
1# -*- perl -*-
2use lib qw(t lib);
3use strict;
4use Test;
5use ConfigSpec;
6
7plan(tests => 1);
8
9my $c = new ConfigSpec(expect => ['mandatory variable "load.file" not set']);
10ok($c->errors() == 1);
11__DATA__
12[core]
13 number = 5
diff --git a/t/conf03.t b/t/conf03.t
new file mode 100644
index 0000000..5b49347
--- a/dev/null
+++ b/t/conf03.t
@@ -0,0 +1,16 @@
1# -*- perl -*-
2use lib qw(t lib);
3use strict;
4use Test;
5use ConfigSpec;
6
7plan(tests => 1);
8
9my $c = new ConfigSpec(expect => ['invalid value for size']);
10ok($c->errors() == 1);
11
12__DATA__
13[core]
14 size = 11
15[load]
16 file = /etc/passwd
diff --git a/t/conf04.t b/t/conf04.t
new file mode 100644
index 0000000..ab4c12a
--- a/dev/null
+++ b/t/conf04.t
@@ -0,0 +1,17 @@
1# -*- perl -*-
2use lib qw(t lib);
3use strict;
4use Test;
5use ConfigSpec;
6
7plan(tests => 1);
8
9my $c = new ConfigSpec(expect => ['not an absolute pathname',
10 'mandatory variable "load.file" not set']);
11ok($c->errors() == 2);
12
13__DATA__
14[core]
15
16[load]
17 file = test
diff --git a/t/conf05.t b/t/conf05.t
new file mode 100644
index 0000000..aaec270
--- a/dev/null
+++ b/t/conf05.t
@@ -0,0 +1,14 @@
1# -*- perl -*-
2use lib qw(t lib);
3use strict;
4use Test;
5use ConfigSpec;
6
7plan(tests => 1);
8
9my $c = new ConfigSpec;
10ok($c->canonical, q{core.base="null" load.file="/test"});
11
12__DATA__
13[load]
14 file = /test

Return to:

Send suggestions and report system problems to the System administrator.