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;