Show Referee.pm syntax highlighted
# REFEREE keeps track of the in-memory: active game, players, teams, game/rounds, maps, etc...
#
package PS::Referee;
use base qw( PS::Base );
use strict;
use Carp;
use util;
use Data::Dumper;
our $AUTOLOAD;
our %validvars;
# valid accessor field/methods used in AUTOLOAD
# ++$validvars{$_} foreach (qw());
sub init {
my ($self, $args) = @_;
$self->SUPER::init($args);
print "DEBUG >> Initializing PS::Referee ...\n" if $self->DEBUG;
$self->{gamestarted} = 0; # when did the last game start
$self->{roundstarted} = 0; # when did the last round start
$self->{players} = {}; # hash of online players (saved per day)
$self->{maps} = {}; # hash of stats for current map (saved per day)
$self->{weapons} = {}; # hash of stats for weapons (saved per day)
$self->{map} = $self->{ps}{conf}{defaultmap}; # current map being played
$self->{plrid} = $self->{ps}{conf}{plrid};
return $self;
}
# -----------------------------------------------------------------------------------------------------------------------------
# in halflife, a player 'connecting' does not actually mean they've connected successfully to the server. But it does give us
# an opportunity to record the players IP address for future use.... However we no longer record IP's via the Referee.
# That's entirely up to the Scanner object now.
sub plrconnected {
my ($self, $plr) = @_;
}
# -----------------------------------------------------------------------------------------------------------------------------
# player disconnected and is no longer part of the game. Note: since halflife doesn't always record a player 'disconnect' in
# the game logs the lookup tables used for IP addresses will always grow in size. But since the tables are very small they
# shouldn't consume all that much memory, Even with months and months of logs.
sub plrdisconnected {
my $self = shift;
my ($plr) = @_;
my $plrid = $plr->{ $self->{plrid} };
my $scanner = $self->{ps}{scanner};
my $p = (exists $self->{players}{$plrid}) ? $self->{players}{$plrid} : undef;
my ($secs, $lasttime);
# print "DISCONNECT: $scanner->{last_log} $scanner->{last_log_line}: $p->{name}\n"; # DEBUG
return unless defined $p and $p->{isconnected};
$p->{isconnected} = 0; # plr is now offline
$lasttime = $p->{lasttime};
$p->{lasttime} = $self->{timestamp};
# add players online time to his total
$secs = $p->{lasttime} - $p->{firsttime};
# if ($secs > 0 && $secs < 60 * 10) {
if ($secs > 0) {
$p->{onlinetime} += $secs; # total online time for player
$p->{maps}{ $self->{map} }{onlinetime} += $secs; # ... on the map
}
# onlinetime debugging/testing
# print "ONLINE: " . compacttime($secs) . " $p->{name}\n";
$p->{maps}{ $self->{map} }{lasttime} = $self->{timestamp}; # the last time the map was played on
$p->{firsttime} = 0;
# echo("<<< '$plrid' disconnected (" . compacttime($secs) . ")\n", $self->{timestamp});
return $p;
}
# -----------------------------------------------------------------------------------------------------------------------------
# player entered the game, which means they are now actually connected to the server and should be considered as ONLINE
sub plrentered {
my ($self, $plr) = @_;
my $saver = $self->{ps}{saver};
my $scanner = $self->{ps}{scanner};
my $players = $self->{players};
my $plrid = $plr->{ $self->{plrid} };
my $p;
$players->{$plrid} = $plr unless exists $players->{$plrid};
$p = $players->{$plrid}; # faster access for the rest of the routines below
$p->{id} = $saver->get_plrid($plr, 1); # always get the plr ID, so usage total is recorded
# disconnect the player first ... since 'entering' the is technically the first thing you can do in a log
$self->plrdisconnected($p) if $p->{isconnected};
if (!$p->{isconnected}) {
$p->{isconnected} = 1;
$p->{firsttime} = $self->{timestamp};
$p->{lasttime} = $self->{timestamp};
if (not defined $p->{skill}) { # load previously known value for this players 'skill'
my $skill = $saver->load_plr_var_decay($p->{id}, 'skill', $self->{timestamp});
$p->{skill} = (defined $skill) ? $skill : $self->{ps}{conf}{baseskill};
}
}
# DEBUG
# if ($p->{name} eq '^slapsvans^') {
# print "\nENTERED: $scanner->{last_log} $scanner->{last_log_line}: $p->{name} ";
# print compacttime($self->{timestamp} - $p->{lasttime}), " $p->{name}";
# print " from: " . (caller(1))[3] . " ...\n" . (caller(2))[3];
# print "\n";
# }
# echo("$plrid entered the game\n", $self->{timestamp});
return $p;
}
# -----------------------------------------------------------------------------------------------------------------------------
# Return the total number of players connected. If $force_all is true then a count of ALL known players (in memory) is returned.
sub connectedcount {
my $self = shift;
my ($force_all) = @_;
my $plrs = $self->{players};
my $total = 0;
return scalar keys %$plrs if $force_all;
foreach (keys %$plrs) {
$total++ if $plrs->{$_}{isconnected};
}
return $total;
}
# -----------------------------------------------------------------------------------------------------------------------------
# cleans up the players hash by removing players who have an old 'lasttime' value
# be sure to SAVE player information before calling this function, as this function does not keep track of any stats
sub cleanupplrs {
my $self = shift;
my $age = shift || (60 * 10); # how old a player 'lasttime' can be (10 minutes by default)
my $now = $self->{timestamp};
my $total = 0; # how many players were removed from the hash
my $plrhash = $self->{players};
my @plrs = (keys %$plrhash); # since we'll be deleting plrs from the hash we need a 2nd array of keys
foreach (@plrs) {
# print "$plrhash->{$_}{lasttime} + $age > $now\n";
if (not defined $plrhash->{$_}{lasttime} or ($plrhash->{$_}{lasttime} + $age < $now)) {
delete $plrhash->{$_};
$total++;
}
}
return $total;
}
# -----------------------------------------------------------------------------------------------------------------------------
# Returns an array of player references that match the $team specified. If 'allplrs' is undefined/false then only online plrs
# are returned, otherwise ALL players in memory are returned (which is often slightly more then the real 'online' players
sub get_team {
my ($self, $team, $allplrs, $aliveonly) = @_;
my $players = $self->{players};
my $plrs = [];
$aliveonly ||= 0;
foreach (keys %$players) {
my $p = $players->{$_};
next if $p->{team} ne $team;
next if !$allplrs and !$p->{isconnected};
next if $aliveonly and $p->{dead};
push(@$plrs, $p);
}
# print "$team = " . scalar(@$plrs) . "\n";
return wantarray ? @$plrs : $plrs;
}
# -----------------------------------------------------------------------------------------------------------------------------
# Returns an array of player references that are online (if $online is true [Default]), or offline (if $online is false)
# if $aliveonly is true then only those players that are not dead (alive) are returned
sub fetch_plrlist {
my ($self, $onlineonly, $aliveonly) = @_;
my $players = $self->{players};
my $plrs = [];
$onlineonly = 1 unless defined $onlineonly;
$aliveonly ||= 0;
foreach (keys %$players) {
my $p = $players->{$_};
next if $onlineonly and !$p->{isconnected};
next if $aliveonly and $p->{dead};
push(@$plrs, $p);
}
return wantarray ? @$plrs : $plrs;
}
# -----------------------------------------------------------------------------------------------------------------------------
# How many players are on a certain team.
sub team_count {
my ($self, $team, $allplrs) = @_;
my $players = $self->{players};
my $total = 0;
$team = lc $team;
foreach (keys %$players) {
$total++ if (($allplrs or $players->{$_}{isconnected}) and $players->{$_}{team} eq $team);
}
return $total;
}
# -----------------------------------------------------------------------------------------------------------------------------
# When a map ends the Referee has to do some cleanup work. Like marking all players offline (since halflife sucks at keeping track)
sub mapend {
my ($self, $timestamp) = @_;
my $plrs = $self->{players};
$self->fetch_mapref( $self->{map} )->{lasttime} = $timestamp if $timestamp;
foreach (keys %$plrs) {
$self->plrdisconnected($plrs->{$_});
}
}
# -----------------------------------------------------------------------------------------------------------------------------
sub fetch_mapref {
my ($self, $map) = @_;
my $maps = $self->{maps};
$maps->{$map} = { name => $map } unless exists $maps->{$map};
return $maps->{$map};
}
# -----------------------------------------------------------------------------------------------------------------------------
sub fetch_weaponref {
my ($self, $weapon) = @_;
my $weapons = $self->{weapons};
$weapons->{$weapon} = { name => $weapon } unless exists $weapons->{$weapon};
return $weapons->{$weapon};
}
# -----------------------------------------------------------------------------------------------------------------------------
# Returns a reference to the player in the players hash. If the player doesn't exist they are automatically created
# and marked as 'online'
sub fetch_plrref {
my ($self, $plr) = @_;
my $players = $self->{players};
my $plrid = $plr->{ $self->{plrid} };
return (exists $players->{$plrid}) ? $players->{$plrid} : $self->plrentered($plr);
}
# -----------------------------------------------------------------------------------------------------------------------------
# sets or gets a player attribute/variable.
sub plrvar {
my $self = shift;
my ($id,$key,$val) = @_;
my $old = $self->{players}{$id}{$key} || '';
if (defined $val) { # SET a variable on a player
$self->{players}{$id}{$key} = $val;
}
return $old; # GET the OLD value (or current if a $val wasn't specified)
}
# -----------------------------------------------------------------------------------------------------------------------------
# Register a var to be used by the Referee for score keeping purposes (like register a var that keeps track of the last person
# that 'planted' the bomb). Registered variables are initialy set to zero (0)
# A list of variables can be given to register a bunch at one time
sub registervar {
my $self = shift;
while (my $var = shift) {
$validvars{$var}++; # register the var
eval "\$self->$var(0)"; # set var to 0
logerror(sprintf($self->{ps}{lang}{err_badregvar},$@), 1) if $@;
}
}
# -----------------------------------------------------------------------------------------------------------------------------
sub map {
return ($_[1]) ? $_[0]->{map} = lc $_[1] : $_[0]->{map} || $_[0]->{ps}{conf}{defaultmap}; # always lc() the mapname
}
# -----------------------------------------------------------------------------------------------------------------------------
sub timestamp {
return ($_[1]) ? $_[0]->{timestamp} = $_[1] : $_[0]->{timestamp};
}
# -----------------------------------------------------------------------------------------------------------------------------
sub gamestarted {
return ($_[1]) ? $_[0]->{gamestarted} = $_[1] : $_[0]->{gamestarted};
}
# -----------------------------------------------------------------------------------------------------------------------------
sub lastteamwin {
return ($_[1]) ? $_[0]->{lastteamwin} = lc $_[1] : $_[0]->{lastteamwin}; # always lc() the team name
}
# -----------------------------------------------------------------------------------------------------------------------------
sub roundstarted {
return ($_[1]) ? $_[0]->{roundstarted} = $_[1] : $_[0]->{roundstarted};
}
# -----------------------------------------------------------------------------------------------------------------------------
# Destructor method.
sub DESTROY {
my $self = shift;
# carp "Destroying " . $self->{classname} if $self->DEBUG;
}
# -----------------------------------------------------------------------------------------------------------------------------
# Handles accessor and 'one-liner' get/set method calls automatically
sub AUTOLOAD {
my $self = shift;
my $var = $AUTOLOAD;
$var =~ s/.*:://;
return if $var eq 'DESTROY';
if ($validvars{$var}) { # set or return the variable.
my $old = (defined $self->{$var}) ? $self->{$var} : undef; # get current value
$self->{$var} = shift if @_; # set new value
return $old; # return previous/current value
} else {
# my $super = "SUPER::$var";
# $self->$super(@_);
croak("FATAL: Referee method '$var' does not exist");
}
}
# -----------------------------------------------------------------------------------------------------------------------------
return 1;
__END__
%player = (
id => 0,
lcname => 'all lowercase name',
name => 'Normal NAME preserved',
ipaddr => '1.2.3.4:12345',
wonid => '123456789',
team => 'terrorist',
role => 'rifleman',
joinedtime => when player joined the game
lasttime => last time an event was seen for the player
connected => 0 or 1; if player is known to be connected/online
)
See more files for this project here