#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;

# $Header: /disks/disk1/users/terry/bin/RCS/wwwtable,v 1.3 1996/09/27 15:54:12 terry Exp terry $

#
# wwwtable [-b] [-c] [-w]
#
# Generate HTML tables from a simple(?) textual description.
#
# This script works as a filter, reading stdin and writing to stdout (unless
# it finds some problem with your input, in which case you'll see something
# on stderr).
#
# Options:
#
#   -b  Turn OFF the insertion of a <BR> tag in
#       otherwise empty table cells. I think (bordered) tables look much
#       better when empty cells have a <BR> in them (this
#       makes them have the lowered 3D appearance of the other cells). If
#       you use this option, the cell will appear raised, like the border
#       is. You wont see any difference in tables with no border.
#
#   -c  Turn ON comments following each cell definition to show what cell is
#       being defined. This makes it simpler to see what's what in the output.
#
#   -w  Turn OFF the read-only messages wwwtable emits to try to stop people
#       changing the output and then losing the changes when the output is
#       regenerated by wwwtable.
#
# For instructions on how to use wwwtable, visit
# http://www.teclata.es/terry/wwwtable
#
# Terry Jones (terry@teclata.es)
# 29 August 1996
#

$0 =~ s/.*\///;

require "getopts.pl";
&Getopts("bctw");

$initial_warning =
"<!-- WARNING: This file is the output of wwwtable - a script that writes   -->
<!--          HTML tables (and this warning message). If you are editing   -->
<!--          this file, you may be making a mistake since your changes    -->
<!--          will be lost if wwwtable is ever used to rebuild the file.   -->
<!--          Make sure you know what you're doing!                        -->
<!--          Get wwwtable from http://www.teclata.es/terry/wwwtable       -->
";

$read_only_warning =
"<!-- WARNING: The following table was produced by wwwtable.                -->
<!--          Unless you are sure you know what you are doing, you should  -->
<!--          not edit it here. Instead, edit the wwwtable source          -->
<!--          specification for this table. Then use wwwtable to rebuild   -->
<!--          the HTML for this table.                                     -->
";

$table_start_re = q/^\s*<\s*wwwtable(\s+.*)?>\s*$/;
$table_end_re = q/^\s*<\s*\/wwwtable\s*>\s*$/;
$cell_info_re = q/^\s*(\(\(?)\s*([\.\*\+=\-\?\[\]\|\d\^\$]*)\s*,\s*([\.\*\+=\-\?\[\]\|\d\^\$]*)\s*\)\)?\s*(.*)\s*$/;
$rowspan_re = q/rowspan\s*=\s*"?(\d+)"?/;
$colspan_re = q/colspan\s*=\s*"?(\d+)"?/;
$doctype_re = q/^<!DOCTYPE HTML PUBLIC/;
$rowcol_inc_re = q/^\+\d+$/;
$rowcol_dec_re = q/^-\d+$/;

$saved_line = "";
$saved_line_exists = 0;
$line_number = 0;
$initial_warning_issued = $opt_w;

while ($line = &GetLine){

    if (!$initial_warning_issued){

	$initial_warning_issued = 1;
	
	if ($line =~ /$doctype_re/i){
	    print "$line\n$initial_warning\n";
	    next;
	}
	else {
	    print "$initial_warning\n";
	}
    }
    
    if ($line =~ /$table_start_re/i){
	print "$read_only_warning\n" unless $opt_w;
	print &ReadTable($1, "");
    }
    else {
	print $line;
    }
}

exit(0);

sub GetLine {
    if ($saved_line_exists){
	$saved_line_exists = 0;
	return $saved_line;
    }

    $line_number++;
    
    return <>;
}

sub UnGetLine {
    die "An input line '$saved_line' has already been pushed back onto STDIN.\n" if $saved_line_exists;

    $saved_line_exists = 1;
    $saved_line = shift(@_);
}

sub ReadTable {
    
    my $table_start = shift(@_);
    my $indent = shift(@_);

    my $table;
    my $initial_text = "";
    my $waiting_for_first_table_data = 1;
    my $table_terminated = 0;
    my $max_row = 0;
    my $max_col = 0;
    my $last_row = 1;
    my $last_col = 1;
    my @default_row_info;
    my @default_col_info;
    my @default_row_text;
    my @default_col_text;
    my $n_wild = 0;
    my @wild_row;
    my @wild_col;
    my @wild_info;
    my @wild_text;
    my $table_start_line = $line_number;
    my %skip;
    my %skip_why;
    my %cell_header;
    my %cell_line;
    my %cell_info;
    my %cell_text;
    my %cell_col_offset;
    my %cell_row_offset;

    while ($line = &GetLine){

	# Check to see if the table ends here.
	if ($line =~ /$table_end_re/i){
	    $table_terminated = 1;
	    last;
	}

	if ($line =~ /$cell_info_re/){
	    # We found exact cell information. Looks like, for example, "(1,2) align=center colspan=1".

	    my $header = ($1 eq "((");
	    my $row = $opt_t ? $3 : $2;
	    my $col = $opt_t ? $2 : $3;
	    my $extra = $4;
	    $waiting_for_first_table_data = 0;

	    $row = "+1"        if $row eq "+";
	    $row = "-1"        if $row eq "-";
	    $row = "$last_row" if $row eq "=" || $row eq "";
	    $row = "$max_row"  if $row eq "\$";
	    
	    $col = "+1"        if $col eq "+";
	    $col = "-1"        if $col eq "-";
	    $col = "$last_col" if $col eq "=" || $col eq "";
	    $row = "$max_col"  if $col eq "\$";

	    if ($row =~ /$rowcol_inc_re/){
		# We have a row increment.
		$row += $last_row;
	    }
	    elsif ($row =~ /$rowcol_dec_re/){
		# We have a row decrement.
		die "$0: Row decrement ($row) on line $. causes non-positive row number. Last row number was $last_row.\n" if $last_row + $row < 1;
		$row = $last_row + $row;

	    }

	    if ($col =~ /$rowcol_inc_re/){
		# We have a col increment.
		$col += $last_col;
	    }
	    elsif ($col =~ /$rowcol_dec_re/){
		# We have a col decrement.
		die "$0: Col decrement ($col) on line $. causes non-positive column number. Last col number was $last_col.\n" if $last_col + $col < 1;
		$col = $last_col + $col;

	    }

	    my $rowcol = "$row,$col";
	    $cell_header{"$rowcol"} = $header;

	    if ($row =~ /^\d+$/ && $col =~ /^\d+$/){

		die "$0: Line $line_number: Cell ($rowcol) has already been specified (see line $cell_line{\"$rowcol\"}).\n"
		    if $cell_text{"$rowcol"} || $cell_info{"$rowcol"};

		die "$0: Line $line_number: Cell ($rowcol) has already been specified, implicitly,
          in the rowspan/colspan specification of cell $skip_why{\"$rowcol\"} (see line $cell_line{$skip_why{\"$rowcol\"}}).\n" if $skip{"$rowcol"};

		$last_row = $row;
		$last_col = $col;

		$cell_line{"$rowcol"} = $line_number;
		$max_row = $row if $row > $max_row;
		$max_col = $col if $col > $max_col;

		if ($opt_t){
		    $extra =~ s/rowspan/kjkjhkjhkjhkjhkjhkjhh9872972/i;
		    $extra =~ s/colspan/rowspan/i;
		    $extra =~ s/kjkjhkjhkjhkjhkjhkjhh9872972/colspan/;
		    
		    $extra =~ s/width/kjkjhkjhkjhkjhkjhkjhh9872972/i;
		    $extra =~ s/height/width/i;
		    $extra =~ s/kjkjhkjhkjhkjhkjhkjhh9872972/height/;
		}
		
		if ($extra =~ /$rowspan_re/i){
		    $cell_row_offset{"$rowcol"} = $1;
		    die "$0: Cell rowspan info on line $line_number has zero offset ($1)\n" if !$1;
		}
		else {
		    $cell_row_offset{"$rowcol"} = 1;
		}
		
		if ($extra =~ /$colspan_re/i){
		    $cell_col_offset{"$rowcol"} = $1;
		    die "$0: Cell colspan info on line $line_number has zero offset ($1)\n" if !$1;
		}
		else {
		    $cell_col_offset{"$rowcol"} = 1;
		}

		for ($ro = 0; $ro < $cell_row_offset{"$rowcol"}; $ro++){
		    for ($co = 0; $co < $cell_col_offset{"$rowcol"}; $co++){
			if ($ro || $co){
			    $sr = $row + $ro;
			    $sc = $col + $co;

			    die "$0: Cell ($rowcol)'s rowspan and colspan information (rowspan=$cell_row_offset{\"$rowcol\"}, colspan=$cell_row_offset{\"$rowcol\"},
          conflicts with a previous definition of that cell's contents (line $cell_line{\"$rowcol\"}).\n" if $cell_text{"$sr,$sc"} || $cell_info{"$sr,$sc"};

			    die "$0: The intersection of the specifications of cell ($skip_why{\"$sr,$sc\"}) on line $cell_line{$skip_why{\"$sr,$sc\"}}
          and cell ($rowcol) on line $line_number is non-empty. Both include cell ($sr,$sc).\n" if $skip{"$sr,$sc"};

			    $skip_why{"$sr,$sc"} = $rowcol;
			    $skip{"$sr,$sc"} = 1;
			    # print STDERR "LINE $.: skip_why $sr,$sc = $rowcol, skip $sr,$sc = 1\n";
			}
		    }
		}
		
		
		$cell_info{$rowcol} = " $extra" if length($extra);

		# Read the cell contents.
		$cell_text{"$rowcol"} = &ReadCellInfo("      $indent");
		next;
	    }
	    else {
		# We've got regexps.

		# Allow just "*" to indicate ".*".
		$row = ".*" if $row eq "*";
		$col = ".*" if $col eq "*";

		# Check for an entire row. These can go into a <tr> tags.
		if ($row =~ /^\d+$/ && $col eq ".*"){
		    $default_row_info[$row] = " $extra" if length($extra);
		    $default_row_text[$row] = &ReadCellInfo("      $indent");
		    next;
		}
		
		# Check for an entire column. There's no <tc> tag but we can special case this one later.
		if ($col =~ /^\d+$/ && $row eq ".*"){
		    $default_col_info[$col] = " $extra" if length($extra);
		    $default_col_text[$col] = &ReadCellInfo("      $indent");
		    next;
		}

                # It's not an easy case, we'll have to check each cell as we create it.
		$wild_row[$n_wild] = $row;
		$wild_col[$n_wild] = $col;
		$wild_info[$n_wild] = " $extra" if length($extra);
		$wild_text[$n_wild] = &ReadCellInfo("      $indent");
		$n_wild++;
		next;
	    }
	}
	
	# It's the initial text. Save it if it's before the first row/col/cell spec.
	# The test may not be needed any more. I suspect not.
	$initial_text .= $line if $waiting_for_first_table_data;
    }

    die "$0: Unterminated <wwwtable> (commences line $table_start_line)\n" unless $table_terminated;

    # We saw the whole table, now build and return it.
    $table = "$indent<table${table_start}>\n";

    $initial_text =~ s/^[\n\s]*//;
    $initial_text =~ s/[\n\s]*$//;

    print "$indent$initial_text" if length("$initial_text");

    for ($row = 1; $row <= $max_row; $row++){

	$table .= "$indent  <tr$default_row_info[$row]>\n";
	
	for ($col = 1; $col <= $max_col; $col++){

	    my $rowcol = "$row,$col";
	    
	    if (!$skip{"$rowcol"}){
		
		my $i;
		my $cell_type = ($cell_header{$rowcol}) ? "th" : "td";
		my $cell_info = $cell_info{"$rowcol"};
		my $cell_text = $cell_text{"$rowcol"};
		
		$cell_info .= $default_col_info[$col];
		$cell_text .= $default_col_text[$col];
		
		# Add info & text from ALL matching wildcard cells.
		for ($i = 0; $i < $n_wild; $i++){
		    if ($row =~ /$wild_row[$i]/ && $col =~ /$wild_col[$i]/){
			$cell_info .= $wild_info[$i];
			$cell_text .= $wild_text[$i];
		    }
		}

		$cell_text =~ s/^[\n\s]*//;
		$cell_text =~ s/[\n\s]*$//;

		# Put in a <br> if we still have nothing (and -b has not been given).
		$cell_text = "<br>" if !$opt_b && $cell_text =~ /^$/;

		# Output the cell.
		$table .= "$indent    <!-- cell ($rowcol) -->\n" if $opt_c;
		$table .= "$indent    <$cell_type$cell_info>$cell_text</$cell_type>\n";
	    }
	}
	
	$table .= "$indent  </tr>\n";
	$table .= "\n" unless $row == $max_row;
    }

    $table .= "$indent</table>\n";

    return $table;
}


sub ReadCellInfo {

    my $indent = shift(@_);
    my $cell = "";

    while ($line = &GetLine){

	# Is it the start of a sub-table?
	if ($line =~ /$table_start_re/i){
	    $cell .= &ReadTable($1, $indent);
	}
	
	# Is it the end of the containing table or a new cell indicator?
	elsif ($line =~ /$table_end_re/i || $line =~ /$cell_info_re/) {
	    &UnGetLine($line);
	    return $cell;
	}

	# Nope, must be cell content. Remember it.
	else {
	    $cell .= "$line";
	}
    }

    return $cell;
}
