# -*- perl -*-


use strict;

package CHIRP::Parse;


my(%parser_map) = (
	'default' => \&TagValueParser,
	'oid' => \&SimpleParser,
	'rra' => \&SimpleParser,
	'html' => \&TextParser,
	'color' => \&SimpleParser,
	'range' => \&SimpleParser);

my($current_line);
my($chunk_line);

sub GenConfig {
	my($config, $configfile) = @_;
	my($chunk) = "";
	my($dict);

	if(!open(CONFIGFILE, "< $configfile")) {
		print STDERR "ERROR: Unable to open $configfile\n";
		return $config;
	}

	$current_line = 0;
	$chunk_line = 0;
	while(<CONFIGFILE>) {
		$current_line++;
		if (m/^\s*#/) {
			# Comment
		} elsif (m/^\s*$/) {
			# Empty line
			if($chunk !~ /^$/) {
				$chunk .= $_;
			}
		} elsif (m/^\s.*/) {
			# Continuation
			if($chunk !~ /^$/) {
				$chunk .= $_;
			} else {
				print STDERR "WARNING: Extraneous characters at line $current_line ignored: >$_<\n";
			}
		} else {
			# Initial line
			if ($chunk !~ /^$/) {
				($dict) = $chunk =~ /([^\s]*)\s*/;
				if(defined($parser_map{lc($dict)})) {
					&{$parser_map{lc($dict)}}($config, $chunk);
				} else {
					&{$parser_map{'default'}}($config, $chunk);
				}
			}
			$chunk = $_;
			$chunk_line = $current_line;
		}
	}
	if ($chunk !~ /^$/) {
		($dict) = $chunk =~ /([^\s]*)\s*/;
		if(defined($parser_map{lc($dict)})) {
			&{$parser_map{lc($dict)}}($config, $chunk);
		} else {
			&{$parser_map{'default'}}($config, $chunk);
		}
	}

	close(CONFIGFILE);

	return $config;
}

sub TextParser {
	my($config, $chunk) = @_;
	my($dict, $tag, $value);

	$dict = PopToken(\$chunk);
	$tag = PopToken(\$chunk);
	$value = $chunk;

	if (!defined($dict)) {
		print STDERR "WARNING: Parse error starting at line $chunk_line: Dictionary is missing\n";
		return undef;
	}
	if (!defined($tag)) {
		print STDERR "WARNING: Parse error starting at line $chunk_line: Tag is missing\n";
		return undef;
	}

	$$config->{lc($dict)}->{lc($tag)} = $value;
	if(!defined($$config->{lc($dict)}->{"--order--"})) {
		$$config->{lc($dict)}->{"--order--"} = lc($tag);
	} else {
		$$config->{lc($dict)}->{"--order--"} .= "," . lc($tag);
	}

	return $config;
}

sub SimpleParser {
	my($config, $chunk) = @_;
	my(@tokenlist);
	my($dict, $tag, $value);

	@tokenlist = Tokenize(\$chunk);

	$dict = shift(@tokenlist);
	$tag = shift(@tokenlist);
	$value = shift(@tokenlist);

	if (!defined($dict)) {
		print STDERR "WARNING: Parse error starting at line $chunk_line: Dictionary is missing\n";
		return undef;
	}
	if (!defined($tag)) {
		print STDERR "WARNING: Parse error starting at line $chunk_line: Tag is missing\n";
		return undef;
	}
	if (!defined($value)) {
		print STDERR "WARNING: Parse error starting at line $chunk_line: Value is missing\n";
		return undef;
	}
	if($#tokenlist >= 0) {
		print STDERR "WARNING: Parse warning staring at line $chunk_line: Extra parameters ignored: >@tokenlist<\n";
	}

	$$config->{lc($dict)}->{lc($tag)} = $value;
	if(!defined($$config->{lc($dict)}->{"--order--"})) {
		$$config->{lc($dict)}->{"--order--"} = lc($tag);
	} else {
		$$config->{lc($dict)}->{"--order--"} .= "," . lc($tag);
	}

	return $config;
}

sub TagValueParser {
	my($config, $chunk) = @_;
	my(@tokenlist);
	my($dict, $name, $tag, $equal, $value);

	@tokenlist = Tokenize(\$chunk);

	$dict = shift(@tokenlist);
	$name = shift(@tokenlist);

	if (!defined($dict)) {
		print STDERR "WARNING: Parse error starting at line $chunk_line: Dictionary is missing\n";
		return undef;
	}
	if (!defined($name)) {
		print STDERR "WARNING: Parse error starting at line $chunk_line: Name is missing\n";
		return undef;
	}

	while($#tokenlist >= 2) {
		$tag = shift(@tokenlist);
		$equal = shift(@tokenlist);
		$value = shift(@tokenlist);

		if($equal !~ /^=$/) {
			print STDERR "WARNING: Parse error starting at line $chunk_line: Tag and value not separated by \"=\"\n";
		} else {
			if($name =~ /^\*$/) {
				foreach my $thing (keys % {$$config->{lc($dict)}}) {
					$$config->{lc($dict)}->{lc($thing)}->{lc($tag)} = $value;
				}
			} else {
				$$config->{lc($dict)}->{lc($name)}->{lc($tag)} = $value;
			}
		}
	}
	if($#tokenlist >= 0) {
		print STDERR "WARNING: Parse warning staring at line $chunk_line: Extra parameters ignored: >@tokenlist<\n";
	}

	if(!defined($$config->{lc($dict)}->{"--order--"})) {
		$$config->{lc($dict)}->{"--order--"} = lc($name);
	} else {
		$$config->{lc($dict)}->{"--order--"} .= "," . lc($name);
	}

	return $config;
}

sub PopToken {
	my($chunk) = @_;
	my($token) = ();

	$$chunk =~ s/^\s*//;

	if ($$chunk =~ /^$/) {
		return undef;
	}

	if ($$chunk =~ /^"/) {
		# Token is delimited by "
		$$chunk =~ s/^("((\\")|([^"]))*")\s*//;
		$token = $1;
	} elsif ($$chunk =~ /^'/) {
		# Token is delimited by '
		$$chunk =~ s/^('((\\')|([^']))*')\s*//;
		$token = $1;
	} else {
		# Token is delimited by white space
		$$chunk =~ s/^([^\s]*)\s*//;
		$token = $1;
	}

	return $token;
}

sub Tokenize {
	my($chunk) = @_;
	my($token);
	my(@tokenlist) = ();
	my($tmp);

	while($$chunk !~ /^$/) {
		$token = PopToken($chunk);
		if (defined($token)) {
			push(@tokenlist, $token);
		}
	}

	return @tokenlist;
}

1;