#!/usr/bin/perl -w
############################################################
# This script will create the monthly Solver's Forum html page from a logfile.
# It will format the text, add the proper state of the bidding box and add the
# comments area.
############################################################
########################################################
# Global Variables.
########################################################
use whereami;
########################################################
# CreateLog Variables.
########################################################
our $targetinfile; # CreateLog file name
our $mm; # forum month. 01- 12
our $yy; # forum year 05+
our $AscDate; # forum month in ascii
our $moderator; # moderator name
our $moderemail; # moderator email address
our @problems = (); # data for the six hands
############################################################
# Start with basic html headers and read the FORM data.
############################################################
print "Content-type: text/html\n\n";
HTMLheader();
my %form = parseform(%form);
########################################################
# This prints the form data. Only used for testing.
########################################################
# foreach $key (keys %form) { print "$key=$form{$key}ZZZ<br> \n"; }
########################################################
# Miscellaneous local variables..
########################################################
my @alertsigns = ("*", "#", "!", "+", "\$");
my $errcnt = 0;
my $days = 0;
########################################################
# retrieve the month-year parms so we can open files.
########################################################
if ( ( !($form{targetmonth}) ) ||
( !($form{targetyear}) ) )
{ errs( "Date parameters missing" ); }
$targetinfile = "../forum/CreateLog/"."$form{targetmonth}"."$form{targetyear}".".txt";
###########################################################
# Open the new hands file and retrieve the data.
###########################################################
#GetLog();
open (CREATELOG, "$targetinfile") or errs ("Open error for Read <br>File - $targetinfile <br> Errmsg - $!");
#################################
# Get the issue date
#################################
($note,$mmyy) = split /:/, <CREATELOG>;
chomp ($mmyy);
($mm,$yy) = split /\//, $mmyy;
$AscDate = AsciiMonth($mm);
##################################
# Get the moderator and email address:
##################################
($note,$moderator) = split /:/, <CREATELOG>;
chomp ($moderator);
($note,$moderemail) = split /:/, <CREATELOG>;
chomp ($moderemail);
##################################################
# Finally, get the data for the six problems and then close the file.
##################################################
$problems[1] = <CREATELOG>;
$problems[2] = <CREATELOG>;
$problems[3] = <CREATELOG>;
$problems[4] = <CREATELOG>;
$problems[5] = <CREATELOG>;
$problems[6] = <CREATELOG>;
close CREATELOG;
###############################################
# Find the number of days between today and the issue date.
###############################################
$days = DayCnt($mm, $yy);
if ( $days == 0 )
{ $duedate = "Entries are now closed for this forum."; }
elsif ( $days == 1 )
{ $duedate = "Hurry, this is the last day to enter the forum."; }
else
{ $duedate = "There are "."$days"." days left to enter the forum"; }
############################################
# We now have enough info to output the HTML banners.
############################################
HTMLbanners( $AscDate, $yy, $moderator, $moderemail, $duedate);
#######################################################
# Now add the form data. First the hidden data fields.
#######################################################
print "<FORM method=\"POST\" action=\"/cgi-bin/D8forum.cgi\">\n";
print "<INPUT type=\"hidden\" name=\"targetmonth\" value=\"$form{targetmonth}\">\n",
"<INPUT type=\"hidden\" name=\"targetyear\" value=\"$form{targetyear}\">\n";
#######################################################
# Create the html for the 6 problems.
#######################################################
shift (@problems);
foreach $question (@problems)
{
my @alerts = (); # Initialize variables
my $alerts = 0;
$lastcall = "00";
$maydouble = "disabled";
$mayredouble = "disabled";
# Split all of the data from the logfile
# ---------------------------------------------------------------------------
my ($probnum,$scoremeth,$colors,$dealer,$auction,$hand,$thanksto)
= (split /:/, $question);
# Format the data
# ---------------------------------------------------------------------------
$scoremeth = EditScoreMethod($scoremeth);
$colors = EditColors($colors);
$dealer = EditDealer($dealer);
#########################################################
# The screen from here on consists of a big table with two columns each of
# which takes up about half the screen, Inside each column are other
# tables, for the hand and comments on the left and bidding and error msgs
# on the right.
#########################################################
print <<PROBHEADER;
<TABLE width="100%">
<TR>
<TD width="50%"><H3>$probnum. $scoremeth, $colors</H3>
PROBHEADER
##################################################
# Create the bidding table
##################################################
print <<DIRECTIONS;
<TABLE class="problem">
<TR>
<TD width="7em" align="center">West </TD>
<TD width="20px"> </TD>
<TD width="7em" align="center">North</TD>
<TD width="20px"> </TD>
<TD width="7em" align="center"> East</TD>
<TD width="20px"> </TD>
<TD width="7em" align="center">South</TD>
</TR>
DIRECTIONS
# Print out the Bidding
# ---------------------------------------------------------------------------
@auction = split /,/, $auction;
####################################################
# Add the right number of -- signs at the beginning of the auction
####################################################
if ($dealer eq "North")
{ @auction = ("--", @auction); }
elsif ($dealer eq "East")
{ @auction = ("--", "--", @auction); }
elsif ($dealer eq "South")
{ @auction = ("--", "--", "--", @auction); }
# Start creating the bidding grid
# ---------------------------------------------------------------------------
$countto4 = 1; # A counter for where we are between West and South
foreach $call (@auction)
{
if ($call =~ /P$/) {$call = "Pass";} # Change P to Pass
if ($call =~ /\(/)
{
###############################################
# There is an alert on this bid. There may be a trailing blank
# on the bid.
###############################################
my ($alert, $ZZZ);
($call, $alert) = split /\(/, $call;
($call, $ZZZ) = split / /, $call;
$call .= $alertsigns[$alerts];
($alert, $ZZZ) = split /\)/, $alert;
$ZZZ= $alertsigns[$alerts];
$ZZZ .= " ";
$ZZZ .= $alert;
push (@alerts, $ZZZ);
$alerts++;
}
$sub3 = substr ($call, 0, 3);
$sub4 = substr ($call, 0, 4);
if ($countto4 == 1) # West
{
print <<WESTTOBID;
<TR><TD align="center">$call$alertsign</TD><TD></TD>
WESTTOBID
unless ( ($sub4 eq "Pass") ||
($call eq "--") )
{
if ( $sub3 eq "DBL")
{$maydouble = "disabled";
$mayredouble = ""; }
elsif ( $sub4 eq "RDBL")
{$maydouble = "disabled";
$mayredouble = "disabled"; }
else {$lastcall = $call;
$maydouble = "";
$mayredouble = "disabled"; }
}
$countto4++;
}
elsif ($countto4 == 2) # North
{
print <<NORTHTOBID;
<TD align="center">$call$alertsign</TD><TD></TD>
NORTHTOBID
unless ( ( $sub4 eq "Pass") ||
($call eq "--") )
{
if ( ( $sub3 eq "DBL") ||
( $sub4 eq "RDBL") )
{$maydouble = "disabled";
$mayredouble = "disabled"; }
else {$lastcall = $call;
$maydouble = "disabled";
$mayredouble = "disabled"; }
}
$countto4++;
}
elsif ($countto4 == 3) # East
{
print <<EASTTOBID;
<TD align="center">$call$alertsign</TD><TD></TD>
EASTTOBID
unless ( ( $sub4 eq "Pass") ||
($call eq "--") )
{
if ( $sub3 eq "DBL")
{$maydouble = "disabled";
$mayredouble = ""; }
elsif ( $sub4 eq "RDBL")
{$maydouble = "disabled";
$mayredouble = "disabled"; }
else {$lastcall = $call;
$maydouble = "";
$mayredouble = "disabled"; }
}
$countto4++;
}
elsif ($countto4 == 4) # South
{
print <<SOUTHTOBID;
<TD align="center">$call$alertsign</TD>
</TR>
SOUTHTOBID
unless ( ($sub4 eq "Pass") ||
($call eq "--") )
{
if ( ( $sub3 eq "DBL") ||
( $sub4 eq "RDBL") )
{$maydouble = "disabled";
$mayredouble = "disabled"; }
else {$lastcall = $call;
$maydouble = "disabled";
$mayredouble = "disabled"; }
}
$countto4 = 1; # Reset the counter
}
}
###################################################
# Always add a question mark in the last cell.
###################################################
print "<TD align=\"center\">?</TD></TR>\n";
print "</TABLE>\n";
###################################################
# Add the list of alerts at the bottom of the bids.
###################################################
ShowAlerts(@alerts);
###################################################
# Show the hand
###################################################
print "<br><span class=\"handinfo\">\n";
unless ($scoremeth =~ /Lead/)
{
print "What is your call as South holding\:\n";
}
else
{
print "What is your opening lead\:<BR>\n";
}
print "</span><br>\n";
#####################################################
# Print the Hand.
#####################################################
($spades, $hearts, $diamonds, $clubs) = split /,/, $hand;
print "<span class=\"handinfo\">\n",
"<IMG src=\"$Hdir/Images/Spade.gif\">$spades \n",
"<IMG src=\"$Hdir/Images/Heart.gif\">$hearts \n",
"<IMG src=\"$Hdir/Images/Diamond.gif\">$diamonds \n",
"<IMG src=\"$Hdir/Images/Club.gif\">$clubs <br>\n",
"</span><br>\n";
##########################################################
# Add the comments textfield at the bottom of each problem
##########################################################
$ZZZ = "comments$probnum";
chomp $form{$ZZZ};
chomp $form{$ZZZ};
print "<SPAN style=\"margin-left:5%; font-weight:bold;\" >Comments</SPAN><BR>\n",
"<TEXTAREA class=\"comments\" name=\"$ZZZ\" wrap=\"hard\" cols=\"46\" rows=\"12\">\n";
print "$form{$ZZZ}\n" if $form{$ZZZ};
print "</TEXTAREA>\n";
##########################################################
# Close off the top left cell, start the top right cell (The bidding box), and start
# the nested table.
##########################################################
print "</TD>\n";
print "<TD width=\"50%\">\n";
print "<TABLE class=\"bidbox\">\n";
# Split up the last call
# ---------------------------------------------------------------------------
$lastcalllevel = substr ($lastcall, 0, 1);
$lastcalldenom = LastCallDenom (substr ($lastcall, 1, 1));
# Now generate the bidding box with the appropriate calls greyed out
# ---------------------------------------------------------------------------
for ($strain=1; $strain<=5; $strain++)
{
print "<TR>";
for ($level=1; $level <= 7; $level++)
{
if ($level < $lastcalllevel)
{
$disabled = "disabled";
$bgcolor = "lightslategray";
}
elsif ( ($strain <= $lastcalldenom) && ($level == $lastcalllevel) )
{
$disabled = "disabled";
$bgcolor = "lightslategray";
}
else
{
$disabled = "";
$bgcolor = "bisque";
}
# Change the strain from a number to a letter
# ---------------------------------------------------------------------------
local $strainletter = StrainLetter ($strain);
local $suitcolor = SuitColor ($strain);
$ZZZ = "bid$probnum";
print "<TD bgcolor=\"$bgcolor\">\n",
"<INPUT type=\"radio\" name=\"$ZZZ\" $disabled value=\"$level$strainletter\" ";
print "checked=\"checked\" " if ( $form{$ZZZ} eq "$level$strainletter" );
print ">\n";
print "<FONT color=\"$suitcolor\">$level$strainletter</FONT></TD>\n";
}
print "</TR>\n";
}
# Post background colors for Double and Redouble
# ---------------------------------------------------------------------------
if ($maydouble eq "")
{$doublebg = "bisque";}
else {$doublebg = "lightslategray";}
if ($mayredouble eq "")
{$redoublebg = "bisque";}
else {$redoublebg = "lightslategray";}
####################################################
# Add the Pass, Double, Redouble, and XX options. Add the error
# message if this field wasn't entered on the previous screen.
####################################################
print "<TR>\n";
print "<TD bgcolor=\"bisque\" colspan=\"2\">\n",
"<INPUT type=\"radio\" name=\"$ZZZ\" value=\"Pass\" ";
print "checked=\"checked\" " if ( $form{$ZZZ} eq "Pass" );
print ">Pass</TD>\n";
print "<TD bgcolor=\"$doublebg\" colspan=\"2\">\n",
"<INPUT type=\"radio\" name=\"$ZZZ\" $maydouble value=\"DBL\" ";
print "checked=\"checked\" " if ( $form{$ZZZ} eq "DBL" );
print ">DBL</TD>\n";
print "<TD bgcolor=\"$redoublebg\" colspan=\"2\">\n",
"<INPUT type=\"radio\" name=\"$ZZZ\" $mayredouble value=\"RDBL\" ";
print "checked=\"checked\" " if ( $form{$ZZZ} eq "RDBL" );
print ">RDBL</TD>\n";
print "<TD bgcolor=\"bisque\">\n",
"<INPUT type=\"radio\" name=\"$ZZZ\" value=\"XX\" ";
print "checked=\"checked\" " if ( $form{$ZZZ} eq "XX" );
print ">XX</TD>\n";
print "</TR>\n",
"</TABLE>\n";
#######################################################
# Finally, print any remaining error msgs.
#######################################################
print "<BR><BR>\n";
if ( ($form{Cnt} > 2) && (!($form{$ZZZ}) ) )
{
print "<SPAN class=\"errmsg\"> No bid entered.</SPAN><BR>\n";
$errcnt++;
}
$ZZZ = "comments$probnum";
if ( ($form{Cnt} > 2) && (length ($form{$ZZZ}) > 320) )
{
print "<SPAN class=\"errmsg\"> Comments field too long.</SPAN><BR>\n";
$errcnt++;
}
if ( CheckMarkup ( $form{$ZZZ} ) )
{
print "<SPAN class=\"errmsg\"> Markup in the Comments field.</SPAN>\n";
$errcnt++;
}
#######################################################
# Close out the top right cell and then the problem.
#######################################################
print "</TD></TR>\n";
print "</TABLE><br><HR><br>\n";
}
##################################################
# Add in the name, city, email, submit and reset buttons, then end
# the FORM.
##################################################
$errcnt += HTMLinfo(%form);
############################################
# Enter the final State-of-the-Screen msg.
############################################
if ( $form{Cnt} > 2)
{
print "<div align=\"center\">\n",
"<SPAN class=\"lastmsg\"> \n";
if ( !$days )
{
print "Past the cutoff date for this Forum.</SPAN>\n",
"</div>\n";
}
elsif ( !$errcnt )
{
UpdateCom (%form);
print "All OK. Answers Posted.</SPAN>\n",
"</div>\n";
}
else
{
print "$errcnt Missing or Invalid Entries.</SPAN>\n",
"</div>\n";
}
}
print <<THEEND;
<br><br><a HREF="http://advocate.district8acbl.com">
Return to the District 8 Home Page</a><br><br>
THEEND
HTMLender();
##############################################################
# Subroutines.
##############################################################
use D8subs qw(EditScoreMethod EditColors AsciiMonth EditDealer
LastCallDenom StrainLetter SuitColor ShowAlerts DayCnt
DaysMonth);
use D8html qw(parseform HTMLbanners HTMLinfo HTMLheader
HTMLender CheckMarkup CheckEmail emsg errs);
use D8scores qw(UpdateCom);