diff options
Diffstat (limited to 'lib/Config')
-rw-r--r-- | lib/Config/Parser.pm | 116 | ||||
-rw-r--r-- | lib/Config/Parser/Ini.pm | 96 |
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 --- /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; + |