package NetHirc::Server;
use strict;
use warnings;
my %cmst = qw(o _chops v _voice);
my %cmtoggle = qw(i _inviteonly m _moderated n _noforeign p _private s _secret t _topic);
my %cmargs = qw( k _key l _limit );
# We don't really track lists.
# b _banlist e _exceptionlist I _noinvitelist
sub connected
{
my $self = shift;
if (@_) {
$self->{'_connected'} = $_[0];
}
return $self->{'_connected'};
}
sub used
{
my $self = shift;
if (@_) {
$self->{'_used'} = $_[0];
}
return $self->{'_used'};
}
sub nick
{
my $self = shift;
if (@_) {
$self->{'Nick'} = $_[0];
}
return $self->{'Nick'};
}
sub oper
{
my $self = shift;
if (@_) {
$self->{'_oper'} = $_[0];
}
return $self->{'_oper'};
}
sub request_nick
{
my $self = shift;
if (@_) {
$self->{'_reqnick'} = $_[0];
}
return $self->{'_reqnick'};
}
sub away
{
my $self = shift;
if (@_) {
$self->{'_away'} = $_[0];
}
return $self->{'_away'};
}
sub artifact
{
my $self = shift;
my $nick = shift;
if (@_)
{
$self->{'_artifacts'}->{$nick} = $_[0];
}
return $self->{'_artifacts'}->{$nick};
}
sub name
{
my $self = shift;
if (@_) {
$self->{'_oldname'} = $self->{'Server'};
$self->{'Server'} = $_[0];
}
return $self->{'Server'};
}
sub aka
{
my $self = shift;
if (@_) {
$self->{'_aka'} = $_[0];
}
return $self->{'_aka'};
}
sub has_channel
{
my $self = shift;
my $channel = shift;
my $chanlist = $self->{'_joined'};
grep { $_ eq $channel } @$chanlist;
}
sub set_channel
{
my $self = shift;
my $channel = shift;
my $chanlist = $self->{'_joined'};
for (my $i = 0; $i < @$chanlist ; $i++)
{
if ($chanlist->[$i] eq $channel)
{
unshift @$chanlist, splice(@$chanlist, $i, 1);
}
}
}
sub current_channel
{
my $self = shift;
return undef unless $self->connected();
my $chanlist = $self->{'_joined'};
return undef unless @$chanlist;
return $chanlist->[0];
}
sub add_channel
{
my $self = shift;
my $channel = shift;
for my $k (qw(_joined channels))
{
my $chanlist = $self->{$k};
unshift(@$chanlist, $channel) unless grep { $_ eq $channel } @$chanlist;
}
}
sub next_channel
{
my $self = shift;
my $chanlist = $self->{'_joined'};
return undef unless @$chanlist;
push @$chanlist, shift @$chanlist;
return $chanlist->[0];
}
sub nuh
{
my $self = shift;
my $nick = $self->{'Nick'};
return "$nick!.@.";
}
sub channels
{
my $self = shift;
return grep { not $self->is_query($_) } @{$self->{'_joined'}};
}
sub wanted_channels
{
my $self = shift;
return @{$self->{'channels'}};
}
sub gather_namreply
{
my $self = shift;
my $channel = shift;
my $namelist = shift;
push @{$self->{'_namreply'}->{$channel}}, split(' ', $namelist);
}
sub retrieve_namreply
{
my $self = shift;
my $channel = shift;
my $list = $self->{'_namreply'}->{$channel} || [];
my $ret = [ @$list ];
delete $self->{'_namreply'}->{$channel};
return $ret;
}
sub remove_channel
{
my $self = shift;
my $channel = shift;
for my $k (qw(channels _joined))
{
my $chanlist = $self->{$k};
for (my $i = 0; $i < @$chanlist ; $i++)
{
if ($chanlist->[$i] eq $channel)
{
splice(@$chanlist, $i, 1);
}
}
}
for my $m (values %cmst)
{
delete $self->{$m}->{$channel};
}
for my $j (values %cmtoggle)
{
delete $self->{$j}->{$channel};
}
for my $h (values %cmargs)
{
delete $self->{$h}->{$channel};
}
}
sub disconnect
{
my $self = shift;
$self->{'_connected'} = 0;
$self->{'_joined'} = [];
}
sub chanmode
{
my $self = shift;
my $channel = shift;
my $modestr = shift;
my $target = shift;
my $nick = $self->nick();
my ($parity, $mode) = split(//, $modestr);
if ($target and $target eq $nick)
{
my $k = $cmst{$mode};
if ($parity eq '+')
{
$self->{$k}->{$channel} = 1;
}
else
{
delete $self->{$k}->{$channel};
}
}
else
{
if (exists $cmtoggle{$mode})
{
my $k = $cmtoggle{$mode};
if ($parity eq '+')
{
$self->{$k}->{$channel} = 1;
}
else
{
delete $self->{$k}->{$channel};
if ($k eq 'm')
{
delete $self->{'_voice'}->{$channel};
}
}
}
if (exists $cmargs{$mode})
{
my $k = $cmargs{$mode};
if ($parity eq '+')
{
$self->{$k}->{$channel} = $target;
}
else
{
delete $self->{$k}->{$channel};
}
}
}
}
sub selfmode
{
my $self = shift;
my $modestr = shift;
my ($parity, $mode) = split(//, $modestr);
if ($parity eq '+')
{
$self->{'_selfmode'}->{$mode} = 1;
}
else
{
delete $self->{'_selfmode'}->{$mode};
}
}
sub has_chops
{
my $self = shift;
my $channel = shift;
return $self->{'_chops'}->{$channel};
}
sub has_voice
{
my $self = shift;
my $channel = shift;
return $self->{'_voice'}->{$channel};
}
sub channel_mode
{
my $self = shift;
my $channel = shift;
my @ret = ("+");
my ($k, $v);
while (($k, $v) = each %cmtoggle)
{
if ($self->{$v}->{$channel})
{
$ret[0] .= $k;
}
}
while (($k, $v) = each %cmargs)
{
if ($self->{$v}->{$channel})
{
$ret[0] .= $k;
push @ret, $self->{$v}->{$channel};
}
}
return join(' ', @ret);
}
sub mymode
{
my $self = shift;
my @modes = keys %{$self->{'_selfmode'}};
my @active = grep { $self->{'_selfmode'}->{$_} } @modes;
my $modestr = sprintf("+%s", join(' ', @active));
return $modestr;
}
sub accept_nick
{
my $self = shift;
$self->{'Nick'} = $self->{'_reqnick'};
delete $self->{'_reqnick'};
}
sub is_query
{
my $self = shift;
my $thing = shift;
my $c = substr($thing, 0, 1);
# XXX If we were smart, we'd record channel types from irc_005.
# This is probably fine in 99% of cases.
return (($c ne '#') && ($c ne '&'));
}
sub current_queries
{
my $self = shift;
return grep { $self->is_query($_) } @{$self->{'_joined'}};
}
1;
__END__
syntax highlighted by Code2HTML, v. 0.9.1