#!/usr/bin/perl
# ================================================================================
# $Rev: 361 $ $URL: file:///C:/daten/archiv/PlayChess/trunk/cgi/playerhome.cgi $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Author: $Author: epts $
# Modified: $Date: 2008-04-29 18:06:39 +0200 (Di, 29 Apr 2008) $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Copyright at playchess.de - all rights reserved
# ================================================================================
use lib "../cgi-bin";
use Time::HiRes qw( time );
use CGI qw( :standard );
use CGI::Carp qw(fatalsToBrowser);
use PCLeagueUtil;
use PCPlayer;
use PC;
use PCConst;
use PCGame;
use Object;
use PCSession;
use Template;
use Util;
use ChessConfig;
use MyDbi;
# performance measurement
local $starttime = time();
local $showTime = (0 || Util::isDebug);
##--------------------------------------------------------------------------
## LOCAL CONFIGURATION
##--------------------------------------------------------------------------
local $config = getConfig();
local $URL = $ENV{DOCUMENT_URI}; # url of your domain
local $ROOT = $ENV{DOCUMENT_ROOT}; # path to document root
local $SERVER = $ENV{SERVER_NAME}; # server name
local $HOST = $ENV{HTTP_HOST};
local $err = ''; # error message
local $syserr = 0;
local $debug = (0 || Util::isDebug);
local $ppp = 50; # ppp = players per page
$cgi = CGI->new();
$sobj = PCSession->new( $cgi );
$name = $sobj->getValue( 'name' );
$pid = $sobj->getValue( 'pid' );
$sort = $sobj->getCgiParam( 'sort' ) || 'clock';
DBG( "starttime = $starttime" );
DBG( "startTime = $Util::startTime" );
# Page requires login
# ~~~~~~~~~~~~~~~~~~~
$sobj->assertLogged();
# print "PlayerLevel=",$sobj->getValue('AccessLevel') ,"
\n";
my( @news, @headlines );
# Player Homepage
#================
{
$name =~ s/^\s*(.*?)\s*$/$1/; # ignore leading and trailing blanks
$name =~ s/\s/_/g; # replace inner blanks with '_'
# Display Homepage
#-----------------
my $page = PlayerPage($config, "playerhome.tpl");
my $html = $page->Expand($sobj);
$sobj->setValue( "A2", "A2-Wert" );
print $html;
}
$sobj->close();
# print "Session closed, expand = $expandtime
\n";
# exit(0);
##############################################################
#------------------------------------
sub PlayerPage
#------------------------------------
{
my( $config, $tplfile ) = @_;
# printf( "%s(%d): %s
\n", __FILE__,__LINE__, join(', ',@_) );
my $pid = $sobj->getValue('pid');
my $myname = $sobj->getValue('name');
my $since = $sobj->getValue('since');
my $passwd = $sobj->getValue('passwd');
my $tpl = Template->new( $tplfile );
my ($g, $leagueactive, $l);
$sobj->addMakros( $tpl );
#$tpl->addMakro( "SESSION_INFO", $sobj->Info );
my $table = "";
my $stmt;
# Connect to database
$dbh = dbiConnect() or die( "Cannot access database" );
# Running games of player and opponent
my( $table_ref, $opptable_ref ) = getRunningGames( $pid );
my @table = @{ $table_ref };
my @opptable = @{ $opptable_ref };
$runninggames = scalar(@table) + scalar(@opptable);
# Pending challenges
$stmt = "
select c.cid, h.name, g.name, c.ctime, c.clockmin, c.clockinc, c.clockmax, c.color, c.publish
from tbl_challenge c, tbl_player h, tbl_player g
where (c.hpid=? or c.gpid=?)
and c.state='pending'
and h.pid=c.hpid
and g.pid=c.gpid
order by c.ctime desc
";
$rows = MyDbi::getRows( $stmt, $pid, $pid );
DBG( "CHALLENGE: rows=$rows" );
my @challenging;
my @challenged;
my ($h, $g ) = (0,0);
for $r ( 0 .. $#{$rows} )
{
my ($cid, $hname, $gname, $when, $cmin, $cinc, $cmax, $color, $publish) = @{ $rows->[$r] };
# color of player: table contains color of challenger - not this player
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$color = ($color eq 'Black') ? 'White' : ($color eq 'White' ? 'Black' : 'Random');
my $line = join( '|', $cid, $hname, $gname,
Util::getDate($when,'dd.mm.yyyy'),
$cmin, $cinc, $cmax, $color, $publish );
push @challenging, $h++.'|'.$line if( $hname eq $name );
push @challenged, $g++.'|'.$line if( $gname eq $name );
DBG( "CHALLENGE: line=$line" );
}
# playchess database is no longer needed
$dbh->disconnect();
# Latest messages from the weblogs
loadNewsFromBlog() if( PCConst->BlogOn );
# News
# ~~~~~~~~~~~~~
$tpl->addMakro( "NNEWS", scalar @news );
$tpl->addArray( "NEWS", \@news );
$tpl->addArray( "HEADLINES", \@headlines );
# holiday status
# ~~~~~~~~~~~~~~
$tpl->addMakro( 'SINCE', Util::getDate($sobj->getValue('holiday-since')) );
$tpl->addMakro( 'UNTIL', Util::getDate($sobj->getValue('holiday-until')) );
$tpl->addMakro( 'ONLEAVE', $sobj->getValue('holiday-until') > time );
# running games
# ~~~~~~~~~~~~~
$tpl->addMakro( "NGAMES", scalar @table );
$tpl->addArray( "GAMES", \@table );
$tpl->addMakro( "NOPPGAMES", scalar @opptable );
$tpl->addArray( "OPPGAMES", \@opptable );
$tpl->addMakro( "RUNNINGGAMES", $runninggames );
$tpl->addMakro( "NCHALLENGING", scalar @challenging );
$tpl->addArray( "CHALLENGING", \@challenging );
$tpl->addMakro( "NCHALLENGED", scalar @challenged );
$tpl->addArray( "CHALLENGED", \@challenged );
#$tpl->addArray( "GAMELIST", \@GameList );
#$tpl->addMakro( "GAMESTRING", join(',',@GameList) );
# randomly create text
#---------------------
if( PCConst->TippOn )
{
my $tpl_dir = 'tpl/wip/raw';
my $randObj = Object::RandomObject("$ROOT/$tpl_dir/Tips.tpl");
my $randTxt = $randObj->{'text'};
# $tpl->addMakro( "RANDOM_TEXT", $randTxt );
## Personalize ads and tips
## ~~~~~~~~~~~~~~~~~~~~~~~~
# print "1: ### template='", $tpl->{'template'}, "'
\n";
my $randTpl = Template->create($randTxt);
# print "2: ### template='", $tpl->{'template'}, "'
\n";
$randTpl->addMakro( "COUNTRY", $sobj->getValue('country') );
$randTpl->addMakro( "IS_MEMBER", $sobj->getValue('isMember') );
$randTpl->addMakro( "HUMAN", !$sobj->getValue('isEngine'));
# $randTpl->addMakro( "PASSWD", $passwd );
# Amazon sites
# ~~~~~~~~~~~~
my $amazon_site = ($sobj) ? $sobj->getValue('amazon-site') : 'COM';
$randTpl->addMakro( 'AMAZON_'.$amazon_site, 1 );
$randTpl->addMakro( 'AMAZON_SITE', $amazon_site );
# print "3: ### template='", $tpl->{'template'}, "'
\n";
my $tipp = $randTpl->Expand($sobj);
# print "4: ### template='", $tpl->{'template'}, "'
\n";
$tipp =~ s/^\s+//gs;
$tipp =~ s/\s+$//gs;
$tpl->addMakro( "RANDOM_TEXT", $tipp );
}
# state macros
#-------------
$new = ( $since && time-$since<7*86400 );
$newpw = ( $passwd =~ /$myname\d\d\d/ix );
$recommend = ( $newpw || $runninggames==0 );
$tpl->addMakro( "WELCOME", $new && !$sobj->getValue('isMember'));
$tpl->addMakro( "NEWPASS", $newpw );
$tpl->addMakro( "RECOMMEND", $recommend );
# reminder for evaluating guests
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$tpl->addMakro( "EVAL_NEAR_END", $sobj->getValue('eval_near_end') )
if $sobj->getValue('eval_near_end');
#print join( ' | ', $new, $recommend, $newpw, $cookie, $runninggames ), "
\n";
AUS( __FILE__,__LINE__, "TOTAL TIME:", time()-$starttime, $starttime );
# print "5: ### template='", $tpl->{'template'}, "'
\n";
return $tpl;
}
# =================================
sub loadNewsFromBlog
# =================================
{
my $stmt = "
select
blog_site_url, blog_name, entry_id, entry_title,
unix_timestamp(entry_created_on),
date_format(entry_created_on,'%Y-%m-%d'),
entry_excerpt, entry_text,
unix_timestamp(comment_modified_on), comment_author
from (mt_blog b, mt_entry e)
left outer join mt_comment c on c.comment_entry_id = e.entry_id
where 1
and (b.blog_id=2 or b.blog_id=3)
and entry_status = 2
and entry_created_on + INTERVAL ? DAY > NOW()
and b.blog_id = e.entry_blog_id
order by entry_created_on desc, comment_modified_on desc
limit 14
";
my $BLOG = MyDbi::dbiConnect( 'blog' );
my $rows = MyDbi::getRowsFromDB( $BLOG, $stmt, PCConst->BlogHeadDuration() );
DBG "#rows = " . (1+$#{$rows}) . "
\n";
my( $hasNews, $last_entry_id );
for my $r ( 0 .. $#{$rows} )
{
#my @fields = @{ $rows->[$r] };
#my $line = join( '|', $r+1, @fields );
my ($blogUrl, $blogname, $id, $title, $created_raw, $created, $excerpt, $text, $cmtTime, $cmtAuthor)
= @{ $rows->[$r] };
next if( $id == $last_entry_id );
$last_entry_id = $id;
# create entry url
my $entryUrl = sprintf( "%s/%06d.html", $blogUrl, $id );
# has been updated?
my $isUpdated = ($cmtTime > $created);
# create excerpt from text if not entered explicitely
unless( $excerpt )
{
# clean text from tags
$text =~ s/<\/?[^>]+>//gs;
# cut off after blank
$text =~ s/(.{30,200}\.).*/$1/gs;
$excerpt = $text;
}
# clean text from tags
$excerpt =~ s/<\/?[^>]+>//gs;
my $line = join( '|', $r+1,
$entryUrl, $blogname, $id, $title, $created, $excerpt, $isUpdated, $cmtTime, $cmtAuthor );
my $new_enough = time() < ($created_raw + PCConst->BlogHeadExcerptDuration()*86400);
# only newest entry is shown completely
# if( !$hasNews && $new_enough )
if( $new_enough )
{
push @news, $line;
DBG "blog($r, $hasNews, $new_enough) = '$line'";
$hasNews = 1;
}
else
{
push @headlines, $line;
}
}
$BLOG->disconnect();
}
#------------------------------------
sub getRunningGames
#
# $forPlayer = 1 player to move
# 2 opponent to move
#------------------------------------
{
my( $pid ) = @_;
my( $stmt, $rows, @table );
my $myname = $sobj->getValue( 'name' );
if(0)
{
$stmt = "
select
p2.name, pg1.color, g.fullmove,
pg1.clock, pg2.clock, g.tomove, g.lastmove, g.name
from
tbl_game g,
tbl_player_game pg1,
tbl_player_game pg2,
tbl_player p2
where
pg1.pid = ? and
pg1.gid = pg2.gid and
pg1.gid = g.gid and
p2.pid = pg2.pid and
pg1.pid <> pg2.pid and
g.result = ''
";
$rows = MyDbi::getRows( $stmt, $pid );
}
else
{
$stmt = "
select
p2.name, pg1.color, g.fullmove,
pg1.clock, pg2.clock, g.tomove, g.lastmove, g.name
from
tbl_game g,
tbl_player_game pg1,
tbl_player_game pg2,
tbl_player p2
where 1
and g.result=''
and g.wpid = ?
and g.wpid = pg1.pid
and g.gid = pg1.gid
and g.gid = pg2.gid
and g.bpid = pg2.pid
and p2.pid = pg2.pid
union distinct
select
p2.name, pg1.color, g.fullmove,
pg1.clock, pg2.clock, g.tomove, g.lastmove, g.name
from
tbl_game g,
tbl_player_game pg1,
tbl_player_game pg2,
tbl_player p2
where 1
and g.result=''
and g.bpid = ?
and g.bpid = pg1.pid
and g.gid = pg1.gid
and g.gid = pg2.gid
and g.wpid = pg2.pid
and p2.pid = pg2.pid
";
$rows = MyDbi::getRows( $stmt, $pid, $pid );
}
# Debug
# print "
pid = $pid rows=$rows\n"; # running games: player to move #------------------------------ my ( $r, $t, $since, $wp, $bp, $mp, $op, @GameList ); my ( @mTable, @mRing ); my ( @oTable, @oRing ); my $lastrow = $#{$rows}; # create tables for output #--------------------------- for $r ( 0 .. $#{$rows} ) { my( $oppname, $mycolor, $moveno, $myclock, $oppclock, $tomove, $lastmove, $gamename, $clockmin ) = @{ $rows->[$r] }; $wp = ($mycolor eq 'w') ? $myname : $oppname; $bp = ($mycolor ne 'w') ? $myname : $oppname; if( $tomove eq $mycolor ) { push @mTable, [ $gamename, $wp, $bp, $moveno, $myclock-(time-$lastmove), $oppclock, $tomove, $lastmove, $clockmin ]; } else { push @oTable, [ $gamename, $wp, $bp, $moveno, $myclock, $oppclock-(time-$lastmove), $tomove, $lastmove, $clockmin ]; } } # Debug # print "
pid = $pid rows=$rows\n"; # running games: player to move #------------------------------ my ( $oppname, $mycolor, $moveno, $myclock, $lastmove, $gamename, $clockmin ); my ( $r, $t, $clocktxt, $since, $wp, $bp, $mp, $op, $line, $elapsed, @GameList, $isAdjourned ); my $lastrow = $#{$rows}; # ring of games #-------------- my @ring; for $r ( 0 .. $#{$rows} ) { push @ring, $rows->[$r][5]; AUS(__FILE__,__LINE__, $r, @GameList ); } my $ring = join( ',', @ring ); $sobj->setValue( "ring$forPlayer", $ring ); $sobj->setValue( "testvalue", time() ); # print "forPlayer=ring$forPlayer
$r: ", @{ $rows->[$r] }, "\n"; $elapsed = time-$lastmove; # Check for adjourned games # ~~~~~~~~~~~~~~~~~~~~~~~~~ $isAdjourned = ($lastmove > time); $elapsed = 0 if( $isAdjourned ); $t = int( ($myclock - $elapsed) / 60 ); $clocktxt = sprintf( "%2dd %02d:%02d ", int($t/1440), int(($t/60)%24), int($t%60) ); # Game lost by time #------------------ if( $myclock < $elapsed ) { # loading the game object triggers the time control my $gobj = PCGame->loadByName( $gamename ); $clocktxt = 'time over'; } if( $isAdjourned ) { $since = 'paused'; } else { $t = int($elapsed/60); $since = sprintf( "%2dd %02d:%02d ", int($t/1440), int(($t/60)%24), int($t%60) ); } $wp = ($mycolor eq 'w') ? $myname : $oppname; $bp = ($mycolor ne 'w') ? $myname : $oppname; ($league,$tour,$bd) = split( /-/, $gamename ); # Assemble line of resulting table #--------------------------------- $line = join("|", $gamename, $wp, $bp, $moveno, $myname, $oppname, $tomove, $clocktxt, $since, $ring); push @table, $line; #AUS(__FILE__,__LINE__, $r, $line ); } return @table; }