#!/usr/bin/perl
#----------------------------------------------------------------------------
# $Header: e:/p/w/playchess/rcs/playerstats-score.cgi 1.3 2003/01/15 16:53:10Z ts init $
# $Log: playerstats-score.cgi $
# Revision 1.3 2003/01/15 16:53:10Z ts
# CGI-scripts moved to cgi directory -> relative path
# Revision 1.2 2002/11/10 21:20:58Z ts
# Renamed all tables: tbl_+oldname
# Revision 1.1 2002/03/26 22:16:40Z ts # Initial revision
#----------------------------------------------------------------------------
use lib "../cgi-bin";
use CGI qw( :standard );
use CGI::Carp qw(fatalsToBrowser);
use PCPlayer;
use PC;
use PCLeagueUtil;
use Annotate;
use Template;
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;
#$| = 1; # disable output buffering
$min = 0;
$max = 0;
local ($starttime,$endtime) = (time(),0);
local $cgi = CGI->new();
local $sobj = PCSession->new($cgi);
local $myname = $sobj->getValue( 'name' );
local $mypid = $sobj->getValue( 'pid' );
local $league = $cgi->param( 'league' ) || 'HCL';
local $name = $cgi->param( 'name' );
local $min = $cgi->param( 'min' );
local $admin = $cgi->param( 'admin' );
# print "mypid=$mypid, myname=$myname, name=$name
\n";
# ignore leading and trailing blanks
$name =~ s/^\s*(.*?)\s*$/$1/;
# Page requires membership
# ~~~~~~~~~~~~~~~~~~~~~~~~
$sobj->assertMember();
# Following actions require database access
#------------------------------------------
$dbh = dbiConnect() or exit(1);
# Games and Rating
#-----------------
{
my $tpl = Template->new( "playerstats-score.tpl" );
my $limit = 25;
my %Rating;
$limit = 40 if($sobj->getValue('isMember')); # Standard + Trial
$limit = 80 if($sobj->getValue('isPremiumMember')); # Premium members
# game history only for members
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# $min = 0 unless($sobj->getValue('isMember'));
my( $stmt, $rows, @games );
# Default values
#---------------
$min = 0 unless $min;
$limit = 10 unless $limit;
$stmt = "
select
p2.name,
pg1.color,
g.result, g.lastmove, g.name,
a.changed
from
(
tbl_player_game pg1,
tbl_game g,
tbl_player_game pg2,
tbl_player p2
)
left outer join tbl_annotation a on a.gid=g.gid and a.apid=pg1.pid
where
pg1.pid = ?
and pg1.gid = pg2.gid
and p2.name = ?
and pg1.gid = g.gid
and p2.pid = pg2.pid
and pg1.pid <> pg2.pid
order by g.lastmove desc
limit $min, $limit
";
# and g.result <> ''
# and g.valid = 1
$rows = MyDbi::getRows( $stmt, $mypid, $name );
# print "mypid=$mypid, myname=$myname, name=$name
\n";
# Loop over the list of games
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~
my ( $r, $annotated, $pts, %Rating, $line, $created, $changed );
for $r ( 0 .. $#{$rows} )
{
( $oppname, $mycolor, $result, $lastmove, $gamename, $changed ) = @{ $rows->[$r] };
# print join( ', ', $oppname, $mycolor, $result, $lastmove, $gamename, $changed ), "
\n";
($league,$tour,$bd) = split( /-/, $gamename );
# date of annotation (if exists)
#-------------------------------
$annotated = ($changed) ? Util::getDate($changed, "dd.mm.yy") : "";
$WDL = ($result eq $mycolor) ? 'W' : ($result eq 'd' ? 'D' : 'L');
if($result eq '')
{
$WDL = '?';
}
else
{
if($result eq $mycolor)
{
$WDL = '+';
$win{$mycolor} += 1;
$pts{$mycolor} += 1;
$win{'r'} += 1;
$pts{'r'} += 1;
}
elsif($result eq 'd')
{
$WDL = '=';
$draw{$mycolor} += 1;
$pts{$mycolor} += 0.5;
$draw{'r'} += 1;
$pts{'r'} += 0.5;
}
else
{
$WDL = '-';
$lose{$mycolor} += 1;
$lose{'r'} += 1;
}
$fin{$mycolor} += 1;
$fin{'r'} += 1;
}
# requiring ter and oppter hides errors in old system!!!
#-------------------------------------------------------
# if( $myelo && $oppelo )
{
$line = join( "|", $gamename, Util::getDate($lastmove,"dd.mm.yy"), $WDL,
$mycolor, $annotated, ($r+1), ($r%2) );
push @games, $line;
#AUS(__FILE__,__LINE__, $r, $line );
}
}
# my @results = getScoreGames( $name, $min, $limit );
my $ngames = scalar(@games);
push @stat,
join( "|", 'White', 0+$win{'w'}, 0+$draw{'w'}, 0+$lose{'w'},
0+$pts{'w'}, 0+$fin{'w'},
($fin{'w'}) ? int(100*$pts{'w'}/$fin{'w'}+0.5) : '?', 0 );
push @stat,
join( "|", 'Black', 0+$win{'b'}, 0+$draw{'b'}, 0+$lose{'b'},
0+$pts{'b'}, 0+$fin{'b'},
($fin{'b'}) ? int(100*$pts{'b'}/$fin{'b'}+0.5) : '?', 0 );
push @stat,
join( "|", 'Total', 0+$win{'r'}, 0+$draw{'r'}, 0+$lose{'r'},
0+$pts{'r'}, 0+$fin{'r'},
($fin{'r'}) ? int(100*$pts{'r'}/$fin{'r'}+0.5) : '?', 1 );
$tpl->addMakro( "SESSION_INFO", $sobj->Info() );
$tpl->addArray( "RESULTS", \@games );
$tpl->addArray( "STAT", \@stat );
$tpl->addMakro( "NGAMES", 0+$ngames );
$tpl->addMakro( "TEST", "NGAMES" );
$tpl->addMakro( "NAME", $name );
$tpl->addMakro( "LEAGUE", $league );
$tpl->addMakro( "MIN", $min );
$tpl->addMakro( "FIRST", $min+1 );
$tpl->addMakro( "NEWMIN", $min+$limit );
$tpl->addMakro( "LIMIT", $limit );
# Display Page
#-------------
print $tpl->Expand($sobj);
AUS( __FILE__,__LINE__, "TOTAL TIME:", time()-$starttime, $starttime, time );
}
#########################################################################################
#------------------------------------
sub getScoreGames
#
# p1 viewing player
# p2 viewed player
#------------------------------------
{
my( $name, $min, $limit ) = @_; DBG(__FILE__,__LINE__, @_ );
my( $stmt, $rows, @table );
# Default values
#---------------
$min = 0 unless $min;
$limit = 10 unless $limit;
$stmt = "
select
p2.name,
pg1.color,
g.result, g.lastmove, g.name,
a.changed
from
tbl_player_game pg1,
tbl_game g,
tbl_player_game pg2,
tbl_player p2
left outer join tbl_annotation a on a.gid=g.gid and a.apid=pg1.pid
where
pg1.pid = ?
and pg1.gid = pg2.gid
and p2.name = ?
and pg1.gid = g.gid
and p2.pid = pg2.pid
and pg1.pid <> pg2.pid
order by g.lastmove desc
limit $min, $limit
";
# and g.result <> ''
# and g.valid = 1
$rows = MyDbi::getRows( $stmt, $mypid, $name );
# print "mypid=$mypid, myname=$myname, name=$name
\n";
# finished games
my ( $r, $annotated, $pts, %Rating, $line, $created, $changed );
for $r ( 0 .. $#{$rows} )
{
( $oppname, $mycolor, $result, $lastmove, $gamename, $changed ) = @{ $rows->[$r] };
($league,$tour,$bd) = split( /-/, $gamename );
# date of annotation (if exists)
#-------------------------------
$annotated = ($changed) ? Util::getDate($changed, "dd.mm.yy") : "";
$WDL = ($result eq $mycolor) ? 'W' : ($result eq 'd' ? 'D' : 'L');
# requiring ter and oppter hides errors in old system!!!
#-------------------------------------------------------
# if( $myelo && $oppelo )
{
$line = join( "|", $gamename, Util::getDate($lastmove,"dd.mm.yy"), $WDL,
$mycolor, $annotated, ($r+1), ($r%2) );
push @table, $line;
#AUS(__FILE__,__LINE__, $r, $line );
}
}
return @table;
}