AnyEvent-IRC

 view release on metacpan or  search on metacpan

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

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} = '#&';

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

   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};
}

=item $cl->connect ($host, $port)

=item $cl->connect ($host, $port, $info)

This method does the same as the C<connect> method of L<AnyEvent::Connection>,
but if the C<$info> parameter is passed it will automatically register with the
IRC server upon connect for you, and you won't have to call the C<register>
method yourself. If C<$info> only contains the timeout value it will not
automatically connect, this way you can pass a custom connect timeout value
without having to register.

The keys of the hash reference you can pass in C<$info> are:

   nick      - the nickname you want to register as
   user      - your username
   real      - your realname
   password  - the server password
   timeout   - the TCP connect timeout

All keys, except C<nick> are optional.

=cut

sub connect {
   my ($self, $host, $port, $info) = @_;

   my $timeout = delete $info->{timeout};

   if (defined $info and keys %$info) {
      $self->{register_cb_guard} = $self->reg_cb (
         ext_before_connect => sub {
            my ($self, $err) = @_;

            unless ($err) {
               $self->register (
                  $info->{nick}, $info->{user}, $info->{real}, $info->{password}
               );
            }

            delete $self->{register_cb_guard};
         }
      );
   }

   $self->SUPER::connect ($host, $port, $timeout);
}

=item $cl->register ($nick, $user, $real, $server_pass)

Sends the IRC registration commands NICK and USER.
If C<$server_pass> is passed also a PASS command is generated.

NOTE: If you passed the nick, user, etc. already to the C<connect> method
you won't need to call this method, as L<AnyEvent::IRC::Client> will do that
for you.

=cut

sub register {
   my ($self, $nick, $user, $real, $pass) = @_;

   $self->{nick} = $nick;
   $self->{user} = $user;
   $self->{real} = $real;
   $self->{server_pass} = $pass;

   $self->send_msg ("PASS", $pass) if defined $pass;
   $self->send_msg ("NICK", $nick);
   $self->send_msg ("USER", $user || $nick, "*", "0", $real || $nick);
}

=item $cl->set_nick_change_cb ($callback)

This method lets you modify the nickname renaming mechanism when registering
the connection. C<$callback> is called with the current nickname as first
argument when a ERR_NICKNAMEINUSE or ERR_UNAVAILRESOURCE error occurs on login.
The return value of C<$callback> will then be used to change the nickname.

If C<$callback> is not defined the default nick change callback will be used
again.

The default callback appends '_' to the end of the nickname supplied in the
C<register> routine.

If the callback returns the same nickname that was given it the connection
will be terminated.

=cut

sub set_nick_change_cb {
   my ($self, $cb) = @_;
   $cb = $self->{def_nick_change} unless defined $cb;
   $self->{nick_change} = $cb;
}

=item $cl->nick ()

Returns the current nickname, under which this connection
is registered at the IRC server. It might be different from the
one that was passed to C<register> as a nick-collision might happened
on login.

=cut

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

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
messages will be send once the connection successfully JOINed the C<$channel>.