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__