XShrub.pm


package XSTAB::RTCW::XShrub;
# RTCW ShrubMod game module
#
# $Id: XShrub.pm,v 1.18 2003/03/21 20:34:07 dranok Exp $
#
# This module is released under the GPL
# Author: DranoK
# Email: dranok@users.sourceforge.net
# Documentation: http://xstab.sourceforge.net
################################################

require XSTAB::RTCW::XCore;
use XSTAB::XData;
use XSTAB::RTCW::XShrubCommands;
use strict;

my $VERSION = 0.9;
our @ISA = qw(XSTAB::RTCW::XCore);

# Game hash
my %Game;
$Game{warmup} = 1;

# Class translation
my %TranslateClass;
$TranslateClass{0} = "sold";
$TranslateClass{1} = "med";
$TranslateClass{2} = "eng";
$TranslateClass{3} = "leut";

# These are events found in the RTCW log file
# Most log entries are simply ignored, but those
# which are important are designated in this hash,
# as well as a regex to pull the appropriate data
my %event;
# The following are from base RTCW
$event{Kill} = "([0-9]+) ([0-9]+) [0-9]+: .* by (.*)";
# killer, victim, mod
$event{ClientDisconnect} = "([0-9]+)";
# client
$event{InitGame} = "(.*)";
# irrelevant
$event{score} = "([0-9]+) +ping: ([0-9]+) +client: ([0-9]+) (.*)";
# score, ping, client, name
$event{ExitLevel} = "(.*)";
# data
# End of base RTCW commands

# The following are from ShrubMod 3.0
$event{Start} = "of ([a-z]+).";
# warmup/round
$event{Revive} = "([0-9]+) ([0-9]+): .*";
# angel corpse
$event{Gib} = "([0-9]+) ([0-9]+): .*";
# killer, victim
$event{uChange} = "[^ ]+: [0-9\.]+:[0-9]+: ([0-9]+): (.*): ([123]): [0-9]\$";
# client, name, team
$event{ENDROUND} = "([0-9]+): .*: ([0-9]+) [0-9]+ [0-9]+ [0-9]+ [0-9]+ [0-9]+ ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+)";
# client, class,  health_given, ammo_given, shots_fired, shots_landed, headshots_landed
$event{cmd} = "([0-9]+): [^:]+: .*: !(.*)";
# client, command
$event{uConnect} = "[^:]+: ([0-9]+): .*";
# client
# End of Shrub commands

# NAME: create
# FUNCTION: constructor
# ARGUMENTS: None explicit; class implicit
# RETURNS: The blessed object
# NOTES: Simple constructor
sub create
{
  my $class = shift;

  my $self = { };
  $self->{command} = XSTAB::RTCW::XShrubCommands->create;
  
  bless($self, $class);
  return $self;
}

# NAME: sensor_command
# FUNCTION: Tells the sensor what command to send
# ARGUMENTS: self object implicit, ID explicit
# RETURNS: Nothing
# NOTES: Part of required API.  Please refer to
#   documentation.
sub sensor_command
{
  my $self = shift;
  my $id = shift;

  if ($id eq 'XUdp') {
    return "plist$Global{sp}pb_sv_plist";
  } elsif ($id eq 'XTail') {
    return;
  } elsif ($id < 0) {
    do_log("Sensor data error", 3);
  } else {
    do_log("Input from ID $id not recognized.", 3);
  }
}

# NAME: do_log
# FUNCTION: Overloads default do_log
# ARGUMENTS: string text, int priority
# RETURNS: Nothing
# NOTES: See documentation for notes concerning
#   the need to overload do_log
sub do_log
{
  my $string = shift;
  my $prio = shift;
  XSTAB::XData::do_log("RTCW::XShrub: $string", $prio);
}

# NAME: process_data
# FUNCTION: Processes data returned by sensors
# ARGUMENTS: self implicit, string rawdata explicit
# RETURNS: -1 on sensor error, nothing on success
# NOTES: Part of required API.  Please refer to
#   documentation.
sub process_data
{
  my $self = shift;
  my $rawdata = shift;
  
  if ($rawdata < 0) {
    do_log("Sensor Error", 3);
    return -1;
  } elsif (!$rawdata) {
    return;
  }

  my @data = split($Global{sp2}, $rawdata);
  my $status;
  my $pbplist;
  my $tail;
  
  foreach my $line (@data) {
    my ($id, $dataline) = split($Global{sp}, $line);
    if ($id eq 'plist') {
      $status .= $dataline;
    } elsif ($id eq 'pb_sv_plist') {
      $pbplist .= $dataline;
    } elsif ($id eq 'tail') {
      $tail .= $dataline;
    } else {
      do_log("Unknown ID: $id", 2);
    }
  }
  
  my @tailar = split('\n', $tail);
  foreach my $tail_elem (@tailar) {
    if ($tail_elem =~ /^ *([0-9]+:[0-9]+) *([a-zA-Z]+)[: ] *(.*)/) {
      my $timestamp = $1;
      my $eventtype = $2;
      my $misc = $3;
      if(defined($event{$eventtype})) {
        my @tokens = ( $misc =~ /$event{$eventtype}/ );
        $self->parse_event($eventtype, @tokens);
      } else {
        do_log("UNMATCHED: $tail_elem", 5);
      }
    } else {
      do_log("UNMATCHED: $tail_elem", 5);
    }
  }

  my @statusar = split('\n', $status);
  foreach my $status_elem (@statusar) {
    if ($status_elem =~ /info: ([0-9]+)\\([^\\]+)\\([0-9:\.]+)\\([A-Z0-9]+)\\([0-9])\\([0-9])/)
    { # It's a valid plist line
      my $client = $1;
      $Players{$client}{rawname} = $2;
      ($Players{$client}{ip}, $Players{$client}{port}) = split(':', $3);
      $Players{$client}{team} = $6;
      $Players{$client}{name} = $self->stripstring($Players{$client}{rawname});
      do_log("MATCHED: $status_elem", 5);
    } elsif ($status_elem =~ /^map: ([^ ]+)/) {
      $Global{map} = $1;
    } else {
      do_log("UNMATCHED: $status_elem", 5);
    }
  }         

  my @pbplistar = split('\n', $pbplist);
  foreach my $pb_elem (@pbplistar) {
    if ($pb_elem =~ /PunkBuster Server: +([0-9]+) +([a-z0-9]+)[^ ]+ +([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+):([0-9\-]+) +[a-zA-Z]+ +[0-9]+ +[0-9\.]+ +[0-9]+ +\((.)\) +(.*) */)
    { # It's a valid pb_sv_plist
      my $pbid = $1;
      my $client = $pbid - 1;
      $Players{$client}{pbid} = $1;
      $Players{$client}{guid} = $2;
      $Players{$client}{os} = $5;
      if (!$Players{$client}{has_loaded}) {
        $self->check_load($client);
        # Add extra TK points for shrubmod and do tagline
        if ($Players{$client}{has_loaded}) { 
          $Players{$client}{tkscore} += 2; 
          $self->do_announce($client);
        }
      }
      do_log("MATCHED: $pb_elem", 5);
#      my $ip = $3;
#      my $port = $4;
#      my $name = $6;
    } else {
      do_log("UNMATCHED: $pb_elem", 5);
    }
  }
}

sub do_announce
{
  my $self = shift;
  my $client = shift;

  if ($Players{$client}{tagline}) {
    $self->do_say("$Players{$client}{rawname}^7: $Players{$client}{tagline}");
  }
}

# NAME: parse_event
# FUNCTION: Parses events from the RTCW log file
# ARGUMENTS: string event, array tokens
# RETURNS: Nothing
# NOTES: @tokens contain all the matches from the
#   regex ran before parse_event was called
sub parse_event
{
  my $self = shift;
  my $eventtype = shift;
  my @tokens = @_;

  if ($eventtype eq 'Kill' && !$Game{warmup}) {
    if ($Players{$tokens[0]}{has_loaded} && $Players{$tokens[1]}{has_loaded}) {
      if ($Players{$tokens[0]}{team} == $Players{$tokens[1]}{team}) {
        if ($tokens[0] eq $tokens[1]) {
          $Players{$tokens[0]}{suicides}++;
          $Players{$tokens[0]}{mod_suicides}{$tokens[2]}++;
        } else {
          $Players{$tokens[0]}{tks}++;
          $Players{$tokens[0]}{tkscore} -= 3;
          $Players{$tokens[0]}{r_lasttkd} = $Players{$tokens[1]}{guid};
          $Players{$tokens[1]}{tkdeaths}++;
          $self->check_kick($tokens[0]);
        }
      } else {
        $Players{$tokens[0]}{kills}++;
        $Players{$tokens[0]}{r_kills}++;
        $Players{$tokens[0]}{mod_kills}{$tokens[2]}++;
        $Players{$tokens[1]}{deaths}++;
        $Players{$tokens[1]}{r_deaths}++;
        $Players{$tokens[1]}{mod_deaths}{$tokens[2]}++;
        if (time - $Players{$tokens[1]}{r_revivetimer} <= 2) {
          $Players{$tokens[1]}{sacrifices}++;
          delete $Players{$tokens[1]}{r_revivetimer};
        } 
      }
    } else {
      do_log("Kill event, one participant not loaded.", 4);
    }
  } elsif ($eventtype eq 'ClientDisconnect') {
    if ($Players{$tokens[0]}{has_loaded}) {
      $Players{$tokens[0]}{last_played} = time;
      $main::storage->save_player_hash($tokens[0]);
    }
    $self->remove_player($tokens[0]);
  } elsif ($eventtype eq 'InitGame') {
    # At the present moment, I see no need to do nothing here.
    # You would want to determine if the new round is real or
    # a warmup here were you to decide to turn warmup damage on 
  } elsif ($eventtype eq 'score') {
    $Players{$tokens[2]}{game_score} = $tokens[0];
    $Players{$tokens[2]}{total_ping} += $tokens[1];
    $Players{$tokens[2]}{ping_size}++;
  } elsif ($eventtype eq 'ExitLevel') {
    foreach my $client (keys %Players) {
      if ($Players{$client}{has_loaded}) {
        $Players{$client}{rounds}++;
        $Players{$client}{last_played} = time;
        $main::storage->save_player_hash($client);
      } else {
        do_log("I will not save unloaded player $client: $Players{$client}{name}", 4);
      }
      $self->reset_rstats($client);
    }
  } elsif ($eventtype eq 'uConnect') {
    $self->remove_player($tokens[0]);
  } elsif ($eventtype eq 'uChange') {
    $Players{$tokens[0]}{rawname} = $tokens[1];
    $Players{$tokens[0]}{team} = $tokens[2];
    $Players{$tokens[0]}{name} = $self->stripstring($Players{$tokens[0]}{rawname});
  } elsif ($eventtype eq 'Revive' && !$Game{warmup}) {
    if ($Players{$tokens[0]}{r_lasttkd} eq $Players{$tokens[1]}{guid}) {
      $Players{$tokens[0]}{tkscore} += 4;
      $Players{$tokens[0]}{tkrevives}++;
      $Players{$tokens[0]}{tks}--;
      delete $Players{$tokens[0]}{r_lasttkd};
      $Players{$tokens[1]}{tkdeaths}--;
      $Players{$tokens[1]}{tkrevived}++;
    } else {
      $Players{$tokens[0]}{tkscore}++;
      $Players{$tokens[0]}{revives}++;
      $Players{$tokens[0]}{r_revivetimer} = time;
      $Players{$tokens[0]}{r_revives}++;
      $Players{$tokens[1]}{revived}++;
    }
  } elsif ($eventtype eq 'Gib' && !$Game{warmup}) {
    if ($Players{$tokens[0]}{team} == $Players{$tokens[1]}{team}) {
      if ($tokens[0] == $tokens[1]) {
        $Players{$tokens[0]}{suigibs}++;
      } else {
        $Players{$tokens[0]}{tgibs}++;
        $Players{$tokens[0]}{tkscore} -= 3;
        $Players{$tokens[1]}{tgibbed}++;
        $self->check_kick($tokens[0]);
      }
    } else {
      $Players{$tokens[0]}{gibs}++;
      $Players{$tokens[0]}{r_gibs}++;
      $Players{$tokens[1]}{gibbed}++;
    }
  } elsif ($eventtype eq 'ENDROUND') {
    my $class = $TranslateClass{$tokens[1]};
    $Players{$tokens[0]}{$class}++;
    $Players{$tokens[0]}{health_given} += $tokens[2];
    $Players{$tokens[0]}{r_health_given} = $tokens[2];
    $Players{$tokens[0]}{ammo_given} += $tokens[3];
    $Players{$tokens[0]}{r_ammo_given} = $tokens[3];
    $Players{$tokens[0]}{shots_fired} += $tokens[4];
    $Players{$tokens[0]}{shots_landed} += $tokens[5];
    $Players{$tokens[0]}{headshots_landed} += $tokens[6];
  } elsif ($eventtype eq 'cmd') {
    do_log("$Players{$tokens[0]}{name} said '$tokens[1]'", 5);
    $self->{command}->parse_command($tokens[0], $tokens[1]);
  } elsif ($eventtype eq 'Start') {
    if ($tokens[0] eq 'warmup') {
      $Game{warmup} = 1;
      do_log("Start of warmup", 3);
    } elsif ($tokens[0] eq 'round') {
      $Game{warmup} = 0;
      do_log("Start of real round", 3);
    } else {
      $Game{warmup} = 1; # Just to be safe
      do_log("Unmatched start event: $tokens[0]", 1);
    }
  } else {
    if (!$Game{warmup}) {
      do_log("Unmatched event: $eventtype", 3);
    } else {
      do_log("Ignored event due to warmup: $eventtype", 4);
    }
  }
}

1;