AnyEvent-IRC

 view release on metacpan or  search on metacpan

lib/AnyEvent/IRC/Client.pm  view on Meta::CPAN

C<$id> and C<$type> are the DCC connection ID and type of the DCC request.

C<$hdl> is a pre-configured L<AnyEvent::Handle> object, which you only
need to care about in case you want to implement your own DCC protocol.
(This event has the on_error and on_eof events pre-configured to cleanup
the data structures in this connection).

=item dcc_connected => $id, $type, $hdl

Whenever we accepted a DCC offer and connected by using C<dcc_accept> this
event is emitted. C<$id> is the DCC connection ID.  C<$type> is the dcc type in
lower case. C<$hdl> is the L<AnyEvent::Handle> object of the connection (see
also C<dcc_accepted> above).

=item dcc_close => $id, $type, $reason

This event is emitted whenever a DCC connection is terminated.

C<$id> and C<$type> are the DCC connection ID and type of the DCC request.

C<$reason> is a human readable string indicating the reason for the end of
the DCC request.

=item dcc_chat_msg => $id, $msg

This event is emitted for a DCC CHAT message. C<$id> is the DCC connection
ID we received the message on. And C<$msg> is the message he sent us.

=item quit => $nick, $msg

Emitted when the nickname C<$nick> QUITs with the message C<$msg>.

=item publicmsg => $channel, $ircmsg

Emitted for NOTICE and PRIVMSG where the target C<$channel> is a channel.
C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.

The last parameter of the C<$ircmsg> will have all CTCP messages stripped off.

=item privatemsg => $nick, $ircmsg

Emitted for NOTICE and PRIVMSG where the target C<$nick> (most of the time you) is a nick.
C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.

The last parameter of the C<$ircmsg> will have all CTCP messages stripped off.

=item error => $code, $message, $ircmsg

Emitted when any error occurs. C<$code> is the 3 digit error id string from RFC
1459 or the string 'ERROR'. C<$message> is a description of the error.
C<$ircmsg> is the complete error irc message.

You may use AnyEvent::IRC::Util::rfc_code_to_name to convert C<$code> to the error
name from the RFC 2812. eg.:

   rfc_code_to_name ('471') => 'ERR_CHANNELISFULL'

NOTE: This event is also emitted when a 'ERROR' message is received.

=item debug_send => $command, @params

Is emitted everytime some command is sent.

=item debug_recv => $ircmsg

Is emitted everytime some command was received.

=back

=head1 METHODS

=over 4

=item $cl = AnyEvent::IRC::Client->new (%args)

This is the constructor of a L<AnyEvent::IRC::Client> object,
which stands logically for a client connected to ONE IRC server.
You can reuse it and call C<connect> once it disconnected.

B<NOTE:> You are free to use the hash member C<heap> to store any associated
data with this object. For example retry timers or anything else.

C<%args> may contain these options:

=over 4

=item send_initial_whois => $bool

If this option is enabled an initial C<WHOIS> command is sent to your own
NICKNAME to determine your own I<ident>. See also the method C<nick_ident>.
This is necessary to ensure that the information about your own nickname
is available as early as possible for the C<send_long_message> method.

C<$bool> is C<false> by default.

=back

=cut

my %LOWER_CASEMAP = (
   rfc1459          => sub { tr/A-Z[]\\\^/a-z{}|~/ },
   'strict-rfc1459' => sub { tr/A-Z[]\\/a-z{}|/ },
   ascii            => sub { tr/A-Z/a-z/ },
);

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = $class->SUPER::new (@_);

   $self->reg_cb (irc_001     => \&welcome_cb);
   $self->reg_cb (irc_376     => \&welcome_cb);
   $self->reg_cb (irc_422     => \&welcome_cb);
   $self->reg_cb (irc_005     => \&isupport_cb);
   $self->reg_cb (irc_join    => \&join_cb);
   $self->reg_cb (irc_nick    => \&nick_cb);
   $self->reg_cb (irc_part    => \&part_cb);
   $self->reg_cb (irc_kick    => \&kick_cb);
   $self->reg_cb (irc_quit    => \&quit_cb);
   $self->reg_cb (irc_mode    => \&mode_cb);
   $self->reg_cb (irc_353     => \&namereply_cb);
   $self->reg_cb (irc_366     => \&endofnames_cb);
   $self->reg_cb (irc_352     => \&whoreply_cb);
   $self->reg_cb (irc_311     => \&whoisuser_cb);
   $self->reg_cb (irc_305     => \&away_change_cb);
   $self->reg_cb (irc_306     => \&away_change_cb);
   $self->reg_cb (irc_ping    => \&ping_cb);
   $self->reg_cb (irc_pong    => \&pong_cb);

   $self->reg_cb (irc_privmsg => \&privmsg_cb);
   $self->reg_cb (irc_notice  => \&privmsg_cb);

   $self->reg_cb ('irc_*'     => \&debug_cb);
   $self->reg_cb ('irc_*'     => \&anymsg_cb);
   $self->reg_cb ('irc_*'     => \&update_ident_cb);

   $self->reg_cb (disconnect  => \&disconnect_cb);

   $self->reg_cb (irc_332     => \&rpl_topic_cb);
   $self->reg_cb (irc_topic   => \&topic_change_cb);

   $self->reg_cb (ctcp        => \&ctcp_auto_reply_cb);

   $self->reg_cb (registered  => \&registered_cb);

   $self->reg_cb (nick_change => \&update_ident_nick_change_cb);

   $self->{def_nick_change} = $self->{nick_change} =
      sub {
         my ($old_nick) = @_;
         "${old_nick}_"
      };

   $self->_setup_internal_dcc_handlers;

   $self->cleanup;

   return $self;
}

sub cleanup {
   my ($self) = @_;

   $self->{channel_list}  = { };
   $self->{isupport}      = { };
   $self->{casemap_func}  = $LOWER_CASEMAP{rfc1459};
   $self->{prefix_chars}  = '@+';
   $self->{prefix2mode}   = { '@' => 'o', '+' => 'v' };
   $self->{channel_chars} = '#&';

   $self->{change_nick_cb_guard} =
      $self->reg_cb (
         irc_437 => \&change_nick_login_cb,
         irc_433 => \&change_nick_login_cb,
      );

   delete $self->{away_status};
   delete $self->{dcc};
   delete $self->{dcc_id};
   delete $self->{_tmp_namereply};
   delete $self->{last_pong_recv};
   delete $self->{last_ping_sent};
   delete $self->{_ping_timer};
   delete $self->{con_queue};
   delete $self->{chan_queue};
   delete $self->{registered};
   delete $self->{idents};
   delete $self->{nick};
   delete $self->{user};
   delete $self->{real};
   delete $self->{server_pass};
   delete $self->{register_cb_guard};
}

lib/AnyEvent/IRC/Client.pm  view on Meta::CPAN

=item $cl->registered ()

Returns a true value when the connection has been registered successful and
you can send commands.

=cut

sub registered { $_[0]->{registered} }

=item $cl->channel_list ()

=item $cl->channel_list ($channel)

Without C<$channel> parameter: This returns a hash reference. The keys are the
currently joined channels in lower case.  The values are hash references which
contain the joined nicks as key (NOT in lower case!) and the nick modes as
values (as returned from C<nick_modes ()>).

If the C<$channel> parameter is given it returns the hash reference of the channel
occupants or undef if the channel does not exist.

=cut

sub channel_list {
   my ($self, $chan) = @_;

   if (defined $chan) {
      return $self->{channel_list}->{$self->lower_case ($chan)}
   } else {
      return $self->{channel_list} || {};
   }
}

=item $cl->nick_modes ($channel, $nick)

This returns the mode map of the C<$nick> on C<$channel>.
Returns undef if the channel isn't joined or the user is not on it.
Returns a hash reference with the modes the user has as keys and 1's as values.

=cut

sub nick_modes {
    my ($self, $channel, $nick) = @_;

    my $c = $self->channel_list ($channel)
       or return undef;

    my (%lcc) = map { $self->lower_case ($_) => $c->{$_} } keys %$c;
    return $lcc{$self->lower_case ($nick)};
}

=item $cl->send_msg (...)

See also L<AnyEvent::IRC::Connection>.

=cut

sub send_msg {
   my ($self, @a) = @_;
   $self->event (debug_send => @a);
   $self->SUPER::send_msg (@a);
}

=item $cl->send_srv ($command, @params)

This function sends an IRC message that is constructed by C<mk_msg (undef,
$command, @params)> (see L<AnyEvent::IRC::Util>). If the C<registered> event
has NOT yet been emitted the messages are queued until that event is emitted,
and then sent to the server.

B<NOTE:> If you stop the registered event (with C<stop_event>, see L<Object::Event>)
in a callback registered to the C<before_registered> event, the C<send_srv> queue
will B<NOT> be flushed and B<NOT> sent to the server!

This allows you to simply write this:

   my $cl = AnyEvent::IRC::Client->new;
   $cl->connect ('irc.freenode.net', 6667, { nick => 'testbot' });
   $cl->send_srv (PRIVMSG => 'elmex', 'Hi there!');

Instead of:

   my $cl = AnyEvent::IRC::Client->new;
   $cl->reg_cb (
      registered => sub {
         $cl->send_msg (PRIVMSG => 'elmex', 'Hi there!');
      }
   );
   $cl->connect ('irc.freenode.net', 6667, { nick => 'testbot' });

=cut

sub send_srv {
   my ($self, @msg) = @_;

   if ($self->registered) {
      $self->send_msg (@msg);

   } else {
      push @{$self->{con_queue}}, \@msg;
   }
}

=item $cl->clear_srv_queue ()

Clears the server send queue.

=cut

sub clear_srv_queue {
   my ($self) = @_;
   $self->{con_queue} = [];
}


=item $cl->send_chan ($channel, $command, @params)

This function sends a message (constructed by C<mk_msg (undef, $command,
@params)> to the server, like C<send_srv> only that it will queue
the messages if it hasn't joined the channel C<$channel> yet. The queued

lib/AnyEvent/IRC/Client.pm  view on Meta::CPAN

   $self->event (part => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
   $self->channel_remove ($msg, $chan, [$nick]);
   $self->event (channel_remove => $msg, $chan, $nick);
}

sub kick_cb {
   my ($self, $msg) = @_;
   my $chan        = $msg->{params}->[0];
   my $kicked_nick = $msg->{params}->[1];
   my $kicker_nick = prefix_nick($msg);

   $self->event (kick           => $kicked_nick, $chan, $self->_was_me ($msg), $msg->{params}->[2], $kicker_nick);
   $self->channel_remove ($msg, $chan, [$kicked_nick]);
   $self->event (channel_remove => $msg, $chan, $kicked_nick);
}

sub quit_cb {
   my ($self, $msg) = @_;
   my $nick = prefix_nick ($msg);

   $self->event (quit => $nick, $msg->{params}->[0]);

   for (keys %{$self->{channel_list}}) {
      if ($self->{channel_list}->{$_}->{$nick}) {
         $self->channel_remove ($msg, $_, [$nick]);
         $self->event (channel_remove => $msg, $_, $nick);
      }
   }
}

sub mode_cb {
   my ($self, $msg) = @_;
   my $changer = prefix_nick ($msg);
   my ($target, $mode, $dest) = (@{$msg->{params}});

   if ($self->is_channel_name ($target)) {
      if ($mode =~ /^([+-])(\S+)$/ && defined $dest) {
         my ($op, $mode) = ($1, $2);

         if (defined $self->map_mode_to_prefix ($mode)) {
            $self->channel_mode_change ($target, $op, $mode, $dest);
            $self->event (channel_nickmode_update => $target, $dest);
         }
      }
   }
}

sub away_change_cb {
   my ($self, $msg) = @_;

   if ($msg->{command} eq '305') { # no longer away
      delete $self->{away_status};
   } else { # away
      $self->{away_status} = 1;
   }

   $self->event (away_status_change => $self->{away_status});
}

sub debug_cb {
   my ($self, $msg) = @_;
   $self->event (debug_recv => $msg);
}

sub change_nick_login_cb {
   my ($self, $msg) = @_;

   if ($self->registered) {
      delete $self->{change_nick_cb_guard};

   } else {
      my $newnick = $self->{nick_change}->($self->nick);

      if ($self->lower_case ($newnick) eq $self->lower_case ($self->{nick})) {
         $self->disconnect ("couldn't change nick to non-conflicting one");
         return 0;
      }

      $self->{nick} = $newnick;
      $self->send_msg ("NICK", $newnick);
   }
}

sub disconnect_cb {
   my ($self) = @_;

   for (keys %{$self->{channel_list}}) {
      $self->channel_remove (undef, $_, [$self->nick]);
      $self->event (channel_remove => undef, $_, $self->nick)
   }

   $self->cleanup;
}

sub rpl_topic_cb {
   my ($self, $msg) = @_;
   my $chan  = $msg->{params}->[1];
   my $topic = $msg->{params}->[-1];

   $self->event (channel_topic => $chan, $topic);
}

sub topic_change_cb {
   my ($self, $msg) = @_;
   my $who   = prefix_nick ($msg);
   my $chan  = $msg->{params}->[0];
   my $topic = $msg->{params}->[-1];

   $self->event (channel_topic => $chan, $topic, $who);
}

sub update_ident_cb {
   my ($self, $msg) = @_;

   if (is_nick_prefix ($msg->{prefix})) {
      $self->update_ident ($msg->{prefix});
   }
}

sub update_ident_nick_change_cb {
   my ($self, $old, $new) = @_;