Show PS.pm syntax highlighted
# Primary interface to PsychoStats
#
#
package PS;
use base qw( PS::Base );
use strict;
use POSIX qw(floor strftime mktime);
use Time::Local;
use File::Spec::Functions;
use File::Path;
use Getopt::Long;
use Data::Dumper;
use LoadConfig;
use util;
use PS::Verbose;
use PS::Scanner;
use PS::Saver;
use PS::Referee;
our $VERSION = "2.3"; # Main PsychoStats version
our $DONE = 0;
#$SIG{INT} = \&DOEXIT; # capture ^C key presses
# --------------------------------------------------------------
# main subroutine that will handle everything for stats compilation, etc
sub main {
my $self = shift;
my $saver = $self->{saver};
my $scanner = $self->{scanner};
my $conf = $self->{conf};
my $lang = $self->{lang};
my $v = $self->{verbose};
my $vdata = {};
my ($res);
$saver->updateinfo('update_in_progress', time());
$res = $self->download_new_logs unless $conf->{nodownload};
goto RETURN if $conf->{downloadonly};
$res = $self->rebuild_database if $conf->{historymaxdays};
unless ($conf->{skiplogs}) {
if ($conf->{logstream}{enabled}) {
$saver->updateinfo('update_in_progress', 0);
# $saver->updateinfo('logstream_update', time());
$res = $scanner->process_log_stream; # go directly to the scanner and allow it to handle everything
return;
} else {
$res = $self->process_new_logs;
}
}
$res = $self->compile_players if $conf->{use}{playerrules};
$res = $self->compile_player_ranks if $conf->{use}{playerranks} and !$conf->{skipranks};
$res = $self->compile_player_names if $conf->{use}{primaryplrname} eq 'most';
$res = $self->delete_clans if $conf->{clans}{delete};
$res = $self->compile_clans if $conf->{clans}{compile};
$res = $saver->cleanup_players if $conf->{cleanupplayers};
$res = $self->compile_awards if !$conf->{skipawards} or scalar @{$conf->{awards}{delete}};
RETURN:
$saver->updateinfo(lastupdate => time(), 'update_in_progress' => 0);
}
# --------------------------------------------------------------
sub rebuild_database {
my $self = shift;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $saver = $self->{saver};
my $v = $self->{verbose};
my $vdata = {};
my ($oldest, $newest) = $saver->stats_get_date_range({ ARRAY => 1 });
return unless $newest;
my $datelimit = $newest - (60 * 60 * 24 * $conf->{historymaxdays});
$vdata->{oldestdate} = strftime("%Y-%m-%d", localtime($oldest));
$vdata->{datelimit} = strftime("%Y-%m-%d", localtime($datelimit));
$vdata->{newestdate} = strftime("%Y-%m-%d", localtime($newest));
# print Dumper($vdata);
return if ($datelimit <= $oldest); # nothing to delete ...
$v->print($lang->{trimhistory1}, $vdata);
$saver->trimhistory($datelimit);
$v->print($lang->{trimhistory2}, $vdata);
}
# --------------------------------------------------------------
sub download_new_logs {
my $self = shift;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $v = $self->{verbose};
my $state = $self->{scanner}{state};
my $vdata = {};
my @list = ();
my $f;
# gather a list of enabled download hosts ...
# we add 'downloadlogs' to the front of this array, since it's not included in the _dlkeys array
foreach my $key ( ( 'downloadlogs', @{$self->{_dlkeys}} ) ) {
my $d = $conf->{$key};
push(@list, $conf->{$key}) if $d->{download} and $d->{host} ne '';
}
return unless scalar @list; # if there's no valid hosts to download from, stop here
$vdata->{total} = scalar @list;
$v->print($lang->{download1}, $vdata);
eval "use Net::FTP"; # I do this here since we don't need it otherwise
foreach my $dl (@list) {
$vdata = $dl;
$v->print($lang->{dlhost1}, $vdata);
$f = new Net::FTP($dl->{host}, Port => $dl->{port}, Passive => $dl->{pasv});
if (!$f or !$f->login($dl->{user}, $dl->{pass})) {
chomp($vdata->{result} = defined $f ? $f->message : 'Error logging into server'); # need to chomp ftp->message
$v->print($lang->{dlhost2}, $vdata);
next;
}
chomp($vdata->{ftproot} = $f->pwd);
$vdata->{result} = 'OK';
$v->print($lang->{dlhost2}, $vdata);
$dl->{binary} ? $f->binary : $f->ascii;
# Make sure our remote-path is correct
if ($dl->{remotepath} ne '') {
if (!$f->cwd($dl->{remotepath})) {
chomp($vdata->{result} = $f->message);
$v->print($lang->{dlcwderr}, $vdata);
next;
}
}
my $localpath = $dl->{localpath};
my $remotepath = $dl->{remotepath};
my $lastlog;
if (defined $state->{source}{ $localpath }) {
# In theory, the localpath should match up with a source directory
$lastlog = $state->{source}{$localpath}{last_log};
}
$lastlog ||= 'L000000.log';
$localpath =~ tr|\\|/|; # convert \ to /
$localpath .= '/' unless substr($localpath,-1) eq '/';
$remotepath =~ tr|\\|/|; # convert \ to /
$remotepath .= '/' unless substr($remotepath,-1) eq '/';
# Make sure our local-path is correct
if (!-r $localpath and !-d $localpath) {
eval { mkpath($localpath) }; # create the directory
if ($@) { # We failed to create the directory
# $@ =~ s/ at .+$//; # strip off tail end of error, it's useless
chomp($vdata->{result} = $@);
$v->print($lang->{dlpatherr}, $vdata);
next;
}
} if (-r $localpath and !-d $localpath) { # localpath IS NOT a directory!
$vdata->{result} = $localpath . " is not a directory.";
$v->print($lang->{dlpatherr}, $vdata);
}
# my @dir = grep { /\.log$/i && !/WS_FTP/ } $f->ls; # get all log files within the directory (ignore WS_FTP.LOG)
my @dir = sort { logcompare($a, $b) } grep { /^L[0-9]{7}\.log$/io } $f->ls; # get all log files within the directory (ignore WS_FTP.LOG)
pop(@dir) if $dl->{skiplast}; # remove the last log (it's most likely still being updated by the game server)
$vdata->{totallogs} = scalar @dir;
$vdata->{idx} = 0;
$vdata->{pct} = "0.00";
$vdata->{ftpcwd} = $f->pwd;
chomp($vdata->{ftpcwd}) if defined $vdata->{ftpcwd};
$v->print($lang->{dlremotetotal}, $vdata);
$f->hash(\*STDOUT, 1024 * 10) if $conf->{verbose};
foreach my $file (@dir) {
my $remotefile = $file; # remotpath is already applied when we CWD into it
my $localfile = $localpath . $file;
my $fetch = ( !-e $localfile && logcompare($lastlog, $file) != 1 );
$vdata->{action} = $fetch ? "Downloading" : "Skipping ";
$vdata->{file} = $file;
$vdata->{idx}++;
$vdata->{pct} = sprintf("%6s", calcpct($vdata->{idx}, $vdata->{totallogs}, 2));
$v->print($lang->{dlprogress}, $vdata);
next unless $fetch;
if (!$f->get($remotefile, $localfile)) {
chomp($vdata->{result} = $f->message);
$v->print($lang->{dlgeterr}, $vdata);
} else {
if ($dl->{delete}) {
if (!$f->delete($remotefile)) {
chomp($vdata->{result} = $f->message);
$v->print($lang->{dldeleteerr}, $vdata);
}
}
}
}
$v->print($lang->{dlhost3}, $vdata);
$f->quit;
}
$v->print($lang->{download2}, $vdata);
}
# --------------------------------------------------------------
# compiles player ranks.
# assigns a 'rank' value to all players. If a player is not allowed to rank they receive a rank of 0.
# this is called AFTER compile_players
sub compile_player_ranks {
my $self = shift;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $v = $self->{verbose};
my $saver = $self->{saver};
my $fields = $saver->explainfields('plr','plr_profile','plrdata');
my (@conditions, $vdata);
# print join(', ', keys %$fields), "\n";
$v->print($lang->{compileplrranks1}, $vdata);
if (!exists $fields->{ $conf->{use}{playerrankfield} }) {
logerror(sprintf($lang->{err_playerrankfield}, $conf->{use}{playerrankfield}), 0, $conf->{verbose});
} else {
$saver->compile_player_ranks();
}
$v->print($lang->{compileplrranks2}, $vdata);
}
# --------------------------------------------------------------
# sets each players 'allowrank' variable based on settings in the users [plr_ranking] section of their config
sub compile_players {
my $self = shift;
my ($ruleskey) = @_;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $saver = $self->{saver};
my $v = $self->{verbose};
my (@conditions, $vdata);
$ruleskey ||= 'player_rules';
@conditions = ();
# First we need to verify & setup the conditions for ranking from the users config
while (my ($key, $var) = each %{$conf->{$ruleskey}}) {
next if uc $key eq $key; # ignore 'SECTION' key (or whatever it might be called; always CAPITAL)
my $list = ref $var ? $var : [ $var ]; # force $cond into a list reference
foreach my $cond (@$list) {
if ($cond =~ /[^-0-9!%^&*()+\\<>|\s\.=]/) { # If there are any chars other then the ones shown the condition is INVALID
logerror(sprintf($lang->{err_badplrcondition}, $key, $cond, "Invalid character present in definition\n"), 0, $conf->{verbose});
} else { # condition is VALID
push(@conditions, { var => $key, expr => $cond } );
}
}
}
$vdata->{status}{start} = time();
$vdata->{validplayers} = 0;
my $total = $vdata->{totalplayers} = $vdata->{status}{total} = $saver->load_registered_plrlist({ TOTAL => 1 });
my $totaldone = $vdata->{status}{totaldone} = 0;
my $limit = 1000; # load X players at a time so we don't hog up all the memory for large lists
$v->print($lang->{compileplrs1}, $vdata);
while ($totaldone < $total) { # while there are players to process .....
my $plrlist = $saver->stats_load_plrlist({
START => $totaldone,
# SORT => 'plr.plrid',
LIMIT => $limit,
ALLOWALL => 1, # make sure we process everyone
NOCALC => 1, # don't include calculated variables
});
foreach my $plr (@$plrlist) {
$totaldone++;
$vdata->{status}{totaldone} = $totaldone;
if ($conf->{verbose}) {
$vdata->{status}{pct} = sprintf("%3.0f", calcpct($totaldone, $vdata->{status}{total}));
$vdata->{status}{time} = compacttime(time() - $vdata->{status}{start}, 'hh:mm:ss');
$vdata->{status}{msg} = $plr->{name};
}
# verify player meets requirements ...
my $res = 1;
# local $^W = 0; # disable warnings in this block?
foreach my $cond (@conditions) {
$plr->{ $cond->{var} } ||= 0; # make sure no variable is undef
my $code = '$plr->{' . $cond->{var} . '} ' . $cond->{expr};
$res = eval $code;
if (!$res) { # condition was not met, ignore the rest
$vdata->{status}{msg} = "[DENIED: $cond->{var}(" . $plr->{ $cond->{var} } . ")]: $plr->{name}";
logerror("PLAYER " . $vdata->{status}{msg},0,0) if $conf->{logdeniedplayers};
last;
}
}
$saver->save_registered_plrvar($plr->{plrid}, { allowrank => $res }) if $plr->{allowrank} != $res;
$vdata->{validplayers}++ if $res;
$v->print($lang->{plrprogress}, $vdata);
}
}
$vdata->{validplayerspct} = calcpct($vdata->{validplayers}, $vdata->{totalplayers});
$v->print($lang->{plrprogress2}, $vdata);
$v->print($lang->{compileplrs2}, $vdata);
}
# --------------------------------------------------------------
# compiles players most used names
# sets the primary name for all players that are currently ranked to use the most used name instead of the 'first'
sub compile_player_names {
my $self = shift;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $saver = $self->{saver};
my $v = $self->{verbose};
my ($vdata);
$vdata->{status}{start} = time();
my $total = $vdata->{totalplayers} = $vdata->{status}{total} = $saver->load_registered_plrlist({ TOTAL => 1, ALLOWALL => 0, WHERE => 'ISNULL(pp.plrnamelocked) OR NOT pp.plrnamelocked' });
my $totaldone = $vdata->{status}{totaldone} = 0;
my $limit = 1000; # load X players at a time so we don't hog up all the memory for large lists
$v->print($lang->{compilenames1}, $vdata);
while ($totaldone < $total) { # while there are players to process .....
my $plrlist = $saver->stats_load_plrlist({
START => $totaldone,
LIMIT => $limit,
ALLOWALL => 0, # we only need to check ranked players
NOCALC => 1, # don't include calculated variables
WHERE => 'ISNULL(pp.plrnamelocked) OR NOT pp.plrnamelocked', # do not change names of players that locked their name
});
foreach my $plr (@$plrlist) {
$totaldone++;
$vdata->{status}{totaldone} = $totaldone;
if ($conf->{verbose}) {
$vdata->{status}{pct} = sprintf("%3.0f", calcpct($totaldone, $vdata->{status}{total}));
$vdata->{status}{time} = compacttime(time() - $vdata->{status}{start}, 'hh:mm:ss');
$vdata->{status}{msg} = $plr->{name};
}
# compile the most used player name ...
# my $names = $saver->load_plr_names({ LIMIT => 1, MATCH => $plr->{worldid}, SORT => 'totaluses', ORDER => 'desc' });
my $names = $saver->load_plr_names({ LIMIT => 1, MATCH => $plr->{ $conf->{uniqueid} }, FIELD => $conf->{uniqueid}, SORT => 'totaluses', ORDER => 'desc' });
$saver->save_registered_plrvar($plr->{plrid}, { name => $names->[0]{name} }) if $names->[0]{name} ne $plr->{name};
$v->print($lang->{plrprogress}, $vdata);
}
}
$vdata->{validplayerspct} = calcpct($vdata->{validplayers}, $vdata->{totalplayers});
$v->print($lang->{compilenames2}, $vdata);
}
# --------------------------------------------------------------
# deletes clans from the database
sub delete_clans {
my $self = shift;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $saver = $self->{saver};
my $v = $self->{verbose};
# this does not delete the clan profiles ...
my $ok = $saver->delete_registered_clans({
WHERE => $conf->{clans}{inactiveonly} ? "claninactive != 0" : "",
OPTIMIZE => 1,
});
$v->print("\nClans deleted" . ($conf->{clans}{inactiveonly} ? " (inactive clans only)" : "") . ".\n"); # if $ok;
}
# --------------------------------------------------------------
# Compiles/processes clantags into clans ...
sub compile_clans {
my $self = shift;
my ($ruleskey) = @_;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $ref = $self->{referee};
my $scanner = $self->{scanner};
my $saver = $self->{saver};
my $v = $self->{verbose};
my $vdata = {}; # stores data to pass to the verbose object to output our progress
my $res = 1;
my ($code, $re, $refunc, $matches, $full, $name, @m, $id, @conditions);
my ($total, $totaldone, $plrlist, $clanlist, $clantags, @taglist, $limit);
$ruleskey ||= 'clan_rules';
@conditions = ();
# First we need to verify & setup the conditions for ranking from the users config
# while (my ($key, $var) = each %{$conf->{$ruleskey}}) {
# next if uc $key eq $key; # ignore 'SECTION' key (or whatever it might be called; always CAPITAL)
# my $list = ref $var ? $var : [ $var ]; # force $cond into a list reference
#
# foreach my $cond (@$list) {
# if ($cond =~ /[^-0-9!%^&*()+\\<>|\s=]/) { # If there are any chars other then the ones shown the condition is INVALID
# logerror(sprintf($lang->{err_badclancondition}, $key, $cond, "Invalid character present in definition\n"), 0, $conf->{verbose});
# } else { # condition is VALID
# push(@conditions, { var => $key, expr => $cond } );
# }
# }
# }
$clantags = LoadConfig->load(
location => $self->{conf}{configs}{clantags},
conftype => "clantags",
paths => $self->{conf}{progpath},
fatal => 1,
);
@taglist = ( sort {$clantags->{$a}{IDX} <=> $clantags->{$b}{IDX}} keys %$clantags );
# print Dumper(\@taglist); exit;
# build a Regexp function to scan for clantags for faster processing ...
$code = "";
logerror($lang->{err_noclantags}, 0, $conf->{verbose}) unless scalar @taglist;
foreach $re ( @taglist ) {
my $regexp = prepare_regexp($clantags->{$re}{SECTION});
$code .= " return ('$re',\\\@parms) if \@parms = (\$_[0] =~ /$regexp/io);\n";
# we also want to tweak the tag and player options a bit (allow $1 to mean the same as $m[1]
foreach my $opt (keys %{$clantags->{$re}}) {
next if uc $opt eq $opt;
$clantags->{$re}{$opt} =~ s/\$(\d)/"\$m[$1]"/ge;
}
}
$refunc = eval "sub { my \@parms = (); $code return (undef,undef); }";
if ($@) {
chomp($@);
logerror(sprintf($lang->{err_clantags}, $@), 0, $conf->{verbose});
}
# print "sub {\n my \@parms = ();\n$code return (undef,undef);\n}\n";
$vdata->{status}{start} = time();
$vdata->{status}{found} = 0;
$vdata->{validplayers} = 0;
$total = $vdata->{status}{total} = $saver->load_registered_plrlist({ TOTAL => 1, WHERE => 'clanid=0' });
$totaldone = 0;
$limit = 0; # how many players to fetch at once
$v->print($lang->{compileclans1}, $vdata);
$SIG{'__WARN__'} = sub {}; # ignore warnings in the block below
# --- SCAN FOR CLANTAGS ON PLAYER NAMES ---
while ($totaldone < $total) {
$plrlist = $saver->load_registered_plrlist({
START => $totaldone,
SORT => 'plr.name',
LIMIT => $limit,
WHERE => "clanid=0 AND allowrank", # if allowrank is not used the PHP pages will list non-valid clans
});
last unless @$plrlist; # if load_registered_plrlist FAILS!
foreach my $plr (@$plrlist) {
$totaldone++;
if ($conf->{verbose}) {
$vdata->{status}{pct} = sprintf("%3.0f", calcpct($totaldone, $vdata->{status}{total}));
$vdata->{status}{time} = compacttime(time() - $vdata->{status}{start}, 'hh:mm:ss');
$vdata->{status}{msg} = $plr->{name};
}
($re, $matches) = &$refunc($plr->{name});
if ($re) {
# $v->print("\n");
@m = ($re, @$matches); # create variable that the eval{} statements will use
$full = $name = '';
#print join(',', @$matches) . " == " . $clantags->{$re}{'tag'} . "\n" if $clantags->{$re}{IDX} == 1;
eval '$full = ' . $clantags->{$re}{'tag'} if $clantags->{$re}{'tag'};
logerror(sprintf($lang->{err_clantagvar}, 'tag', $clantags->{$re}{IDX}, $@), 0, $conf->{verbose}) if $@;
eval '$name = ' . $clantags->{$re}{'player'} if $clantags->{$re}{'player'};
logerror(sprintf($lang->{err_clantagvar}, 'player', $clantags->{$re}{IDX}, $@), 0, $conf->{verbose}) if $@;
if ($full ne '' and $name ne '') { # both parts must have matched something
if ( $id = $saver->get_clanid($full) ) { # get the clanid
$saver->save_registered_plrvar($plr->{plrid}, { clanid => $id }); # add this player to the clan
$vdata->{status}{found}++;
}
}
}
$v->print($lang->{clanprogress}, $vdata);
}
}
$v->print($lang->{clanprogress2}, $vdata);
$v->print($lang->{compileclans2}, $vdata);
# --- VERIFY CLANS ALL MEET THE MINIMUM REQUIREMENTS TO BE DISPLAYED IN THE STATS ---
$plrlist = undef;
$total = $vdata->{status}{total} = $saver->load_registered_clanlist({ TOTAL => 1 });
$totaldone = 0;
$limit = 0; # how many clans to fetch at once
$v->print($lang->{clanverify1}, $vdata);
while ($totaldone < $total) {
$clanlist = $saver->load_clan_stats({
START => $totaldone,
SORT => 'clanid',
LIMIT => $limit,
WHERE => "(clanlocked != 1)", # do not mess with clans that are locked
});
last unless @$clanlist; # if load_registered_clanlist FAILS!
foreach my $clan (@$clanlist) {
$totaldone++;
if ($conf->{verbose}) {
$vdata->{status}{pct} = sprintf("%3.0f", calcpct($totaldone, $vdata->{status}{total}));
$vdata->{status}{time} = compacttime(time() - $vdata->{status}{start}, 'hh:mm:ss');
$vdata->{status}{totalmembers} = $clan->{members};
$vdata->{status}{msg} = $clan->{clantag};
}
# my $res = 1;
# foreach my $cond (@conditions) {
# my $code = '$plr->{' . $cond->{var} . '} ' . $cond->{expr};
# $res = eval $code;
#
# if (!$res) { # condition was not met, ignore the rest
# $vdata->{status}{msg} = "DENIED[$cond->{var}(" . $plr->{ $cond->{var} } . ")]: $plr->{name}\n";
# last;
# }
# }
my $min = [];
my $err = "";
my $clanmembers = $clan->{members};
my $clankills = $clan->{kills};
my $clanskill = $clan->{skill};
push(@$min, "members($clanmembers)") unless $clanmembers >= $conf->{clans}{minmembers};
push(@$min, "kills($clankills)") unless $clankills >= $conf->{clans}{minkills};
push(@$min, "skill($clanskill)") unless $clanskill >= $conf->{clans}{minskill};
$vdata->{status}{clan} = @$min ? "DENIED: " . join(',', @$min) : "GOOD";
$v->print($lang->{clanverify2}, $vdata);
# $v->print("\n") if @$min; # force a newline on DENIED clans
logerror("CLAN DENIED: \"$clan->{clantag}\" due to: " . join(',', @$min) , 0, 0) if @$min and $conf->{clans}{debug};
if (!@$min) {
if ( $clan->{claninactive} == 1 ) {
$saver->save_registered_clanvar($clan->{clanid}, { claninactive => 0, clanupdatetime => time() });
}
$vdata->{validplayers} += $clanmembers;
} else {
if ( $clan->{claninactive} == 0 ) {
$saver->save_registered_clanvar($clan->{clanid}, { claninactive => 1, clanupdatetime => time() });
$saver->save_registered_clanvar($clan->{clanprofileid}, { clanlocked => 0 }, 1); # 1 = profile information
}
}
}
last;
}
$SIG{'__WARN__'} = 'DEFAULT'; # restore warnings
$vdata->{totalclans} = $saver->load_registered_clanlist({ TOTAL => 1 });
$vdata->{validclans} = $saver->load_registered_clanlist({ TOTAL => 1, WHERE => 'NOT claninactive' });
$vdata->{validclanspct} = calcpct($vdata->{validclans}, $vdata->{totalclans}, 2);
# $vdata->{validplayers} = $saver->load_registered_plrlist({ TOTAL => 1, WHERE => 'clanid != 0' });
$v->print($lang->{clanverify3}, $vdata);
$v->print($lang->{clanverify4}, $vdata);
return $res;
}
# --------------------------------------------------------------
# processes player awards ...
sub compile_awards {
my $self = shift;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $ref = $self->{referee};
my $scanner = $self->{scanner};
my $saver = $self->{saver};
my $v = $self->{verbose};
my $vdata = {}; # stores data to pass to the verbose object to output our progress
my $res = 1;
my ($awards, $curdate, $oldest, $newest, $weeks, $months);
my $oneday = 60 * 60 * 24;
my $oneweek = $oneday * 7;
my $weekcode = $conf->{awards}{startofweek} eq 'monday' ? '%W' : '%U';
if (scalar @{$conf->{awards}{delete}}) {
$v->print($lang->{deleteawards1});
$saver->delete_awards($conf->{awards}{delete});
$v->print($lang->{deleteawards2});
return if $conf->{skipawards};
}
$v->print($lang->{checkawards1});
($oldest, $newest) = $saver->stats_get_date_range({ ARRAY => 1 });
if (!$oldest or !$newest) { # if true, there is no log data yet
$v->print($lang->{noawarddata});
$v->print($lang->{checkawards2});
return;
}
$weeks = [];
if ($conf->{awards}{weekly}) {
# curdate will always start on the first day of the week
$curdate = $oldest - ($oneday * (localtime($oldest))[6]);
$curdate += $oneday if $conf->{awards}{startofweek} eq 'monday';
while ($curdate <= $newest) {
last if $curdate + $oneweek - $oneday > $newest; # ignore weeks that are not completed
push(@$weeks, $curdate);
# print strftime("$weekcode %d %m %Y\n", localtime($curdate));
$curdate += $oneweek; # go forward 1 week
}
}
$months = [];
if ($conf->{awards}{monthly}) {
my ($m,$y) = (localtime($oldest))[4,5];
# curdate will always start on the 1st day of the month (@ 2am, so DST time changes will not affect values)
$curdate = timelocal(0,0,2, 1,$m,$y); # get oldest date starting on the 1st of the month
while ($curdate <= $newest) {
my $onemonth = $oneday * daysinmonth($curdate);
last if $curdate + $onemonth - $oneday > $newest; # ignore months that are not completed
push(@$months, $curdate);
# print strftime("$weekcode %d %m %Y\n", localtime($curdate));
$curdate += $onemonth; # go forward 1 month
}
}
unless (scalar @$weeks or scalar @$months) {
$v->print($lang->{checkawards2});
return $res;
}
$v->print($lang->{awards1}); # basic awards info
$conf->{awarddefs} = LoadConfig->load(
location => $conf->{configs}{awards},
conftype => "awards",
noarrays => 1, # do not create auto-arrays
paths => [ $conf->{gamepath} ]
);
$v->print($lang->{awards2});
$v->print($lang->{modawards1}); # modtype awards info
$conf->{awarddefs} = LoadConfig->load(
location => $conf->{configs}{awards},
conftype => "awards_" . $conf->{modtype},
oldconf => $conf->{awarddefs},
warning => 0, fatal => 0, # do not error if there's no modtype config
noarrays => 1, # do not create auto-arrays
paths => [ catfile($conf->{gamepath}, $conf->{modtype}) ]
);
$v->print($lang->{modawards2});
$awards = $scanner->processawards($conf->{awarddefs});
while (my ($key, $a) = each(%$awards)) {
my $dates;
next if uc $key eq $key or !ref $a; # skip special keys and non-award blocks
$a->{awardname} = $key;
if ($conf->{awards}{weekly} and scalar @$weeks) {
$dates = $saver->get_award_dates($key, 'weekly');
my $updated = 0;
foreach my $w (@$weeks) {
my $date = strftime('%Y-%m-%d', localtime($w));
$vdata = { award => $a, awardname => $key, date => $date };
if (exists $dates->{$date} and !$conf->{awards}{force}) {
next;
}
$v->print($lang->{calcaward1w}, $vdata);
$updated++;
$a->{start} = $w;
$a->{end} = $w + ($oneweek - $oneday);
my $plrs = $saver->get_award_plrlist($a);
next unless @$plrs;
$saver->save_award_plrlist($a, $plrs, 'weekly', $w);
}
$v->print($lang->{calcaward2w}, $vdata) if $updated;
$v->print($lang->{noweeklyaward}, $vdata) if !$updated;
}
if ($conf->{awards}{monthly} and scalar @$months) {
$dates = $saver->get_award_dates($key, 'monthly');
my $updated = 0;
foreach my $m (@$months) {
my $date = strftime('%Y-%m-%d', localtime($m));
my $onemonth = $oneday * daysinmonth($m);
$vdata = { award => $a, awardname => $key, date => $date };
if (exists $dates->{$date} and !$conf->{awards}{force}) {
next;
}
$v->print($lang->{calcaward1m}, $vdata);
$updated++;
$a->{start} = $m;
$a->{end} = $m + $onemonth - $oneday;
my $plrs = $saver->get_award_plrlist($a);
next unless @$plrs;
$saver->save_award_plrlist($a, $plrs, 'monthly', $m);
}
$v->print($lang->{calcaward2m}, $vdata) if $updated;
$v->print($lang->{nomonthlyaward}, $vdata) if !$updated;
}
}
$v->print($lang->{checkawards2});
return $res;
}
# --------------------------------------------------------------
# processes all new logs from all sources in the config
sub process_new_logs {
my $self = shift;
my $conf = $self->{conf};
my $lang = $self->{lang};
my $ref = $self->{referee};
my $scanner = $self->{scanner};
my $saver = $self->{saver};
my $v = $self->{verbose};
my $state = $scanner->{state};
my $vdata = {}; # stores data to pass to the verbose object to output our progress
my $res = 1;
my ($logs, $logfile, $daysscanned, $lineofs);
return $res if $conf->{skiplogs};
$SIG{INT} = \&DOEXIT;
$v->print($lang->{gatherlogs1}, $vdata);
foreach my $src (@{$conf->{logsource}}) {
last if $DONE;
$scanner->{last_source} = $src; # SCANNER SOURCE
$vdata->{source}{path} = $src;
# load the previous state information into memory
if (defined $state->{source}{ $src }) {
my $s = $state->{source}{$src}; # short-cut
%{$vdata->{source}} = ( %{$vdata->{source}}, %$s );
$ref->timestamp($s->{ref}{timestamp});
$ref->map($s->{ref}{map});
$ref->{players} = copyhash($s->{ref}{plrs});
}
$v->print($lang->{logsource1}, $vdata);
$logs = [ sort { logcompare($a, $b) } @{$scanner->loadlogs($src)} ];
#print Dumper($logs); exit;
if ($conf->{verbose}) {
$vdata->{source}{total} = scalar @$logs;
$vdata->{source}{size} = 0;
$vdata->{source}{size} += -s $_ foreach (map { catfile($src, $_) } @$logs); # get total size of all log files
$vdata->{source}{ksize} = abbrnum($vdata->{source}{size},2); # same as 'size' but its abbr'd (ie: 58.20 KB)
$vdata->{source}{idx} = 0;
$vdata->{source}{start} = time();
$vdata->{source}{last_timestr} ||= 'never';
$v->print($lang->{logsource2}, $vdata);
}
$scanner->{lastday} = 0; # reset the day
$daysscanned = 0;
foreach (@$logs) {
last if $DONE;
$lineofs = 0;
$scanner->{last_log} = $_; # SCANNER LOG
$logfile = catfile($src, $_);
if ($conf->{verbose}) {
$vdata->{source}{log} = $_;
$vdata->{source}{logsize} = -s $logfile;
$vdata->{source}{klogsize} = sprintf("%10s", abbrnum(-s $logfile,2));
$vdata->{source}{idx}++;
$vdata->{source}{padidx} = sprintf("%" . length($vdata->{source}{total}) . "d", $vdata->{source}{idx});
$vdata->{source}{pct} = sprintf("%3.0f", calcpct($vdata->{source}{idx}, $vdata->{source}{total}));
$vdata->{source}{time} = compacttime(time() - $vdata->{source}{start}, 'hh:mm:ss');
}
# The log comparison is done AFTER the 'verbose' block above so that if we're running in verbose mode
# all of the indexes and percents will be updated accordingly.
# skip previously scanned logs
next if exists $vdata->{source}{last_log} and logcompare($vdata->{source}{last_log}, $_) == 1;
# are we on the most recently loaded log (from the previous state)
if (exists $vdata->{source}{last_log_line} and exists $vdata->{source}{last_log} and $vdata->{source}{last_log} eq $_) {
$lineofs = $vdata->{source}{last_log_line};
}
$v->print($lang->{logprogress}, $vdata);
# Now, process the actual log file with the Scanner object (finally!)
$scanner->logprocess($logfile, $lineofs);
push(@{$scanner->{parsedlogs}}, $logfile) if $logs->[-1] ne $_; # add log to buffer ONLY if its not the last log in the directory
} # end foreach @logs ...
# print Dumper($scanner->{_restats}) if $self->DEBUG;
if ($ref->timestamp) {
$v->print($lang->{scannerclean1}, $vdata);
$scanner->cleanup($ref->timestamp);
$v->print($lang->{scannerclean2}, $vdata);
}
$v->print($lang->{logsource3}, $vdata);
}
$v->print($lang->{saverclean1}, $vdata);
$saver->cleanup;
$v->print($lang->{saverclean2}, $vdata);
$v->print($lang->{gatherlogs2}, $vdata);
return $res;
}
# --------------------------------------------------------------
# Initialize the class... Most initialization for PS.pm will be done in the do_init() method
sub init {
my ($self, $args) = @_;
print "DEBUG >> Initializing PS ...\n" if $self->DEBUG;
return $self; # always return $self
}
# -------------------------------------------------------------
# Secondary init method has to be used for main PS object otherwise all other classes will not be created correctly
sub do_init {
my ($self, $args) = @_;
my $params = {}; # command line options
my $conf = {}; # main config
my $conffile;
$self->{verbose} = PS::Verbose->new(); # create verbose object
my $h = GetOptions(
"logstream|stream" => \$params->{logstream}{enabled},
"rebuild" => \$params->{rebuild},
"compileclans|clans" => \$params->{compileclans},
"deleteclans|clearclans" => \$params->{deleteclans},
"cleanupplayers|cleanupplrs" => \$params->{cleanupplayers},
"compileplayers|compileplrs|playerrules|plrrules" => \$params->{use}{playerrules},
"primaryplrname|plrnames=s" => \$params->{use}{primaryplrname},
"plrranks|playerranks" => \$params->{use}{playerranks},
"clandebug|logdeniedclans" => \$params->{clandebug},
"playerdebug|plrdebug|logdeniedplayers" => \$params->{logdeniedplayers},
"clanrules" => \$params->{use}{clanrules},
"inactiveclansonly" => \$params->{inactiveclans},
"clantags" => \$params->{checkclantags},
"newclansonly" => \$params->{newclansonly},
"nologs|skiplogs" => \$params->{skiplogs},
"noawards|skipawards" => \$params->{skipawards},
"noranks" => \$params->{skipranks},
"forceawards" => \$params->{awards}{force},
"deleteawards:s" => \@{$params->{awards}{delete}},
"downloadonly" => \$params->{downloadonly},
"nodownload|noftp" => \$params->{nodownload},
"config=s" => \$params->{config},
"gametype=s" => \$params->{gametype},
"help" => \$params->{help},
"logsource|logsrc|directory=s" => \$params->{logsource},
"language=s" => \$params->{language},
"modtype=s" => \$params->{modtype},
"newlogsonly" => \$params->{newlogsonly},
"output=s" => \$params->{output},
"quiet" => \$params->{quiet},
# "scanmaxdays=i" => \$params->{scanmaxdays},
"verbose" => \$params->{verbose},
"version" => \$params->{version},
);
$params->{help} = 1 if !$h;
if ($params->{version}) {
print "PsychoStats version: v$VERSION\n";
exit(0);
}
# determine where to find main config file (cmd line, explicitly set by the class, or by script filename
$conffile = $params->{config} || $args->{CONFFILE} || getprogbasename() . '.cfg';
$self->{conf} = LoadConfig->load( location => $conffile, conftype => 'main', oldconf => $args->{CONF} || undef, fatal => 1 );
$self->{conf}{configs}{main} = $conffile;
$self->loadparams($params); # process parameters and config
$self->validateconfig; # validate configuration
if ($self->{verbose}) {
$self->{verbose}->verbose(!$args->{INSTALL} and $self->{conf}{verbose}); # enable/disable verbosity
$self->{verbose}->add($self->{conf}); # init the VERBOSE obj with conf data
}
$self->{lang} = LoadConfig->load( # load language file
location => $self->{conf}{configs}{langmain},
conftype => "langmain",
paths => $self->{conf}{languagepath},
fatal => 1,
);
$| = !$self->{conf}{bufferedoutput}; # should console output be buffered?
$self->displayhelp() if defined $params->{help}; # must be done here, so we know the 'language' to use
$self->{verbose}->print($self->{lang}{referee1});
# $self->{referee} = PS::Referee->new($args);
$self->{referee} = $self->newreferee($args);
$self->{verbose}->print($self->{lang}{referee2});
$self->{verbose}->print($self->{lang}{scanner1});
$self->{scanner} = $self->newscanner($args);
$self->{verbose}->print($self->{lang}{scanner2});
$self->{verbose}->print($self->{lang}{saver1});
$self->{saver} = $self->newsaver($args);
$self->{verbose}->print($self->{lang}{saver2});
return $self;
}
# --------------------------------------------------------------
sub validateconfig {
my ($self) = @_;
my $conf = $self->{conf};
my $lang = $self->{lang};
logerror("'gametype' was not specified in configuration!",1) unless exists $conf->{gametype};
# logerror("'logsource' was not specified in configuration!",1) unless exists $conf->{logsource};
logerror("'logsource' was not specified in configuration!",1) unless map { /^logsource/ ? $conf->{$_} : () } keys %$conf;
$conf->{verbose} = 0 unless defined $conf->{verbose};
$conf->{bufferedoutput} = 0 unless defined $conf->{bufferedoutput};
$conf->{language} = "english" unless defined $conf->{language};
$conf->{logerrors} = 1 unless defined $conf->{logerrors};
$conf->{startdate} = time() unless defined $conf->{startdate};
$conf->{maxdays} = 30 unless defined $conf->{maxdays};
$conf->{historymaxdays} = 0 unless defined $conf->{historymaxdays};
$conf->{uniqueid} = "name" unless defined $conf->{uniqueid} and $conf->{uniqueid} =~ /^(name|wonid|steamid|worldid|ipaddr)$/;
$conf->{ignorechat} = 0 unless defined $conf->{ignorechat};
$conf->{ignorebots} = 0 unless defined $conf->{ignorebots};
$conf->{ignorestatsme} = 0 unless defined $conf->{ignorestatsme};
$conf->{removeoldlogs} = 0 unless defined $conf->{removeoldlogs};
$conf->{oldlogspath} = '' unless defined $conf->{oldlogspath};
$conf->{ignoremaps} = [] unless defined $conf->{ignoremaps};
$conf->{theme}{source} = "standard" unless defined $conf->{theme}{source};
$conf->{theme}{compile} = 0 unless defined $conf->{theme}{compile};
$conf->{theme}{allowuserchange} = 0 unless defined $conf->{theme}{allowuserchange};
$conf->{eventmaxdays} = 0 unless defined $conf->{eventmaxdays};
$conf->{reportunknown} = 0 unless defined $conf->{reportunknown};
$conf->{defaultmap} = "unknown" unless defined $conf->{defaultmap};
$conf->{baseskill} = 1000 unless defined $conf->{baseskill};
$conf->{skillfunc} = "default" unless defined $conf->{skillfunc};
$conf->{minconnected} = 0 unless defined $conf->{minconnected};
$conf->{skiplogs} = 0 unless defined $conf->{skiplogs};
$conf->{skipawards} = 0 unless defined $conf->{skipawards};
$conf->{skipranks} = 0 unless defined $conf->{skipranks};
$conf->{compileclans} = 0 unless defined $conf->{compileclans};
$conf->{checkclantags} = 0 unless defined $conf->{checkclantags};
$conf->{use}{weaponweights} = 0 unless defined $conf->{use}{weaponweights};
$conf->{use}{playerrules} = 0 unless defined $conf->{use}{playerrules};
$conf->{use}{playerranks} = 1 unless defined $conf->{use}{playerranks};
$conf->{use}{playerrankfield} = 'skill' unless defined $conf->{use}{playerrankfield};
$conf->{use}{playerrankorder} = 'desc' unless defined $conf->{use}{playerrankorder};
$conf->{use}{clanrules} = 0 unless defined $conf->{use}{clanrules};
$conf->{use}{primaryplrname} = 'first' unless defined $conf->{use}{primaryplrname};
$conf->{decay}{skill} = 0 unless defined $conf->{decay}{skill};
$conf->{configs}{theme} = "theme.cfg" unless defined $conf->{configs}{theme};
$conf->{configs}{logdata} = "logdata.cfg" unless defined $conf->{configs}{logdata};
$conf->{configs}{langmain} = "lang_main.cfg" unless defined $conf->{configs}{langmain};
$conf->{configs}{clantags} = "clantags.cfg" unless defined $conf->{configs}{clantags};
$conf->{configs}{weapons} = "weapons.cfg" unless defined $conf->{configs}{weapons};
$conf->{configs}{bonus} = "bonus.cfg" unless defined $conf->{configs}{bonus};
$conf->{configs}{awards} = "awards.cfg" unless defined $conf->{configs}{awards};
$conf->{clans}{inactiveonly} = 0 unless defined $conf->{clans}{inactiveonly};
$conf->{clans}{delete} = 0 unless defined $conf->{clans}{delete};
$conf->{clans}{compile} = 0 unless defined $conf->{clans}{compile};
$conf->{clans}{debug} = 0 unless defined $conf->{clans}{debug};
$conf->{clans}{minmembers} = 3 unless defined $conf->{clans}{minmembers};
$conf->{clans}{minkills} = 0 unless defined $conf->{clans}{minkills};
$conf->{clans}{minskill} = 0 unless defined $conf->{clans}{minskill};
$conf->{filters}{stripcd} = 0 unless defined $conf->{filters}{stripcd};
$conf->{downloadlogs} = {} unless defined $conf->{downloadlogs} or ref $conf->{downloadlogs} ne 'HASH';
$conf->{nodownload} = 0 unless defined $conf->{nodownload};
$conf->{match}{saystart} = "" unless defined $conf->{match}{saystart};
$conf->{match}{saystop} = "" unless defined $conf->{match}{saystop};
$conf->{awards}{startofweek} = 'monday' unless defined $conf->{awards}{startofweek};
$conf->{awards}{force} = 0 unless defined $conf->{awards}{force};
$conf->{awards}{delete} = [ 0 ] unless defined $conf->{awards}{delete};
$conf->{logstream}{enabled} = 0 unless defined $conf->{logstream}{enabled};
$conf->{logstream}{listenport} = 28000 unless defined $conf->{logstream}{listenport};
$conf->{historymaxdays} = 0 unless $conf->{historymaxdays} =~ /^\d+$/;
$conf->{minconnected} = 0 unless $conf->{minconnected} =~ /^\d+$/;
$conf->{awards}{startofweek} = lc $conf->{awards}{startofweek};
# make sure weekname isn't abbr'd. 'monday' is default for any value other than 'sunday'
$conf->{awards}{startofweek} = ($conf->{awards}{startofweek} =~ /^s/) ? 'sunday' : 'monday';
$conf->{decay}{skill} =~ s/%$//g; # remove trailing percent sign(s)
$conf->{decay}{skill} = 0 unless $conf->{decay}{skill} =~ /^[-+]?\d+(\.\d+)?$/; # make sure it's an int/float
$conf->{gametype} = lc $conf->{gametype};
$conf->{modtype} = lc $conf->{modtype};
$conf->{uniqueid} = lc $conf->{uniqueid};
$conf->{uniqueid} = "worldid" if $conf->{uniqueid} =~ /(?:won|steam)id/; # specifies what key to track players on
$conf->{plrid} = $conf->{uniqueid} eq "name" ? "lcname" : $conf->{uniqueid}; # used for $players{} and $plr{} lookups (if 'name' is used then we always want to use 'lcname' instead
$conf->{use}{primaryplrname} = lc $conf->{use}{primaryplrname};
$conf->{use}{primaryplrname} = 'first' unless $conf->{use}{primaryplrname} =~ /^(?:most|first)$/;
$conf->{use}{primaryplrname} = 'first' if $conf->{uniqueid} eq 'name';
$conf->{use}{playerrankfield} = lc $conf->{use}{playerrankfield};
$conf->{use}{playerrankorder} = 'desc' unless $conf->{use}{playerrankorder} =~ /^(de|a)sc$/i;
# force certain config options into an ARRAY REF
foreach my $k (qw( logsource ignoremaps )) {
if (ref $conf->{$k} ne 'ARRAY') {
my $s = $conf->{$k};
$conf->{$k} = [ $s ];
}
}
# combine all 'logsource:xxx' entries into a single logsource array
foreach my $k (map { /^logsource:/ ? $_ : () } keys %$conf) {
push(@{$conf->{logsource}}, ref $conf->{$k} ? @{$conf->{$k}} : $conf->{$k});
}
# verify the primary [downloadlogs] section has valid options for all of its fields
$conf->{downloadlogs}{download} = 1 unless defined $conf->{downloadlogs}{download};
$conf->{downloadlogs}{host} = '' unless defined $conf->{downloadlogs}{host};
$conf->{downloadlogs}{port} = 21 unless defined $conf->{downloadlogs}{port};
$conf->{downloadlogs}{pasv} = 0 unless defined $conf->{downloadlogs}{pasv};
$conf->{downloadlogs}{user} = '' unless defined $conf->{downloadlogs}{user};
$conf->{downloadlogs}{pass} = '' unless defined $conf->{downloadlogs}{pass};
$conf->{downloadlogs}{binary} = 0 unless defined $conf->{downloadlogs}{binary};
$conf->{downloadlogs}{localpath} = '' unless defined $conf->{downloadlogs}{localpath};
$conf->{downloadlogs}{remotepath} = '' unless defined $conf->{downloadlogs}{remotepath};
$conf->{downloadlogs}{skiplast} = 1 unless defined $conf->{downloadlogs}{skiplast};
$conf->{downloadlogs}{delete} = 0 unless defined $conf->{downloadlogs}{delete};
# get a list of all extra download locations ... sorted in the order they appear in the config
$self->{_dlkeys} = [ sort { $conf->{$a}{IDX} <=> $conf->{$b}{IDX} } grep { /^downloadlogs:/ } keys %$conf ];
# Make sure all download log sections have proper values. First we
foreach my $dlkey (@{$self->{_dlkeys}}) {
foreach my $key (keys %{$conf->{downloadlogs}}) {
next if uc $key eq $key; # ignore internal keys (SECTION, IDX)
$conf->{$dlkey}{$key} = $conf->{downloadlogs}{$key} unless defined $conf->{$dlkey}{$key};
}
}
## Verify the host:port for all {downloadlog} sources
# for (my $i=0; $i < @{$dl->{host}}; $i++) {
# my $h = $dl->{host}->[$i];
# my ($host, $port) = split(/:/, $h, 2); # strip apart host:port
# $port = undef if !defined $port or $port !~ /^\d+$/; # validate port is present and a number
# }
# Verify that we have the same number of elements in all arrays of {downloadlogs}
# print Dumper($conf->{downloadlogs});
$util::LOGGING = $conf->{logerrors}; # enable/disable logging in util module
}
# --------------------------------------------------------------
# loads parameters into the conf (overriding original config options). Also adds a few extra variables for use.
sub loadparams {
my ($self, $params) = @_;
my $conf = $self->{conf};
$conf->{progpath} = $params->{progpath} || getprogpath();
$conf->{verbose} = (($params->{verbose} or $conf->{verbose}) and !$params->{quiet});
$conf->{logsource} = $params->{logsource} if defined $params->{logsource};
$conf->{output} = $params->{output} if defined $params->{output};
$conf->{gametype} = $params->{gametype} if defined $params->{gametype};
$conf->{modtype} = $params->{modtype} if defined $params->{modtype};
$conf->{language} = $params->{language} if defined $params->{language};
$conf->{skiplogs} = $params->{skiplogs} if defined $params->{skiplogs};
$conf->{skipawards} = $params->{skipawards} if defined $params->{skipawards};
$conf->{skipranks} = $params->{skipranks} if defined $params->{skipranks};
$conf->{scanmaxdays} = $params->{scanmaxdays} if defined $params->{scanmaxdays};
$conf->{cleanupplayers} = $params->{cleanupplayers} if defined $params->{cleanupplayers};
$conf->{checkclantags} = $params->{checkclantags} if defined $params->{checkclantags};
$conf->{clans}{delete} = $params->{deleteclans} if defined $params->{deleteclans};
$conf->{clans}{inactiveonly} = $params->{inactiveclans} if defined $params->{inactiveclans};
$conf->{clans}{compile} = $params->{compileclans} if defined $params->{compileclans};
$conf->{clans}{debug} = $params->{clandebug} if defined $params->{clandebug};
$conf->{logdeniedplayers} = $params->{logdeniedplayers} if defined $params->{logdeniedplayers};
$conf->{downloadonly} = $params->{downloadonly} if defined $params->{downloadonly};
$conf->{nodownload} = $params->{nodownload} if defined $params->{nodownload};
$conf->{use}{playerrules} = $params->{use}{playerrules} if defined $params->{use}{playerrules};
$conf->{use}{playerranks} = $params->{use}{playerranks} if defined $params->{use}{playerranks};
$conf->{use}{primaryplrname} = $params->{use}{primaryplrname} if defined $params->{use}{primaryplrname};
$conf->{awards}{force} = $params->{awards}{force} if defined $params->{awards}{force};
$conf->{awards}{delete} = $params->{awards}{delete} if defined $params->{awards}{delete};
$conf->{logstream}{enabled} = $params->{logstream}{enabled} if defined $params->{logstream}{enabled};
## set some various/useful variables...
$conf->{os} = $^O;
$conf->{os_slash} = ($^O ne 'MSWin32') ? '/' : '\\';
$conf->{os_eol} = ($^O ne 'MSWin32') ? "\012" : "\015\012"; # \n or \r\n -- s/$CR?$LF/\n/;
$conf->{CRLF} = $conf->{os_eol}; # just another way to reference it
$conf->{gamepath} = catfile($conf->{progpath}, "games", $conf->{gametype}, '');
$conf->{themepath} = catfile($conf->{progpath}, "themes", $conf->{theme}{source}, '');
$conf->{languagepath} = catfile($conf->{progpath}, "lang", $conf->{language}, '');
$conf->{version} = $VERSION; # current version of PsychoStats
}
# --------------------------------------------------------------
# returns a reference to the config hash that the STATS object is using
sub config {
return $_[0]->{conf};
}
# --------------------------------------------------------------
# returns a reference to the language hash that the STATS object is using
sub language {
return $_[0]->{lang};
}
# --------------------------------------------------------------
# creates a new 'Referee' object and returns its reference
sub newreferee {
my $self = shift;
my $args = (ref($_[0]) eq 'HASH') ? $_[0] : { @_ };
my $conf = $self->{conf};
my $file = catfile($conf->{gamepath} . "Referee") . ".pm";
my $obj = "PS::Referee";
if (-e $file) {
$obj = "games::" . lc($conf->{gametype}) . "::Referee";
} else {
$file = "PS/Referee.pm";
}
require $file;
return $obj->new($args);
}
# --------------------------------------------------------------
# creates a new 'Scanner' object and returns its reference
sub newscanner {
my $self = shift;
my $args = (ref($_[0]) eq 'HASH') ? $_[0] : { @_ };
my $conf = $self->{conf};
my $file = catfile($conf->{gamepath} . "Scanner") . ".pm";
if (!-e $file) {
logerror(sprintf($self->{lang}{err_scannernotfound},$conf->{gametype}), 1);
}
require $file;
my $obj = "games::" . lc($conf->{gametype}) . "::Scanner";
return $obj->new($args);
}
# --------------------------------------------------------------
# creates a new 'Saver' object and returns its reference
sub newsaver {
my $self = shift;
my $args = (ref($_[0]) eq 'HASH') ? $_[0] : { @_ };
my $conf = $self->{conf};
my $file = catfile($conf->{progpath}, "PS", "Saver", $conf->{savetype}) . ".pm";
if (!-e $file) {
logerror(sprintf($self->{lang}{err_savetypenotfound},$conf->{savetype}), 1);
}
require $file;
my $obj = "PS::Saver::" . lc $self->{conf}{savetype};
return $obj->new($args);
}
# --------------------------------------------------------------
sub displayhelp {
my $self = shift;
my $str = shift || "- error with 'help' language definition -\n";
$self->{conf}{verbose} = 1; # must override verbosity otherwise verbose() might not display anything
$self->{conf}{quiet} = 0; # ...
$self->{verbose}->print($self->{lang}{help} || $str);
exit(0);
}
# --------------------------------------------------------------
# this function is called when the user presses ^C. You have to press ^C a second time in order to exit immediately.
sub DOEXIT {
$DONE++;
local $SIG{INT} = 'DEFAULT';
if ($DONE > 1) {
logerror("Stats update has been terminated by user.");
exit;
}
print STDERR "\n\n*** ^C pressed. Waiting for current log to be processed.\n";
print STDERR "*** Press ^C again to exit immediately (some dataloss may occur).\n\n";
}
# --------------------------------------------------------------
1;
See more files for this project here