view release on metacpan or  search on metacpan

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

package Alice::Test::MockIRC;

use Any::Moose;
use AnyEvent::IRC::Util qw/parse_irc_msg prefix_nick mk_msg/;
use Try::Tiny;

has cbs => (is => 'rw', default => sub {{}});
has nick => (is => 'rw');
has is_connected => (is => 'rw', default => 0);
has channels => (is => 'rw', default => sub {{}});
has user_prefix => (
  is => 'rw',
  lazy => 1,
  default => sub{$_[0]->nick."!".$_[0]->nick."\@host"}
);

has events => (
  is => 'rw',
  default => sub {
    my $self = shift;
    {
      TOPIC => sub {
        my $msg = shift;
        my $nick = prefix_nick($msg->{prefix});
        $self->cbs->{channel_topic}->($self, @{$msg->{params}}, $nick);
      },
      JOIN => sub {
        my $msg = shift;
        my $nick = prefix_nick($msg->{prefix});
        $self->{channels}{$msg->{params}[0]} = 1;
        $self->cbs->{join}->($self, $nick, $msg->{params}[0], $nick eq $self->nick);
        $self->cbs->{channel_add}->($self, $msg, $msg->{params}[0], $nick);
        $self->send_srv(WHO => $msg->{params}[0]);
      },
      NICK => sub {
        my $msg = shift;
        my $nick = prefix_nick($msg->{prefix});
        $self->cbs->{nick_change}->($self, $nick, ${$msg->{params}}[0], $nick eq $self->nick);
      },
      PART => sub {
        my $msg = shift;
        my $nick = prefix_nick($msg->{prefix});
        delete $self->{channels}{$msg->{params}[0]};
        $self->cbs->{part}->($self, $nick, $msg->{params}[0], $nick eq $self->nick);
        $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{