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