view release on metacpan or  search on metacpan

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

package AnyEvent::IRC::Client;
use common::sense;

use Scalar::Util qw/weaken/;

use Encode;
use AnyEvent::Socket;
use AnyEvent::Handle;
use AnyEvent::IRC::Util
      qw/prefix_nick decode_ctcp split_prefix
         is_nick_prefix join_prefix encode_ctcp
         split_unicode_string mk_msg/;

use base AnyEvent::IRC::Connection::;

=head1 NAME

AnyEvent::IRC::Client - A highlevel IRC connection

=head1 SYNOPSIS

   use AnyEvent;
   use AnyEvent::IRC::Client;

   my $c = AnyEvent->condvar;

   my $timer;
   my $con = new AnyEvent::IRC::Client;

   $con->reg_cb (connect => sub {
      my ($con, $err) = @_;
      if (defined $err) {
         warn "connect error: $err\n";
         return;
      }
   });
   $con->reg_cb (registered => sub { print "I'm in!\n"; });
   $con->reg_cb (disconnect => sub { print "I'm out!\n"; $c->broadcast });
   $con->reg_cb (
      sent => sub {
         my ($con) = @_;

         if ($_[2] eq 'PRIVMSG') {
            print "Sent message!\n";

            $timer = AnyEvent->timer (
               after => 1,
               cb => sub {
                  undef $timer;
                  $con->disconnect ('done')
               }
            );
         }
      }
   );

   $con->send_srv (
      PRIVMSG => 'elmex',
      "Hello there I'm the cool AnyEvent::IRC test script!"
   );

   $con->connect ("localhost", 6667, { nick => 'testbot' });
   $c->wait;
   $con->disconnect;

=head1 DESCRIPTION

L<AnyEvent::IRC::Client> is a (nearly) highlevel client connection,
that manages all the stuff that noone wants to implement again and again
when handling with IRC. For example it PONGs the server or keeps track
of the users on a channel.

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

This method can be used to split up long messages into multiple
commands.

C<$cmd> and C<@params> are the IRC command and it's first parameters,
except the last one: the C<$msg>. C<$msg> can be a Unicode string,
which will be encoded in C<$encoding> before sending.

If you want to send a CTCP message you can encode it in the C<$cmd> by
appending the CTCP command with a C<"\001">. For example if you want to
send a CTCP ACTION you have to give this C<$cmd>:

   $cl->send_long_message (undef, 0, "PRIVMSG\001ACTION", "#test", "rofls");

C<$encoding> can be undef if you don't need any recoding of C<$msg>.
But in case you want to send Unicode it is necessary to determine where
to split a message exactly, to not break the encoding.

Please also note that the C<nick_ident> for your own nick is necessary to
compute this. To ensure best performance as possible use the
C<send_initial_whois> option if you want to use this method.

But note that this method might not work 100% correct and you might still get
at least partially chopped off lines if you use C<send_long_message> before the
C<WHOIS> reply to C<send_initial_whois> arrived.

To be on the safest side you might want to wait until that initial C<WHOIS>
reply arrived.

The return value of this method is the list of the actually sent lines (but
without encoding applied).

=cut

sub send_long_message {
   my ($self, $encoding, $overhead, $cmd, @params) = @_;
   my $msg = pop @params;

   my $ctcp;
   ($cmd, $ctcp) = split /\001/, $cmd;

   my $id = $self->nick_ident ($self->nick);
   if ($id eq '') {
      $id = "X" x 60; # just in case the ident is not available...
   }

   my $init_len = length mk_msg ($id, $cmd, @params, " "); # i know off by 1

   if ($ctcp ne '') {
      $init_len += length ($ctcp) + 3; # CTCP cmd + " " + "\001" x 2
   }

   my $max_len = 500; # give 10 bytes extra margin

   my $line_len = $max_len - $init_len;

   # split up the multiple lines in the message:
   my @lines = split /\n/, $msg;

   # splitup long lines into multiple ones:
   @lines =
      map split_unicode_string ($encoding, $_, $line_len), @lines;

   # send lines line-by-line:
   for my $line (@lines) {
      my $smsg = encode ($encoding, $line);

      if ($ctcp ne '') {
         $smsg = encode_ctcp ([$ctcp, $smsg])
      }

      $self->send_srv ($cmd => @params, $smsg);
   }

   @lines
}

=item $cl->enable_ping ($interval, $cb)

This method enables a periodical ping to the server with an interval of
C<$interval> seconds. If no PONG was received from the server until the next
interval the connection will be terminated or the callback in C<$cb> will be called.

(C<$cb> will have the connection object as it's first argument.)

Make sure you call this method after the connection has been established.
(eg. in the callback for the C<registered> event).

=cut

sub enable_ping {
   my ($self, $int, $cb) = @_;

   $self->{last_pong_recv} = 0;
   $self->{last_ping_sent} = time;

   $self->send_srv (PING => "AnyEvent::IRC");

   $self->{_ping_timer} =
      AE::timer $int, 0, sub {
         if ($self->{last_pong_recv} < $self->{last_ping_sent}) {
            delete $self->{_ping_timer};
            if ($cb) {
               $cb->($self);
            } else {
               $self->disconnect ("Server timeout");
            }

         } else {
            $self->enable_ping ($int, $cb);
         }
      };
}

=item $cl->lower_case ($str)

Converts the given string to lowercase according to CASEMAPPING setting given by
the IRC server. If none was sent, the default - rfc1459 - will be used.

=cut

sub lower_case {