# 	acbl.pl
# This program reads ACBLSCore event files.
# Unfortunately, I don't know what their format
# really is; I have a bunch of examples from
# which to work, but no sure info.  It seems
# to work quite well.  I have almost 100 examples
# so far.

# Event
# size
# MPs      rank pair score
# MPs      rank pair score
# ...
# blank line
# Event
# size
# etc.
 
# It is complicated by the possibility
# that there may be lines of the form
#            pair
# which are extensions of the previous
# line, although the score is on the 
# first line.  As far as I know, there
# are no exceptions.

# Current Command line flags:
#  
# none             produce 59 column text output
# -l nn            change the width of the columns
# -h               produce HTML output with <pre> blocks
# -H               produce HTML output with <table> blocks
# -t words         set title for HTML
# -o outputfile    set redirection of output

# Version 0.1
#     read score file and produce
#     some sort of output.
# Version 0.2
#     parse lines carefully so that
#     we can deal with long continuation
#     lines, lack of masterpoint numbers,
#     and scores at the end of continuations
# Version 0.3
#     folds in html version with -h flag
#	-h means "produce html output" 
#	   otherwise, don't.
#       -H means "produce html output,
#          but use <table> instead of <pre>
#       mnemonic: lower h = simple html; bigger H = harder html
#       -t set title
#       -l linewidth
# Version 0.4
#     - ignores blank lines between events and sizes
#     - somewhat fixed bug in HTML wrto continuation lines
#     - fixed bug that loses last char on continuations
#     - fixed bug that hangs if eof is continuation line
#     - checked to ensure that the event size was right
#       and we weren't ripping off some other record.
# Version 0.5
#     Gets new ACBLScore input---no changes except:
#	- event titles now might include "Bracket"
#	  in mixed case.
#     Move ID stuff into "myid.pl".
# Version 0.6
#     Event titles can start with 49ER, 199ER, 299ER
#     or just have "PAIRS" or "KNOCKOUT"
# Version 0.7
#     PC date command support.  PCs' date output looks like
#   	Current date is Fri 03-22-1996
#     whereas UNIX's is
# 	Fri Mar 22 10:16:38 PST 1996
#     The choice is invoked by changing the global "unix" to zero.
#     Added a second space between rank and names for Chyah.
#     Allowing -o outputfile for systems in which redirection 
#     is broken.

# constants
$defaultheader = "Results from Nationals";
$linelength = 59;
$unix = 1;
@month = ("none","January","February","March","April",
	  "May","June","July","August","September",
          "October","November","December");

# who I am, web info
require "myid.pl";

# process arguments
require "getopts.pl";

&Getopts('hHt:l:o:');
$html = $opt_h + $opt_H;
$table = $opt_H;
if ($opt_l) { $linelength = $opt_l; }

if ($html) { $sep = "<hr>";}
else       { $sep = "-"x$linelength;}

# this is probably bad
if ($opt_o ne "") { open(STDOUT,">$opt_o"); }

$top = 1;	# we've only just begun
$inputbuffered = 0;
$eof = 0;	# <> returns false only once

if ($html)
    {
    # make title
    if ($opt_t)
	{
	$_ = $opt_t;
	}
    else
	{
        $_ = <>;
        s/^\s*//;
        if ($_ eq "") {$_ = $defaultheader;}
	}
    &htmlheader;
    }

while()
    {
    # get newline
    if ($inputbuffered)
	{
	$_ = $inputbuffer;
	$inputbuffered = 0;
	}
    elsif ($eof)
	{
	last;
	}
    else
	{ 
        $_ = <>; 
        if (($_ eq eof) || ($_ eq undef)) {last;}
	}
    chop;	# no newline for you
    s/^\s*//;	# remove leading white space
    s/Bracket/BRACKET/; # upcase word in event name
    if (/^$/) # is this a blank line?
	{
	# do nothing
	}
    # Events are in all caps
    elsif ((/^[A-Z]/ && !/[a-z]/) || (/^1ST/) || (/^2ND/) || 
	   (/^49ER/) || (/^199ER/) || (/^299ER/) ||
	   (/KNOCKOUT/ && !/[a-z]/) ||
	   (/PAIRS/ && !/[a-z]/))
	{
	# do separator
	&eventseparator;
	# print event
	&printeventname;
 	# next line is size;
	$_ = "";
	while ($_ eq "") {$_ = <>; if ($_ eq eof) {$eof = 1; last;}}
	if (!/Players/ && !/Pairs/ && !/Teams/)
	    {
	    # don't know what this is, but put it back
	    $inputbuffer = $_." ";
	    $inputbuffered = 1;
	    }
	else
	    {
	    &printeventsize;
	    }
	if ($table) {print "<table cellspacing = 6>\n";}
	elsif ($html) {print "<pre>\n";}
	}
    # first entry for pair/team
    elsif (/^[0-9]/)
	{
	# break into fields
	split;
	($mps,$rank,@names) = @_;
	$score = pop(@names);
	# Is there a masterpoint field?
	if ($rank =~ /[a-zA-Z\-]/)
	    { 
	    $ismps = 0; 
	    @names = ($rank,@names);
	    $rank = $mps;  
	    }
	else
	    { $ismps = 1; }
	# Is there a score here?
	# (undefined record is ok...means "no")
	if ($score =~ /[a-zA-Z\-;]/)
	    {
	    push(@names,$score);
	    $isscore = 0;
	    }
	else
	    { $isscore = 1; }
 	# if no score, read until we find one
	# or a new rank record appears
	while (!$isscore)
	    {
	    $_ = <>;
	    if (($_ eq eof) || ($_ eq undef))
		{$eof = 1; $score = ""; $isscore = 1; last;}
	    s/^\s*//;
	    chop; split;
	    if ($_[0] =~ /[a-zA-Z\-]/)
		{
	        $score = pop(@_);
	        if (($score =~ /[a-zA-Z;]/) || ($score eq "-"))
		    {
		    push(@names,@_,$score);
		    }
	        else
		    {
		    $isscore = 1;
		    push(@names,@_);
		    }
		}
	    else
		{
		# new rank, but no score
		$inputbuffer = $_." ";
		$inputbuffered = 1;
		$score = "";
		$isscore = 1;
		}
	    }

	# Print record
	# masterpoints
	if ($table)  {print "<tr><td valign = top align = right>\n";}
	if ($ismps) {&printmps;}
	else        {print " "x6;}
	if ($table)  {print "</td>\n";}

	# one space filler
	print " ";

	# rank
	if ($table) {print "<td valign = top><b>\n";}
	&printrank;
	if ($table) {print "</b></td>\n";}

	# two space filler
	print "  ";

	# replace marrieds with "&"
	&couplize;

	# how much room do we have on the line?
	$_ = $score;
	$slen = tr///c;
	# mps takes up 6
	# one for filler
	# rank takes up 5
	# two for filler
	# one between names and score
	$space = $linelength - 15 - $slen;

  	# print names
	if ($table) {print "<td valign = top>\n";}
	&printnames;
	print " ";
	if ($table) {print "</td>\n";}

	# print score
	if ($table) {print "<td valign = bottom align = right><b>\n";}
	&printscore;
	print "\n";
	if ($table) {print "</b></td></tr>\n";}
	}
    # continuation lines
    else
	{
	if ($table) {print "<tr><td></td><td></td><td valign = top>\n";}
	print " "x14;
	split;
	@names = @_;
	&printnames;
	if ($table) {print "</td></tr>\n";}
	print "\n";
	}
    }
if ($html) {&htmltrailer;}
#done

##############################################

sub eventseparator
    {
    if ($top)
	{
	$top = 0;
	}
    else
	{
	if ($table) {print "</table>\n";}
	elsif ($html) {print "</pre>\n";}
        print $sep;
        print "\n";
	}
    }

sub printeventname
    {
    if ($html)
	{
	print "<b><i>$_</b></i><br>\n";
	}
    else
	{
        print;
        print "\n";
	}
    }

sub printeventsize
    {
    if ($html)
	{
	print "$_<br>\n";
	}
    else
	{
        print;
        print "\n";
	}
    }

sub printmps
    {
    printf "%6s",$mps;
    }

sub printrank
    {
    printf "%5s",$rank;
    }

sub printnames
    {
    $_ = join(" ",@names);
    # how long is this?
    $len = tr///c;
    if ($len <= $space)
	{
        print;
	print " "x($space-$len);
	}
    else
	{
	$used = 0;
	$first = 1;
	$buffer = "";
	while ($_ = shift(@names))
	    {
	    $tlen = tr///c;
	    if ($used + $tlen + 1 > $space)
		{  # out of room
		# don't break at the word just after a comma
		@temp = split(" ",$buffer);
		if ($temp[$#temp-1] =~ /,$/)
		    {
		    @names = (pop(@temp),$_,@names);
		    $buffer = join(" ",@temp);
		    $tlen = 0;
		    $_ = "";
		    $first = 1;
		    }
		# check for orphans
		elsif ($names[0] eq "")
		    {
		    if ($temp[$#temp-2] =~ /,$/)
			{
			@names = (pop(@temp));
			}
		    @names = (pop(@temp),@names,$_);
		    $buffer = join(" ",@temp);
		    $_ = "";
		    $tlen = 0;
		    $first = 1;
		    }
		else
		    {$first = 0;}
		print "$buffer\n";
		if ($table) {print "<br>";}
		print " "x14;
		$buffer = $_;
		$used = $tlen;
		}
	    elsif (/;$/ && $names[0] ne "")
		{  # split at semicolons
		if (!$first) {$buffer .= " ";}
		$buffer = $buffer.$_;
		print "$buffer\n";
		if ($table) {print "<br>";}
		$buffer = "";
		print " "x14;
		$used = 0;
		$first = 1;
		}
	    else
		{  # just print
		if (!$first) {$buffer .= " ";}
		$buffer = $buffer.$_;
		$used += $tlen + !$first;
	        $first = 0;
		}
	    }
	# add filler
	print "$buffer";
	print " "x($space-$used);
	}
    }

sub couplize
    {
    if (($names[2] eq "-") && ($names[1]."," eq $names[4]))
	{
	@names = ($names[0],"&",@names[3..$#names]);
	}
    }

sub printscore
    {
    print $score;
    }

sub htmlheader
    {
    print "<html>\n";
    print "<head>\n";
    print "<title>";
    print;
    print "</title>\n";
    print "<body>\n";
    print "<center>\n";
    print "<h2>$_</h2>\n";
    print "</center>\n";
    }

sub htmltrailer
    {
    if ($table) {print "</table>\n";}
    else        {print "</pre>\n";}
    print "<hr>\n";
    print "<address>\n";
    print '<a href = "';
    print $webpage;
    print '">';
    print $webname;
    print "</a>,\n";
    print '<a href = "mailto:';
    print $email;
    print '">';
    print $email;
    print "</a>\n";
    &printdate;
    print "\n";
    print "</address>\n";
    print "</body>\n";
    print "</html>\n";
    }


# PC date
#       Fri 03-22-1996
# UNIX date
#       Fri Mar 22 10:16:38 PST 1996

sub oldprintdate
    {
    $_ = `date`;
    if ($unix)
	{ split; print ", $_[1]. $_[2], $_[5]\n"; }
    else
        { 
	split(/[\s-]+/,$_); 
	if ($month[$_[4]] ne "none")
	    {
            print ", ",$month[$_[4]]," $_[5], $_[6]\n";
	    }
        }
    }

sub printdate 
   {
   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   print ", ",$month[$mon+1]," $mday, 19$year\n";
   }