#!/usr/local/bin/perl

## wyg 1.0
## Lars Kellogg-Stedman <lars@larsshack.org>
## http://www.larsshsack.org/sw/wyg/
##
## wyg automates the use of lex, yacc, and getopts so that
## you can worry about using a grammar rather than
## building it.  See the README file for more details.

use IO::File;
use Getopt::Long;

##
## CONFIGURATION
##

$WYG_VERSION_MAJOR	= 1;
$WYG_VERSION_MINOR	= 1;
$WYG_VERSION_REVISION	= 3;

$WYG_RCS_ID		= '$Id: wyg.in,v 1.18 1999/03/10 17:50:12 lars Exp $';

$prefix="/usr/local";
$wygdir="${prefix}/share/wyg";

$default_config_file	= "wyg.conf";

##
## don't edit things below this point unless you know
## what you're doing.
##

$types{'int'} = 0;
$types{'string'} = 1;
$types{'float'} = 2;
$types{'bool'} = 3;

$opt_number = 1000;

$SIG{__DIE__}	= "wyg_die";
$SIG{__WARN__}	= "wyg_warn";

@wyg_internal_vars=(
	["wyg_float_precision", "-", "int", 4, "precision for converting floats to strings"]
);

##
## BANNER
##

print <<EOM;
Where's Your Grammar?  v$WYG_VERSION_MAJOR.$WYG_VERSION_MINOR.$WYG_VERSION_REVISION
by Lars Kellogg-Stedman <lars\@larsshack.org>
http://www.larsshack.org/sw/wyg/

EOM

##
## OPTIONS PROCESSING
##

eval "Getopt::Long::Configure(qw(bundling))";
GetOptions(
	'verbose|v',
	'make|m',
	'maketest',
	'version|V',
	'help|h'
) or show_usage(\*STDERR), exit(2);

if ($opt_version) {
	print $WYG_RCS_ID, "\n";
	exit(0);
}

if ($opt_help) {
	show_usage(\*STDOUT);
	exit(0);
}

my $conf_name = $ARGV[0] || $default_config_file;
my $conf = new IO::File $conf_name, "r" or
	die "unable to open variable configuration file \"$conf_name\".\n";

##
## MAIN
##

print "Reading variable configuration file \"$conf_name\"...\n";

my $line;
while (<$conf>) {
	$line++;

	next if /^\s*#/;
	next if /^\s*$/;

	chomp(my @entry = split(/\s+/, $_, 5));

	print "$line ($#entry): ", join(",", @entry), "\n" if $opt_verbose;

	die "error parsing \"$conf_name\" at line $line.\n" if
		$#entry <= 3;

	add_variable(@entry);
}
print "read ", $#varlist + 1, " variables.\n\n";

## add internal variables
print "Adding ", $#wyg_internal_vars + 1, " internal variables...\n";
for (@wyg_internal_vars) {
	print "internal (", $#{$_},"): ", join(",", @{$_}). "\n" if $opt_verbose;
	add_variable(@{$_});
}
print "\n";

generate_yacc();
generate_lex();
generate_h();
generate_c();
generate_makefile();
get_getopt();

print "\nFinished wyggling.\n";

if ($opt_make || $opt_maketest) {
	print "Attempting to build the wyg library...\n";
	my $res = system("make -f Makefile.wyg libwyg.a");
	$res >>= 8;
	if ($res) {
		die "Error building wyg library.\n";
	} else {
		print "Build complete.\n";
	}
}

if ($opt_maketest) {
	print "Attempting to build wyg test program...\n";
	my $res = system("make -f Makefile.wyg wygtest");
	$res >>= 8;
	if ($res) {
		die "Error building wygtest.\n";
	} else {
		print "Build complete.\n";
	}
}

exit 0;

## output: parse.y
##         (input for yacc (or bison...))
sub generate_yacc {
	my ($yacc, $yacc_tokens);
	print "Generating parse.y...\n";

	## build the '%token' lines that go at the top
	## of our grammar file.
	my @vars = @varlist;
	while (@vars) {
		my $count;

		$yacc_tokens .= "%token";
		while (@vars) {
			last if $count++ >= 4;
			$yacc_tokens .= " " . token(shift @vars);
		}
		$yacc_tokens .= "\n";
	}

	$yacc_tokens	.= "%token <ival> " . token("int") . "\n"
			.  "%token <sval> " . token("string") . "\n"
			.  "%token <fval> " . token("float") . "\n";

	for (@varlist) {
		if ($varinfo{$_}->{'type'} eq "bool") {
			## allow both 'option' and '!option' for boolean
			## variables.
			$yacc	.= "		| "
				.  token($_)
				.  " { setvar(" . vardef($_) . ", 0, 0, 1); }\n";
			$yacc	.= "		| "
				.  "'!' " . token($_)
				.  " { setvar(" . vardef($_) . ", 0, 0, 0); }\n";
		} elsif ($varinfo{$_}->{'type'} eq "string") {
			$yacc	.= "		| "
				.  token($_) . " '=' " . token("string")
				.  " { setvar(" . vardef($_) . ", 0, 0, \$3); }\n";
		} elsif ($varinfo{$_}->{'type'} eq "float") {
			## a float variable can be assigned a float value OR
			## an int value, so needs to cases.
			$yacc	.= "		| "
				.  token($_) . " '=' " . token("float")
				.  " { setvar(" . vardef($_) . ", 0, 0, \$3); }\n";
			$yacc	.= "		| "
				.  token($_) . " '=' " . token("int")
				.  " { setvar(" . vardef($_) . ", 0, 0, \$3); }\n";

		} else {
			$yacc	.= "		| "
				.  token($_) . " '=' " . token("int")
				.  " { setvar(" . vardef($_) . ", 0, 0, \$3); }\n";
		}
	}

	my $text = slurp_file("$wygdir/parse.y.tmpl");
	$text =~ s/.*INSERT_TOKENS.*/$yacc_tokens/m;
	$text =~ s/.*INSERT_STATEMENTS.*/$yacc/m;

	my $fh = new IO::File("parse.y", "w");
	die "unable to open parse.y for writing.\n" if ! $fh;

	print $fh $text;

	$fh->close;
}

## output: parse.lex
##         (input to lex (or flex...))
sub generate_lex {
	my $lex;
	print "Generating parse.lex...\n";

	for (@varlist) {
		$lex .= "$_	{ return " . token($_) . "; }\n";
	}

	my $text = slurp_file("$wygdir/parse.lex.tmpl");
	$text =~ s/.*INSERT_PATTERNS.*/$lex/m;

	my $fh = new IO::File("parse.lex", "w");
	die "unable to open parse.lex for writing.\n" if ! $fh;

	print $fh $text;

	$fh->close;
}

## output: parse.h
##
## #defines, function prototypes, etc., for import into other
## code.
sub generate_h {
	my ($v_defines, $opt_defines, $varnum, $optnum);
	print "Generating parse.h...\n";

	$varnum = 0;
	$optnum = 1000;

	## generate #defines for variable numbers and command line
	## options.
	for (@varlist) {
		$v_defines .= "#define " . vardef($_) . " " . $varnum++ . "\n";
		if ($varinfo{$_}->{'letter'} ne '-') {
			$optstring .= $varinfo{$_}->{'letter'};
			$optstring .= ":" if ($varinfo{$_}->{'type'} ne "bool");
			$opt_defines .= "#define " . optdef($_) . " '" . $varinfo{$_}->{'letter'} . "'\n";
		} else {
			$opt_defines .= "#define " . optdef($_) . " " . $optnum++ . "\n";
		}

		## define an additional command line option for boolean
		## variables; we end up with 'option' and 'nooption'.
		if ($varinfo{$_}->{'type'} eq "bool") {
			$opt_defines .= "#define " . optdef($_) . "_NOT " . $optnum++ . "\n";
		}
	}

	my $typedefs = "#define TYPE_INT " . $types{'int'} . "\n"
		. "#define TYPE_STRING " . $types{'string'} . "\n"
		. "#define TYPE_FLOAT " . $types{'float'} . "\n"
		. "#define TYPE_BOOL " . $types{'bool'} . "\n";

	my $defines = 
		  "#define WYG_VERSION_MAJOR " . $WYG_VERSION_MAJOR . "\n"
		. "#define WYG_VERSION_MINOR " . $WYG_VERSION_MINOR . "\n"
		. "#define WYG_VERSION_REVISION " . $WYG_VERSION_REVISION . "\n"
		. "\n"
		. $v_defines 
		. "\n" 
		. $opt_defines
		. "#define OPT_HELP " . $optnum++ . "\n"
		. "#define OPT_SHOW_CONFIG " . $optnum++ . "\n"
		. "\n"
		. "#define OPTSTRING \"" . $optstring . "\"\n"
		. "\n"
		. "#define V_NUM_VARS " . ($#varlist + 1 ) . "\n"
		. "#define V_MAX_VARNAME_LENGTH $max_varname_length\n"
		. "\n" . $typedefs;

	my $text = slurp_file("$wygdir/parse.h.tmpl");
	$text =~ s/.*INSERT_DEFINES.*/$defines/m;


	my $fh = new IO::File("parse.h", "w");
	die "unable to open parse.h for writing.\n" if ! $fh;

	print $fh $text;

	$fh->close;
}

sub generate_c {
	print "Generating parse.c...\n";

	## generate variables[] entries
	for (@varlist) {
		$varvars .= "	{\"$_\", ";
		my $vn = $_;
		for ($varinfo{$_}->{'type'}) {
			/int/	&&	($varvars .= "TYPE_INT, "
					. $varinfo{$vn}->{'default'}
					. ", NULL, 0");
			/bool/	&&	($varvars .= "TYPE_BOOL, 0, NULL, 0");
			/string/&&	($varvars .= "TYPE_STRING, 0, "
					. "\""
					. $varinfo{$vn}->{'default'}
					. "\", 0");
			/float/	&&	($varvars .= "TYPE_FLOAT, 0, NULL, "
					. $varinfo{$vn}->{'default'});
		}
		$varvars .= ", \"" . $varinfo{$vn}->{'help'} . "\", 0},\n";

		my $opt = $_;
		$opt =~ s/_/-/;

		if ($varinfo{$_}->{'type'} eq "bool") {
			## define an additional command line option for boolean
			## variables; we end up with 'option' and 'nooption'.
			$optvars .= "	{\"$opt\", no_argument, NULL, "
				. optdef($_) . "},\n";
			$optvars .= "	{\"no$opt\", no_argument, NULL, "
				. optdef($_) . "_NOT},\n";
		} else {
			$optvars .= "	{\"$opt\", required_argument, NULL, "
				. optdef($_) . "},\n";
		}

		if ($varinfo{$_}->{'type'} eq "bool") {
			## define an additional command line option for boolean
			## variables; we end up with 'option' and 'nooption'.
			$optcases .= "			case " . optdef($_) . ":\n"
				. "				setvar(" . vardef($_) . ", 0, 0, 1);\n"
				. "				break;\n";
			$optcases .= "			case " . optdef($_) . "_NOT:\n"
				. "				setvar(" . vardef($_) . ", 0, 0, 0);\n"
				. "				break;\n";
		} else {
			$optcases .= "			case " . optdef($_) . ":\n"
				. "				setvar(" . vardef($_) . ", 0, 1, optarg);\n"
				. "				break;\n";
		}
	}

	$optvars .= "	{\"help\", optional_argument, NULL, OPT_HELP},\n";
	$optvars .= "	{\"show-config\", no_argument, NULL, OPT_SHOW_CONFIG},\n";

	$varvars .= "	{NULL, 0, 0, NULL, 0, NULL}\n";
	$optvars .= "	{NULL, 0, NULL, 0}\n";

	my $text = slurp_file("$wygdir/parse.c.tmpl");

	$text =~ s/.*DEFINE_OPTIONS.*/$optvars/m;
	$text =~ s/.*DEFINE_VARS.*/$varvars/m;
	$text =~ s/.*PROCESS_COMMAND_LINE.*/$optcases/m;

	my $fh = new IO::File("parse.c", "w");
	die "unable to open parse.c for writing.\n" if ! $fh;

	print $fh $text;

	$fh->close;
}

sub generate_makefile {
	print "Generating Makefile.wyg...\n";

	my $text = slurp_file("$wygdir/Makefile.wyg");
	$text =~ s/\@CONF\@/$conf_name/g;

	my $fh = new IO::File("Makefile.wyg", "w");
	die "unable to open Makefile.wyg for writing.\n" if ! $fh;

	print $fh $text;

	$fh->close;
}

sub get_getopt {
	if ( ! -f "getopt.c" || ! -f "getopt.h" ) {
		print "Copying in getopt code...\n";

		system("cp","$wygdir/getopt.c", "getopt.c");
		system("cp","$wygdir/getopt.h", "getopt.h");
	}
}

## returns the token form of a variable
sub token {
	my $t = shift @_;
	return 'T_' . uc($t);
}

## returns the index constant of a variable
sub vardef {
	my $t = shift @_;
	return 'V_' . uc($t);
}

## returns the command line constant of a variable
sub optdef {
	my $t = shift @_;
	return 'OPT_' . uc($t);
}

## returns the text of an entire file as a scalar variable.
sub slurp_file {
	my $filename = shift @_;

	my $fh = new IO::File $filename or
		die "unable to open $filename: $!.\n";

	my $text = join(undef,<$fh>);

	$fh->close;

	return $text;
}

sub wyg_die {
	die "wygged out: ", @_;
}

sub wyg_warn {
	warn "wygged out: ", @_;
}

sub show_usage {
	my $out = shift @_;
	my $p = " " x length($0);

	print $out "$0: usage: $0 [ --verbose ] [ --make ]\n";
	print $out "$p         $p [ --maketest ] [ config_file ]\n";
	print $out "$p         $0 [ --version ]\n";
	print $out "$p         $0 [ --help ]\n";
}

sub add_variable {
	my (@entry) = @_;
	my $varname = $entry[0];

	push @varlist, $varname;
	$max_varname_length = length($varname) if
		(length($varname) > $max_varname_length);
	$varinfo{$varname}->{'letter'} = $entry[1];
	$varinfo{$varname}->{'type'} = $entry[2];
	$varinfo{$varname}->{'default'} = $entry[3];
	$varinfo{$varname}->{'help'} = $entry[4];
}
