#!/usr/bin/perl
# ================================================================================
# $Rev: 170 $ $URL: file:///C:/daten/archiv/PlayChess/trunk/cgi/annotate.cgi $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Author: $Author: Thomas $
# Modified: $Date: 2005-11-02 22:36:50 +0100 (Mi, 02 Nov 2005) $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Copyright at playchess.de - all rights reserved
# ================================================================================
use lib "../cgi-bin";
use CGI::Carp qw(fatalsToBrowser);
use CGI qw( :standard );
use Annotate;
use PCGame;
use PCMove;
use PCSession;
use Template;
use Object;
use Util;
use ChessConfig;
use PCLeagueUtil;
use Time::Local;
use MyDbi;
local $starttime = time;
# Connect to database
#--------------------
$dbh = dbiConnect() or die( "DB-Handle is undefined" );
# ---------- Konstanten ----------------
local $MIN_MOVENO = 10;
#$| = 1;
# ---------- Parameter ----------------
local $config = getConfig();
local $cgi = CGI->new();
local $sobj = PCSession->new( $cgi );
local $sname = $sobj->getValue( 'name' );
local $spid = $sobj->getValue( 'pid' );
local $name = $cgi->param( 'name' ) || $sname;
local $passwd = $cgi->param( 'passwd' );
local $action = $cgi->param( 'action' ) || $ENV{ 'action' } || 'view';
local $anno = $cgi->param( 'anno' ) || $ENV{ 'anno' };
local $errmsg = $cgi->param( 'err' ) || $ENV{ 'err' };
local $publish = $cgi->param( 'publish' );
local $result = $cgi->param( 'result' );
# Aufsplitten von anno in game und author ist nicht trivial:
# HCL-A123-1-name
# HCL-A123-1-doppel-name
# PRV-123456-name
# PRV-123456-doppel-name
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# local ($game,$author) = ($anno =~ /(.+)-([^-]+)$/);
local ($game,$author);
my ($league, $tour, $bd);
($league, $tour, $bd, $author) = split( /-/, $anno, 4) if( $anno =~ /^[HAC]CL/ );
($league, $bd, $author) = split( /-/, $anno, 3) if( $anno =~ /^PRV/ );
$game = "$league-" . (($tour) ? "$tour-" : '') . $bd;
# Debug-Output
# ~~~~~~~~~~~~
# print "anno='$anno', league='$league', tour='$tour', bd='$bd', game='$game', author='$author'
\n";
# print "action = $action
\n ";
# print "result = $result
\n ";
# print "action=$action
\n";
# ---------- Edit Comments ---------------------
if( $action eq 'edithelp' )
{
my $tpl = Template->new( "anno-edithelp.pop" );
print $tpl->Expand($sobj);
}
# ---------- Edit Comments ---------------------
elsif( $action eq 'edit' )
{
# Page requires login
# ~~~~~~~~~~~~~~~~~~~
$sobj->assertLogged();
local $author = $sname;
# -------------------------------------------
# Try to load annotation first
# -------------------------------------------
$cobj = Annotate->Load("$game-$author");
IGNORE(__FILE__,__LINE__, $cobj );
#cgiError( "Cannot load \"$game\"" ) unless $cobj;
#print "cobj=$cobj
\n";
# -------------------------------------------
# annotation does not exist yet ==>
# create annotation object from normal game
# -------------------------------------------
unless( $cobj && $cobj->Id )
{
my $gobj = PCGame->loadByName( $game );
cgiError( "Game $game not found" ) unless $gobj;
# cgiError( "Game $game is not finished" ) unless( $gobj->Result || $sobj->getValue('isMember') );
$sobj->assertMember unless( $gobj->Result );
$cobj = Annotate->createFromGame($gobj);
cgiError( "Cannot create \"$game\"" ) unless $cobj;
$cobj->Author( $author );
$cobj->APid( $sobj->getValue('pid') );
}
# End of data retrieval. Now generating output
#---------------------------------------------
$dbh->disconnect();
displayGame( $cobj, 'EDIT' );
# Store session and exit
# ~~~~~~~~~~~~~~~~~~~~~~
$sobj->close();
exit(0);
}
#----------------------------------------------------------------------------
if( $action eq 'view' )
{
# ---------- Annotations ---------------------------
$cobj = Annotate->Load($anno);
#print "cobj=$cobj
\n";
IGNORE(__FILE__,__LINE__, $action, $cobj );
cgiError( "Cannot load \"$anno\"" ) unless $cobj;
# End of data retrieval. Now generating output
#---------------------------------------------
$dbh->disconnect();
displayGame( $cobj, 'PREVIEW', 1 );
IGNORE( __FILE__,__LINE__, $#{$rows}, "TOTAL TIME:", time()-$starttime, $starttime, time );
exit(0);
}
#----------------------------------------------------------------------------
if( $action =~ /Preview|Store/i )
{
my $game = $cgi->param( 'game' );
my $author = $cgi->param( 'author' );
$cobj = Annotate->Load( "$game-$author" );
# ---------- Annotations ---------------------------
#$cobj = Annotate->new();
IGNORE(__FILE__,__LINE__, $cobj->Id, $cobj->GPP );
cgiError( "Could not create game" ) unless $cobj;
# New Annotations only
#---------------------
unless( $cobj->Id )
{
#print "New Annotation
\n ";
IGNORE(__FILE__,__LINE__, $cobj->Id, $cobj->GPP );
$cobj->Id ( $cgi->param( 'aid' ) );
$cobj->Gid ( $cgi->param( 'gid' ) );
$cobj->APid ( $cgi->param( 'apid' ) );
$cobj->WPid ( $cgi->param( 'wpid' ) );
$cobj->BPid ( $cgi->param( 'bpid' ) );
$cobj->Plycount ( $cgi->param( 'plycount' ) );
$cobj->WPlayer ( $cgi->param( 'wp' ) );
$cobj->BPlayer ( $cgi->param( 'bp' ) );
$cobj->WFlag ( $cgi->param( 'wf' ) );
$cobj->BFlag ( $cgi->param( 'bf' ) );
$cobj->Result ( $cgi->param( 'result' ) );
$cobj->Game ( $cgi->param( 'game' ) );
$cobj->Author ( $cgi->param( 'author' ) );
$cobj->Email ( $cgi->param( 'email' ) );
$cobj->GameEnd ( $cgi->param( 'gameend' ) );
}
#else
#{
# print "Old Annotation
\n ";
#}
# Always
#-------
$cobj->Intro ( $cgi->param( 'intro' ) );
$cobj->Extro ( $cgi->param( 'extro' ) );
$cobj->Opening ( $cgi->param( 'opening' ) );
$cobj->Language ( $cgi->param( 'language' ) );
$cobj->Publish ( $cgi->param( 'publish' ) );
$cobj->Result ( $cgi->param( 'result' ) );
#$cobj->GPP ( $cgi->param( 'gpp' ) );
#print "GPP = " . $cobj->GPP . "
\n ";
#print "Publish = " . $cobj->Publish . "
\n ";
#print "Result = " . $cobj->Result . "
\n ";
# Loop over ply-array
DBG(__FILE__,__LINE__, $cobj->Plycount );
for( $p=1; $p<=$cobj->Plycount; $p++ )
{
DBG(__FILE__,__LINE__, '=' x 60, $p );
$cobj->Movestring($p, $cgi->param("m$p") );
$cobj->Comment($p, $cgi->param("c$p") );
$cobj->ShowBoard($p, ($cgi->param("s$p")) ? 1 : 0 );
$cobj->ValueSign($p, $cgi->param("v$p") );
#IGNORE(__FILE__,__LINE__, $p, $cobj->Movestring($p), $cobj->ShowBoard($p), $cobj->ValueSign($p) );
$nComments++ if( $cobj->Comment($p) );
$nBoards++ if( $cobj->ShowBoard($p) );
$length += length( $cobj->Comment($p) );
}
DBG(__FILE__,__LINE__, $length );
$length += length( $cobj->Intro );
$length += length( $cobj->Extro );
DBG(__FILE__,__LINE__, $length );
DBG(__FILE__,__LINE__, $cobj->GPP );
DBG(__FILE__,__LINE__, $length );
if( $action =~ /Preview/i )
{
$dbh->disconnect();
displayGame( $cobj, 'PREVIEW', 0 );
}
else
{
# give Grand Prix Points if appropriate
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if( $cobj->Publish && !$cobj->GPP && $nComments >= 5 && $nBoards >= 1 && $length >= 700 )
{
#print "Give new GPP, previously = " . $cobj->GPP . "
\n ";
my( $rv );
$rv = doStmt( "update tbl_player set gpp=gpp+1 where pid=?", $cobj->APid );
IGNORE(__FILE__,__LINE__, $rv, "aid:", $cobj->Id, "gpp:", $cobj->GPP );
$newGPP = 1;
$cobj->GPP($newGPP);
IGNORE(__FILE__,__LINE__, $rv, "aid:", $cobj->Id, "gpp:", $cobj->GPP );
# Send notification mail to players
my $mtpl = Template->new( "mail-newanno.tpl" );
$mtpl->addMakro( 'GAME', $cobj->Game );
$mtpl->addMakro( 'AUTHOR', $cobj->Author );
$mtpl->addMakro( "WHITE", $cobj->WPlayer );
$mtpl->addMakro( "BLACK", $cobj->BPlayer );
my $mailtext = $mtpl->Expand($sobj);
sendMail( $cobj->WMail, 'games@playchess.de', $cobj->Game . ' has been annotated', $mailtext ) if $cobj->WMail;
sendMail( $cobj->BMail, 'games@playchess.de', $cobj->Game . ' has been annotated', $mailtext ) if $cobj->BMail;
}
DBG(__FILE__,__LINE__, $anno, $storedobj, $oldgpp );
$cobj->Save();
DBG(__FILE__,__LINE__, $anno, $storedobj, $oldgpp );
# display information
#--------------------
$dbh->disconnect();
my $tpl = Template->new( "anno-store.tpl" );
$tpl->addMakro( 'GAME', $cobj->Game );
$tpl->addMakro( 'AUTHOR', $cobj->Author );
$tpl->addMakro( 'DIAGS', 0+$nBoards );
$tpl->addMakro( 'COMMENTS', 0+$nComments );
$tpl->addMakro( 'LENGTH', 0+$length );
$tpl->addMakro( 'GPP', 0+$cobj->GPP );
$tpl->addMakro( 'PUBLISH', 0+$cobj->Publish );
$tpl->addMakro( 'NEWGPP', 0+$newGPP );
print $tpl->Expand($sobj);
DBG(__FILE__,__LINE__, $anno, $storedobj, $oldgpp );
}
DBG(__FILE__,__LINE__, $cobj );
IGNORE( __FILE__,__LINE__, $#{$rows}, "SELECT TIME:", time()-$starttime, $starttime, time );
# Store session and exit
# ~~~~~~~~~~~~~~~~~~~~~~
$sobj->close();
exit(0);
}
#------------------------------------
sub displayGame
#------------------------------------
{
my( $cobj, $section, $viewonly ) = @_; AUS(__FILE__,__LINE__, @_ );
my( $p, $iswhite, $comment, $showboard, $moveentry, @movelist, $disptime );
my( $GOBJ );
my %tplfile = ( EDIT => 'anno-edit.tpl', PREVIEW => 'anno-view.tpl' );
my $visual = ( $section ne 'EDIT' );
AUS(__FILE__,__LINE__, $visual, $section, $viewonly );
# print "cobj=$cobj section=$section visual=$visual
\n";
if( $visual )
{
# Create board with start position
$GOBJ = PCGame->new($bd, $tour, $league);
cgiError( "Could not create game" ) unless $GOBJ;
AUS(__FILE__,__LINE__, $GOBJ );
AUS(__FILE__,__LINE__, "Board = ", $GOBJ->Board );
AUS(__FILE__,__LINE__, "FEN = ", $GOBJ->Board->FEN );
unless( $GOBJ->Board )
{
AUS(__FILE__,__LINE__ );
my $board = PCBoard->new();
$GOBJ->Board( $board );
}
}
my $tpl = Template->new( $tplfile{$section} );
DBG(__FILE__,__LINE__, $tpl, $section, $tplfile{$section} );
cgiError( "Template $tplfile{$section} not found" ) unless $tpl;
# Loop over ply-array
my ($rc, $von, $nach, $san);
DBG(__FILE__,__LINE__, $cobj->Plycount );
$disptime = time;
for( $p=1; $p<=$cobj->Plycount; $p++ )
{
my( $boardtxt );
AUS(__FILE__,__LINE__, '=' x 40, $p );
my $move = $cobj->Movestring($p);
# my $von = $cobj->FromField($p);
# my $nach = $cobj->ToField($p);
# print "move($p) = $move
\n";
$iswhite = ($p % 2 != 0);
$comment = $cobj->Comment($p);
$showboard = $cobj->ShowBoard($p); # ? 'on' : 'off';
$valuesign = $cobj->ValueSign($p);
# $valuesign = ' ' unless( $cobj->ValueSign($p) );
if( $visual )
{
@PCMove::special = ();
my $gid = $cobj->Gid;
# print __LINE__, ": displayGame($gid): $p, $move
\n" if( Util::isLocal || Util::isTest );
($rc, $von, $nach, $san) = makeAnnoMove( $p, $move, $GOBJ );
#print "annotate: sobj=$sobj showboard=$showboard
\n"; # DEBUG
$boardtxt = $GOBJ->Board->HTML( 'w', $align, $sobj, 32, $von, $nach )."
" if $showboard;
$comment =~ s/\bBR\b/
/g;
}
else
{
$san = $move;
$tpl->addCheckMakro( "s$p", $showboard );
$tpl->addRadioMakro( "v$p", $valuesign );
#IGNORE(__FILE__,__LINE__, $p, $valuesign ) if $valuesign;
}
$moveentry = join("|", $p, $iswhite, 1+int(($p-1)/2), $san, $comment, $showboard, $valuesign, $boardtxt );
# print "Line($p)=", $moveentry, "
\n";
push @movelist, $moveentry;
}
IGNORE( __FILE__,__LINE__, "DIAGRAM TIME:", time()-$disptime, "seconds" );
$disptime = time;
my $result = $cobj->Result;
# $result = ($result eq 'w') ? '1 - 0' : (($result eq 'b') ? '0 - 1' : '½ - ½');
$tpl->addMakro( "isMyAnno", $spid == $cobj->APid );
$tpl->addMakro( "AID", $cobj->Id );
$tpl->addMakro( "GID", $cobj->Gid );
$tpl->addMakro( "APID", $cobj->APid );
$tpl->addMakro( "WPID", $cobj->WPid );
$tpl->addMakro( "BPID", $cobj->BPid );
$tpl->addMakro( "WPLAYER", $cobj->WPlayer );
$tpl->addMakro( "BPLAYER", $cobj->BPlayer );
$tpl->addMakro( "WFLAG", $cobj->WFlag );
$tpl->addMakro( "BFLAG", $cobj->BFlag );
$tpl->addMakro( "AUTHOR", $cobj->Author );
$tpl->addMakro( "EMAIL", $cobj->Email );
$tpl->addMakro( "LANGUAGE", $cobj->Language );
$tpl->addMakro( "OPENING", $cobj->Opening );
$tpl->addMakro( "INTRO", $cobj->Intro );
$tpl->addMakro( "EXTRO", $cobj->Extro );
$tpl->addMakro( "RESULT", $result );
$tpl->addMakro( "PLYCOUNT", $cobj->Plycount );
$tpl->addMakro( "GAMEEND", $cobj->GameEnd );
$tpl->addRadioMakro( "publish", $cobj->Publish );
$tpl->addMakro( "GAMEENDSTR", getMonth($cobj->GameEnd) );
$tpl->addMakro( "GPP", $cobj->GPP );
$tpl->addArray( "GPPARR", [ ("x") x $cobj->GPP ] );
$tpl->addMakro( "GAME", $game );
$tpl->addMakro( "ANNO", $anno );
$tpl->addMakro( "GAMENO", $bd );
$tpl->addMakro( "LEAGUE", $league );
$tpl->addMakro( "TOUR", $tour );
$tpl->addMakro( "ERR", $errmsg );
$tpl->addMakro( "VIEWONLY", $viewonly );
$tpl->addArray( "MOVELIST", \@movelist );
IGNORE( __FILE__,__LINE__, "MAKRO TIME:", time()-$disptime, "seconds" );
$disptime = time;
my $text = $tpl->Expand($sobj);
IGNORE( __FILE__,__LINE__, "TEMPLATE TIME:", time()-$disptime, "seconds" );
# Methode print (std)
#--------------------
if(1)
{
$disptime = time;
print $text;
AUS( __FILE__,__LINE__, "PRINT TIME:", time()-$disptime, "seconds since ".getDate($disptime,'hh:mm:ss') );
}
# Methode syswrite
#-----------------
if(0)
{
$disptime = time;
my( $textlen, $written, $offset );
$textlen = length($text);
while( $textlen )
{
$written = syswrite STDOUT, $text, $textlen, $offset;
die( "Could not write output at offset $offset" ) unless(defined $written);
$offset += $written;
$textlen -= $written;
}
IGNORE( __FILE__,__LINE__, "PRINT TIME:", time()-$disptime, "seconds since ".getDate($disptime,'hh:mm:ss') );
}
# cat-Programm gibt aus
#----------------------
if(0)
{
open CAT, "|cat" or die( "cannot open pipe" );
$disptime = time;
print CAT $text;
IGNORE( __FILE__,__LINE__, "PRINT TIME:", time()-$disptime, "seconds since ".getDate($disptime,'hh:mm:ss') );
}
# Output-Buffer for stdout
#-------------------------
if(0)
{
$bs = $cgi->param( 'bs' ) || 4;
$disptime = time;
local $buffsize = $bs * 1024;
local $outbuff = ' ' x $buffsize;
STDOUT->setvbuf($outbuff, _IOLBF, $buffsize);
IGNORE( __FILE__,__LINE__, "BUFFER TIME:", time()-$disptime, "seconds ($buffsize bytes)" );
$disptime = time;
STDOUT->autoflush( 0 );
STDOUT->print( $text );
IGNORE( __FILE__,__LINE__, "PRINT TIME:", time()-$disptime, "seconds since ".getDate($disptime,'hh:mm:ss') );
}
}
#------------------------------------
sub makeAnnoMove
#------------------------------------
{
my( $ply, $move, $GOBJ ) = @_; DBG(__FILE__,__LINE__, @_ );
my $tomove = ($ply % 2) ? 'w' : 'b';
$GOBJ->ToMove( $tomove );
my $mobj = PCMove->createFromSAN( $move, $GOBJ->Board, $tomove );
unless( $mobj )
{
print "annotate-2: sobj=$sobj
\n"; # DEBUG
print $GOBJ->Board->HTML, "
\n";
print( "Cannot create move object from $move ($ply)" );
exit(0);
}
# print "makeAnnoMove($rc): $ply, $move, ", $mobj->SAN, ", ", $mobj->FromStr, ", ", $mobj->ToStr, "
\n";
#@PCMove::special = ();
my $valid = $mobj->isValid;
AUS(__FILE__,__LINE__, $valid );
#@PCMove::special = ();
unless( $valid )
{
DBG(__FILE__,__LINE__, $mobj, $mobj->FromStr, $mobj->ToStr );
print "annotate-3: sobj=$sobj
\n"; # DEBUG
cgiError( "Invalid Move in ply $ply: " . $mobj->FromStr . "-" . $mobj->ToStr . " '".$mobj->SAN."'
" . $GOBJ->Board->HTML() );
}
$rc = $GOBJ->makeMove( $mobj ); DBG(__FILE__,__LINE__, $rc );
# print "makeAnnoMove($rc): $ply, $move, ", $mobj->SAN, ", ", $mobj->FromStr, ", ", $mobj->ToStr, "
\n";
return (wantarray) ? ($rc, $mobj->FromStr, $mobj->ToStr, $mobj->SAN) : $rc;
}
sub IGNORE{}