#
# Generate C-code and documentation from the optdefs file
#
#
# Copyright (C) 2003  Sam Horrocks
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#
$^W = 1;
use strict;
use Text::Wrap qw(wrap $columns);

my %context = (
    'mod_speedycgi'	=>1,
    'speedy'		=>1,
    'module'		=>1,
    'all'		=>[qw(mod_speedycgi speedy module)],
    'frontend'		=>[qw(speedy mod_speedycgi)],
);

my %ctype = (
    'whole'	=>'i',
    'natural'	=>'i',
    'toggle'	=>'i',
    'str'	=>'c',
);
my @type = sort keys %ctype;

my $INFILE	= "optdefs";
my $INSTALLBIN	= shift;
$columns = 68;		# For the wrap function

die "Usage: $0 installbin-directory\n" unless $INSTALLBIN;


#
# Slurp the optdefs file into @options as a list of hashes
#
my(@options, $curopt);
my $startnew = 1;
open(F, $INFILE) || die "${INFILE}: $!\n";
while (<F>) {
    next if /^#/;
    if (/\S/) {
	chop;
	s/\$INSTALLBIN/$INSTALLBIN/g;
	@_ = split(' ', $_, 2);
	next if @_ < 2;
	if ($startnew) {
	    push(@options, $curopt = {});
	    $startnew = 0;
	}
	$curopt->{$_[0]} .= " " if exists $curopt->{$_[0]};
	$curopt->{$_[0]} .= $_[1];
    } else {
	$startnew = 1;
    }
}
close(F);

# Process/Check the input
for (my $i = 0; $i <= $#options; ++$i) {
    my $opt = $options[$i];

    if (!$opt->{option}) {
	die sprintf("Missing option name in entry #%d in $INFILE file\n", $i+1);
    }
    if (!grep {lc($opt->{type}) eq $_} @type) {
	die "Bad type $opt->{type} for option entry $opt->{option}\n";
    }
    
    if ($opt->{context}) {
	my %c;
	foreach my $c (split(' ', $opt->{context})) {
	    my $val = $context{$c};
	    if (!$val) {
		die "Invalid context name $c for option entry $opt->{option}\n";
	    }
	    foreach my $x (ref($val) ? @$val : $c) {
		$c{$x} = 1;
	    }
	}
	$opt->{context} = \%c;
    }
}

# Sort by name - required for the bsearch call in speedy_opt.c
@options = sort {uc($a->{option}) cmp uc($b->{option})} @options;

#
# Write speedy_optdefs.c
#
&open_file('speedy_optdefs.c');
print "\n#include \"speedy.h\"\n\n";

# Make storage for integer option values
foreach my $opt (@options) {
    if ($ctype{$opt->{type}} eq 'i') {
	printf "static int value_%s = %d;\n",
	    $opt->{option}, $opt->{defval} || 0;
    }
}

print "\nOptRec speedy_optdefs[] = {\n";
foreach my $opt (@options) {
    my @toprint = (
	["\"%s\"",	uc($opt->{option})],
	["%s",		($ctype{$opt->{type}} eq 'c'
	    ? defined($opt->{defval}) ? "\"$opt->{defval}\"" : 'NULL'
	    : "&value_$opt->{option}")
	],
	["'%s'",	$opt->{letter} || "\\0"],
	["OTYPE_%s",	uc($opt->{type})],
	["%d",		0],
	["%d",		length($opt->{option})],
    );
    my $fmt = "\t{\n". join('', map {"\t\t".$_->[0].",\n"} @toprint) . "\t},\n";
    printf $fmt, map {$_->[1]} @toprint;
}
print "};\n";

#
# Write speedy_optdefs.h
#
&open_file('speedy_optdefs.h');
for (my $i = 0; $i <= $#type; ++$i) {
    printf "#define OTYPE_%s %d\n", uc($type[$i]), $i;
}
printf "\n#define SPEEDY_NUMOPTS %d\n\n", scalar @options;
for (my $i = 0; $i <= $#options; ++$i) {
    my $opt = $options[$i];
    my $nm = uc($opt->{option});

    printf "#define OPTVAL_%s %s_OPTVAL(speedy_optdefs + %d)\n",
	$nm, $ctype{$opt->{type}} eq 'i' ? 'INT' : 'STR', $i;
    printf "#define OPTREC_%s speedy_optdefs[%d]\n", $nm, $i;
}
print "\n";
print "extern OptRec speedy_optdefs[SPEEDY_NUMOPTS];\n\n";
print "#define OPTIDX_FROM_LETTER(var, letter) switch(letter) {\\\n";
for (my $i = 0; $i <= $#options; ++$i) {
    my $opt = $options[$i];

    if ($opt->{letter}) {
	printf "    case '%s': var = $i; break;\\\n", $opt->{letter}, $i;
    }
}
print "    default: var = -1; break;}\n\n";


sub quote { my $x = shift;
    $x =~ s/"/\\"/g;
    return $x;
}

#
# Write mod_speedycgi_cmds.c
#
&open_file("mod_speedycgi_cmds.c");
print "static const command_rec cgi_cmds[] = {\n";
for (my $i = 0; $i <= $#options; ++$i) {
    my $opt = $options[$i];

    next unless $opt->{context} && $opt->{context}{mod_speedycgi};

    printf "    {\n\t\"Speedy%s\", set_option, (void*)(speedy_optdefs + %d), OR_ALL, TAKE1,\n\t\"%s\"\n    },\n",
	$opt->{option}, $i, &quote($opt->{desc});
}
print "{NULL}\n};\n";

#
# Write mod_speedycgi2_cmds.c
#
&open_file("mod_speedycgi2_cmds.c");
print "static const command_rec cgi_cmds[] =\n{\n";
for (my $i = 0; $i <= $#options; ++$i) {
    my $opt = $options[$i];

    next unless $opt->{context} && $opt->{context}{mod_speedycgi};
    
    printf "AP_INIT_TAKE1(\"Speedy%s\", set_option, (void*)(speedy_optdefs+%d), RSRC_CONF,\n     \"%s\"),\n",
	$opt->{option}, $i, &quote($opt->{desc});
}
print "    {NULL}\n};\n";

#
# Write SpeedyCGI.pm
#
&open_file('SpeedyCGI.pm', 1);
open(I, '<SpeedyCGI.src') || die "SpeedyCGI.src: $!\n";
my $doprint = 1;
while (<I>) {
    if (/^SP_DIRECTIVE\s+(\S+)\s*$/) {
	my $directive = $1;
	if ($directive eq 'INSERT_OPTIONS_POD_HERE') {
	    &insert_pod_options;
	}
	elsif ($directive eq 'BEGIN_ONLY_IN_SP') {
	    $doprint = !('SpeedyCGI' eq 'PersistentPerl');
	}
	elsif ($directive eq 'END_ONLY_IN_SP') {
	    $doprint = 1;
	}
    } else {
	if ($doprint) {print;}
    }
}
close I;

close F;

sub insert_pod_options {
    foreach my $opt (@options) {
	next unless $opt->{context};
	my $cmdline = 'N/A';
	if ($opt->{letter}) {
	    my $arg = '';
	    if ($opt->{type} ne 'toggle') {
		$arg = $ctype{$opt->{type}} eq 'c' ? '<string>' : '<number>'
	    }
	    $cmdline = sprintf("-%s%s", $opt->{letter}, $arg);
	}
	printf "=item %s\n\n", $opt->{option};
	printf "    Command Line    : %s\n", $cmdline;
	if ($opt->{type} ne 'toggle') {
	    my $defval = defined($opt->{defval}) ? $opt->{defval} : '';
	    if ($ctype{$opt->{type}} eq 'c') {
		$defval = "\"$defval\"";
	    }
	    printf "    Default Value   : %s%s\n",
		$defval,
		defined($opt->{defdesc}) ? " ($opt->{defdesc})" : '';
	}
	printf "    Context         : %s\n",
	    join(', ', sort keys %{$opt->{context}});
	printf "\n";
	printf "    Description:\n\n";
	printf "%s\n\n", wrap("\t", "\t", $opt->{desc});
    }
}


sub open_file { my($fname, $use_pound) = @_;
    print STDERR "Writing $fname\n";
    open(F, ">$fname");
    select F;
    my($combeg, $comend) = $use_pound ? ('#', '') : ('/*', '*/');
    print "$combeg Automatically generated by $0 - DO NOT EDIT! $comend\n\n";
}