#!/usr/bin/perl
# ================================================================================
# $Rev: 216 $ $URL: svn://localhost/PlayChess/trunk/cgi/playerdata.cgi $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Author: $Author: Thomas $
# Modified: $Date: 2006-10-01 17:28:53 +0200 (So, 01 Okt 2006) $
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Copyright at playchess.de - all rights reserved
# ================================================================================
use lib "../cgi-bin";
use CGI qw( :standard );
use CGI::Carp qw(fatalsToBrowser);
use Member;
use PCPlayer;
use PC;
use PCLeagueUtil;
use PCSession;
use Template;
use Util;
use ChessConfig;
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;
local ($starttime,$endtime) = (time(),0);
local $cgi = CGI->new();
local $sobj = PCSession->new($cgi);
local $name = $sobj->getValue( 'name' );
local $action = $sobj->getCgiParam( 'action' ) || $ENV{'action'} || 'account';
local $sort = $sobj->getCgiParam( 'sort' );
local $league = $sobj->getCgiParam( 'league' ) || 'HCL';
local $last = $sobj->getCgiParam( 'last' );
local $first = $sobj->getCgiParam( 'first' );
local $email = $sobj->getCgiParam( 'email' );
local $homepage = $sobj->getCgiParam( 'homepage' );
local $image = $sobj->getCgiParam( 'image' );
local $isengine = $sobj->getCgiParam('isengine');
local $cflag = $sobj->getCgiParam('cflag');
local ($flag,$country) = split('-',$cflag) if $cflag;
# Page requires login
# ~~~~~~~~~~~~~~~~~~~
$sobj->assertLogged();
ShowPage('playerdata.tpl') if( $action eq 'account' );
ShowPage('playerdata-pw.tpl') if( $action eq 'changepasswd' );
# Following actions require database access
#------------------------------------------
local $dbh = dbiConnect() or exit(1);
ShowPage('playerdata-hex.tpl') if( $action eq 'editx' );
#-------------------- Edit Dialog ---------------------------
if( $action eq 'edit' )
{
$pobj = PCPlayer->Load( $name );
print EditPlayerDialog( $config, $cgi, "" );
}
#-------------------- Update Player Data ---------------------
elsif( $action eq 'update' )
{
AUS(__FILE__,__LINE__, $name, $passwd );
#print "
", $sobj->Info(), "
";
$err = CheckPlayerData();
DBG(__FILE__,__LINE__, $err );
if( $err )
{
$err .= ".
Data reset to previous values";
$pobj = PCPlayer->Load( $name );
print EditPlayerDialog( $config, $cgi, $err );
exit(0);
}
#---------------------------------------------------------
# Change Player Data
#---------------------------------------------------------
my $pobj = PCPlayer->Load($name);
$pobj->Email ( $sobj->getCgiParam('email') );
$pobj->Emaillevel( $sobj->getCgiParam('emaillevel') );
$pobj->FirstName( $sobj->getCgiParam('first') );
$pobj->LastName ( $sobj->getCgiParam('last') );
$pobj->Name ( $sobj->getCgiParam('name') );
$pobj->Country ( $country );
$pobj->Flag ( $flag );
$pobj->Age ( $sobj->getCgiParam('age') );
$pobj->Gender ( $sobj->getCgiParam('gender') );
$pobj->Privacy ( "".$sobj->getCgiParam('privacy') );
$pobj->Title ( $sobj->getCgiParam('title') );
#-------------- Engines ----------------------------
$pobj->IsEngine ( "".$sobj->getCgiParam('isengine') );
$pobj->Computer ( $sobj->getCgiParam('computer') );
$pobj->OpSystem ( $sobj->getCgiParam('opsystem') );
$pobj->Processors ( $sobj->getCgiParam('processors') );
$pobj->Cycles ( $sobj->getCgiParam('cycles') );
$pobj->Program ( $sobj->getCgiParam('program') );
$pobj->Company ( $sobj->getCgiParam('company') );
$pobj->Version ( $sobj->getCgiParam('version') );
$pobj->Programmer ( $sobj->getCgiParam('programmer') );
# Storing the changed data
#-------------------------
my( $stmt, $rv );
$stmt = "
update tbl_player
set email=?,country=?,flag=?,privacy=?,title=?
where pid=?
";
$rv = doStmt( $stmt, $pobj->Email, $pobj->Country, $pobj->Flag, $pobj->Privacy, $pobj->Title, $pobj->Id );
AUS(__FILE__,__LINE__, $rv, $pobj->Name, $pobj->Id );
# Human Player
#-------------
if( ! $pobj->IsEngine )
{
$stmt = "
update tbl_humanplayer
set firstname=?,lastname=?,age=?,gender=?
where pid=?
";
$rv = doStmt( $stmt, $pobj->FirstName, $pobj->LastName, $pobj->Age, $pobj->Gender, $pobj->Id );
AUS(__FILE__,__LINE__, $rv, $pobj->Name, $pobj->Id );
}
# Computer Player
#----------------
else
{
$stmt = "
update tbl_computerplayer
set computer=?,opsystem=?,operator=?,program=?,company=?,
programmer=?,version=?,processors=?,speed=?
where pid=?
";
$rv = doStmt( $stmt, $pobj->Computer, $pobj->OpSystem, $pobj->Operator, $pobj->Program,
$pobj->Company, $pobj->Programmer, $pobj->Version, $pobj->Processors,
$pobj->Cycles, $pobj->Id );
AUS(__FILE__,__LINE__, $rv, $pobj->Name, $pobj->Id );
}
# Display compiled player information
my $tpl = Template->new( "playerdata-ups.tpl" );
$tpl->addMakro( "NAME", $pobj->Name );
#$tpl->addMakro( "PASSWD", $pobj->Passwd );
print $tpl->Expand($sobj);
exit(0);
}
#-------------------- Update extended profile ---------------------
elsif( $action eq 'updatex' )
{
# must be *paying* member
$sobj->assertMember(1);
ShowPage( 'playerdata-hex.tpl', 'Homepage not valid' ) if( $homepage && ($homepage =~ /\s/ || $homepage !~ /\S+\.\S+/) );
ShowPage( 'playerdata-hex.tpl', 'Image not valid' ) if $image && $image !~ /.+\..+\/.+\.(gif|jpg|png)$/i;
#---------------------------------------------------------
# Change Player Data
#---------------------------------------------------------
my $pobj = PCPlayer->Load($name);
$pobj->Homepage ( $sobj->getCgiParam('homepage') );
$pobj->Image ( $sobj->getCgiParam('image') );
# Remove carriage returns from textarea fields
$ShortStmt = $sobj->getCgiParam('shortstmt');
$LongStmt = $sobj->getCgiParam('longstmt');
$ShortStmt =~ s/\n//g;
$LongStmt =~ s/\n//g;
$pobj->ShortStmt( $ShortStmt );
$pobj->LongStmt ( $LongStmt );
# Storing the changed data
#-------------------------
my( $stmt, $rv );
$stmt = "
update tbl_player
set homepage=?,image=?,shortstmt=?,longstmt=?
where pid=?
";
$rv = doStmt( $stmt, $pobj->Homepage, $pobj->Image,
$pobj->ShortStmt, $pobj->LongStmt,
$pobj->Id );
# Display compiled player information
my $tpl = Template->new( "playerdata-ups.tpl" );
$tpl->addMakro( "NAME", $pobj->Name );
print $tpl->Expand($sobj);
exit(0);
}
#-------------------- Change Password ---------------------------
elsif( $action eq 'newpasswd' )
{
my $newpass1 = $sobj->getCgiParam( 'newpass1' );
my $newpass2 = $sobj->getCgiParam( 'newpass2' );
DBG(__FILE__,__LINE__, $name, $passwd, $newpass1, $newpass2 );
# Validating the input
# ~~~~~~~~~~~~~~~~~~~~
$err = 'Confirmation password differs' unless $newpass1 eq $newpass2;
$err = 'Please fill in both fields!' unless $newpass1 && $newpass2;
ShowPage( 'playerdata-pw.tpl', $err ) if( $err );
# Input is ok => store new password
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$pobj = PCPlayer->Load( $name );
$pobj->Passwd($newpass1, 1); # change password
$rv = doStmt( "update tbl_player set passwd=? where pid=?", $newpass1, $pobj->Id );
# Feedback to user (HTML+Email)
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my $tpl = Template->new( "playerdata-pws.tpl" );
$tpl->addMakro( "NAME", $name );
print $tpl->Expand($sobj);
$pobj->MailMessage( 'newpasswd' );
exit(0);
}
#-------------------- Send Password ---------------------------
elsif( $action eq 'sendpasswd' )
{
if( $name )
{
my $pobj = PCPlayer->Load($name);
if( $pobj )
{
$pobj->MailMessage('sendpasswd');
$err = "Password successfully sent";
}
else
{
$err = "Player '$name' is unknown";
}
}
my $tpl = Template->new( "sendpasswd.tpl" );
$tpl->addMakro( 'NAME', $name );
$tpl->addMakro( 'ERR', $err );
print $tpl->Expand($sobj);
exit(0);
}
#-------------------- Player Central ---------------------------
else
{
die( "Invalid action $action" );
}
##############################################################
#------------------------------------
sub EditPlayerDialog
#------------------------------------
{
my( $config, $cgi, $errstr ) = @_;
my $type = $pobj->IsEngine ? "COMPUTER" : "HUMAN";
my $tpl = Template->new( ($pobj->IsEngine) ? "playerdata-ce.tpl" : "playerdata-he.tpl" );
my $cflag = $pobj->Flag."-".$pobj->Country;
$sobj->addMakros( $tpl );
$pobj->addMakros( $tpl );
$tpl->addMakro ( "CFLAG", $cflag );
$tpl->addMakro ( "ERR", $errstr );
$tpl->addRadioMakro ( "emaillevel", $pobj->Emaillevel );
$tpl->addSelectMakro( "cflag", $cflag );
unless( $pobj->IsEngine )
{
my $pclass = $pobj->Class('HCL');
if( $pclass eq 'M' || $pclass eq 'X' )
{
$tpl->addMakro( "TITLE", $title );
$tpl->addMakro( "MAYBE_MASTER", 1 );
$tpl->addSelectMakro( "title", $pobj->Title );
}
$tpl->addRadioMakro( "gender", $pobj->Gender );
$tpl->addCheckMakro( "privacy", $pobj->Privacy );
}
my $txt = $tpl->Expand($sobj);
return $txt;
}
#------------------------------------
sub ShowPage
#------------------------------------
{
my( $template, $errstr ) = @_;
my $tpl = Template->new( $template );
# print "name=$name
\n";
$sobj->addMakros( $tpl );
if( $action =~ /^(editx|updatex)$/i )
{
# must be *paying* member
$sobj->assertMember(1);
my $pobj = PCPlayer->Load( $name );
$pobj->addMakros( $tpl );
}
$tpl->addMakro( "URL", $URL );
$tpl->addMakro( "NAME", $name );
$tpl->addMakro( "ERR", $errstr );
$tpl->addMakro( "SESSION_INFO", $sobj->Info() );
print $tpl->Expand($sobj);
exit(0);
}
#------------------------------------
sub LoginErrMsg
#------------------------------------
{
my $rc = shift;
return 'Nickname is required' if $rc==1;
return 'Password is required' if $rc==2;
return 'Player data not available' if $rc==3;
return 'Invalid password' if $rc==4;
return 'Unknown nickname' if $rc==5;
return 'This account is not valid anymore' if $rc==6;
return '';
}
#------------------------------------
sub CheckPlayerData
#------------------------------------
{
return 'Nickname contains blank characters. Use "_" instead.' if $name =~ /\s/;
return 'Nickname not allowed' if $name !~ /^[A-Za-z][\w-]+$/;
return 'Nickname too long' if length($name) > 20;
return 'Nickname is required' unless $name;
return 'Invalid email address' unless PCPlayer->checkEmail( $email );
return 'Last Name is required' unless $isengine || $last;
return 'First Name is required' unless $isengine || $first;
return 'Program is required' unless !$isengine || $sobj->getCgiParam('program');
# Check if player name is still free
#-----------------------------------
my $rc = PCPlayer->Exists( $name );
return "Nickname $name is already in use" if $rc && $action ne 'update';
return "Player $name is unknown" if !$rc && $action eq 'update';
# Check for existing aliases
# Allowed are no more than 1 accounts per email address
#------------------------------------------------------
my $engine = ($player eq 'computer') ? "isengine is not NULL and isengine <> ''"
: "(isengine is NULL or isengine = '')";
my $stmt = "
select count(*) from tbl_player
where email=?
and name <> ?
and $engine
and (deleted is NULL or deleted <> 1)";
my $alias = MyDbi::getValue( $stmt, $email, $name );
#print "stmt=$stmt
";
#print "alias=$alias
";
#print "name=$name
";
#print "email=$email
";
#return "Too many aliases.
No more than two accounts per email address allowed (there are already $aliases)."
#if( $aliases >= 2 );
return "Alias accounts are not allowed (email already in use)"
if( $alias );
return "";
}