#!/usr/bin/perl
# ================================================================================
# $Rev: 143 $ $URL: svn://localhost/PlayChess/trunk/cgi/annodir-vars.cgi $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Author: $Author: Thomas $
# Modified: $Date: 2005-08-15 14:06:50 +0200 (Mo, 15 Aug 2005) $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Copyright at playchess.de - all rights reserved
# ================================================================================
use lib "../cgi-bin";
use CGI qw( :standard );
use CGI::Carp qw(fatalsToBrowser);
use PCPlayer;
use OTree;
use PC;
use PCLeagueUtil;
use Annotate;
use Template;
# use Chronos;
use Util;
use ChessConfig;
use PCSession;
use MyDbi;
##--------------------------------------------------------------------------
## LOCAL CONFIGURATION
##--------------------------------------------------------------------------
local $config = getConfig();
$URL = $ENV{DOCUMENT_URI}; # url of your domain
$ROOT = $ENV{DOCUMENT_ROOT}; # path to document root
$SERVER = $ENV{SERVER_NAME}; # server name
$HOST = $ENV{HTTP_HOST};
$err = ''; # error message
$syserr = 0;
# local $| = 1; # disable output buffering
local ($starttime,$endtime) = (time(),0);
$cgi = CGI->new();
$sobj = PCSession->new($cgi);
$sname = $sobj->getValue( 'name' );
#$spasswd = $sobj->getValue( 'passwd' );
local $action = $cgi->param( 'action' ) || $ENV{'action'};
local $name = $cgi->param( 'name' ) || $sname;
local $pColor = $cgi->param( 'c' ) || 'x';
local $league = $cgi->param( 'league' );
local $level = $cgi->param( 'level' );
local $pDepth = $cgi->param( 'd' );
local $pMove = $cgi->param( 'm' );
local $pTime = $cgi->param( 't' );
local $free = $cgi->param( 'free' );
local $var = $cgi->param( 'var' );
# ignore leading and trailing blanks
$name =~ s/^\s*(.*?)\s*$/$1/;
local $minply = 4;
$minply-- if( $league );
$minply-- if( $level );
$minply-- if( $pTime );
@Moves = split(/\s+/,$pMove);
local $specific = ((!$free || @Moves >= $minply || $var) ? 1 : 0);
# print join(', ', $free, scalar(@Moves), $specific), "
\n";
$pMove = $var if $var;
# Show intro page if Color isn't set
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
unless( $pMove && $specific )
{
my $tpl = Template->new( "annodir-vars.tpl" );
$tpl->addMakro( "NAME", $name );
$tpl->addMakro( "MOVES", $pMove );
$tpl->addMakro( "SPECIFIC", $specific );
$tpl->addMakro( "MINPLY", $minply );
$tpl->addSelectMakro( "level", $level ) if( $level );
$tpl->addSelectMakro( "league", $league ) if( $league );
$tpl->addSelectMakro( 'd', $pDepth ) if( $pDepth );
$tpl->addSelectMakro( 't', $pTime ) if( $pTime );
print $tpl->Expand($sobj);
# print "TPL-Time: ", time()-$ST, " seconds
\n";
exit(0);
}
# Page requires membership unless example opening selected
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if( $pMove !~ /^\s*(b4|g4|b3|f4)\s*$/ ) { $sobj->assertMember(); }
# else { $sobj->assertMember(); }
# Following actions require database access
#------------------------------------------
$dbh = dbiConnect() or exit(1);
# Chronos::AnnoResult();
# print "AnnoResult has been called
\n";
# Create variant tree
# ~~~~~~~~~~~~~~~~~~~
{
local $ST = time();
my( $stmt, $rows, @results );
my $starttime = time;
my $depth = $pDepth || 10;
my $plies = 2*$depth;
my $movecond = ($pMove) ? "and m.moves like '$pMove%'" : '';
# $movecond = "and m.moves like '$var%'" if( $var );
my $timecond = ($pTime) ? "and a.changed > unix_timestamp(now())-$pTime*86400" : '';
my %Level = ( B => 'B|A|E|M|X', A => 'A|E|M|X', E => 'E|M|X', M => 'M|X' );
my $classes = ($level) ? '-(' . $Level{$level} . ')[0-9]' : '';
my $levelcond = ($league || $level) ? "and a.game REGEXP '$league$classes'" : '';
# if( $level eq 'b' ) { $levelcond = "and class='X'"
$stmt = "
select
m.gid, m.moves,
IF(a.result='w',1,0),
IF(a.result='d',1,0),
IF(a.result='b',1,0),
0, concat(a.game, '-', p.name), a.changed
from
tbl_annotation a,
tbl_move_archive m,
tbl_player p
where 1
and a.gid=m.gid
and a.apid=p.pid
$movecond
$timecond
$levelcond
and a.publish=1
order by 3,2
";
$rows = MyDbi::getRows( $stmt );
# print "$stmt
\n";
unless( $var )
{
# Create HTML for opening tree
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my $multiUrl = "/annodir-vars.cgi?d=$level&var=%s";
my $singleUrl = "/annotate.cgi?action=view&anno=%s";
$tree = OTree::createTree( $rows, $plies, $singleUrl, $multiUrl );
# create output
# ~~~~~~~~~~~~~
my $tpl = Template->new( "annodir-varlist.tpl" );
$tpl->addMakro( "NAME", $name );
$tpl->addMakro( "FOUND", $#{$rows}+1 );
$tpl->addMakro( "MOVES", $pMove );
$tpl->addMakro( "SPECIFIC", $specific );
$tpl->addMakro( "MINPLY", $minply );
$tpl->addMakro( "TREE", $tree );
$tpl->addSelectMakro( 'd', $pDepth ) if( $pDepth );
$tpl->addSelectMakro( 't', $pTime ) if( $pTime );
$tpl->addSelectMakro( "league", $league ) if( $league );
$tpl->addSelectMakro( "level", $level ) if( $level );
print $tpl->Expand($sobj);
}
else
{
# Create HTML for game list
# ~~~~~~~~~~~~~~~~~~~~~~~~~
my $gamelist_ref;
($gamelist_ref, $var) = OTree::createList( $rows, $var );
# create output
# ~~~~~~~~~~~~~
my $tpl = Template->new( "annodir-varlist.tpl" );
$tpl->addMakro( "NAME", $name );
$tpl->addMakro( "COLOR", (($pColor eq 'w') ? 'White' : 'Black') );
$tpl->addArray( 'GAMELIST', $gamelist_ref );
$tpl->addMakro( "FOUND", $#{$rows}+1 );
$tpl->addMakro( "VARIANT", $var );
$tpl->addMakro( "MOVES", $pMove );
$tpl->addMakro( "SPECIFIC", $specific );
$tpl->addMakro( "MINPLY", $minply );
$tpl->addSelectMakro( 'd', $pDepth ) if( $pDepth );
$tpl->addSelectMakro( 't', $pTime ) if( $pTime );
$tpl->addSelectMakro( "league", $league ) if( $league );
$tpl->addSelectMakro( "level", $level ) if( $level );
print $tpl->Expand($sobj);
}
exit(0);
# Sample opening patterns
#------------------------
my( $r, %white, %black, @results, $moves, $gid, $oldgid, $oldcolor );
for $r ( 0 .. $#{$rows} )
{
$gid = $rows->[$r][0];
$moves = $rows->[$r][1];
$color = $pColor; # $rows->[$r][2];
$w = $rows->[$r][3];
$d = $rows->[$r][4];
$l = $rows->[$r][5];
$game = $rows->[$r][6];
$author = $rows->[$r][7];
#print uc($color), ": ", join(' | ', @{ $rows->[$r] } ), "
\n";
#print "test
\n";
# clean move list from not needed (and disturbing) elements
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$moves =~ s/\+//g; # chess!
$moves =~ s/ e\.p\.?//g; # en passant
#$moves .= ''.(1 + int( ($ply-1)/2 )).'.' if( $ply%2 );
my @branch = split(/ /, $moves);
my($k, $b);
for($k=0; $k<@branch && $k<$plies; $k++)
{
#$b = join(' ', @branch[0..$k]);
$b .= ' ' if( $b );
$b .= 1+($k/2).'.' if( $k%2==0 );
$b .= $branch[$k];
#print "BRANCH: $moves === $b
\n";
$count{$color}{$b}++;
$win{$color}{$b} += $w;
$draw{$color}{$b} += $d;
$loss{$color}{$b} += $l;
$GAME{$color}{$b} = $game;
$AUTHOR{$color}{$b} = $author;
}
#push @{$Moves{$c}}, $moves;
#$count{$color}{$moves}++;
#$win{$color}{$moves} += $w;
#$draw{$color}{$moves} += $d;
#$loss{$color}{$moves} += $l;
#$GAME{$color}{$moves} = $game;
}
# No database access beyond this point
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$dbh->disconnect();
$db_time = "DB-Time: ". (time()-$ST) . " seconds
\n";
#exit(0);
# Beginning to create output
# ~~~~~~~~~~~~~~~~~~~~~~~~~~
my $tpl = Template->new( "annodir-varlist.tpl" );
$tpl->addMakro( "NAME", $name );
#$tpl->addMakro( "COLOR", (($pColor eq 'w') ? 'White' : 'Black') );
$tpl->addMakro( "FOUND", $#{$rows}+1 );
$tpl->addMakro( "MOVES", $pMove );
$tpl->addMakro( "SPECIFIC", $specific );
$tpl->addMakro( "MINPLY", $minply );
#$tpl->addSelectMakro( 'c', $pColor ) if( $pColor );
$tpl->addSelectMakro( 'd', $pDepth ) if( $pDepth );
$tpl->addSelectMakro( 't', $pTime ) if( $pTime );
$tpl->addSelectMakro( "league", $league ) if( $league );
$tpl->addSelectMakro( "level", $level ) if( $level );
#$tpl->addMakro( "SESSION_INFO", $sobj->Info() );
# Fill results into template
#---------------------------
#foreach $c ('w', 'b')
foreach $c ($pColor)
{
my %Count = %{ $count{$c} };
my @sortkey = sort {$a cmp $b or $Count{$b} <=> $Count{$a}} (keys %Count);
my( @Result, $o, $oldopening, $oldnumber, $line, $level );
my $table_b = '
'; my $table_e = ' |