File Coverage

blib/lib/Sirc/LimitMan.pm

Criterion	Covered	Total	%
statement	15	80	18.7
branch	0	38	0.0
condition	0	9	0.0
subroutine	5	13	38.4
pod	0	6	0.0
total	20	146	13.7

# $Id: LimitMan.pm,v 1.6 2000-07-27 12:04:46-04 roderick Exp $
#
# Copyright (c) 2000 Roderick Schertler.  All rights reserved.  This
# program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# Documentation is at the __END__.

use strict;

package Sirc::LimitMan;

use Sirc::Chantrack	qw(%Chan_limit %Chan_user);
use Sirc::LckHash	();
use Sirc::Util		qw(addcmd add_hook arg_count_error by_server deltimer
			    have_ops_q ieq newtimer optional_channel
			    settable_boolean settable_int sl
			    tell_error tell_question timer
			    xtell);

use vars qw($VERSION);

$VERSION  = do{my@r=q$Revision: 1.6 $=~/\d+/g;sprintf '%d.'.'%03d'x$#r,@r};
$VERSION .= '-l' if q$Locker:  $ =~ /: \S/;

# These variables are tied to /set options.  XXX Allow setting these
# per-channel.
my $Enabled	= 1;		# no limit management done if false
my $Tween	= 60;		# secs between checks
my $Skew	= $Tween / 2;	# random skew if not master
my $Skew_offset	= $Skew / 2;	# constant added to skew
my $Debug	= 0;

my $N_low	= 2;
my $N_high	= 5;
my $N_reset	= $N_high - 1;

settable_boolean 'limitman', \$Enabled;
settable_int 'limitman_tween',	\$Tween,	sub { $_[1] > 0 };
settable_int 'limitman_skew',	\$Skew,		sub { $_[1] > 0 };
settable_int 'limitman_skew_offset', \$Skew_offset, sub { $_[1] > 0 };
settable_int 'limitman_low',	\$N_low,	sub { $_[1] > 0 };
settable_int 'limitman_high',	\$N_high,	sub { $_[1] > 0 };
settable_int 'limitman_reset',	\$N_reset,	sub { $_[1] > 0 };

settable_boolean 'limitman_debug', \$Debug;

# Keys are channels I'm doing limit management for, values are lists:
#
#    0 timer
#    1 true if I'm the master

sub F_TIMER	() { 0 }
sub F_AM_MASTER	() { 1 }

sub TIMER_NOW	() { 0 }
sub TIMER_MASTER () { 1 }
sub TIMER_SLAVE	() { 2 }

my %Limitman;
tie %Limitman, 'Sirc::LckHash';

sub debug {
    xtell 'limitman debug ' . join '', @_
	if $Debug;
}

# So I can examine the value.

sub debug_fetch {
    return \%Limitman;
}

sub am_master {
    my ($c) = @_;
    return $Limitman{$c} && $Limitman{$c}[F_AM_MASTER];
}

sub set_timer {
    unless (@_ == 2) {
	arg_count_error undef, 2, @_;
	return;
    }
    my ($c, $type) = @_;
    my ($delay);

    if ($type == TIMER_NOW) {
	$delay = 3;
    }
    elsif ($type == TIMER_MASTER) {
	$delay = $Tween;
    }
    elsif ($type == TIMER_SLAVE) {
	$delay = $Tween + $Skew_offset + 1 + int rand $Skew;
    }
    else {
	tell_error "set_timer called with invalid timer type $type";
	return;
    }

    debug "setting timer for $c type $type at now + $delay";
    timer $delay, sub { limitman_do($c) }, $Limitman{$c}[F_TIMER] ||= newtimer;
}

sub limitman_do {
    my ($c) = @_;

    my $set	= 0;
    my $limit	= $Chan_limit{$c};
    my $users	= keys %{ $Chan_user{$c} };

    if (!$Enabled) {
	debug "not enabled";
    }
    elsif (!$Limitman{$c}) {
	tell_error "limitman_do called for $c even though disabled";
	# Don't set the timer again.
	return;
    }
    elsif (!have_ops_q $c) {
	debug "$c not opped";
    }
    elsif (!defined $limit) {
	debug "$c no current limit";
	$set = 1;
    }
    else {
    	my $room = $limit - $users;
	debug "$c limit $limit users $users room $room low $N_low high $N_high";
	$set = 1 if $room < $N_low || $room > $N_high;
    }

    if ($set) {
	my $new = $users + $N_reset;
	debug "new limit on $c is $new";
	sl "MODE $c +l $new";
	$Limitman{$c}[F_AM_MASTER] = 1;
    }

    # Use the standard delay here, even for slaves.  The slaves only
    # pick a new random time when they see a master change the limit, so
    # that they stay at a certain offset from the master (so they don't
    # creep around and take over inadvertently).
    set_timer $c, TIMER_MASTER;
}

# Hook called when somebody changes the limit.

sub limit_change {
    my ($c, $old, $new) = @_;

    return if !$Limitman{$c};
    return if ieq $::who, $::nick;

    debug "limit change on $c, $old => $new";
    if (by_server) {
	if (am_master $c) {
	    debug "resetting after limit change made by server";
	    set_timer $c, TIMER_NOW;
	}
	else {
	    debug "ignoring server change, I'm not master";
	}
    }
    else {
	# Somebody else changed it.  Let them be the master.
	if (am_master $c) {
	    debug "abdicating master position";
	    $Limitman{$c}[F_AM_MASTER] = 0;
	}
	# Regardless of whether I was the master, re-start my timer to
	# sync to the new master.
	set_timer $c, TIMER_SLAVE;
    }
}
add_hook 'limit', \&limit_change;

sub main::cmd_limitman {
    optional_channel or return;

    my @a = split ' ', $::args;
    unless (@a == 1) {
	tell_question "Too many args, 0 or 1 expected";
	return;
    }

    my $c = shift @a;
    if ($Limitman{$c}) {
	xtell "Disabling limit managment on $c";
	deltimer ${ delete $Limitman{$c} }[F_TIMER];
    }
    else {
	xtell "Starting limit management on $c";
	$Limitman{$c} = [];
	limitman_do $c;
    }
}
addcmd 'limitman';

1;

__END__