#!/usr/bin/perl
use strict;
use warnings;

# the following are not really comments
# they're more like perl2exe controls.

#perl2exe_exclude "File/BSDGlob.pm"
#perl2exe_exclude "Compress/Bzip2.pm"
#perl2exe_exclude "I18N/Langinfo.pm"
#perl2exe_exclude "Convert/EBCDIC.pm"
#perl2exe_exclude "Mac/InternetConfig.pm"
#perl2exe_exclude "MacPerl.pm"

#perl2exe_include "File/Glob.pm"
#perl2exe_include "feature.pm"
#perl2exe_include "attributes.pm"
#perl2exe_include "Class/Accessor.pm"
#perl2exe_include "File::HomeDir::Windows.pm"
#perl2exe_include utf8;
#perl2exe_include "unicore/lib/gc_sc/Word.pl"
#perl2exe_include "unicore/lib/gc_sc/Digit.pl"
#perl2exe_include "unicore/lib/gc_sc/SpacePer.pl"
#perl2exe_include "unicore/To/Fold.pl"
#perl2exe_include "unicore/To/Upper.pl"
#perl2exe_include "unicore/To/Lower.pl"
#perl2exe_include "unicore/lib/gc_sc/Alpha.pl"
#perl2exe_include "Tk/Scrollbar.pm"
#perl2exe_include "Tk/Canvas.pm"

my $table_width = 900;
my $table_height = $table_width/2;
my $cushion = $table_height/25;
my $pocket_radius = $cushion+5;     # it is very tricky to draw the 'jaw'.
my $rail = 0.09*$table_height;
my $rc = $rail+$cushion;
my $dr = 3;     # diamond (little circle) diameter
my $ball_radius = 10.5;     # 21 in diameter
my $co_pang = 38;
my $si_pang = 76;

my $hdr      = 20;
my $lab_ent  = 13;
my $but      = 13;
my $browse   = 13;
my $stat     = 13;
my $back     = '#99ff99';
my $sheath   = '#eeee99';
my $rail_color = 'brown';

use Tk;
use Tk::PNG;
use Tk::DirTree;
use Config::Easy 'C:\APA_Sched\config.txt';
use Date::Simple ':all';
use Net::FTP;
use File::Copy;
use File::HomeDir;
use Win32;
use Math::Trig;
use Spreadsheet::ParseExcel;
use Win32::FileOp qw/ShellExecute/;

$|++;       # unbuffer STDOUT

# no DOS windows, please - for system() things
Win32::SetChildShowWindow(0);

my $dir = trim($C{sched_dir});
if (!$dir) {
    $dir = File::HomeDir->my_documents();
}

chdir $dir;
open STDERR, ">", 'C:\APA_Sched\stderr.txt';

my $debug = 0;
my $dbg;
my %daynum = qw/
    Sunday    0
    Monday    1
    Tuesday   2
    Wednesday 3
    Thursday  4
    Friday    5
    Saturday  6
/;
my @full_mon_name = qw/
    none
    January
    February
    March
    April
    May
    June
    July
    August
    September
    October
    November
    December
/;
my $Gstate;
my %except;

sub empty {
    my ($s) = @_;
    return $s !~ m{\S};
}

sub trim {
    my ($s) = @_;
    $s =~ s{^\s*|\s*$}{}g;
    $s;
}

sub load_except {
    %except = ();
    if (open my $in, "<", 'C:\APA_Sched\except.txt') {
        EXCEPT:
        while (my $line = <$in>) {
            chomp $line;
            next EXCEPT if $line =~ m{^#} || $line !~ m{\S};
            my ($num, $rest) = $line =~ m{([^|]+)\|(.*)};
            $num = trim($num);
            $except{$num} = $rest;
        }
    }
}

my $mw = MainWindow->new(
    -title => "APA Schedule Converter",
    -background => $back,
);
my $tot_width = $table_width + $cushion*2 + $rail*2;
my $tot_height = $table_height + $cushion*2 + $rail*2;
$mw->geometry(int($tot_width) . "x" . int($tot_height));
$mw->protocol("WM_DELETE_WINDOW", sub { 
    $C{sched_dir} = $dir;
    conf_save();
    exit;
});
my $cv = $mw->Canvas(
    -background => $back,
    -width => $tot_width,
    -height => $tot_height,
)->pack(
    -anchor => 'center',
    -expand => 1,
);
# top rail
$cv->createRectangle(0, 0, $tot_width, $rail,
    -fill  => $rail_color,
    -width => 0,
);
# bottom rail
$cv->createRectangle(0, $tot_height-$rail,
                     $tot_width, $tot_height,
    -fill  => $rail_color,
    -width => 0,
);
# left rail
$cv->createRectangle(0, $rail, $rail,
                     $tot_height-$rail,
    -fill  => $rail_color,
    -width => 0,
);
# right rail
$cv->createRectangle($tot_width-$rail, $rail,
                     $tot_width, $tot_height-$rail,
    -fill  => $rail_color,
    -width => 0,
);
# pocket sheaths
$cv->createRectangle(       # top left 1
    0, 0,
    $rail+$pocket_radius, $rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top left 2
    0, 0,
    $rail, $rail+$pocket_radius,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # bottom left 1
    0, $tot_height-$rail-$pocket_radius,
    $rail, $tot_height-$rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # bottom left 2
    0, $tot_height,
    $rail+$pocket_radius, $tot_height-$rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top center
    $tot_width/2-$pocket_radius, 0,
    $tot_width/2+$pocket_radius, $rail,
    -fill => $sheath,
);
$cv->createRectangle(       # bottom center
    $tot_width/2-$pocket_radius, $tot_height-$rail,
    $tot_width/2+$pocket_radius, $tot_height,
    -fill => $sheath,
);
$cv->createRectangle(       # bottom right 1
    $tot_width-$rail-$pocket_radius, $tot_height-$rail,
    $tot_width, $tot_height,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # bottom right 2
    $tot_width-$rail, $tot_height-$pocket_radius-$rail,
    $tot_width, $tot_height-$rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top right 1
    $tot_width-$rail-$pocket_radius, 0,
    $tot_width, $rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top right 2
    $tot_width-$rail, $rail,
    $tot_width, $rail+$pocket_radius,
    -fill => $sheath,
    -width => 0,
);
# pockets
my @pockets = (    # (x, y) of center of circle
    $rc+$table_width/2, $rail,
    $rc+$table_width/2, $tot_height-$rail,

    $rail, $rail,
    $tot_width-$rail, $rail,
    $rail, $tot_height-$rail,
    $tot_width-$rail, $tot_height-$rail,
);
while (@pockets) {
    my $x = shift @pockets;
    my $y = shift @pockets;
    $cv->createOval(
        $x-$pocket_radius, $y-$pocket_radius,
        $x+$pocket_radius, $y+$pocket_radius,
        -fill => '#444444',
    );
}
# cushions
my $co = tan(deg2rad($co_pang));
my $si = tan(deg2rad($si_pang));
$cv->createLine(        # top left
    $rail+$pocket_radius, $rail,
    $rail+$pocket_radius+$cushion/$co, $rail+$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius
        -$cushion/$si, $rail+$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius, $rail,
    -width => 1,
);
$cv->createLine(        # top right
    $rail+$cushion+$table_width/2+$pocket_radius, $rail,
    $rail+$cushion+$table_width/2+$pocket_radius+$cushion/$si, $rail+$cushion,
    $tot_width-$rail-$pocket_radius-$cushion/$co, $rail+$cushion,
    $tot_width-$rail-$pocket_radius, $rail,
);
$cv->createLine(        # left
    $rail,          $rail+$pocket_radius,
    $rail+$cushion, $rail+$pocket_radius+$cushion/$co,
    $rail+$cushion, $tot_height-$rail-$pocket_radius-$cushion/$co,
    $rail,          $tot_height-$rail-$pocket_radius,
);
$cv->createLine(        # right
    $tot_width-$rail, $rail+$pocket_radius,
    $tot_width-$rail-$cushion, $rail+$pocket_radius+$cushion/$co,
    $tot_width-$rail-$cushion, $tot_height-$rail-$pocket_radius-$cushion/$co,
    $tot_width-$rail,          $tot_height-$rail-$pocket_radius,
);
$cv->createLine(        # bottom left
    $rail+$pocket_radius, $tot_height-$rail,
    $rail+$pocket_radius+$cushion/$co, $tot_height-$rail-$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius-$cushion/$si,
        $tot_height-$rail-$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius,
        $tot_height-$rail,
);
$cv->createLine(        # bottom right
    $rail+$cushion+$table_width/2+$pocket_radius, $tot_height-$rail,
    $rail+$cushion+$table_width/2+$pocket_radius+$cushion/$si, 
        $tot_height-$rail-$cushion,
    $tot_width-$rail-$pocket_radius-$cushion/$co, $tot_height-$rail-$cushion,
    $tot_width-$rail-$pocket_radius, $tot_height-$rail,
);
# diamonds (actually white circles)
my $r2 = 2*$rail/3;
my $rb = $tot_height-$r2;
my $rr = $tot_width-$r2;
my $t8 = $table_width/8;
my @diamonds = (        # (x, y) of center of circle
    $rc+$t8*1, $r2,
    $rc+$t8*2, $r2,
    $rc+$t8*3, $r2,
    $rc+$t8*5, $r2,
    $rc+$t8*6, $r2,
    $rc+$t8*7, $r2,

    $rc+$t8*1, $rb,
    $rc+$t8*2, $rb,
    $rc+$t8*3, $rb,
    $rc+$t8*5, $rb,
    $rc+$t8*6, $rb,
    $rc+$t8*7, $rb,

    $r2, $rc+$t8*1,
    $r2, $rc+$t8*2,
    $r2, $rc+$t8*3,

    $rr, $rc+$t8*1,
    $rr, $rc+$t8*2,
    $rr, $rc+$t8*3,
);
while (@diamonds) {
    my $x = shift @diamonds;
    my $y = shift @diamonds;
    $cv->createOval(
        $x-$dr, $y-$dr,
        $x+$dr, $y+$dr,
        -fill => 'white',
    );
}
# balls
# we need to make sure that
# no two balls occupy the same space!
#
my @nums;
my @x;
my @y;
sub place_balls {
    $cv->delete('ball');
    @x = ();
    @y = ();
    place('c');
    place('8');
    @nums = (1 .. 7, 9 .. 15);
    for (1 .. 4) {
        place(splice @nums, rand @nums, 1);
    }
}

my $rcb = $rail + $cushion + $ball_radius;
sub place {
    my ($n) = @_;
    my ($x1, $y1);
    NO_COLLISION_LOOP:
    while (1) {
        $x1 = $rcb + rand(115) + 1;
        $y1 = $rcb + rand($table_height-$ball_radius*2) - 1;
            # we need the +1 and -1 above because of the width
            # of the cushion line, I think.
        if (!@x) {
            # no other balls on the table
            last NO_COLLISION_LOOP;
        }
        for my $i (0 .. $#x) {
            if (sqrt(($x[$i] - $x1)**2 + ($y[$i] - $y1)**2)
                    <= $ball_radius*2 + 1
                        # +1 is need for some reason... ?
                        # otherwise balls can seem to overlap just
                        # a little.  perhaps int() rounding errors?
            ) {
                # the ball would overlap the
                # ball at coordinates ($x[$i], $y[$i])
                # so try again.
                next NO_COLLISION_LOOP;
            }
        }
        # the location is okay - no other balls overlap
        last NO_COLLISION_LOOP;
    }
    $cv->createImage(
        $x1, $y1,
        -image => $mw->Photo(
                      -format => 'png',
                      -file   => "C:/APA_Sched/$n.png",
                  ),
        -tags => 'ball',        # so we can easily delete it later
    );
    push @x, $x1;
    push @y, $y1;
}

place_balls();
$mw->bind('<Control-Key-r>', \&place_balls);    # for power users

my $fr = $cv->Frame(
    -background => $back,
);
$cv->createWindow(
    $tot_width/2,
    $tot_height/2,
    -window => $fr,
);

my $r = 0;
$fr->Label(
    -text => "APA Schedule Converter",
    -font => "Arial $hdr bold",
    -background => $back,
)->grid(
    -row => $r++,
    -column => 0,
    -columnspan => 3,
    -ipady => 20,
);

my @data = qw/
    League_Name   league
    Schedule_Directory sched_dir
    FTP_Site      ftp_site
    FTP_User      ftp_user
    FTP_Password  ftp_pass
    FTP_Directory ftp_dir
/;

my %entry;
my $browsing = 0;
while (@data) {
    my $lab = shift @data;
    $lab =~ s{_}{ }g;
    my $key = shift @data;
    $fr->Label(
        -text => $lab,
        -font => "Arial $lab_ent bold",
        -width => 15,
        -background => $back,
        -anchor => 'w',
    )->grid(
        -row => $r,
        -column => 0,
        -sticky => 'e',
        -ipady => 5,
        -pady => 3,
        -padx => 5,
    );
    my @opt = ();
    if ($key eq 'ftp_pass') {
        @opt = (-show => '*');
    }
    $entry{$key} = $fr->Entry(
        -textvariable => ($key eq 'sched_dir'? \$dir: \$C{$key}),
        -font => "Arial $lab_ent normal",
        -width => 40,
        @opt,
    )->grid(
        -row => $r,
        -column => 1,
        -columnspan => 1,
        -sticky => 'w',
    );
    if ($lab eq 'Schedule Directory') {
        $fr->Button(
            -text => 'Browse',
            -font => "Arial $browse bold",
            -background => '#ddffdd',
            -activebackground => '#55ff55',
            -command => sub {
                return if $browsing;
                my $mw1 = MainWindow->new(
                    -title => "Browsing for Schedule Directory",
                );
                $mw1->protocol("WM_DELETE_WINDOW", sub { 
                    $mw1->destroy();
                    $browsing = 0;
                });
                $mw1->Label(
                    -font => "Arial $browse bold",
                    -text => "Double click to select a directory.",
                    -bg => $back,
                    -height => 1,
                )->pack(-expand => 1, -fill => 'x');
                my $dirtree;
                $dirtree = $mw1->Scrolled('DirTree',
                    -scrollbars => 'osoe',
                    -directory => $dir,
                    -bg => $back,
                    -selectbackground => 'white',
                    -font => "Arial $browse",
                    -height => 30,
                    -width => 40,
                    -command => sub {
                        my @files = $dirtree->selectionGet();
                        $dir = $files[0];
                        $mw1->destroy();
                        $browsing = 0;
                        chdir $dir;
                    },
                )->pack(-expand => 1, -fill => 'both');
                $browsing = 1;
            },
        )->grid(
            -row => $r,
            -column => 2,
            -columnspan => 1,
            -sticky => 'w',
            -padx => 7,
        );
    }
    ++$r;
}
$entry{league}->focus();

my $status = "";

# spacer
my $status_lab = $fr->Label(
    -textvariable => \$status,
    -background => $back,
    -font => "Arial $stat bold",
    -fg => 'black',
)->grid(
    -row => $r++,
    -column => 0,
    -columnspan => 3,
    -ipady => 10,
);

my $fr1 = $fr->Frame(
    -background => $back,
)->grid(
    -row => $r++,
    -column => 0,
    -columnspan => 4,
    -sticky => 'we',
);

$fr1->Button(
    -text => "Convert",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        convert_all();
    },
)->grid(
    -row => $r,
    -column => 0,
    -padx => 5,
);

$fr1->Button(
    -text => "View",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        if (! -f "index.html") {
            return my_die("Nothing to view.");
        }
        ShellExecute("index.html");
    },
)->grid(
    -row => $r,
    -column => 1,
    -padx => 5,
);

$fr1->Button(
    -text => "Publish",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        $status_lab->configure(-fg => 'black');
        $status = "Connecting to $C{ftp_site} ...";
        $mw->after(10, \&publish);
    },
)->grid(
    -row => $r,
    -column => 2,
    -padx => 5,
);

$fr1->Button(
    -text => "Quit",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        $C{sched_dir} = $dir;
        conf_save();
        exit;
    },
)->grid(
    -row => $r,
    -column => 3,
    -padx => 5,
);

MainLoop();

my %game_tally;
my %div_name;
my %day_of_play;
my %div_team;
my %div_timestamp;
my $nscheds;
my @scheds;
my $cur_sched;
my $errs;
my $cur_timestamp;
sub convert_all {
    # JUST in case they changed the system time
    # after they started APA_Sched...
    #
    $cur_timestamp = scalar(localtime);
    $cur_timestamp =~ s{^... (... ..).*}{$1};
    $cur_timestamp = "<span class=timestamp>Last updated on $cur_timestamp</span>";
    
    $status_lab->configure(-fg => 'black');
    %game_tally = %div_name = %div_team = %div_timestamp = ();
    load_except();
    $C{sched_dir} = $dir;
    chdir $C{sched_dir};        # in case it changed ...
    $debug = $C{league} =~ m{xx$};
    if ($debug) {
        $dbg = undef;
        open $dbg, ">", "debug.txt";
    }
    unlink <*.html *.css *.js *.txt>;
    copy 'C:\APA_Sched\style.css', 'style.css';
    copy 'C:\APA_Sched\init.js',   'init.js';
    @scheds = sort <*.pdf *.xls>;
    $nscheds = scalar(@scheds);
    $cur_sched = 1;
    if ($nscheds == 0) {
        $status = "No schedules found in $dir.";
        return;
    }
    $status = "Converting $cur_sched of $nscheds ...";
    $mw->after(300, \&next_sched);
}

sub next_sched {
    if ($cur_sched <= $nscheds) {
        convert_sched($scheds[$cur_sched-1]);
        if ($errs) {
            $status_lab->configure(-fg => 'red');
            return;     # stop on first error
        }
        ++$cur_sched;
        if ($cur_sched <= $nscheds) {
            $status = "Converting $cur_sched of $nscheds ...";
            $mw->after(300, \&next_sched);
            return;
        }
    }
    generate();
}

sub generate {
    open my $out, ">", "index.html"
        or die "no index.html: $!\n";
    print {$out} <<"EOH";
<html>
<head>
<link rel="stylesheet" type="text/css" href="style.css" />
</head>
<body>
<h1>$C{league}</h1>
<p class=instr>
See your team's schedule by first clicking on your division
and then on your team.<br>
On that page you can request a weekly
email reminder of where your team is playing.
</p>
<table cellpadding=4 border=1>
<tr>
<th>&nbsp;Day of Play</th>
<th width=200 align=left>&nbsp;Division Name</th>
<th width=30 align=right>#&nbsp;</th>
</tr>
EOH
    for my $d (sort by_day keys %div_name) {
        my $d0 = sprintf("%03d", $d);
        print {$out} <<"EOH";
<tr>
<td align=left>&nbsp;$day_of_play{$d}</a></td>
<td>&nbsp;<a href=#$d>$div_name{$d}</a></td>
<td align=right>$d0&nbsp;</td>
</tr>
EOH
    }
    print {$out} "</table>\n";

    #
    # Host Site Match Tallies
    #
    print {$out} <<"EOH";
<p class=instr>
How many matches does each host site need to provide for?
</p>
<table cellpadding=5 border=1>
<tr>
<th>&nbsp;Host Site</th>
</tr>
EOH

    for my $hn (sort keys %game_tally) {
        my $fname = host_fname($hn);
        print {$out} "<tr><td>&nbsp;<a href=$fname>$hn</a></td></tr>\n";
    }
    print {$out} "</table>\n";

    for my $d (sort by_day keys %div_team) {
        my $d0 = sprintf("%03d", $d);
        print {$out} <<"EOH";
<a name=$d>
<table style="margin-top: 9mm; margin-bottom: 2mm;">
<tr><td align=right class=divhead>Division $d0:</td><td align=left class=divhead>$div_name{$d}$div_timestamp{$d}</td></tr>
<tr><td align=right class=divhead>Day of Play:</td><td align=left class=divhead>$day_of_play{$d}</td></tr>
</table>
<table cellpadding=4 border=1>
<tr><th width=30 align=right>#&nbsp;</th><th width=250 align=left>&nbsp;Team Name</th></tr>
EOH
        for my $n (sort {$a <=> $b} keys %{$div_team{$d}}) {
            print {$out} "<tr><td align=right>$n&nbsp;</td><td>&nbsp;<a href=$d-$n.html>$div_team{$d}{$n}</td></tr>\n";
        }
        print {$out} "</table>\n";
    }
    print {$out} <<"EOH";
</body>
</html>
EOH
    close $out;
    #
    # host table tallies
    #
    for my $host (sort keys %game_tally) {
        my $fn = host_fname($host);
        open my $tt, ">", $fn
            or die "cannot create $fn: $!\n";
        print {$tt} <<"EOH";
<html>
<head>
<link rel="stylesheet" type="text/css" href="style.css" />
</head>
<body>
EOH
        print {$tt} <<"EOH";
<p class=hostname>$host$cur_timestamp</p>
EOH
        my %months = ();
        for my $dt (keys %{$game_tally{$host}}) {
            $months{substr($dt, 0, 6)} = 1;
        }
        for my $mon (sort keys %months) {
            my $y = substr($mon, 0, 4);
            my $m = substr($mon, 4, 2);
            my $mdays = days_in_month($y, $m);
            my $dow = date($y, $m, 1)->day_of_week();
            print {$tt} <<"EOH";
<table cellpadding=5 border=1>
<tr>
<td colspan=7 class=monthname>$full_mon_name[$m]</td>
</tr>
<tr>
<td class=dayname>Sun</td>
<td class=dayname>Mon</td>
<td class=dayname>Tue</td>
<td class=dayname>Wed</td>
<td class=dayname>Thu</td>
<td class=dayname>Fri</td>
<td class=dayname>Sat</td>
</tr>
EOH
            # days before the first
            for (0 .. $dow-1) {
                print {$tt} "<td class=day>&nbsp;</td>\n";
            }
            for my $d (1 .. $mdays) {
                my $dt = "$y$m" . sprintf("%02d", $d);
                my $n = (exists $game_tally{$host}{$dt})?
                               $game_tally{$host}{$dt}/2: '&nbsp;';
                print {$tt} <<"EOF";
<td class=day>
<div class=daynum>$d</div>
<div class=tally>$n</div>
</td>
EOF
                ++$dow;
                if ($dow == 7) {
                    $dow = 0;
                    print {$tt} "</tr>\n<tr>\n";
                }
            }
            # days after the last day
            for ($dow .. 6) {
                print {$tt} "<td class=day>&nbsp;</td>\n";
            }
            print {$tt} "</tr>\n";
            print {$tt} "</table><p>\n";
        }
        close $tt;
    }
    my $pl = $nscheds == 1? "": "s";
    $status = "$nscheds schedule$pl converted.";
}

sub host_fname {
    my ($hn) = @_;
    $hn = lc $hn;
    $hn =~ s{ }{_}g;
    $hn =~ s{[^\w]}{}g;
    "$hn.html";
}

my @bye_teams;
sub is_bye {
    my ($team) = @_;
    for my $b (@bye_teams) {
        if ($b == $team) {
            return 1;
        }
    }
    return 0;
}

sub convert_sched {
    my ($fname) = @_;

    print {$dbg} "$fname\n" if $debug;
    my ($delim, $delim_char);
    if ($fname =~ m{[.]pdf}i) {
        system(qq!C:/APA_Sched/pdftotext.exe -layout "$fname"!);
        $delim = '\s\s+';
        $delim_char = " ";
    }
    else {
        my $outfile = $fname;
        $outfile =~ s{xls$}{txt}i;

        my $parser   = Spreadsheet::ParseExcel->new();
        my $workbook = $parser->parse($fname);
        if ( !defined $workbook ) {
            die $parser->error(), ".\n";
        }

        open my $out, ">", $outfile
            or die "cannot open $outfile: $!\n"; 

        for my $worksheet ($workbook->worksheets()) {

            my ( $row_min, $row_max ) = $worksheet->row_range();
            my ( $col_min, $col_max ) = $worksheet->col_range();

            for my $row ($row_min .. $row_max) {
                for my $col ($col_min .. $col_max) {

                    my $cell = $worksheet->get_cell( $row, $col );
                    next unless $cell;

                    print {$out} $cell->value();
                    if ($col != $col_max) {
                        print {$out} "~";
                    }
                }
                print {$out} "\n";
            }
        }
        close $out;
        $delim = qr{~[~\s]*};     # ~ followed by one or more ~ or spaces 
        $delim_char = "~ ";
    }
    my $txt = $fname;
    $txt =~ s{(pdf|xls)$}{txt}i;

    open my $in, "<", $txt
        or die "no $txt: $!\n";

    my %matches;
    @bye_teams = ();
    my @team;
    my %host;
    my $div;
    my $div0;
    my $division = "";
    my $day_of_play;

    $errs = 0;
    LINE:
    while (my $line = <$in>) {
        chomp $line;
        $line =~ s{[.]00}{};        # hack for weird spreadsheet error
        if ($line =~ m{([A-Z][a-z]+)\s+(\d+)[\s,]*(\d\d\d\d)[\s~]*$}) {
            print {$dbg} "date updated: $line\n" if $debug;
            print {$dbg} "date $1 $2, $3\n"      if $debug;
            my ($month, $day) = ($1, $2);       # as of date
            if ($div) {
                $month = substr($month, 0, 3);
                $div_timestamp{$div}
                    = "<span class=timestamp>Last updated on $month $day</span>";
            }
            next LINE;
        }
        if ($line =~ m{Division Rep}i) {
            print {$dbg} "ignore div rep: $line" if $debug;
            next LINE;
        }
        if ($line =~ m{day of play}i) {
            ($day_of_play) = $line =~ m{(\w+)\s*$};
            print {$dbg} "day of play: $line - got $day_of_play\n" if $debug;
            # need to remember this until we find
            # the division number.
        }
        if ($line =~ m{Division(.*\d+.*)}) {
            print {$dbg} "got division? $line" if $debug;
            if ($div && $division) {
                $status = "$fname: Cannot have more than one division in a file.";
                ++$errs;
                return;
            }
            # division and name
            #
            $division = $1;
            $division =~ s{.*?(\d+)\s*}{};
            $div = $1;
            $div =~ s{^0}{};
            $div0 = sprintf("%03d", $div);
            $division =~ s{$delim.*}{};
            $division =~ s{^[\s,]*|\s*$}{}g;
            print {$dbg} "got div $div and division '$division'\n"
                if $debug;
            $div_name{$div} = $division;
            $day_of_play{$div} = $day_of_play;
        }
        elsif ($line =~ m{^\s*\d+$delim\d+/\d+/\d+}) {
            print {$dbg} "home-away: $line\n" if $debug;
            # a date, home-away line
            #
            next LINE unless $line =~ m{^[\d\s\-/$delim_char]*$};
                # the line was to indicate a special week
                # like Play Off or No Play, etc.
                # skip it.
            $line =~ s{^\s*}{};

            my @flds = split m{$delim}, $line;
            my $week = shift @flds;    # week #
            my $date = shift @flds;
            my $date_obj = Date::Simple->new($date);
            my $d = $date_obj->as_d8();

            # the rest of the fields are in this format: 4-6
            for my $f (@flds) {
                my ($home, $away) = split m{-}, $f;
                print {$dbg} "got $home, $away\n" if $debug;
                if (! ($home =~ m{^\d+$} && $away =~ m{^\d+$})) {
                    my $mon = $date_obj->month();
                    my $day = $date_obj->day();
                    my $date = substr($full_mon_name[$mon], 0, 3) . " $day";
                    $status = "$fname: bogus home-away:"
                              . " $home-$away on week $date";
                    ++$errs;
                    return;
                }
                $f = [ $home, $away ];
            }

            $matches{$d} = \@flds;
        }
        elsif (defined $div && $line =~ m{^\s*0?$div}) {
            print {$dbg} "host: $line\n" if $debug;
            # team home etc
            #
            # get team number first
            $line =~ s{^\s*(\d+)$delim}{};
            my $num = $1;
            my ($name, $home, $addr, $city, $state, $phone);
            my $dl = $delim;
            if ($except{$num}) {
                $line = $except{$num};
                print {$dbg} "using except: $line\n" if $debug;
                $dl = qr{\s*\|\s*};
            }
            ($name, $home, $addr, $city, $state, $phone)
                = split $dl, $line; 
            #
            # did we get the data properly?
            #
            if (! (defined $state && length($state) == 2)
                && length($city) == 2
                && $home =~ m{\d}
            ) {
                # likely what happened was that
                # the $home site name and $addr address
                # were merged into $home because there were
                # not two spaces between them.
                # Split them apart at the first digit.
                # the others 'ripple down'.
                #
                $phone = $state;
                $state = $city;
                $city = $addr;
                my ($h, $a) = $home =~ m{(\D+)(\d.*)};
                $addr = $a;
                $home = $h;
            }
            elsif ($state =~ m{^[\d-]+$}) {
                # they forgot the state?
                # and the phone became the state
                $phone = $state;
                $state = '';
            }
            elsif ($name !~ m{bye}i
                   && empty($addr) && empty($state) && empty($phone)
            ) {
                # it is all screwed up - error!
                $status = "$fname: host address error for team named '$name'.";
                ++$errs;
                return;
            }
            if (!$Gstate) {
                $Gstate = $state;
            }
            for my $f ($name, $home, $addr, $city, $state, $phone) {
                if (!$f) {
                    $f = "&nbsp;";
                }
            }
            $num =~ s{.*(\d\d)$}{$1};
            $num =~ s{^0*}{};
            if ($name =~ m{^bye$}i) {
                push @bye_teams, $num;
                $team[$num] = {
                    name => "Bye",
                    home => "",
                };
            }
            else {
                $team[$num] = {
                    name => $name,
                    home => $home,
                };
                $div_team{$div}{$num} = $name;
                # shoreline had a troublesome two part address :(
                #if ($home =~ m{shoreline}i) {
                #    $city = "Mountain View";
                #    $phone = "650-964-0780";
                #}
                if (! exists $host{$home}) {
                    $host{$home} = {
                        addr => $addr,
                        city => $city,
                        state => $state,
                        phone => $phone,
                    };
                }
            }
        }
        else {
            print {$dbg} "ignore: $line\n" if $debug;
            # ignore the line
        }
    }
    close $in;
    unlink $txt if ! $debug;
    if ($errs) {
        return;
    }

    $errs = 0;      # start again
    # schedules for each team:
    TEAM:
    for my $i (1 .. $#team) {
        if ($team[$i]{name} eq 'Bye') {
            next TEAM;
        }

        open my $out, ">", "$div-$i.html"
            or die "cannot open $div-$i.html: $!\n";
        print {$out} <<"EOH";
<html>
<head>
<link rel="stylesheet" type="text/css" href="style.css" />
<script type="text/javascript">
var dates = new Array(1
EOH
        my @dates = sort keys %matches;
        for my $d (@dates) {
            print {$out} ",$d\n";
        }
        print {$out} <<"EOH";
);
</script>
<script src="init.js"></script>
</head>
<body onload="init();">
<!-- state $Gstate -->
<h1>Team $i: $team[$i]{name}$div_timestamp{$div}</h1>
<p>
<table cellpadding=5 style="margin-bottom: 2mm;">
<tr><td class=header align=right>Day of Play:</td><td class=header>$day_of_play
<span id=email_reminder style="margin-left: 1in; font-size: 13pt;"></span>
</td></tr>
<tr><td class=header align=right>Division $div0:</td><td class=header>$division</td></tr>
<tr><td class=header align=right>League:</td><td class=header>$C{league}</td></tr>
</table>
<table cellpadding=5 border=1>
<tr>
<th>&nbsp;Date</th>
<th>&nbsp;Host Site</th>
<th>&nbsp;Opponent</th>
</tr>
EOH
        my $reminder_data = "";
        my $r = 1;
        for my $d (@dates) {
            my ($host, $against);
            MATCH:
            for my $m (@{$matches{$d}}) {
                my ($home, $away) = @$m;
                if ($home == $i || $away == $i) {
                    $host = $home;
                    $against = ($home == $i)? $away
                               :              $home
                               ;
                    last MATCH;
                }
            }
            my $mon = substr($d, 4, 2);
            my $day = int(substr($d, 6, 2));    # remove any leading zero 
            my $date = substr($full_mon_name[$mon], 0, 3) . " $day";
            print {$out}
                  "<tr id=r$r><td>&nbsp;"
                  . $date
                  . "</td>"
                  ;
            ++$r;
            if (! $host     # couldn't find it on the line so must be a bye?
                ||
                (is_bye($host) || is_bye($against))
            ) {
                print {$out} "<td colspan=2 align=center>Bye</td>";
                $reminder_data .= "$d|Bye|\n";
            }
            else {
                if (! exists $team[$host]{home}) {
                    $status = "$fname: unknown team: $host on $date";
                    ++$errs;
                    return;
                }
                elsif (! exists $team[$against]{name}) {
                    $status = "$fname: unknown team: $against on $date";
                    ++$errs;
                    return;
                }
                else {
                    ++$game_tally{$team[$host]{home}}{$d};
                    print {$out} "<td>&nbsp;$team[$host]{home}</td>"
                               . "<td>&nbsp;$team[$against]{name}</td>";
                    $reminder_data 
                        .= "$d|$team[$host]{home}|$team[$against]{name}\n";
                }
            }
            print {$out} "</tr>\n";
        }
        print {$out} "</table>\n";

        # host info
        print {$out} <<"EOH";
<h2>Host Sites<span class=mapclick>Click on the address for a map.</span></h2>
<table cellpadding=5 border=1>
<tr>
<th>Name</th>
<th>Address</th>
<th>City</th>
<th>Telephone</th>
</tr>
EOH
        for my $h (sort keys %host) {
            my $addr = $host{$h}{addr};
            $addr =~ s{# C-1}{};     # special case
            print {$out}
                  "<tr>"
                . "<td>$h</td>"
                . "<td><a target=_blank href='http://maps.google.com/maps?near="
                  . "$addr $host{$h}{city} $host{$h}{state}"
                  . "'>$host{$h}{addr}</a></td>"
                . "<td>$host{$h}{city}</td>"
                . "<td>$host{$h}{phone}</td>"
                . "</tr>"
                . "\n";
        }
        print {$out} "</table>\n";
        #
        # cleanly formatted data for reminders
        #
        print {$out} "<!--REMINDER\n${reminder_data}REMINDER-->\n";
        print {$out} "</body>\n</html>\n";
        close $out;
    }
}

my $curf;
my $nfiles;
my @files;
my $ftp;

sub publish {
    if (! -f "index.html") {
        return my_die("Nothing to publish.");
    }
    if (   empty($C{ftp_site})
        || empty($C{ftp_user})
        || empty($C{ftp_pass})
        || empty($C{ftp_dir})
    ) {
        return my_die("You must supply complete FTP information.");
    }
    my $ftp_site = trim($C{ftp_site});
    my $ftp_user = trim($C{ftp_user});
    my $ftp_pass = trim($C{ftp_pass});
    my $ftp_dir  = trim($C{ftp_dir});
    $ftp = Net::FTP->new($ftp_site, Timeout => 5)
        or return my_die("Cannot connect to $ftp_site");
    $ftp->login($ftp_user, $ftp_pass)
        or return my_die("Cannot login - check user and password.");

    my @comps = split m{[/\\]}, $ftp_dir;
    my $dir = "";
    while (my $c = shift @comps) {
        $ftp->mkdir($c);
        $dir .= "$c/";
        $ftp->cwd($c) or return my_die("Cannot change to directory $dir.");
    }

    $ftp->ascii();
    @files = <*.html *.css *.js>;
    $nfiles = @files;
    $curf = 0;
    $status = sprintf "Publishing file %2d of $nfiles ...", $curf+1;
    $mw->after(10, \&put_next);
}

sub put_next {
    if ($curf < $nfiles) {
        $ftp->put($files[$curf])
                or return my_die("Could not publish $files[$curf]");
        $status = sprintf "Publishing file %2d of $nfiles ...", $curf+1;
        ++$curf;
        $mw->after(10, \&put_next);
    }
    else {
        $status = "$nfiles files published.";
        $ftp->quit();
    }
}

sub my_die {
    $status = shift;
    $status_lab->configure(-fg => 'red');
}

sub by_day {
    $daynum{$day_of_play{$a}} cmp $daynum{$day_of_play{$b}} or
    $div_name{$a} cmp $div_name{$b}
}