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;

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

            $hdl->push_read (line => sub {
               my ($hdl, $line) = @_;
               $self->event (dcc_chat_msg => $id, $line);
            });
         });
      }
   });

   $self->reg_cb (dcc_connected => sub {
      my ($self, $id, $type, $hdl) = @_;

      if ($type eq 'chat') {
         $hdl->on_read (sub {
            my ($hdl) = @_;

            $hdl->push_read (line => sub {
               my ($hdl, $line) = @_;
               $self->event (dcc_chat_msg => $id, $line);
            });
         });
      }
   });
}

=item $cl->dcc_initiate ($dest, $type, $timeout, $local_ip, $local_port)

This function will initiate a DCC TCP connection to C<$dest> of type C<$type>.
It will setup a listening TCP socket on C<$local_port>, or a random port if
C<$local_port> is undefined. C<$local_ip> is the IP that is being sent to the
receiver of the DCC connection. If it is undef the local socket will be bound
to 0 (or "::" in case of IPv6) and C<$local_ip> will probably be something like
"0.0.0.0". It is always advisable to set C<$local_ip> to a (from the "outside",
what ever that might be) reachable IP Address.

C<$timeout> is the time in seconds after which the listening socket will be
closed if the receiver didn't connect yet. The default is 300 (5 minutes).

When the local listening socket has been setup the C<dcc_ready> event is
emitted.  When the receiver connects to the socket the C<dcc_accepted> event is
emitted.  And whenever a dcc connection is closed the C<dcc_close> event is
emitted.

For canceling the DCC offer or closing the connection see C<dcc_disconnect> below.

The return value of this function will be the ID of the initiated DCC connection,
which can be used for functions such as C<dcc_disconnect>, C<send_dcc_chat> or
C<dcc_handle>.

=cut

sub dcc_initiate {
   my ($self, $dest, $type, $timeout, $local_ip, $local_port) = @_;

   $dest = $self->lower_case ($dest);
   $type = lc $type;

   my $id = ++$self->{dcc_id};
   my $dcc = $self->{dcc}->{$id} = { id => $id, type => $type, dest => $dest };

   weaken $dcc;
   weaken $self;

   $dcc->{timeout} = AnyEvent->timer (after => $timeout || 5 * 60, cb => sub {
      $self->dcc_disconnect ($id, "TIMEOUT") if $self;
   });

   $dcc->{listener} = tcp_server undef, $local_port, sub {
      my ($fh, $h, $p) = @_;
      return unless $dcc && $self;

      $dcc->{handle} = AnyEvent::Handle->new (
         fh => $fh,
         on_eof => sub {
            $self->dcc_disconnect ($id, "EOF");
         },
         on_error => sub {
            $self->dcc_disconnect ($id, "ERROR: $!");
         }
      );

      $self->event (dcc_accepted => $id, $type, $dcc->{handle});

      delete $dcc->{listener};
      delete $dcc->{timeout};

   }, sub {
      my ($fh, $host, $port) = @_;
      return unless $dcc && $self;

      $local_ip   = $host unless defined $local_ip;
      $local_port = $port;

      $dcc->{local_ip}   = $local_ip;
      $dcc->{local_port} = $local_port;

      $self->event (dcc_ready => $id, $dest, $type, $local_ip, $local_port);
   };

   $id
}


=item $cl->dcc_disconnect ($id, $reason)

In case you want to withdraw a DCC offer sent by C<start_dcc> or close
a DCC connection you call this function.

C<$id> is the DCC connection ID.  C<$reason> should be a human readable reason
why you ended the dcc offer, but it's only used for local logging purposes (see
C<dcc_close> event).

=cut

sub dcc_disconnect {
   my ($self, $id, $reason) = @_;

   if (my $dcc = delete $self->{dcc}->{$id}) {
      delete $dcc->{handle};
      $self->event (dcc_close => $id, $dcc->{type}, $reason);
   }
}

=item $cl->dcc_accept ($id, $timeout)

This will accept an incoming DCC request as received by the C<dcc_request>
event. The C<dcc_connected> event will be emitted when we successfully
connected. And the C<dcc_close> event when the connection was disconnected.

C<$timeout> is the connection try timeout in seconds. The default is 300 (5 minutes).

=cut

sub dcc_accept {
   my ($self, $id, $timeout) = @_;

   my $dcc = $self->{dcc}->{$id}
      or return;

   weaken $dcc;
   weaken $self;

   $dcc->{timeout} = AnyEvent->timer (after => $timeout || 5 * 60, cb => sub {
      $self->dcc_disconnect ($id, "CONNECT TIMEOUT") if $self;
   });

   $dcc->{connect} = tcp_connect $dcc->{ip}, $dcc->{port}, sub {
      my ($fh) = @_;
      return unless $dcc && $self;

      delete $dcc->{timeout};
      delete $dcc->{connect};

      unless ($fh) {
         $self->dcc_disconnect ($id, "CONNECT ERROR: $!");
         return;
      }

      $dcc->{handle} = AnyEvent::Handle->new (
         fh => $fh,
         on_eof => sub {
            delete $dcc->{handle};
            $self->dcc_disconnect ($id, "EOF");
         },
         on_error => sub {
            delete $dcc->{handle};
            $self->dcc_disconnect ($id, "ERROR: $!");
         }
      );

      $self->event (dcc_connected => $id, $dcc->{type}, $dcc->{handle});
   };

   $id
}

sub dcc_handle {
   my ($self, $id) = @_;

   if (my $dcc = $self->{dcc}->{$id}) {
      return $dcc->{handle}
   }
   return;
}

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

   if (my $dcc = $self->{dcc}->{$id}) {
      if ($dcc->{handle}) {
         $dcc->{handle}->push_write ("$msg\015\012");
      }
   }
}

################################################################################
# Private utility functions
################################################################################

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