#!/usr/bin/perl
# ================================================================================
# $Rev: 173 $ $URL: svn://localhost/PlayChess/trunk/cgi/thematics.cgi $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Author: $Author: Thomas $
# Modified: $Date: 2005-12-14 00:36:16 +0100 (Mi, 14 Dez 2005) $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Copyright at playchess.de - all rights reserved
# ================================================================================
use lib "../cgi-bin";
use CGI qw( :standard );
use CGI::Carp qw(fatalsToBrowser);
use PCSession;
use Template;
use Util;
use PCBoard;
use MyDbi;
local $cgi = CGI->new(); DBG(__FILE__,__LINE__, $cgi );
local $sobj = PCSession->new( $cgi );
local $sname = $sobj->getValue( 'name' );
local $topic = $cgi->param( 'topic' );
local $vid = $cgi->param( 'vid' );
local $thema = $cgi->param( 'thema' );
local $config = getConfig();
my $tplfile = ($topic) ? "thematics-$topic.tpl" : "thematics.tpl";
my $tpl = Template->new( $tplfile );
if( !$topic )
{
print $tpl->Expand( $sobj );
}
elsif( $topic eq 'show' )
{
# Connect to database
#--------------------
$dbh = dbiConnect() or die( "Cannot access database" );
my $stmt = "select name, firstply, startpos, castling, epfield, variant
from tbl_thema
where vid=?
";
my $row = MyDbi::getRow( $stmt, $vid );
$thematic = 1;
($thema, $ply, $pos, $castling, $epfield, $variant ) = @{ $row };
# print __LINE__, ": ", join(', ', @{ $row }), "
\n";
$moveno = int( ($ply+1)/2 );
$firstmove = ($ply % 2) ? 'w' : 'b';
# statistic for this opening
# ~~~~~~~~~~~~~~~~~~~~~~~~~~
$stmt = "select g.result
from tbl_tournament t, tbl_game g
where t.vid=$vid
and t.tid=g.tid
and g.result<>''
and g.valid=1
";
my @results = @{ MyDbi::getColumn( $stmt ) };
my( $white, $draw, $black ) = (0, 0, 0);
foreach $result (@results)
{
if( $result eq 'w' ) { $white++ }
elsif( $result eq 'b' ) { $black++ }
elsif( $result eq 'd' ) { $draw++ }
}
my $total = scalar @results;
# database is no longer needed
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$dbh->disconnect();
@var = split( /\s+/, $variant );
my $moveno = 1;
foreach $v (0 .. $#var)
{
$var[$v] = ($moveno++) . '.' . $var[$v] if( $v%2==0 );
}
$variant = join( ' ', @var );
$bobj = PCBoard->createFromFen( $pos, $epfield, $castling );
# $tpl->addMakro( 'BOARD', $bobj->HTML( $firstmove, 'center', $config, 32 ) );
$tpl->addMakro( 'BOARD', $bobj->HTML( 'w', 'center', $sobj, 32 ) );
$tpl->addMakro( 'THEMA', $thema );
$tpl->addMakro( 'MOVES', $variant );
$tpl->addMakro( 'TOMOVE', $firstmove );
$tpl->addMakro( 'VID', $vid );
$tpl->addMakro( 'N_WHITE', $white );
$tpl->addMakro( 'N_BLACK', $black );
$tpl->addMakro( 'N_DRAW', $draw );
$tpl->addMakro( 'N_GAMES', $total );
if($total)
{
$tpl->addMakro( 'W_PERCENT', int(50*(2*$white+$draw)/$total+0.5) );
$tpl->addMakro( 'B_PERCENT', int(50*(2*$black+$draw)/$total+0.5) );
}
print $tpl->Expand( $sobj );
}
elsif( $topic eq 'list' )
{
# Connect to database
#--------------------
$dbh = dbiConnect() or die( "Cannot access database" );
my $stmt = "select vid, name, firstply, startpos, castling, epfield, variant
from tbl_thema
where vid>1
order by variant desc
";
my $rows = MyDbi::getRows( $stmt );
$thematic = 1;
for $r ( 0 .. $#{$rows} )
{
($vid, $thema, $ply, $pos, $castling, $epfield, $variant ) = @{ $rows->[$r] };
# print __LINE__, ": ", join(', ', @{ $row }), "
\n";
$moveno = int( ($ply+1)/2 );
$firstmove = ($ply % 2) ? 'w' : 'b';
# Move numbers in variant
# ~~~~~~~~~~~~~~~~~~~~~~~
@var = split( /\s+/, $variant );
my $moveno = 1;
foreach $v (0 .. $#var)
{
$var[$v] = ($moveno++) . '.' . $var[$v] if( $v%2==0 );
}
$variant = join( ' ', @var );
push @Variant, join( '|', $vid, $thema, $variant, $moveno, $firstmove );
}
my $total = scalar @Variant;
# database is no longer needed
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$dbh->disconnect();
$tpl->addArray( 'VARIANTS', \@Variant );
$tpl->addMakro( 'TOTAL', $total );
print $tpl->Expand( $sobj );
}
exit(0);