Moved lag-checking code to LagChecker.pm; improved output of !lagcheck command

This commit is contained in:
Pragmatic Software 2011-01-24 23:56:55 +00:00
parent a619f8fe9b
commit 45a2a66d0f
4 changed files with 138 additions and 52 deletions

View File

@ -15,6 +15,8 @@ use feature 'switch';
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
use PBot::LagChecker;
use Time::HiRes qw(gettimeofday tv_interval);
use Time::Duration;
use Carp ();
@ -48,16 +50,9 @@ sub initialize {
$self->{last_timestamp} = gettimeofday;
$self->{message_history} = {};
$self->{lag} = undef;
$self->{lag_history} = [];
$self->{LAG_HISTORY_MAX} = 3;
$self->{LAG_HISTORY_INTERVAL} = 10;
$pbot->timer->register(sub { $self->prune_message_history }, 60 * 60 * 1);
$pbot->timer->register(sub { $self->send_ping }, $self->{LAG_HISTORY_INTERVAL});
$pbot->commands->register(sub { return $self->unbanme(@_) }, "unbanme", 0);
$pbot->commands->register(sub { return $self->lagcheck(@_) }, "lagcheck", 0);
}
sub get_flood_account {
@ -183,8 +178,11 @@ sub check_flood {
# do not do flood processing if channel is not in bot's channel list or bot is not set as chanop for the channel
return if ($channel =~ /^#/) and (not exists $self->{pbot}->channels->channels->hash->{$channel} or $self->{pbot}->channels->channels->hash->{$channel}{chanop} == 0);
# do not do flood processing for this event if lag is uninitialized or is significant
return if not defined $self->{lag} or $self->{lag} >= 2;
# do not do flood enforcement for this event if bot is lagging
if($self->{pbot}->lagchecker->lagging) {
$self->{pbot}->logger->log("Disregarding enforcement of anti-flood due to lag: " . $self->{pbot}->lagchecker->lagstring . "\n");
return;
}
if($max_messages > $self->{pbot}->{MAX_NICK_MESSAGES}) {
$self->{pbot}->logger->log("Warning: max_messages greater than MAX_NICK_MESSAGES; truncating.\n");
@ -296,47 +294,6 @@ sub prune_message_history {
}
}
sub send_ping {
my $self = shift;
return unless defined $self->{pbot}->conn;
$self->{ping_send_time} = [gettimeofday];
$self->{pbot}->conn->sl("PING :lagcheck");
# $self->{pbot}->logger->log("sent lagcheck PING\n");
}
sub on_pong {
my $self = shift;
my $elapsed = tv_interval($self->{ping_send_time});
push @{ $self->{lag_history} }, $elapsed;
# $self->{pbot}->logger->log("got lagcheck PONG\n");
# $self->{pbot}->logger->log("Lag: $elapsed\n");
my $len = @{ $self->{lag_history} };
if($len > $self->{LAG_HISTORY_MAX}) {
shift @{ $self->{lag_history} };
$len--;
}
my $lag = 0;
foreach my $l (@{ $self->{lag_history} }) {
$lag += $l;
}
$self->{lag} = $lag / $len;
}
sub lagcheck {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
my $lag = $self->{lag} || "initializing";
return "Lag: $lag";
}
sub unbanme {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
my $channel = lc $arguments;

116
PBot/LagChecker.pm Normal file
View File

@ -0,0 +1,116 @@
# File: LagChecker.pm
# Author: pragma_
#
# Purpose: sends PING command to IRC server and times duration for PONG reply in
# order to maintain lag history and average.
package PBot::LagChecker;
use warnings;
use strict;
use feature 'switch';
use vars qw($VERSION);
$VERSION = $PBot::PBot::VERSION;
use Time::HiRes qw(gettimeofday tv_interval);
use Time::Duration;
use Carp ();
sub new {
if(ref($_[1]) eq 'HASH') {
Carp::croak("Options to LagChecker should be key/value pairs, not hash reference");
}
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
my $pbot = delete $conf{pbot};
if(not defined $pbot) {
Carp::croak("Missing pbot reference to LagChecker");
}
$self->{pbot} = $pbot;
$self->{LAG_HISTORY_MAX} = 3; # maximum number of lag history entries to retain
$self->{LAG_THRESHOLD} = 2; # lagging is true if lag_average reaches or exceeds this threshold, in seconds
$self->{LAG_HISTORY_INTERVAL} = 10; # how often to send PING, in seconds
$self->{lag_average} = undef; # average of entries in lag history, in seconds
$self->{lag_string} = undef; # string representation of lag history and lag average
$self->{lag_history} = []; # history of previous PING/PONG timings
$pbot->timer->register(sub { $self->send_ping }, $self->{LAG_HISTORY_INTERVAL});
$pbot->commands->register(sub { return $self->lagcheck(@_) }, "lagcheck", 0);
}
sub send_ping {
my $self = shift;
return unless defined $self->{pbot}->conn;
$self->{ping_send_time} = [gettimeofday];
$self->{pbot}->conn->sl("PING :lagcheck");
# $self->{pbot}->logger->log("sent lagcheck PING\n");
}
sub on_pong {
my $self = shift;
my $elapsed = tv_interval($self->{ping_send_time});
push @{ $self->{lag_history} }, [ $self->{ping_send_time}[0], $elapsed ];
my $len = @{ $self->{lag_history} };
if($len > $self->{LAG_HISTORY_MAX}) {
shift @{ $self->{lag_history} };
$len--;
}
$self->{lag_string} = "";
my $comma = "";
my $lag_total = 0;
foreach my $entry (@{ $self->{lag_history} }) {
my ($send_time, $lag_result) = @{ $entry };
$lag_total += $lag_result;
my $ago = ago(gettimeofday - $send_time);
$self->{lag_string} .= $comma . "[$ago] $lag_result";
$comma = "; ";
}
$self->{lag_average} = $lag_total / $len;
$self->{lag_string} .= "; average: $self->{lag_average}";
}
sub lagging {
my $self = shift;
return 0 if not defined $self->{lag_average};
return $self->{lag_average} >= $self->{LAG_THRESHOLD};
}
sub lagstring {
my $self = shift;
my $lag = $self->{lag_string} || "initializing";
return $lag;
}
sub lagcheck {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
return "My lag: " . $self->lagstring;
}
1;

View File

@ -27,7 +27,9 @@ use PBot::IRC;
use PBot::IRCHandlers;
use PBot::Channels;
use PBot::LagChecker;
use PBot::AntiFlood;
use PBot::Interpreter;
use PBot::Commands;
@ -141,6 +143,7 @@ sub initialize {
$self->module_dir($module_dir);
$self->{lagchecker} = PBot::LagChecker->new(pbot => $self);
$self->{antiflood} = PBot::AntiFlood->new(pbot => $self);
$self->{ignorelist} = PBot::IgnoreList->new(pbot => $self, filename => $ignorelist_file);
@ -214,7 +217,7 @@ sub connect {
$self->conn->add_handler('part' , sub { $self->irchandlers->on_departure(@_) });
$self->conn->add_handler('join' , sub { $self->irchandlers->on_join(@_) });
$self->conn->add_handler('quit' , sub { $self->irchandlers->on_departure(@_) });
$self->conn->add_handler('pong' , sub { $self->antiflood->on_pong(@_) });
$self->conn->add_handler('pong' , sub { $self->lagchecker->on_pong(@_) });
}
#main loop
@ -263,6 +266,10 @@ sub check_stdin {
return $self->interpreter->process_line($from, $self->{botnick}, "stdin", "localhost", $text);
}
###################################################################################
# Getters/Setters
###################################################################################
sub irc {
my $self = shift;
return $self->{irc};
@ -352,6 +359,12 @@ sub ignorelist {
return $self->{ignorelist};
}
sub lagchecker {
my $self = shift;
if(@_) { $self->{lagchecker} = shift; }
return $self->{lagchecker};
}
sub antiflood {
my $self = shift;
if(@_) { $self->{antiflood} = shift; }

View File

@ -13,7 +13,7 @@ use warnings;
# These are set automatically by the build/commit script
use constant {
BUILD_NAME => "PBot",
BUILD_REVISION => 251,
BUILD_REVISION => 252,
BUILD_DATE => "2011-01-24",
};