view release on metacpan or  search on metacpan

lib/App/Alice/Test/MockIRC.pm  view on Meta::CPAN

        $self->cbs->{channel_remove}->($self, $msg, $msg->{params}[0], $nick);
      },
      PRIVMSG => sub {
        my $msg = shift;
        my $nick = prefix_nick($msg->{prefix});
        $self->cbs->{privatemsg}->($self, $nick, $msg);
      },
      numeric => sub {
        my ($msg, $number) = @_;
        $self->cbs->{"irc_$number"}->($self, $msg);
      },
    }
  }
);

sub send_srv {
  my ($self, $command, @args) = @_;
  my $echo = sub {mk_msg($self->user_prefix, $command, @args)};
  my $map = {
    map({$_ => $echo} qw/TOPIC JOIN PART NICK/),
    WHO => sub{
      my $user = ($args[0] =~ /^#/ ? "test" : $args[0]);
      ":local.irc 352 ".$self->nick." #test $user il.comcast.net local.irc $user H :0 $user";
    },
  };
  $map->{$command} ? $self->send_cl($map->{$command}->())
                   : warn "no line mapped for $command\n"
}

sub send_raw {
  my ($self, $line) = @_;
  $self->send_srv(split ' ', $line);
}

sub send_cl {
  my ($self, $line) = @_;
  my $msg = parse_irc_msg($line);
  my $cmd = ($msg->{command} =~ /^\d+/ ? 'numeric' : $msg->{command});
  try { $self->events->{$cmd}->($msg, $msg->{command}) if $self->events->{$cmd} }
  catch { warn "$_\n" };
}

sub enable_ssl {}
sub isupport {}
sub ctcp_auto_reply {}
sub connect {
  my $self = shift;
  $self->cbs->{connect}->();
}
sub register {
  my $self = shift;
  $self->cbs->{registered}->();
}
sub disconnect {
  my $self = shift;
  $self->cbs->{disconnect}->();
}
sub enable_ping {}

sub reg_cb {
  my ($self, %callbacks) = @_;
  for (keys %callbacks) {
    $self->cbs->{$_} = $callbacks{$_}; 
  }
}

__PACKAGE__->meta->make_immutable;
1;