summaryrefslogtreecommitdiffabout
path: root/lib/Config
authorSergey Poznyakoff <gray@gnu.org.ua>2018-01-20 10:10:57 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2018-01-20 16:22:40 (GMT)
commite406653af5ae596d2d6f212f6ebaf66bcfe5dbf1 (patch) (side-by-side diff)
treed02955cecd38c297b70feaad168cad91c748a4f7 /lib/Config
downloadconfig-parser-e406653af5ae596d2d6f212f6ebaf66bcfe5dbf1.tar.gz
config-parser-e406653af5ae596d2d6f212f6ebaf66bcfe5dbf1.tar.bz2
Initial commit
Diffstat (limited to 'lib/Config') (more/less context) (ignore whitespace changes)
-rw-r--r--lib/Config/Parser.pm116
-rw-r--r--lib/Config/Parser/Ini.pm96
2 files changed, 212 insertions, 0 deletions
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 @@
+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
--- a/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;
+

Return to:

Send suggestions and report system problems to the System administrator.