diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2018-01-20 11:10:57 +0100 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2018-01-20 17:22:40 +0100 |
commit | e406653af5ae596d2d6f212f6ebaf66bcfe5dbf1 (patch) | |
tree | d02955cecd38c297b70feaad168cad91c748a4f7 /lib/Config/Parser.pm | |
download | config-parser-e406653af5ae596d2d6f212f6ebaf66bcfe5dbf1.tar.gz config-parser-e406653af5ae596d2d6f212f6ebaf66bcfe5dbf1.tar.bz2 |
Initial commit
Diffstat (limited to 'lib/Config/Parser.pm')
-rw-r--r-- | lib/Config/Parser.pm | 116 |
1 files changed, 116 insertions, 0 deletions
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; + + |