File Coverage

blib/lib/IRC/Indexer/Report/Server.pm

Criterion	Covered	Total	%
statement	102	117	87.1
branch	33	44	75.0
condition	10	22	45.4
subroutine	28	36	77.7
pod	20	30	66.6
total	193	249	77.5

package IRC::Indexer::Report::Server;

use 5.10.1;
use strict;
use warnings;
use Carp;

use Storable qw/dclone/;

## A single server.


sub new {
  my $self = {};
  my $class = shift;
  bless $self, $class;
  my %args = @_;
  $args{lc $_} = delete $args{$_} for keys %args;

  if ($args{fromhash} && ref $args{fromhash} eq 'HASH') {
    ## given a previously-created hash
    ## does no validation currently
    $self->{NetInfo} = dclone($args{fromhash});
  } else {
    $self->{NetInfo} = {};
  }
  return $self
}

sub clone {
  my $self = shift;
  my %args = @_;
  $args{lc $_} = $args{$_} for keys %args;

  my $cloned = dclone($self->{NetInfo});

  delete $cloned->{HashChans} if $args{nochannels};
  delete $cloned->{ListChans} if $args{nochannels};

  return $cloned
}

sub info { netinfo(@_) }
sub netinfo {
  my $self = shift;
  my %args = @_;
  $args{lc $_} = $args{$_} for keys %args;

  return $self->clone(%args) if $args{nochannels};

  return $self->{NetInfo}
}

sub connectedto {
  my ($self, $server) = @_;
  return $self->netinfo->{ConnectedTo} = $server if defined $server;
  return $self->netinfo->{ConnectedTo}
}

sub connectedat {
  my ($self, $ts) = @_;
  return $self->netinfo->{ConnectedAt} = $ts if defined $ts;
  return $self->netinfo->{ConnectedAt}
}

sub startedat {
  my ($self, $ts) = @_;
  return $self->netinfo->{StartedAt} = $ts if defined $ts;
  return $self->netinfo->{StartedAt}
}

sub finishedat {
  my ($self, $ts) = @_;
  return $self->netinfo->{FinishedAt} = $ts if defined $ts;
  return $self->netinfo->{FinishedAt}
}

sub status {
  ## empty string = nuthin' doin'
  ## INIT  = socket connected
  ## CONNECTED = irc_001
  ## DONE = finished
  ## FAIL = error encountered
  my ($self, $status) = @_;
  return $self->netinfo->{Status} = $status
    if defined $status;
  return $self->netinfo->{Status}//''
}

sub failed {
  my ($self, $reason) = @_;
  ## set a failure reason and FAIL status
  if ($reason) {
    $self->status('FAIL');
    $self->netinfo->{Failure} = $reason;
  }
  return $self->netinfo->{Failure}
}

sub netname { network(@_) }
sub network {
  my ($self, $netname) = @_;
  return $self->netinfo->{NetName} = $netname
    if defined $netname;
  return $self->netinfo->{NetName}
}

sub servername { server(@_) }
sub server {
  my ($self, $server) = @_;
  return $self->netinfo->{ServerName} = $server if defined $server;
  return $self->netinfo->{ServerName}
}

sub blank_motd {
  my ($self) = @_;
  $self->netinfo->{MOTD} = [];
}

sub motd {
  my ($self, $line) = @_;
  push(@{ $self->netinfo->{MOTD} }, $line) if defined $line;
  return $self->netinfo->{MOTD}
}

sub opercount { opers(@_) }
sub opers {
  my ($self, $opers) = @_;
  return $self->netinfo->{OperCount} = $opers
    if defined $opers;
  return $self->netinfo->{OperCount}
}

sub globalusers { users(@_) }
sub users {
  my ($self, $global) = @_;
  return $self->netinfo->{GlobalUsers} = $global
    if defined $global;
  return $self->netinfo->{GlobalUsers}
}

sub listlinks { links(@_) }
sub links {
  my ($self, $linklist) = @_;
  return $self->netinfo->{ListLinks} = $linklist
    if $linklist and ref $linklist eq 'ARRAY';
  return $self->netinfo->{ListLinks}//[]
  ## FIXME better links handling
}

sub chancount { totalchans(@_) }
sub totalchans {
  ## usually automagically updated
  my ($self, $count) = @_;
  return $self->netinfo->{ChanCount} = $count
    if defined $count;
  return $self->netinfo->{ChanCount}
}

sub listchans { channels(@_) }
sub channels {
  my ($self, $chanlist) = @_;
  return $self->netinfo->{ListChans} = $chanlist
    if $chanlist and ref $chanlist eq 'ARRAY';
  $self->_sort_listchans;
  return $self->netinfo->{ListChans}
}

sub hashchans { chanhash(@_) }
sub chanhash {
  my ($self, $hash) = @_;
  return $self->netinfo->{HashChans} = $hash
    if $hash and ref $hash eq 'HASH';
  return $self->netinfo->{HashChans}
}

sub ircd {
  my ($self, $version) = @_;
  return $self->netinfo->{IRCD} = $version
    if defined $version;
  return $self->netinfo->{IRCD}
}

sub add_channel {
  my ($self, $channel, $users, $topic) = @_;
  return unless $channel;
  $users //= 0;
  $topic //= '';
  $self->netinfo->{HashChans}->{$channel} = {
    Topic => $topic,
    Users => $users,
  };
  ++$self->netinfo->{ChanCount};
  return $channel
}

sub _sort_listchans {
  my ($self) = @_;
  my $chash = $self->netinfo->{HashChans}//{};
  return unless keys %$chash;
  my @sorted = sort {
      $chash->{$b}->{Users} <=> $chash->{$a}->{Users}
    } keys %$chash;
  $self->netinfo->{ListChans} = [];
  for my $chan (@sorted) {
    my $users = $chash->{$chan}->{Users};
    my $topic = $chash->{$chan}->{Topic};
    push(@{ $self->netinfo->{ListChans} }, [ $chan, $users, $topic ] );
  }
}

1;
__END__