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 @@ | |||
1 | .emacs* | ||
2 | *~ | ||
3 | *.bak | ||
4 | /MANIFEST | ||
5 | /MYMETA.json | ||
6 | /MYMETA.yml | ||
7 | Makefile | ||
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 --- /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.* | ||
39 | tmp/ | ||
40 | \.tar | ||
41 | \.tar\..* | ||
42 | \.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 @@ | |||
1 | # -*- perl -*- | ||
2 | use strict; | ||
3 | use warnings; | ||
4 | use ExtUtils::MakeMaker; | ||
5 | use Module::Metadata; | ||
6 | |||
7 | WriteMakefile(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 --- /dev/null +++ b/lib/Config/Parser.pm | |||
@@ -0,0 +1,116 @@ | |||
1 | package Config::Parser; | ||
2 | use strict; | ||
3 | use warnings; | ||
4 | use parent 'Config::Tree'; | ||
5 | use Carp; | ||
6 | use Cwd qw(abs_path); | ||
7 | use Text::ParseWords; | ||
8 | use Class::Inspector; | ||
9 | |||
10 | our $VERSION = "1.00"; | ||
11 | |||
12 | sub 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 | |||
51 | sub 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 | |||
67 | sub 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 | |||
114 | 1; | ||
115 | |||
116 | |||
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 @@ | |||
1 | package Config::Parser::Ini; | ||
2 | use strict; | ||
3 | use warnings; | ||
4 | use parent 'Config::Parser'; | ||
5 | use Carp; | ||
6 | use Text::ParseWords; | ||
7 | |||
8 | sub 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 | } | ||