#!/usr/bin/perl -w

# Copyright 2002 by Eric House
#
# 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.



# TODO

# nuke _xtoy.bin files before every build!

# Figure out if makeseb will work.  If not, ask Franklin.

# Do I need to limit the number of simultaneous users?

# Read perlmonk.org about 1) saving local files; 2) using hidden fields
# to save state.

# consider giving user ability to enter the URL of a file instead of
# doing an upload.  That would make it possible for them to list URLs
# of files I provide online.

# Get some identifier from ENV or whatever, use that to create a
# unique tmp dir, and limit the number of simultaneous users.  Set up
# to delete their files after some short period of time.
#
# Look at the security stuff in Perl Cookbook and the CGI.pm docs.

use strict;

use File::Basename;
use CGI qw/:standard *table  :html3/;
use xloc;
use POSIX;

my $debug = 0;

my $gQuery;

my $NAME_LANG = "LANGUAGE";
my $NAME_LANGINFO = "LANGINFO";
my $NAME_PLAT = "PLATFORM";
my $NAME_FILEUP = "DICTFILE";
my $NAME_SHORTEST = "SHORTEST";
my $NAME_LONGEST = "LONGEST";
my $NAME_DICTNAME = "DNAME";

my $NAME_SUBMIT_PLAT = "SUBMIT_PLAT";
my $NAME_SUBMIT_LANG = "SUBMIT_LANG";
my $NAME_SUBMIT_FILE = "SUBMIT_FILE";
my $NAME_SUBMIT_LIMITS = "SUBMIT_LIMITS";
my $NAME_SUBMIT_BUILDIT = "BUILDIT";

my $NAME_URLFIELD = "URLFIELD";

my $XWD_DICT_FLAGS = 0x0001;

my @varnames = ( "HIDDEN_UID", 
                 "HIDDEN_PLAT",
                 "HIDDEN_LANG",
                 "HIDDEN_FILE",
                 "HIDDEN_SHORTEST",
                 "HIDDEN_LONGEST",
                 );

my $TMPPATH = "/tmp/byod";
my $TMP_DIR_HOURS_TO_LIVE = 24; # how many hours to keep user dirs in $TMPPATH
#my $TMPPATH = "/tmp/byod/$ENV{'REMOTE_HOST'}";
my $DATADIR = "./langinfo";

my $DEFAULT_LANG = "English";
my $DEFAULT_PLAT = "PalmOS";
my $DEFAULT_SHORTEST = 2;
my $DEFAULT_LONGEST = 8;

my %platHash;
if ( $debug ) {
    %platHash = (
                 Franklin => "FRANK",
                 PalmOS => "PALM",
                 WinCE => "WINCE",
                 Linux => "LINUX",
                 );
} else {
    %platHash = (
                 Franklin => "FRANK",
                 PalmOS => "PALM",
                 );
}
#my @bogusList = ("Delete words", "Fail" );

my %gResult;

my $shortWordLow = 2;
my $shortWordHigh = 5;
my $longWordLow = 2;
my $longWordHigh = 15;

my $JSCRIPT = <<END;
    function forceOther(me) {
        if ( me.name == \"$NAME_SHORTEST\" ) {
            if ( me.value > $NAME_LONGEST.value ) {
                me.value = $NAME_LONGEST.value;
            }
        } else {
            if ( me.value < $NAME_SHORTEST.value ) {
                me.value = $NAME_SHORTEST.value;
            }
        }
    }
END

sub addHideVars() {
    my $str = "";

    foreach my $name ( @varnames ) {
        my $value = $gResult{$name};
        if ( $value ) {
            $str .= $gQuery->hidden( -name=>$name, -default=>"$value" );
        }
    }

    return $str;
} # addHideVars

sub readHiddenVars() {
    
    foreach my $name ( @varnames ) {
        my $value = $gQuery->param($name);
        $gResult{$name} = $value ? $value : "";
    }

    # now sanity-check!  die if somebody's stuffed bogus values!  
    # PENDING(ehouse)

} # readHiddenVars

sub makePlatformPage() { 

    my $resultString = "";

    $resultString .= p( "This site allows you to build <a
    href=\"http://www.peak.org/~fixin/xwords\">Crosswords</a>
    dictionaries from wordlists you provide.  It will ask you several
    questions.  As you make decisions your answers will appear in the
    progress table above." )

    . p(" The first step is to tell me what platform you'll be
    building for." )

    . hr . "\n"

    . start_multipart_form()

    . addHideVars()

    . "Select your platform: "
    . popup_menu(-name=>$NAME_PLAT,
                 -values=>[keys(%platHash)],
                 -default=>$DEFAULT_PLAT)
    . br ."\n"

    . submit(-name=>$NAME_SUBMIT_PLAT, -value=>"Choose platform")
    . end_form;

    $gResult{"CONTENT"} = $resultString;

} # makePlatformPage

sub makeLanguagePage() { 

    my $resultString;

    $resultString .= p( "Next you need to choose the language for your
    dictionary.  The language choice determines what letters will be
    allowed in the dictionary that's created here, and how many points
    each will be worth when you play." )

    . p ( "For information about each language click the Details
    button below." )

    . hr . "\n"

    . start_multipart_form()

    . addHideVars()

    . "Select your language"
    . popup_menu(-name=>$NAME_LANG,
               -values=>[langDirList()],
               -default=>$DEFAULT_LANG)
    . submit(-name=>$NAME_LANGINFO, -value=>"Details")
    . br . "\n" 

    . submit(-name=>$NAME_SUBMIT_LANG, -value=>"Choose language")
    . end_form;

    $gResult{"CONTENT"} = $resultString;

} # makeLanguagePage

sub makeUploadPage($) {
    my ( $lang ) = @_;

    my $resultString;

    $resultString .= <<'EOF';

    <p>Now point me at the file you want used to build your
    dictionary.</p>

    <p>Your file should be a plain text list of words, ideally in
    alphabetical order.  Formatted text, wordprocessor files (e.g.
    .doc files), html, etc., won't work.  Here's a sample of what the
    first few lines of your (English, "OSPD") file might look like:

<pre>
AA
AAH
AAHED
AAHING
AAHS
AAL
</pre>

</p>

	<p>Case isn't critical, by the way.  The scripts on this site
	will force everything to upper-case if that's appropriate for
	the language you've chosen.</p>

    <p>To speed the upload process and save bandwidth, we encourage
       you to compress files before you send them.  We will 'unzip'
       files with the .zip extension, 'gunzip' files with the '.gz'
       extension, and 'bunzip2' files with the '.bz2' extension.  All
       other files will be treated as text files -- with unpredictable
       results if that's not in fact what they are.</p>

EOF


    $resultString .= $gQuery->hr
        . $gQuery->start_multipart_form()

        . addHideVars()

        . "Choose a wordlist file to upload from your machine: "
        . $gQuery->filefield(-name=>$NAME_FILEUP,
                             -size=>40,
                             -maxlen=>80)
        . br . "\n"

#         . "<em>OR</em> you can just point us at a file that's already online: "
#         . $gQuery->textfield(-name=>$NAME_URLFIELD,
#                              -default=>"http://ahost.org/~myname/mylist.txt",
#                              -size=>80,
#                              -maxlength=>128)
#         . br
        . $gQuery->submit(-name=>$NAME_SUBMIT_FILE, -value=>"Upload file")
        . $gQuery->end_form;

    $gResult{"CONTENT"} = $resultString;
} # makeUploadPage

sub sampleAsPre() {
    my $userPath = "$TMPPATH/$gResult{'HIDDEN_UID'}";
    my $dictFile = "$userPath/$gResult{'HIDDEN_FILE'}";
    die "File $dictFile doesn't exist!\n" if ! -s $dictFile;
    my $filterString = getUncompFilterFor($dictFile);

    my $resultString = "<pre>\n"

        . `cat "$dictFile" | $filterString head -n 3`
        . "...\n"
        . `cat "$dictFile" | $filterString tail -n 3`

        . "</pre>\n";

    return $resultString;
} # sampleAsPre

# Once we have the dict, we let them figure out what sort of dict to
# generate with it.
sub makePostUploadPage() { 

    my @shortest;
    foreach my $i ( $shortWordLow .. $shortWordHigh ) {
        push @shortest, $i;
    }
    my @longest;
    foreach my $i ( $longWordLow .. $longWordHigh ) {
        push @longest, $i;
    }

    $gResult{"TITLE"} = "Building dictionaries";
    $gResult{"SCRIPT"} = $JSCRIPT; # not used right now

    my $resultString = 

        p( "You have successfully uploaded the wordlist to our server.
        Here are the first and last words in your list.  If these
        aren't what you expect then the file is corrupted or of a type
        we don't understand.  Please back up, check the file type, and
        try again.")

        . sampleAsPre()

        . p("Now tell us what range of words you want included.
            Longer words make for larger dictionaries, slower
            compression times, and more powerful robots.  But
            including words longer than 8 letters only rarely improves
            robot scores while still having a huge (negative) impact
            on size and compression time. " )

        . hr . "\n";

    $resultString .= start_multipart_form()

        . addHideVars()

        . "Shortest words: "
        . popup_menu(-name=>$NAME_SHORTEST,
                     -values=>[@shortest],
                     -default=>$DEFAULT_SHORTEST,
                     -onchange=>"forceOther(this);")
        . " Longest words: "
        . popup_menu(-name=>$NAME_LONGEST,
                     -values=>[@longest],
                     -default=>$DEFAULT_LONGEST,
                     -onchange=>"forceOther(this);")
        . br . "\n"

    . submit(-name=>$NAME_SUBMIT_LIMITS, -value=>"Choose limits" )
                 
    . end_form;

    $gResult{"CONTENT"} = $resultString;
} # makePostUploadPage


sub oneTileInfo($$) {

    my ( $xlocToken, $index ) = @_;

    my $tileR = xloc::GetNthTile($xlocToken, $index);

    return "<th>" . ($index + 1) . "</th><td>"
        . join( "</td><td>", xloc::TileFace($tileR), 
                xloc::TileCount($tileR), xloc::TileValue($tileR))
        . "</td>\n";
} # oneTileInfo

sub makeLangInfoPage($) {
    my ( $lang ) = @_;
    my $resultString;

    my $xlocToken = GetXlocToken( $lang );

    if ( $xlocToken ) {

        my $title = "Tile and language info for $lang";
        $gResult{"TITLE"} = $title;

        $resultString .= h2($title);

        $resultString .= xloc::GetValue( $xlocToken, "LANGINFO" );

        $resultString .= <<'EOF';

        <table class="ltable">
            <tr>
            <th></th>
            <th>Tile face</th>
            <th>Tile value</th>
            <th>Number of tiles</th>
            <th></th>
            <th>Tile face</th>
            <th>Tile value</th>
            <th>Number of tiles</th>
            </tr>
EOF

        my $nTiles = xloc::GetNTiles($xlocToken);
        my $midLast = POSIX::floor(($nTiles + 1) / 2);
        print STDERR "nTiles=$nTiles\n" if $debug;

        my $col1 = 0;
        my $col2 = $midLast;
        while ( $col1 < $midLast ) {
            $resultString .= "<tr>";

            $resultString .= oneTileInfo($xlocToken, $col1);
            if ( $col2 < $nTiles ) {
                $resultString .= oneTileInfo($xlocToken, $col2);
            }

            $col1++;
            $col2++;

            $resultString .= "</tr>";
        }

        $resultString .= end_table;

        $gResult{"CONTENT"} = $resultString;

    }  else {
        $gResult{"ERROR"} = "No data for language $lang";
    }
} # makeLangInfoPage

sub fileSafeName($) {
    my ( $nam ) = @_;

    # get rid of dots and whitespace -- so far
    $nam =~ s/\W/_/g;

    return $nam;
} # fileSafeName

sub myBName($) {

    my ( $fullName ) = @_;

    foreach my $ch ( "\\", "/", ":" ) {
        my $pos = rindex( $fullName, $ch );
        if ( $pos >= 0 ) {		# windoze
            $fullName = substr( $fullName, $pos + 1 );
            last;
        }
    }

    # strip off and preserve any trailing extension THAT WE KNOW.  All
    # other extensions get turned into part of the file name.  White
    # space gets turned into underbars (fixing a bug).
    $fullName =~ s/(\.gz|\.zip|\.bz2)$//;
    my $ext = $1;
    $fullName = fileSafeName($fullName);
    $fullName .= $ext;

    return $fullName;
} # myBName

# Write the contents of the filehandle into a temporary file.  If it's
# a .zip or .gz go ahead and decompress it (deleting old guy).
# Basically do a sanity check to help ensure that the user got us
# something we can use.  If we can't continue, clean up, and call a
# sub to write an error page -- since here we have the best clue what
# it was.

sub storeOrMakeError($$) {

    my ( $name, $handle ) = @_;

    my $errString;

    my $tmpFileName = myBName($name);
    my $inFileName = $name;
    print STDERR "tmpFileName=$tmpFileName\n" if $debug;
    my $userPath = "$TMPPATH/$gResult{'HIDDEN_UID'}";
    mkdir $userPath;
    # arrange for the new directory to die eventually
#    system "echo \"rm -rf $TMPPATH\" | at now + 1 hour";
    my $tmpFilePath = "$userPath/$tmpFileName";
    unlink $tmpFilePath if -s $tmpFilePath;   # nuke if already there

    # Create a copy of the users file
    open TMPFILE, ">$tmpFilePath";
    print STDERR "writing to $tmpFilePath\n" if $debug;
    while (my $bytesread = read( $handle, my $buffer, 1024 ) ) {
        print TMPFILE $buffer;
    }
    close TMPFILE;

} # storeOrMakeError

sub forceLimits( $$ ) {
    my ( $shortestR, $longestR ) = @_;

    my $shortest = ${$shortestR};
    my $longest = ${$longestR};

    if ( $longest > $longWordHigh ) {
        $longest = $longWordHigh;
    }
    if ( $shortest < $shortWordLow ) {
        $shortest = $shortWordLow;
    }

    if ( $shortest > $longest ) {
        $shortest = $longest
    }
    
    ${$shortestR} = $shortest;
    ${$longestR} = $longest;
} # forceLimits

sub makeDefaultName() {

    my $outBase = "$gResult{'HIDDEN_FILE'}";
    $outBase =~ s/(\.gz)|(\.zip)|(\.bz2)$//;
    $outBase =~ s/\./_/;
    $outBase .= "$gResult{'HIDDEN_SHORTEST'}" . "to"
        . "$gResult{'HIDDEN_LONGEST'}";

    return $outBase;
} # makeDefaultName

sub makeBuilditPage() {

    my $resultString = "";

    $resultString =

        p("Now you're ready to build your dictionary.  Please
           double-check that the parameters listed in the table above
           are what you want.  If not, use your browser's back button
           to move back and correct them.  Edit the name of your new
           dictionary if you don't like the default below.  Finally,
           click the \"Build it!!\" button.")

        . p("Then please be patient.  It can take several minutes to
             build a large dictionary." )

        . start_form()

        . addHideVars()
        
        . "Finished dictionary name: " 
        . textfield( -name=>$NAME_DICTNAME,
                     -override=>1,
                     -maxlength=>31,
                     -size=>31,
                     -default=>makeDefaultName() )

        . br

        . submit(-name=>$NAME_SUBMIT_BUILDIT, -value=>"Build it!!" )

        . end_form;

    $gResult{"CONTENT"} = $resultString;
} # makeBuilditPage

sub getUncompFilterFor($) {
    my ( $inFileName ) = @_;
    my $catter;

    if ( $inFileName =~ /\.gz$/ ) {
        $catter = " zcat | ";
    } elsif ( $inFileName =~ /\.zip$/ ) {
        $catter = " zcat | ";
    } elsif ( $inFileName =~ /\.bz2$/ ) {
        $catter = " bzcat | ";
    } else {
        $catter = "";
    }

    return $catter;
} # getUncompFilterFor

sub makeBuiltOrFailure($) {

    my ( $userName ) = @_;

    if ( !$userName ) {
        $userName = makeDefaultName();
    }
    my $safeOutName = fileSafeName( $userName );

    my $lang = $gResult{'HIDDEN_LANG'};
    my $shortest = $gResult{'HIDDEN_SHORTEST'};
    my $longest = $gResult{'HIDDEN_LONGEST'};
    my $platform = $gResult{'HIDDEN_PLAT'};

  BREAKABLE: {

        if ( $longest > $longWordHigh ) {
            $longest = $longWordHigh;
        }
        if ( $shortest < $shortWordLow ) {
            $shortest = $shortWordLow;
        }

        if ( $shortest > $longest ) {
            $gResult{"ERROR"} = "$shortest is not <= $longest";
            last;
        }

        my $langDir = "$DATADIR/$lang";
        my $userPath = "$TMPPATH/$gResult{'HIDDEN_UID'}";
        my $dictFile = "$userPath/$gResult{'HIDDEN_FILE'}";

        if ( ! -s $dictFile ) {
            $gResult{"ERROR"} = "uploaded dictionary file ($dictFile) not found";
            last;
        }

        my $mapFile = checkMakeMapFile( $lang );
        my $valuesFile = checkMakeValuesFile( $lang );
        my $bytesPerFile = $platform eq "PalmOS"? "-b 28000":"";
        my $nosort = "";
        my $outBase = "$userPath/" . $safeOutName;

        nukeBinFiles( $outBase, $userPath );

        my $xlFilterString = getUncompFilterFor($dictFile);
        print STDERR "xlFilterString=$xlFilterString\n" if $debug;

        # All files must be grepped for word size limits.  Beyond that
        # the filtering is language-specific.
        my $xlocToken = GetXlocToken($lang);
        die "unable to pars langinfo file" if ! $xlocToken;

        my $preclip = xloc::GetValue($xlocToken, "LANGFILTER_PRECLIP");
        if ( $preclip ) {
            $xlFilterString .= $preclip;
        }
        $xlFilterString .= "grep '^.\\\{$shortest,$longest\\\}\$' ";

        $xlFilterString .= xloc::GetValue( $xlocToken,
                                           "LANGFILTER_POSTCLIP" );
        if ( xloc::GetValue( $xlocToken, "NEEDSSORT" ) =~ /false/ ) {
            $nosort = "-nosort";
        }

        my $startLocFile = "$userPath/startloc.bin";
        my $wc = "$userPath/wc.bin";

        print STDERR $xlFilterString, "\n" if $debug;

        my $dict2dawg = " ./dict2dawg.pl -m $mapFile $bytesPerFile "
            . " -ob $outBase $nosort -term 0 -sn $startLocFile -wc $wc";
        print STDERR $dict2dawg,"\n" if $debug;

        my $zipFilePath = figureZipName( $outBase, $platform );

        defined(my $pid = fork) or die "Can't fork: $!";
        if ( $pid != 0 ) { # parent process
            return $zipFilePath;
        } else {
            local $SIG{ALRM} = sub { die "alarm killing process...\n" }; # NB: \n required
            alarm 1000;            # avoid infinite loops...

            open COMPRESSOR, "| $xlFilterString | $dict2dawg" 
                or die "no COMPRESSOR";
            open INFILE, "< $dictFile" or die "no INFILE";
            while ( my $nBytes = read( INFILE, my $buffer, 1024 ) ) {
                print COMPRESSOR $buffer;
            }
            close COMPRESSOR;
            close INFILE;

            # At this point we *should* have all the parts needed to build
            # the dict.
            my $dictPath = buildFile( $lang, $platform, $outBase, $userName,
                                      $userPath, $startLocFile, $wc );

            zipFile( $dictPath, $zipFilePath );
            print STDERR "back from zipFile!!\n if $debug";
            exit 0;               # we're the child process
        }

    } # BREAKABLE

} # makeBuiltOrFailure

sub startStatusPage($) {
    my ( $zipName ) = @_;

    my $dir = dirname( $ENV{"REQUEST_URI"} );
    my $url = "$dir/download.cgi?file=$zipName;count=1";

    print $gQuery->redirect("$url");
} # startStatusPage

sub zipFile($$) {
    my ( $target, $zipfile ) = @_;

    die "file \"$target\" not found" if ! -s $target;

    `zip -j $zipfile $target`;
} # zipFile

sub figureZipName($$) {
  my ( $base, $platform ) = @_;
  my $result;

  if ( $platform eq "PalmOS" ) {
      $result = $base . "_pdb";
  } else {
      $result = $base . "_xwd";
  }
  $result .= ".zip";

  return $result;
} # figureZipName

sub buildFile($$$$$$$) {
  my ( $lang, $platform, $base, $userName, $tmpPath, $startLoc, $wcpath ) = @_;

  my $result;

  my $map = checkMakeMapFile( $lang );

  if ( $platform eq "PalmOS" ) {

      my $palmvalues = checkMakePalmValuesFile( $lang );

      my $palmheader = checkMakePalmHeaderFile( $lang, $tmpPath, $wcpath );

      my $binbase = $base;
      $base .= ".pdb";
      my @args = ( "./par.pl", "c", "-a", "backup", $base,
                   "$userName", "DAWG", "Xwr3", 
                   $palmheader, $map, $palmvalues, 
                   listBinFiles( $binbase, $tmpPath ) );
      print STDERR "args are ", join( " ", @args), "\n" if $debug;
      die "par isn't here and executable!!!" if ! -x "./par.pl";
      0 == system @args or die "par.pl call failed\n";

      $result = $base;
  } else {

      my $values = checkMakeValuesFile( $lang );
      my $specials = checkMakeFrankSpecialsFile( $lang );

      my $resultName = "$base.xwd";
      open OUTFILE, "> $resultName";

      print OUTFILE pack( "n", $XWD_DICT_FLAGS ); # the flags
      print OUTFILE pack("c", -s $map );          # the number of chars

      map {
          open INFILE, "< $_";
          while ( my $nBytes = read( INFILE, my $buffer, 1024 ) ) {
              print OUTFILE $buffer;
          }
          close INFILE;
      } ( $map, $values, $specials, $startLoc,
          listBinFiles( $base, $tmpPath ) );
      close OUTFILE;

      if ( $platform eq "WinCE" || $platform eq "Linux" ) {
          # we're done
      } elsif ( $platform eq "Franklin" ) {
          die "Can't do the .seb thing yet";
      } else  {
          die "what is this $platform platform?";
      }
      $result = $resultName;
  }

  return $result;
} # buildFile
	      
sub nukeBinFiles($$) {
    my ( $base, $path ) = @_;

    map unlink, listBinFiles( $base, $path );
}

sub listBinFiles($$) {

    my ( $base, $path ) = @_;

    my $regex = "$base" . "_\\d+" . ".bin";

    opendir DIRHANDLE, $path or die "couldn't opendir $path";
    my @bins;
    foreach my $fil (readdir DIRHANDLE) {
        $fil = "$path/$fil";
        if ( $fil =~ /$regex/ ) {
            push @bins, $fil;
        }
    }
    closedir DIRHANDLE;
    return sort @bins;

} # listBinFiles

sub langDirList() {
  opendir DIRHANDLE, $DATADIR or die "couldn't opendir $DATADIR";
  my @names;
  foreach my $name (readdir DIRHANDLE) {
    if ( -d "$DATADIR/$name" && $name =~ /\w/ ) {
      push @names, $name;
    }
  }
  closedir DIRHANDLE;
  return sort @names;
} # langDirList

sub tmpDirList() {
    opendir DIRHANDLE, $TMPPATH or die "couldn't opendir $TMPPATH";
    my @names;
    foreach my $name (readdir DIRHANDLE) {
        if ( $name =~ /\w/ ) {
            push @names, "$TMPPATH/$name";
        }
    }
    closedir DIRHANDLE;
    return @names;
} # tmpDirList

sub checkMakePalmHeaderFile($$$) {
  my ( $lang, $tmpPath, $wc ) = @_;

  # make anew each time, as $wc content can change
  die "strange $wc format" if ! -s $wc == 4;

  my $resultPath = "$tmpPath/palmheader.bin";
  open OUTFILE, "> $resultPath" or die "couldn't open $resultPath\n";

  open COUNT, "< $wc" or die "couldn't open $wc\n";
  while ( my $nBytes = read( COUNT, my $buffer, 4 ) ) {  
      print OUTFILE $buffer;
  }
  close COUNT;

  print OUTFILE pack("C",3);
  print OUTFILE pack("C",1);
  print OUTFILE pack("C",2);
  print OUTFILE pack("CCC",0);
  print OUTFILE pack("CC",0);

  close OUTFILE;
  return $resultPath;
} # checkMakePalmHeaderFile

sub checkMakeMapFile($) {
  my ( $lang ) = @_;

  my $tmpname = "./$DATADIR/$lang/table.bin";
  die "no table file" if ! -s $tmpname;
  return $tmpname;
}

sub checkMakePalmValuesFile($) {
  my ( $lang ) = @_;

  my $tmpname = "./$DATADIR/$lang/palmvalues.bin";
  die "no values file" if ! -s $tmpname;
  return $tmpname;
}

sub checkMakeValuesFile($) {
  my ( $lang ) = @_;

  my $tmpname = "./$DATADIR/$lang/values.bin";
  die "no values file" if ! -s $tmpname;
  return $tmpname;
}

sub checkMakeFrankSpecialsFile($) {
    my ( $lang ) = @_;

    my $tmpname = "./$DATADIR/$lang/frankspecials.bin";
    die "no values file" if ! -s $tmpname;
    return $tmpname;
} # checkMakeFrankSpecialsFile

sub GetXlocToken($) {

    my ( $lang ) = @_;

    my $langDir = "$DATADIR/$lang";
    my $fil = "$langDir/info.txt";

    my $xlocToken;
    if ( -s $fil ) {
        $xlocToken = xloc::ParseTileInfo($fil);
      }

    return $xlocToken;
} # GetXlocToken

sub printPage() {

    print STDERR "printPage\n" if $debug;

    my $title = $gResult{"TITLE"};
    if ( !$title ) {
        $title = "Crosswords Build-Your-Own-Dictionary page";
    }

    print header,
    start_html( -title=>$title, 
		-style=>{'src'=>'./byod.css'} );

    printStartFluff();

    print q {
        <div class="inner">
        };

    if ( $gResult{"ERROR"} ) {
        print $gResult{"ERROR"};
    } else {
        print $gResult{"CONTENT"};
    }

    print q {
        </div>
    };

    printEndFluff();

    print end_html;

} # printPage

sub printStartFluff() {

    print q [
             <div class="outer">
             ];

    print q [
        <table class="stable">
            <tr>
            <th>Options:</th>
              <th>Platform</th>
              <th>Language</th>
              <th>Wordlist file</th>
              <th>Shortest</th>
              <th>Longest</th>
            </tr>
	 ];
    print qq [ 
            <tr>
            <th>Choices:</th>
              <td>$gResult{'HIDDEN_PLAT'}</td>
              <td>$gResult{'HIDDEN_LANG'}</td>
              <td>$gResult{'HIDDEN_FILE'}</td>
              <td>$gResult{'HIDDEN_SHORTEST'}</td>
              <td>$gResult{'HIDDEN_LONGEST'}</td>
            </tr>
        </table>
    ];

#     print "debug info<ul>";
#     foreach my $key (keys(%ENV)) {
#         print "<li>$key: $ENV{$key}</li>\n";
#     }
#     print "</ul>";
} # printStartFluff

sub printEndFluff() {
    print q [
	     <div class="cright">
	     Copyright 2002 by Eric House.  All rights reserved.<br>
	     Questions or comments? Send us
	     <a href="mailto:fixin@peak.org">mail</a>
	     </div>
	     </div>
	     ];
}

sub nukeOldDirs() {

    my $curtime = time();
    foreach my $dir (tmpDirList()) {
        my @stats = stat($dir);
        # the 8th elem is atime, last access in seconds
#        my $atime = $stats[8]; # access time
        my $tim = $stats[9]; # mod time

        my $age = $curtime - $tim;
        if ( $age  > (60 * 60 * $TMP_DIR_HOURS_TO_LIVE) ) { # 2 hours.
            print STDERR "removing old user dir $dir\n" if $debug;
            `rm -rf $dir`;
        }
    }
} # nukeOldDirs

sub debugStr($) {
    print header, start_html, p(shift(@_)), end_html;
    exit;
}

##############################################################################
# actual work starts here
##############################################################################

mkdir $TMPPATH;
$gQuery = new CGI;

my @names = $gQuery->param;

if ( @names == 0 ) {            # Opening page

    nukeOldDirs();

    my $uid = $ENV{"REMOTE_ADDR"};
    $uid =~ y/\./_/;
    $uid .= "_" . time();
    print STDERR "created UID of $uid\n";
    $gResult{"HIDDEN_UID"} = $uid;
    makePlatformPage();

}  else {

    readHiddenVars();
#     $gUID = $gQuery->param("HIDDEN_UID");

    if ( $gQuery->param($NAME_SUBMIT_PLAT) ) {

        my $platform = $gQuery->param($NAME_PLAT);
        $gResult{'HIDDEN_PLAT'} = $platform;
        makeLanguagePage();

    } elsif ( $gQuery->param($NAME_LANGINFO) ) {

        my $lang = $gQuery->param($NAME_LANG);
        makeLangInfoPage( $lang );

    } elsif ( $gQuery->param($NAME_SUBMIT_LANG) ) {

        my $lang = $gQuery->param($NAME_LANG);
        $gResult{'HIDDEN_LANG'} = $lang;
        makeUploadPage( $lang );

    } else {

        # if we get here, we've settled on a language.  but be
        # paranoid
        my $lang = $gResult{'HIDDEN_LANG'};
        die "no language hidden!" if !$lang;
        die "bogus language $lang" if ! -d "$DATADIR/$lang";

        if ( $gQuery->param($NAME_SUBMIT_FILE) ) {

            # check if we have a valid download file, and either
            # proceed or print an error

            my $filename = $gQuery->param($NAME_FILEUP);
            $gResult{'HIDDEN_FILE'} = myBName($filename);
            my $fh = $gQuery->upload($NAME_FILEUP);
            my $siz = -s $fh;

            if ( $siz > 0 ) {
                storeOrMakeError( $filename, $fh );

                if ( ! $gResult{"ERROR"} ) {
                    makePostUploadPage();
                } else {
                    print STDERR "That other case!!\n";            
                }
            } else {
                $gResult{"ERROR"} = "unable to upload file $filename";
            }

        } elsif (  $gQuery->param($NAME_SUBMIT_LIMITS) ) {

            my $shortest = $gQuery->param($NAME_SHORTEST);
            my $longest = $gQuery->param($NAME_LONGEST);
            forceLimits( \$shortest, \$longest );
            $gResult{'HIDDEN_SHORTEST'} = $shortest;
            $gResult{'HIDDEN_LONGEST'} = $longest;
            makeBuilditPage();

        } elsif ( $gQuery->param($NAME_SUBMIT_BUILDIT) ) {

            my $userName = $gQuery->param($NAME_DICTNAME);

            # This guy will fork before returning a filename if things
            # look good.  The fork will do the work and then the
            # status page will detect and upload the file.

            my $zipName = makeBuiltOrFailure( $userName );
            if ( $zipName ) {
                startStatusPage( $zipName );
            }
            exit 0;                 # don't print the usual page!

        } else {
            die "unexpected form element";
        }
    }
}

printPage();

exit 0;

