[nexuiz-commits] r7249 - in branches/nexuiz-2.0: . misc/tools server/rcon2irc
DONOTREPLY at icculus.org
DONOTREPLY at icculus.org
Tue Jul 21 03:01:47 EDT 2009
Author: div0
Date: 2009-07-21 03:01:45 -0400 (Tue, 21 Jul 2009)
New Revision: 7249
Added:
branches/nexuiz-2.0/misc/tools/WeaponEncounterProfile.pm
branches/nexuiz-2.0/misc/tools/weapon-profiler-analyzer.pl
branches/nexuiz-2.0/misc/tools/weapon-profiler.pl
branches/nexuiz-2.0/server/rcon2irc/joinsparts.pl
branches/nexuiz-2.0/server/rcon2irc/ping-pl.pl
branches/nexuiz-2.0/server/rcon2irc/suggestmap.pl
Modified:
branches/nexuiz-2.0/.patchsets
Log:
fix some svn messups
Modified: branches/nexuiz-2.0/.patchsets
===================================================================
--- branches/nexuiz-2.0/.patchsets 2009-07-21 06:58:26 UTC (rev 7248)
+++ branches/nexuiz-2.0/.patchsets 2009-07-21 07:01:45 UTC (rev 7249)
@@ -1,2 +1,2 @@
master = svn://svn.icculus.org/nexuiz/trunk
-revisions_applied = 1-7245
+revisions_applied = 1-7247
Added: branches/nexuiz-2.0/misc/tools/WeaponEncounterProfile.pm
===================================================================
--- branches/nexuiz-2.0/misc/tools/WeaponEncounterProfile.pm (rev 0)
+++ branches/nexuiz-2.0/misc/tools/WeaponEncounterProfile.pm 2009-07-21 07:01:45 UTC (rev 7249)
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+
+package WeaponEncounterProfile;
+use strict;
+use warnings;
+
+sub new
+{
+ my ($cls, $filename) = @_;
+ my $self = bless { fn => $filename }, 'WeaponEncounterProfile';
+ $self->load();
+ return $self;
+}
+
+sub load($)
+{
+ my ($self) = @_;
+ $self->{stats} = {};
+ $self->{mapstats} = {};
+ $self->{addrstats} = {};
+ $self->{allstats} = {};
+ open my $fh, "<", $self->{fn}
+ or return;
+ while(<$fh>)
+ {
+ chomp;
+ my ($addr, $map, $attackerweapon, $targweapon, $value) = split /\t/, $_;
+ $targweapon = int $self->weaponid_from_name($targweapon)
+ if $targweapon ne int $targweapon;
+ $attackerweapon = int $self->weaponid_from_name($attackerweapon)
+ if $attackerweapon ne int $attackerweapon;
+ $self->{stats}->{$addr}{$map}{$attackerweapon}{$targweapon} += $value;
+ $self->{mapstats}->{$map}{$attackerweapon}{$targweapon} += $value;
+ $self->{addrstats}->{$addr}{$attackerweapon}{$targweapon} += $value;
+ $self->{allstats}->{$attackerweapon}{$targweapon} += $value;
+ }
+}
+
+sub save($)
+{
+ my ($self) = @_;
+ open my $fh, ">", $self->{fn}
+ or die "save: $!";
+ while(my ($addr, $addrhash) = each %{$self->{stats}})
+ {
+ while(my ($map, $maphash) = each %$addrhash)
+ {
+ while(my ($attackerweapon, $attackerweaponhash) = each %$maphash)
+ {
+ while(my ($targweapon, $value) = each %$attackerweaponhash)
+ {
+ print $fh "$addr\t$map\t$attackerweapon\t$targweapon\t$value\n";
+ }
+ }
+ }
+ }
+}
+
+sub event($$$$$$)
+{
+ my ($self, $addr, $map, $attackerweapon, $targweapon, $type) = @_;
+ return if $map eq '';
+ if($type > 0)
+ {
+ $self->{stats}->{$addr}{$map}{$attackerweapon}{$targweapon} += $type;
+ $self->{mapstats}->{$map}{$attackerweapon}{$targweapon} += $type;
+ $self->{addrstats}->{$addr}{$attackerweapon}{$targweapon} += $type;
+ $self->{allstats}->{$attackerweapon}{$targweapon} += $type;
+ }
+}
+
+sub allstats($$)
+{
+ my ($self, $callback) = @_;
+ # send global stats
+ $callback->(undef, undef, $self->{allstats});
+ # send per-host stats
+ while(my ($k, $v) = each %{$self->{addrstats}})
+ {
+ $callback->($k, undef, $v);
+ }
+ # send per-map stats
+ while(my ($k, $v) = each %{$self->{mapstats}})
+ {
+ $callback->(undef, $k, $v);
+ }
+ # send single stats
+ while(my ($k1, $v1) = each %{$self->{stats}})
+ {
+ while(my ($k2, $v2) = each %$v1)
+ {
+ $callback->($k1, $k2, $v2);
+ }
+ }
+}
+
+our %WeaponMap = (
+ 1 => ["Laser", "laser"],
+ 2 => ["Shotgun", "shotgun"],
+ 3 => ["Uzi", "uzi"],
+ 4 => ["Mortar", "gl"],
+ 5 => ["Electro", "electro"],
+ 6 => ["Crylink", "crylink"],
+ 7 => ["Nex", "nex"],
+ 8 => ["Hagar", "hagar"],
+ 9 => ["Rocket Launcher", "rl"],
+ 10 => ["Port-O-Launch", "porto"],
+ 11 => ["MinstaNex", "minstanex"],
+ 12 => ["Grappling Hook", "hookgun"],
+ 13 => ["Heavy Laser Assault Cannon", "hlac"],
+ 14 => ["T.A.G. Seeker", "seeker"],
+ 15 => ["Camping Rifle", "campingrifle"],
+);
+
+sub weaponid_valid($$)
+{
+ my ($self, $id) = @_;
+ return exists $WeaponMap{$id};
+}
+
+sub weaponid_to_name($$)
+{
+ my ($self, $id) = @_;
+ return $WeaponMap{$id}[0];
+}
+
+sub weaponid_to_model($$)
+{
+ my ($self, $id) = @_;
+ return $WeaponMap{$id}[1];
+}
+
+sub weaponid_from_name($$)
+{
+ my ($self, $name) = @_;
+ for(keys %WeaponMap)
+ {
+ return $_
+ if $WeaponMap{$_}[0] eq $name;
+ }
+}
+
+1;
Added: branches/nexuiz-2.0/misc/tools/weapon-profiler-analyzer.pl
===================================================================
--- branches/nexuiz-2.0/misc/tools/weapon-profiler-analyzer.pl (rev 0)
+++ branches/nexuiz-2.0/misc/tools/weapon-profiler-analyzer.pl 2009-07-21 07:01:45 UTC (rev 7249)
@@ -0,0 +1,321 @@
+#!/usr/bin/perl
+
+# no warranty for this script
+# and no documentation
+# take it or leave it
+
+use strict;
+use warnings;
+use FindBin; use lib $FindBin::Bin;
+use WeaponEncounterProfile;
+
+my ($statsfile) = @ARGV;
+my $stats;
+
+sub LoadData()
+{
+ $stats = WeaponEncounterProfile->new($statsfile);
+}
+
+sub LinSolve($$)
+{
+ my ($m, $v) = @_;
+ my $n = @$m;
+
+ my @out = ();
+
+ my @bigmatrix = map { [ @{$m->[$_]}, $v->[$_] ] } 0..$n-1;
+
+ # 1. Triangulate
+ for my $i(0..$n-1)
+ {
+ # first: bring the highest value to the top
+ my $best = -1;
+ my $bestval = 0;
+ for my $j($i..$n-1)
+ {
+ my $v = $bigmatrix[$j]->[$i];
+ if($v*$v > $bestval*$bestval)
+ {
+ $best = $j;
+ $bestval = $v;
+ }
+ }
+ die "lindep" if $best == -1;
+
+ # swap
+ ($bigmatrix[$i], $bigmatrix[$best]) = ($bigmatrix[$best], $bigmatrix[$i]);
+
+ # then: eliminate
+ for my $j($i+1..$n-1)
+ {
+ my $r = $bigmatrix[$j]->[$i];
+ for my $k(0..$n)
+ {
+ $bigmatrix[$j]->[$k] -= $bigmatrix[$i]->[$k] * $r / $bestval;
+ }
+ }
+ }
+
+ # 2. Diagonalize
+ for my $i(reverse 0..$n-1)
+ {
+ my $bestval = $bigmatrix[$i]->[$i];
+ for my $j(0..$i-1)
+ {
+ my $r = $bigmatrix[$j]->[$i];
+ for my $k(0..$n)
+ {
+ $bigmatrix[$j]->[$k] -= $bigmatrix[$i]->[$k] * $r / $bestval;
+ }
+ }
+ }
+
+ # 3. Read off solutions
+ return map { $bigmatrix[$_]->[$n] / $bigmatrix[$_]->[$_] } 0..($n-1);
+}
+
+sub SolveBestSquares($$)
+{
+ my ($d, $w) = @_;
+
+ my $n = @$d;
+
+ if($ENV{stupid})
+ {
+ my @result = ();
+ for my $i(0..$n-1)
+ {
+ my $num = 0;
+ my $denom = 0;
+ for my $j(0..$n-1)
+ {
+ my $weight = $w->[$i]->[$j];
+ $num += $weight * $d->[$i]->[$j];
+ $denom += $weight;
+ }
+ push @result, $num / $denom;
+ }
+ return @result;
+ }
+
+ # build linear equation system
+
+ my @matrix = map { [ map { 0 } 1..$n ] } 1..$n;
+ my @vector = map { 0 } 1..$n;
+
+ for my $i(0..$n-1)
+ {
+ $matrix[0][$i] += 1;
+ }
+ $vector[0] += 0;
+ for my $z(1..$n-1)
+ {
+ for my $i(0..$n-1)
+ {
+ $matrix[$z][$i] += $w->[$i]->[$z];
+ $matrix[$z][$z] -= $w->[$i]->[$z];
+ $vector[$z] += $w->[$i]->[$z] * $d->[$i]->[$z];
+ }
+ }
+
+ return LinSolve(\@matrix, \@vector);
+}
+
+sub Evaluate($)
+{
+ my ($matrix) = @_;
+ my %allweps;
+ while(my ($k, $v) = each %$matrix)
+ {
+ for(my ($k2, $v2) = each %$v)
+ {
+ next if $k eq $k2;
+ next if !$v2;
+ ++$allweps{$k};
+ ++$allweps{$k2};
+ }
+ }
+ my @allweps = keys %allweps;
+ my %values;
+
+ my @dmatrix = map { [ map { 0 } @allweps ] } @allweps;
+ my @wmatrix = map { [ map { 0 } @allweps ] } @allweps;
+
+ for my $i(0.. at allweps - 1)
+ {
+ my $attackweapon = $allweps[$i];
+ my $v = 0;
+ my $d = 0;
+ for my $j(0.. at allweps - 1)
+ {
+ my $defendweapon = $allweps[$j];
+ next if $attackweapon eq $defendweapon;
+ my $win = ($matrix->{$attackweapon}{$defendweapon} || 0);
+ my $lose = ($matrix->{$defendweapon}{$attackweapon} || 0);
+ my $c = ($win + $lose);
+ next if $c == 0;
+ my $p = $win / $c;
+ my $w = 1 - 1/($c * 0.1 + 1);
+
+ $dmatrix[$i][$j] = $p - (1 - $p); # antisymmetric
+ $wmatrix[$i][$j] = $w; # symmetric
+ }
+ }
+
+ my @val;
+ eval
+ {
+ @val = SolveBestSquares(\@dmatrix, \@wmatrix);
+ 1;
+ }
+ or do
+ {
+ @val = map { undef } @allweps;
+ };
+
+ for my $i(0.. at allweps - 1)
+ {
+ my $attackweapon = $allweps[$i];
+ $values{$attackweapon} = $val[$i];
+ }
+ return \%values;
+}
+
+sub out_text($@)
+{
+ my ($event, @data) = @_;
+ if($event eq 'start')
+ {
+ }
+ elsif($event eq 'startmatrix')
+ {
+ my ($addr, $map, @columns) = @data;
+ $addr ||= 'any';
+ $map ||= 'any';
+ print "For server @{[$addr || 'any']} map @{[$map || 'any']}:\n";
+ }
+ elsif($event eq 'startrow')
+ {
+ my ($row, $val) = @data;
+ printf " %-30s %8s |", $stats->weaponid_to_name($row), defined $val ? sprintf("%8.5f", $val) : "N/A";
+ }
+ elsif($event eq 'cell')
+ {
+ my ($win, $lose, $p) = @data;
+ if(!defined $p)
+ {
+ print " . ";
+ }
+ elsif(!$p)
+ {
+ printf " %6.3f", 0;
+ }
+ else
+ {
+ printf " %+6.3f", $p;
+ }
+ }
+ elsif($event eq 'endrow')
+ {
+ print "\n";
+ }
+ elsif($event eq 'endmatrix')
+ {
+ my ($min) = @data;
+ $min ||= 0;
+ print " Relevance: $min\n";
+ print "\n";
+ }
+ elsif($event eq 'end')
+ {
+ }
+}
+
+sub out_html($@)
+{
+ my ($event, @data) = @_;
+ if($event eq 'start')
+ {
+ print "<html><body><h1>Weapon Profiling</h1>\n";
+ }
+ elsif($event eq 'startmatrix')
+ {
+ my ($addr, $map, @columns) = @data;
+ $addr ||= 'any';
+ $map ||= 'any';
+ print "<h2>For server @{[$addr || 'any']} map @{[$map || 'any']}:</h2>\n";
+ print "<table><tr><th>Weapon</th><th>Rating</th>\n";
+ printf '<th><img width=70 height=80 src="http://svn.icculus.org/*checkout*/nexuiz/trunk/Docs/htmlfiles/weaponimg/thirdperson-%s.png" alt="%s"></th>', $stats->weaponid_to_model($_), $stats->weaponid_to_name($_) for @columns;
+ print "</tr>\n";
+ }
+ elsif($event eq 'startrow')
+ {
+ my ($row, $val) = @data;
+ printf '<tr><th><img width=108 height=53 src="http://svn.icculus.org/*checkout*/nexuiz/trunk/Docs/htmlfiles/weaponimg/firstperson-%s.png" alt="%s"></th><th align=right>%s</th>', $stats->weaponid_to_model($row), $stats->weaponid_to_name($row), defined $val ? sprintf("%8.5f", $val) : "N/A";
+ }
+ elsif($event eq 'cell')
+ {
+ my ($win, $lose, $p) = @data;
+ my $v = 200;
+ if(!defined $p)
+ {
+ printf '<td align=center bgcolor="#808080">%d</td>', $win;
+ }
+ elsif($p > 0)
+ {
+ printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', $v - $v * $p, 255, 0, $win;
+ }
+ elsif($p < 0)
+ {
+ #printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', (255 - $v) - $v * $p, $v + $v * $p, 0, $win;
+ printf '<td align=center bgcolor="#%02x%02x%02x">%d</td>', 255, $v + $v * $p, 0, $win;
+ }
+ else
+ {
+ printf '<td align=center bgcolor="#ffff00">%d</td>', $win;
+ }
+ }
+ elsif($event eq 'endrow')
+ {
+ print "</tr>";
+ }
+ elsif($event eq 'endmatrix')
+ {
+ my ($min) = @data;
+ $min ||= 0;
+ print "</table>Relevance: $min\n";
+ }
+ elsif($event eq 'end')
+ {
+ }
+}
+
+my $out = $ENV{html} ? \&out_html : \&out_text;
+
+LoadData();
+$out->(start => ());
+$stats->allstats(sub
+{
+ my ($addr, $map, $data) = @_;
+ my $values = Evaluate $data;
+ my $valid = defined [values %$values]->[0];
+ my @weapons_sorted = sort { $valid ? $values->{$b} <=> $values->{$a} : $a <=> $b } keys %$values;
+ my $min = undef;
+ $out->(startmatrix => ($addr, $map, @weapons_sorted));
+ for my $row(@weapons_sorted)
+ {
+ $out->(startrow => $row, ($valid ? $values->{$row} : undef));
+ for my $col(@weapons_sorted)
+ {
+ my $win = ($data->{$row}{$col} || 0);
+ my $lose = ($data->{$col}{$row} || 0);
+ $min = $win + $lose
+ if $row ne $col and (not defined $min or $min > $win + $lose);
+ $out->(cell => ($win, $lose, (($row ne $col) && ($win + $lose)) ? (2 * $win / ($win + $lose) - 1) : undef));
+ }
+ $out->(endrow => ());
+ }
+ $out->(endmatrix => ($min));
+});
+$out->(end => ());
Property changes on: branches/nexuiz-2.0/misc/tools/weapon-profiler-analyzer.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: branches/nexuiz-2.0/misc/tools/weapon-profiler.pl
===================================================================
--- branches/nexuiz-2.0/misc/tools/weapon-profiler.pl (rev 0)
+++ branches/nexuiz-2.0/misc/tools/weapon-profiler.pl 2009-07-21 07:01:45 UTC (rev 7249)
@@ -0,0 +1,180 @@
+#!/usr/bin/perl
+
+# no warranty for this script
+# and no documentation
+# take it or leave it
+
+use strict;
+use warnings;
+use FindBin; use lib $FindBin::Bin;
+use IO::Socket;
+use Socket;
+use sigtrap qw(die normal-signals);
+use WeaponEncounterProfile;
+
+my ($statsfile) = @ARGV;
+my $password = $ENV{rcon_password};
+my $server = $ENV{rcon_address};
+my $bind = $ENV{rcon_bindaddress};
+
+my $stats;
+
+sub AddKill($$$$$)
+{
+ my ($addr, $map, $attackerweapon, $targweapon, $type) = @_;
+ $stats->event($addr, $map, $attackerweapon, $targweapon, $type);
+}
+
+sub StoreData()
+{
+ $stats->save();
+}
+
+sub LoadData()
+{
+ $stats = WeaponEncounterProfile->new($statsfile);
+}
+
+$SIG{ALRM} = sub
+{
+ print STDERR "Operation timed out.\n";
+ exit 1;
+};
+
+our @discosockets = ();
+sub LogDestUDP($)
+{
+ # connects to a DP server using rcon with log_dest_udp
+ my ($sock) = @_;
+ my $value = sprintf "%s:%d", $sock->sockhost(), $sock->sockport();
+ $sock->send("\377\377\377\377rcon $password log_dest_udp", 0)
+ or die "send rcon: $!";
+ alarm 15;
+ for(;;)
+ {
+ $sock->recv(my $response, 2048, 0)
+ or die "recv: $!";
+ if($response =~ /^\377\377\377\377n"log_dest_udp" is "(.*)" \[".*"\]\n$/s)
+ {
+ alarm 0;
+ my @dests = split /\s+/, $1;
+ return
+ if grep { $_ eq $value } @dests;
+ push @dests, $value;
+ $sock->send("\377\377\377\377rcon $password log_dest_udp \"@dests\"");
+ last;
+ }
+ }
+ alarm 0;
+ push @discosockets, [$sock, $value];
+
+ END
+ {
+ for(@discosockets)
+ {
+ my ($s, $v) = @$_;
+ # disconnects (makes the server stop send the data to us)
+ $s->send("\377\377\377\377rcon $password log_dest_udp", 0)
+ or die "send rcon: $!";
+ alarm 15;
+ for(;;)
+ {
+ $s->recv(my $response, 2048, 0)
+ or die "recv: $!";
+ if($response =~ /^\377\377\377\377n"log_dest_udp" is "(.*)" \[".*"\]\n$/s)
+ {
+ alarm 0;
+ my @dests = split /\s+/, $1;
+ return
+ if not grep { $_ eq $v } @dests;
+ @dests = grep { $_ ne $v } @dests;
+ $s->send("\377\377\377\377rcon $password log_dest_udp \"@dests\"");
+ last;
+ }
+ }
+ alarm 0;
+ }
+ }
+}
+
+sub sockaddr_readable($)
+{
+ my ($binary) = @_;
+ my ($port, $addr) = sockaddr_in $binary;
+ return sprintf "%s:%d", inet_ntoa($addr), $port;
+}
+
+my $sock;
+if(defined $bind)
+{
+ # bind to a port and wait for any packets
+ $sock = IO::Socket::INET->new(Proto => 'udp', LocalAddr => $bind, LocalPort => 26000)
+ or die "socket: $!";
+}
+else
+{
+ # connect to a DP server
+ $sock = IO::Socket::INET->new(Proto => 'udp', PeerAddr => $server, PeerPort => 26000)
+ or die "socket: $!";
+ LogDestUDP $sock;
+}
+my %currentmap = ();
+
+my %bots = ();
+
+LoadData();
+while(my $addr = sockaddr_readable $sock->recv($_, 2048, 0))
+{
+ $addr = $server
+ if not defined $bind;
+ s/^\377\377\377\377n//
+ or next;
+ for(split /\r?\n/, $_)
+ {
+ if(/^:gamestart:([^:]+):/)
+ {
+ StoreData();
+ $currentmap{$addr} = $1;
+ $bots{$addr} = {};
+ print "($addr) switching to $1\n";
+ next;
+ }
+
+ next
+ unless defined $currentmap{$addr};
+ if(/^:join:(\d+):bot:/)
+ {
+ $bots{$addr}{$1} = 1;
+ }
+ elsif(/^:kill:frag:(\d+):(\d+):type=(\d+):items=(\d+)([A-Z]*)(?:|(\d+)):victimitems=(\d+)([A-Z]*)(?:|(\d+))$/)
+ {
+ my ($a, $b, $type, $killweapon, $killflags, $killrunes, $victimweapon, $victimflags, $victimrules) = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
+ next
+ if exists $bots{$addr}{$a} or exists $bots{$addr}{$b}; # only count REAL kills
+ $type &= 0xFF
+ if $type < 10000;
+ $killweapon = $type
+ if $stats->weaponid_valid($type); # if $type is not a weapon deathtype, count the weapon of the killer
+ $killweapon = 0
+ if not $stats->weaponid_valid($killweapon); # invalid weapon? that's 0 then
+ $victimweapon = 0
+ if not $stats->weaponid_valid($victimweapon); # dito
+ next
+ if $killflags =~ /S|I/ or $victimflags =~ /T/; # no strength, shield or typekills (these skew the statistics)
+ AddKill($addr, $currentmap{$addr}, $killweapon, $victimweapon, +1);
+ }
+ elsif(/^:kill:suicide:\d+:\d+:type=(\d+):items=(\d+)([A-Z]*)(?:|(\d+))$/)
+ {
+ my ($type, $killweapon, $killflags, $killrunes) = ($1, $2, $3, $4, $5, $6, $7);
+ $type &= 0xFF
+ if $type < 10000;
+ $killweapon = $type
+ if $stats->weaponid_valid($type);
+ $killweapon = 0
+ if not $stats->weaponid_valid($killweapon);
+ next
+ if $killflags =~ /S/; # no strength suicides (happen too easily accidentally)
+ AddKill($addr, $currentmap{$addr}, $killweapon, $killweapon, +1);
+ }
+ }
+}
Property changes on: branches/nexuiz-2.0/misc/tools/weapon-profiler.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: branches/nexuiz-2.0/server/rcon2irc/joinsparts.pl
===================================================================
--- branches/nexuiz-2.0/server/rcon2irc/joinsparts.pl (rev 0)
+++ branches/nexuiz-2.0/server/rcon2irc/joinsparts.pl 2009-07-21 07:01:45 UTC (rev 7249)
@@ -0,0 +1,58 @@
+# Nexuiz rcon2irc plugin by Merlijn Hofstra licensed under GPL - joinsparts.pl
+# Place this file inside the same directory as rcon2irc.pl and add the full filename to the plugins.
+# Don't forget to edit the options below to suit your needs.
+
+my %pj = (
+ irc_announce_joins => 1,
+ irc_announce_parts => 1,
+ irc_show_playerip => 0,
+ irc_show_mapname => 0,
+ irc_show_amount_of_players => 0
+);
+
+$store{plugin_joinsparts} = \%pj;
+
+sub out($$@);
+
+sub get_player_count
+{
+ my $count = 0;
+ for (1 .. $store{slots_max}) {
+ my $id = $store{"playerid_byslot_$_"};
+ $count++ if (defined $id && $store{"playerip_byid_$id"} ne 'bot');
+ }
+ return $count;
+}
+
+# chat: Nexuiz server -> IRC channel, nick set
+[ dp => q{:join:(\d+):(\d+):([^:]*):(.*)} => sub {
+ my ($id, $slot, $ip, $nick) = @_;
+ my $pj = $store{plugin_joinsparts};
+ $store{"playernickraw_byid_$id"} = $nick;
+ $nick = color_dp2irc $nick;
+ if ($pj->{irc_announce_joins} && !$store{"playerid_byslot_$slot"} && $ip ne 'bot') {
+ out irc => 0, "PRIVMSG $config{irc_channel} :\00309+ join\017: $nick\017" .
+ ($pj->{irc_show_playerip} ? " (\00304$ip\017)" : '') .
+ ($pj->{irc_show_mapname} ? " playing on \00304$store{map}\017" : '') .
+ ($pj->{irc_show_amount_of_players} ? " players: \00304" . (get_player_count()+1) . "\017/$store{slots_max}" : '');
+ }
+ return 0;
+} ],
+# Record parts so the info in $store is always up to date
+[ dp => q{:part:(\d+)} => sub {
+ my ($id) = @_;
+ my $pj = $store{plugin_joinsparts};
+ if ($pj->{irc_announce_parts} && defined $store{"playernick_byid_$id"} && $store{"playerip_byid_$id"} ne 'bot') {
+ out irc => 0, "PRIVMSG $config{irc_channel} :\00304- part\017: " . $store{"playernick_byid_$id"} . "\017" .
+ ($pj->{irc_show_playerip} ? " (\00304" . $store{"playerip_byid_$id"} . "\017)" : '') .
+ ($pj->{irc_show_mapname} ? " playing on \00304$store{map}\017" : '') .
+ ($pj->{irc_show_amount_of_players} ? " players: \00304" . (get_player_count()-1) . "\017/$store{slots_max}" : '');
+ }
+ my $slot = $store{"playerslot_byid_$id"};
+ $store{"playernickraw_byid_$id"} = undef;
+ $store{"playernick_byid_$id"} = undef;
+ $store{"playerip_byid_$id"} = undef;
+ $store{"playerslot_byid_$id"} = undef;
+ $store{"playerid_byslot_$slot"} = undef;
+ return 0;
+} ],
Added: branches/nexuiz-2.0/server/rcon2irc/ping-pl.pl
===================================================================
--- branches/nexuiz-2.0/server/rcon2irc/ping-pl.pl (rev 0)
+++ branches/nexuiz-2.0/server/rcon2irc/ping-pl.pl 2009-07-21 07:01:45 UTC (rev 7249)
@@ -0,0 +1,78 @@
+# Nexuiz rcon2irc plugin by Merlijn Hofstra licensed under GPL - ping-pl.pl
+# Place this file inside the same directory as rcon2irc.pl and add the full filename to the plugins.
+# Don't forget to edit the options below to suit your needs.
+
+# This script monitors players ping and packet loss, people with really large values here are
+# lagging a lot, and this lag appears to other players as well as seeing the lagging player move
+# with lots of stutter. Bare in mind that even those of us on very good connections may lose a
+# packet or have a high ping every once in the while.
+# PLEASE CHOOSE SANE VALUES HERE !!!
+
+my %pp = (
+ max_ping => 300,
+ max_pl => 15,
+ warn_player => 1, # send a tell command to the player to notify of bad connection (0 or 1)
+ warn_irc => 1, # send a warning to irc to notify that a player has a bad connection (0 or 1)
+ warnings => 3, # how many times must ping/pl exceed the limit before a warning
+ kick => 0, # how many times must ping/pl exceed the limit before a kick (0 to disable)
+ timeframe => 20, # minutes until a count is forgotten
+ warnmsg => 'You are having connection problems, causing you to lag - please fix them',
+ kickmsg => 'You are getting kicked for having connection problems.'
+);
+
+$store{plugin_ping-pl} = \%pp;
+
+sub out($$@);
+
+# Check users ping and packet loss
+[ dp => q{\^\d(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(-?\d+)\s+\#(\d+)\s+\^\d(.*)} => sub {
+ my ($ip, $pl, $ping, $time, $frags, $no, $name) = ($1, $2, $3, $4, $5, $6, $7);
+ my $id = $store{"playerid_byslot_$no"};
+ return 0 unless ( defined $id );
+ return 0 if ($frags == -666 || $ip eq 'bot');
+ my $pp = $store{plugin_ping-pl};
+
+ #does the player violate one of our limits?
+ my $warn = 0;
+ if ($ping >= $pp->{max_ping} || $pl >= $pp->{max_pl}) {
+ #add a violation
+ push @{ $pp->{"violation_$id"} }, time();
+ $warn = 1;
+ }
+
+ #maybe we need to clear the oldest violation
+ shift @{ $pp->{"violation_$id"} } if (defined ${ $pp->{"violation_$id"} }[0] && (${ $pp->{"violation_$id"} }[0] + (60 * $pp->{timeframe})) <= time());
+
+ #do we have to kick the user?
+ if ((scalar @{ $pp->{"violation_$id"} }) >= $pp->{kick} && $pp->{kick} > 0) {
+ if ($pp->{warn_player}) {
+ out dp => 0, "tell #$no " . $pp{kickmsg};
+ }
+ if ($pp->{warn_irc}) {
+ out irc => 0, "PRIVMSG $config{irc_channel} :* \00304kicking\017 " . $store{"playernick_byid_$id"} . "\017 for having a bad connection";
+ }
+ out dp => 0, "kick # $no bad connection";
+ $pp->{"violation_$id"} = undef;
+ return 0;
+ }
+
+ #do we have to warn the user?
+ if ($warn && (scalar @{ $pp->{"violation_$id"} }) && ((scalar @{ $pp->{"violation_$id"} }) % $pp->{warnings}) == 0) {
+ if ($pp->{warn_player}) {
+ out dp => 0, "tell #$no $pp{warnmsg}";
+ }
+ if ($pp->{warn_irc}) {
+ out irc => 0, "PRIVMSG $config{irc_channel} :* \00308warning\017 " . $store{"playernick_byid_$id"} . "\017 for having a bad connection";
+ }
+ }
+ return 0;
+} ],
+
+# For now will just empty our data at the end of a match
+[ dp => q{^:end} => sub {
+ my $pp = $store{plugin_ping-pl};
+ foreach ( keys %{ $pp } ) {
+ $pp->{$_} = undef if ($_ =~ m/^violation/);
+ }
+ return 0;
+} ],
Added: branches/nexuiz-2.0/server/rcon2irc/suggestmap.pl
===================================================================
--- branches/nexuiz-2.0/server/rcon2irc/suggestmap.pl (rev 0)
+++ branches/nexuiz-2.0/server/rcon2irc/suggestmap.pl 2009-07-21 07:01:45 UTC (rev 7249)
@@ -0,0 +1,13 @@
+# Nexuiz rcon2irc plugin by Merlijn Hofstra licensed under GPL - suggestmap.pl
+# Place this file inside the same directory as rcon2irc.pl and add the full filename to the plugins.
+
+sub out($$@);
+
+#read the suggest vote
+[ dp => q{:vote:suggested:(.+):(\d+)} => sub {
+ my ($map, $id) = @_;
+ my $nick = color_dp2irc $store{"playernick_byid_$id"};
+ $nick ||= '(console)';
+ out irc => 0, "PRIVMSG $config{irc_channel} :* map suggested: \00304$map\017 by $nick\017";
+ return 0;
+} ],
More information about the nexuiz-commits
mailing list