#!/usr/bin/perl -w

use strict;
use Data::Dumper;
use ABNF;
use vars qw($debuglevel);

sub usage($) {
	my $message = shift;

	die <<EOF;
$message
Usage: abnftest [-d [debuglevel]] command parameters (give rules on standard input)

command is one of optree or matches

Parameters:
	optree - no parameters
	matches - rule datafile
EOF
}

sub prettify {
	my($rule, $tmp, $newrule) = shift;

	#_mode and _type sort near the top of whatever order Data::Dumper uses.
	#This way we get the important traits together at the top - makes
	#things easier on the eyes.

	$tmp = delete $rule->{type};
	if($tmp == 1) {
		$rule->{_type} = "OPS";
		foreach $newrule(@{$rule->{value}}) {
			prettify($newrule) if ref($newrule);
		}
	} elsif($tmp == 2) {
		$rule->{_type} = "NUMVAL";
	} elsif($tmp == 3) {
		$rule->{_type} = "CHARVAL";
	} else {
		$rule->{_type} = "NONE";
	}

	$tmp = delete $rule->{mode};
	if($tmp == 1) {
		$rule->{_mode} = "ALTERNATOR";
	} elsif($tmp == 2) {
		$rule->{_mode} = "AGGREGATOR";
	} else {
		$rule->{_mode} = "SINGLETON";
	}
}

my ($action, $rule, $data) = ("", "", "");
$action = shift;
if($action and $action eq "-d") {
	$debuglevel = 1;
	$action = shift;
	if($action =~ /^\d+$/) {
		$debuglevel = $action;
		$action = shift;
	}
}
if($action and $action eq "matches") {
	$rule = shift;
	$data = shift;
}

usage("Too many parameters!") if @ARGV;
usage("No command given!") unless $action;
usage("Invalid command!") unless $action eq "optree" or $action eq "matches";
usage("Not enough parameters!") if $action eq "matches" and (not $data or not $rule);
	
my @rules = <STDIN>;
my $obj = Parse::ABNF->new(@rules);

if($action eq "optree") {
	#Print a version of obj without the core rules
	my $printobj = {};
	my $key;
	%$printobj = %$obj;
	foreach $key(keys %$printobj) {
		next if $key eq "DEBUG";
		delete $printobj->{$key} and next if $printobj->{$key}->{core};
		prettify($printobj->{$key});
	
	}
	print Data::Dumper->new([$printobj])->Quotekeys(0)->Terse(1)->Dump(), "\n============\n";
} elsif($action eq "matches") {
	open(DATA, $data) or die "Couldn't open data $data: $!\n";
	$data = join("", <DATA>);
	close DATA;

	$obj->DEBUG($debuglevel);
	my $parse = $obj->matches($rule, $data, "*");
	die "No match!\n" unless $parse;
	$obj->printparse($parse);
}