AnyEvent-IRC-0.97/0000755000000000000000000000000012121404774012315 5ustar rootrootAnyEvent-IRC-0.97/samples/0000755000000000000000000000000012121404774013761 5ustar rootrootAnyEvent-IRC-0.97/samples/anyeventirccl0000755000000000000000000000310411444066626016562 0ustar rootroot#!/usr/bin/env perl use common::sense; use AnyEvent::IRC::Client; my $c = AnyEvent->condvar; my $pc = AnyEvent::IRC::Client->new; $pc->reg_cb ( irc_privmsg => sub { my ($self, $msg) = @_; if ($msg->{params}->[-1] =~ m/net_irc3:\s*(.*)/) { $pc->send_chan ("#test", "PRIVMSG", "#test", "yes?"); } } ); $pc->reg_cb ( channel_add => sub { my ($self, $msg, $chan, @nicks) = @_; my $nick = join ",", @nicks; print "$chan += $nick\n"; print "chans: " . (join ";", keys %{$self->channel_list}) ."\n"; print "nicks: " . (join ";", keys %{$self->channel_list ()->{$chan}}) ."\n"; }, channel_remove => sub { my ($self, $msg, $chan, @nicks) = @_; my $nick = join ",", @nicks; print "$chan -= $nick\n"; print "chans: " . (join ";", keys %{$self->channel_list}) ."\n"; print "nicks: " . (join ";", keys %{$self->channel_list ()->{$chan}}) ."\n"; } ); $pc->reg_cb ( connect => sub { my ($pc, $err) = @_; if (defined $err) { print "Couldn't connect to server: $err\n"; } }, registered => sub { my ($self) = @_; print "registered!\n"; $pc->enable_ping (60); }, disconnect => sub { print "disconnected: $_[1]!\n"; } ); # these commands will queue until the connection # is completly registered and has a valid nick etc. $pc->send_srv ("JOIN", "#test"); $pc->send_chan ("#test", "PRIVMSG", "#test", "hi, i'm a bot!"); $pc->connect ( "irc.freenode.net", 6667, { nick => 'net_irc3', user => 'net_irc3', real => 'test bot' } ); $c->wait; AnyEvent-IRC-0.97/samples/anyeventirc0000755000000000000000000000271211444066626016247 0ustar rootroot#!/usr/bin/env perl use common::sense; use AnyEvent::Impl::Perl; use AnyEvent; use AnyEvent::IRC::Connection; my $c = AnyEvent->condvar; my $con = AnyEvent::IRC::Connection->new; my ($nick, $user, $real) = qw/BinDepp BinDepp depp/; $con->reg_cb (irc_001 => sub { my ($con) = @_; $con->event ('welcome'); # emit a self defined event }); # display all irc messages for debugging $con->reg_cb ('irc_*' => sub { my @p = @{delete $_[1]->{params} || []}; warn "DEBUG: " . join ('|', %{$_[1]}, @p) . "\n"; }); $con->reg_cb ('sent' => sub { shift; warn "DEBUG SENT: " . join ('|', @_) . "\n"; }); # we register now a callback on our self defined event $con->reg_cb (welcome => sub { my ($con) = @_; $con->send_msg ("PRIVMSG", "elmex", "Hi!!!"); }); # Disconnect after 10 seconds: my $t; $t = AnyEvent->timer (after => 10, cb => sub { $con->disconnect ("Timeout exceeded"); undef $t; }); # lets register connect and disconnect handlers. $con->reg_cb ( connect => sub { my ($con, $err) = @_; if (defined $err) { warn "Connect ERROR! => $err\n"; $c->broadcast; } else { warn "Connected! Yay!\n"; } # send IRC registration $con->send_msg ("NICK", $nick); $con->send_msg ("USER", $user || $nick, "*", "0", $real || $nick); }, disconnect => sub { warn "Oh, got a disconnect: $_[1], exiting...\n"; $c->broadcast; } ); $con->connect ("localhost", 6667); $c->wait; AnyEvent-IRC-0.97/samples/debug_console0000755000000000000000000000441411444066626016531 0ustar rootroot#!/usr/bin/env perl # This is a simple script that connects stdin/stdout with a client # connection to an irc server. the command line arguments are: # # $ ./debug_console # use common::sense; use IO::Handle; use AnyEvent; use AnyEvent::IRC::Client; use AnyEvent::IRC::Util qw/mk_msg parse_irc_msg encode_ctcp/; use Data::Dumper; my ($nick, $server, $port) = @ARGV; my $c = AnyEvent->condvar; my $stdout = AnyEvent::Handle->new (fh => \*STDOUT); my $con = new AnyEvent::IRC::Client; $con->reg_cb ( connect => sub { my ($con, $err) = @_; if (defined $err) { warn "Couldn't connect: $err\n"; $c->broadcast; } else { $stdout->push_write ("Connected!\n"); } $con->register ($nick, $nick, $nick); }, debug_recv => sub { my ($con, $msg) = @_; $stdout->push_write ( "< " . mk_msg ($msg->{prefix}, $msg->{command}, @{$msg->{params}}) . "\n" ); }, debug_send => sub { my ($con, @msg) = @_; $stdout->push_write ( "> " . mk_msg (undef, @msg) . "\n" ); }, registered => sub { my ($con) = @_; my $stdin; $stdin = AnyEvent::Handle->new ( fh => \*STDIN, on_eof => sub { warn "EOF on STDIN, disconnecting...\n"; $con->disconnect ("Console EOF"); }, on_error => sub { warn "Error on STDIN: $!\n"; }, on_read => sub { $stdin->push_read (line => sub { my ($stdin, $line) = @_; if ($line =~ /^!/) { my $r = eval $line; if ($@) { warn "eval error: $@\n"; } else { $Data::Dumper::Terse = 1; $stdout->push_write ("result: " . Data::Dumper::Dumper ($r)); } } else { my $msg = parse_irc_msg ($line); $con->send_msg ($msg->{command}, @{$msg->{params}}); } }); } ); }, disconnect => sub { warn "disconnect: $_[1]!\n"; $c->broadcast }, ); $con->ctcp_auto_reply ('VERSION', ['VERSION', 'DebugConsole:0.1:Perl']); $con->connect ($server, $port || 6667); $c->wait; AnyEvent-IRC-0.97/samples/dcc0000755000000000000000000000220411444066626014445 0ustar rootroot#!/usr/bin/env perl # Just a small sample script on how DCC is used. # use common::sense; use AnyEvent; use AnyEvent::IRC::Client; my $c = AnyEvent->condvar; my $con = new AnyEvent::IRC::Client; $con->connect ("localhost", 6667, { nick => 'testdcc' }); $con->reg_cb ( registered => sub { my ($con) = @_; $con->dcc_initiate ("root", "chat", 20); }, dcc_request => sub { my ($con, $id, $src, $type, $arg, $addr) = @_; warn "DCC REQ $id/$type\n"; $con->dcc_accept ($id); }, dcc_connected => sub { my ($con, $id, $type, $hdl) = @_; warn "DCC CONN $id/$type\n"; if ($type eq 'chat') { $con->send_dcc_chat ($id, "Hi!"); } }, dcc_accepted => sub { my ($con, $id, $type) = @_; warn "DCC ACC $id/$type\n"; if ($type eq 'chat') { $con->send_dcc_chat ($id, "Hi!"); } }, dcc_close => sub { my ($con, $id, $type, $reason) = @_; warn "DCC $type [$id] CLOSE: $reason\n"; }, dcc_chat_msg => sub { my ($con, $id, $msg) = @_; warn "DCC $id> $msg\n"; $con->send_dcc_chat ($id, "<$msg>?"); }, ); $c->wait; AnyEvent-IRC-0.97/samples/test_connect0000755000000000000000000000076711665643221016415 0ustar rootroot#!/usr/bin/env perl use AnyEvent; use AnyEvent::IRC::Connection; my $c = AnyEvent->condvar; my $con = new AnyEvent::IRC::Connection; $con->connect ("localhost", 6667); $con->reg_cb ( connect => sub { my ($con) = @_; $con->send_msg (NICK => "testbot"); $con->send_msg (USER => "testbot", '*', '0', 'testbot'); }, irc_001 => sub { my ($con, $msg) = @_; print "$msg->{prefix} says i'm in the IRC: $msg->{params}->[-1]!\n"; $c->broadcast } ); $c->wait; AnyEvent-IRC-0.97/samples/notify0000755000000000000000000000156311444066626015233 0ustar rootroot#!/usr/bin/env perl use common::sense; use AnyEvent; use AnyEvent::IRC::Client; my $c = AnyEvent->condvar; my $con = new AnyEvent::IRC::Client; $con->reg_cb ( connect => sub { my ($con, $err) = @_; if (defined $err) { warn "Couldn't connect: $err\n"; $c->send; } else { print "Connected!\n"; } $con->register (qw/testbot testbot testbot/); }, registered => sub { my ($con) = @_; print "I'm in!\n"; $con->reg_cb (buffer_empty => sub { my ($con) = @_; $con->unreg_me; $con->disconnect ("Message delivered!"); }); $con->send_msg ( PRIVMSG => 'elmex', "Hello there i'm the cool AnyEvent::IRC test script!" ); }, disconnect => sub { print "I'm out ($_[1])!\n"; $c->send }, ); $con->connect ("localhost", 6667); $c->recv; AnyEvent-IRC-0.97/samples/version_dump0000755000000000000000000000210011444066626016421 0ustar rootroot#!/usr/bin/env perl # Dumps the version of the irc server and exits. # # Command line: # $ ./version_dump # use common::sense; use AnyEvent; use AnyEvent::IRC::Client; use AnyEvent::IRC::Util qw/mk_msg parse_irc_msg encode_ctcp/; use Data::Dumper; my $nick = "vtest1"; my ($server, $port) = @ARGV; my $c = AnyEvent->condvar; my $con = new AnyEvent::IRC::Client; $con->reg_cb ( connect => sub { my ($con, $err) = @_; if (defined $err) { warn "Couldn't connect: $err\n"; $c->broadcast; } $con->register ($nick, $nick, $nick); }, registered => sub { my ($con, $msg) = @_; $con->send_srv ('VERSION'); }, irc_351 => sub { # < :irctest.test 351 elmex hybrid-7.2.3(SVN). irctest.test :eGgIKM6 TS6ow my ($con, $msg) = @_; my @v = @{$msg->{params}}; print "$v[1]\n"; $con->disconnect ("done"); }, disconnect => sub { $c->broadcast }, ); $con->ctcp_auto_reply ('VERSION', ['VERSION', 'VersionDump:0.1:Perl']); $con->connect ($server, $port || 6667); $c->wait; AnyEvent-IRC-0.97/lib/0000755000000000000000000000000012121404774013063 5ustar rootrootAnyEvent-IRC-0.97/lib/AnyEvent/0000755000000000000000000000000012121404774014614 5ustar rootrootAnyEvent-IRC-0.97/lib/AnyEvent/IRC/0000755000000000000000000000000012121404774015231 5ustar rootrootAnyEvent-IRC-0.97/lib/AnyEvent/IRC/Client.pm0000644000000000000000000013652011671323612017014 0ustar rootrootpackage 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 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. This module also implements the ISUPPORT (command 005) extension of the IRC protocol (see http://www.irc.org/tech_docs/005.html) and will enable the NAMESX and UHNAMES extensions when supported by the server. Also CTCP support is implemented, all CTCP messages will be decoded and events for them will be generated. You can configure auto-replies to certain CTCP commands with the C method, or you can generate the replies yourself. =head2 A NOTE TO CASE MANAGEMENT The case insensitivity of channel names and nicknames can lead to headaches when dealing with IRC in an automated client which tracks channels and nicknames. I tried to preserve the case in all channel and nicknames AnyEvent::IRC::Client passes to his user. But in the internal structures I'm using lower case for the channel names. The returned hash from C for example has the lower case of the joined channels as keys. But I tried to preserve the case in all events that are emitted. Please keep this in mind when handling the events. For example a user might joins #TeSt and parts #test later. =head1 EVENTS The following events are emitted by L. Use C as described in L to register to such an event. =over 4 =item registered Emitted when the connection got successfully registered and the end of the MOTD (IRC command 376 or 422 (No MOTD file found)) was seen, so you can start sending commands and all ISUPPORT/PROTOCTL handshaking has been done. =item channel_add => $msg, $channel, @nicks Emitted when C<@nicks> are added to the channel C<$channel>, this happens for example when someone JOINs a channel or when you get a RPL_NAMREPLY (see RFC1459). C<$msg> is the IRC message hash that as returned by C. =item channel_remove => $msg, $channel, @nicks Emitted when C<@nicks> are removed from the channel C<$channel>, happens for example when they PART, QUIT or get KICKed. C<$msg> is the IRC message hash that as returned by C or undef if the reason for the removal was a disconnect on our end. =item channel_change => $msg, $channel, $old_nick, $new_nick, $is_myself Emitted when a nickname on a channel changes. This is emitted when a NICK change occurs from C<$old_nick> to C<$new_nick> give the application a chance to quickly analyze what channels were affected. C<$is_myself> is true when yourself was the one who changed the nick. =item channel_nickmode_update => $channel, $dest This event is emitted when the (user) mode (eg. op status) of an occupant of a channel changes. C<$dest> is the nickname on the C<$channel> who's mode was updated. =item channel_topic => $channel, $topic, $who This is emitted when the topic for a channel is discovered. C<$channel> is the channel for which C<$topic> is the current topic now. Which is set by C<$who>. C<$who> might be undefined when it's not known who set the channel topic. =item ident_change => $nick, $ident Whenever the user and host of C<$nick> has been determined or a change happened this event is emitted. =item join => $nick, $channel, $is_myself Emitted when C<$nick> enters the channel C<$channel> by JOINing. C<$is_myself> is true if yourself are the one who JOINs. =item part => $nick, $channel, $is_myself, $msg Emitted when C<$nick> PARTs the channel C<$channel>. C<$is_myself> is true if yourself are the one who PARTs. C<$msg> is the PART message. =item kick => $kicked_nick, $channel, $is_myself, $msg, $kicker_nick Emitted when C<$kicked_nick> is KICKed from the channel C<$channel> by C<$kicker_nick>. C<$is_myself> is true if yourself are the one who got KICKed. C<$msg> is the KICK message. =item nick_change => $old_nick, $new_nick, $is_myself Emitted when C<$old_nick> is renamed to C<$new_nick>. C<$is_myself> is true when yourself was the one who changed the nick. =item away_status_change => $bool Emitted whenever a presence/away status change for you was detected. C<$bool> is true if you are now away, or false/undef if you are not away anymore. You can change your away status by emitting the C IRC command: $cl->send_srv (AWAY => "I'm not here right now"); Or reset it: $cl->send_srv ('AWAY'); =item ctcp => $src, $target, $tag, $msg, $type Emitted when a CTCP message was found in either a NOTICE or PRIVMSG message. C<$tag> is the CTCP message tag. (eg. "PING", "VERSION", ...). C<$msg> is the CTCP message and C<$type> is either "NOTICE" or "PRIVMSG". C<$src> is the source nick the message came from. C<$target> is the target nickname (yours) or the channel the ctcp was sent on. =item "ctcp_$tag", => $src, $target, $msg, $type Emitted when a CTCP message was found in either a NOTICE or PRIVMSG message. C<$tag> is the CTCP message tag (in lower case). (eg. "ping", "version", ...). C<$msg> is the CTCP message and C<$type> is either "NOTICE" or "PRIVMSG". C<$src> is the source nick the message came from. C<$target> is the target nickname (yours) or the channel the ctcp was sent on. =item dcc_ready => $id, $dest, $type, $local_ip, $local_port Whenever a locally initiated DCC request is made this event is emitted after the listening socket has been setup. C<$id> is the DCC connection ID. C<$dest> and C<$type> are the destination and type of the DCC request. C<$local_ip> is the C<$local_ip> argument passed to C or the IP the socket is bound to. C<$local_port> is the TCP port is the socket is listening on. =item dcc_request => $id, $src, $type, $arg, $addr, $port Whenever we receive a DCC offer from someone else this event is emitted. C<$id> is the DCC connection ID, C<$src> is his nickname, C<$type> is the DCC type in lower cases (eg. 'chat'). C<$arg> is the DCC type argument. C<$addr> is the IP address we can reach him at in ASCII encoded human readable form (eg. something like "127.0.0.1"). And C<$port> is the TCP port we have to connect to. To answer to his request you can just call C with the C<$id>. =item dcc_accepted => $id, $type, $hdl When the locally listening DCC socket has received a connection this event is emitted. C<$id> and C<$type> are the DCC connection ID and type of the DCC request. C<$hdl> is a pre-configured L 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 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 object of the connection (see also C 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. 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. 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 object, which stands logically for a client connected to ONE IRC server. You can reuse it and call C once it disconnected. B You are free to use the hash member C 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 command is sent to your own NICKNAME to determine your own I. See also the method C. This is necessary to ensure that the information about your own nickname is available as early as possible for the C method. C<$bool> is C 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 => \®istered_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}; } =item $cl->connect ($host, $port) =item $cl->connect ($host, $port, $info) This method does the same as the C method of L, 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 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 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 method you won't need to call this method, as L 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 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 as a nick-collision might happened on login. =cut sub nick { $_[0]->{nick} } =item $cl->is_my_nick ($string) This returns true if C<$string> is the nick of ourself. =cut sub is_my_nick { my ($self, $string) = @_; $self->eq_str ($string, $self->nick); } =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). 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. =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 (see L). If the C event has NOT yet been emitted the messages are queued until that event is emitted, and then sent to the server. B If you stop the registered event (with C, see L) in a callback registered to the C event, the C queue will B be flushed and B 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 to the server, like C 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>. C<$channel> will be lowercased so that any case that comes from the server matches. (Yes, IRC handles upper and lower case as equal :-( Be careful with this, there are chances you might not join the channel you wanted to join. You may wanted to join #bla and the server redirects that and sends you that you joined #blubb. You may use C to remove the queue after some timeout after joining, so that you don't end up with a memory leak. =cut sub send_chan { my ($self, $chan, @msg) = @_; if ($self->{channel_list}->{$self->lower_case ($chan)}) { $self->send_msg (@msg); } else { push @{$self->{chan_queue}->{$self->lower_case ($chan)}}, \@msg; } } =item $cl->clear_chan_queue ($channel) Clears the channel queue of the channel C<$channel>. =cut sub clear_chan_queue { my ($self, $chan) = @_; $self->{chan_queue}->{$self->lower_case ($chan)} = []; } =item my (@lines) = $cl->send_long_message ($encoding, $overhead, $cmd, @params, $msg) As IRC only allows 512 byte blocks of messages and sometimes your messages might get longer, you have a problem. This method will solve your problem: 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 for your own nick is necessary to compute this. To ensure best performance as possible use the C 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 before the C reply to C arrived. To be on the safest side you might want to wait until that initial C 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 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 { my($self, $str) = @_; local $_ = $str; $self->{casemap_func}->(); return $_; } =item $cl->eq_str ($str1, $str2) This function compares two strings, whether they are describing the same IRC entity. They are lower cased by the networks case rules and compared then. =cut sub eq_str { my ($self, $a, $b) = @_; $self->lower_case ($a) eq $self->lower_case ($b) } =item $cl->isupport () =item $cl->isupport ($key) Provides access to the ISUPPORT variables sent by the IRC server. If $key is given this method will return its value only, otherwise a hashref with all values is returned =cut sub isupport { my($self, $key) = @_; if (defined ($key)) { return $self->{isupport}->{$key}; } else { return $self->{isupport}; } } =item $cl->split_nick_mode ($prefixed_nick) This method splits the C<$prefix_nick> (eg. '+elmex') up into the mode of the user and the nickname. This method returns 2 values: the mode map and the nickname. The mode map is a hash reference with the keys being the modes the nick has set and the values being 1. NOTE: If you feed in a prefixed ident ('@elmex!elmex@fofofof.de') you get 3 values out actually: the mode map, the nickname and the ident, otherwise the 3rd value is undef. =cut sub split_nick_mode { my ($self, $prefixed_nick) = @_; my $pchrs = $self->{prefix_chars}; my %mode_map; my $nick; if ($prefixed_nick =~ /^([\Q$pchrs\E]+)(.+)$/) { my $p = $1; $nick = $2; for (split //, $p) { $mode_map{$self->map_prefix_to_mode ($_)} = 1 } } else { $nick = $prefixed_nick; } my (@n) = split_prefix ($nick); if (@n > 1 && defined $n[1]) { return (\%mode_map, $n[0], $nick); } else { return (\%mode_map, $nick, undef); } } =item $cl->map_prefix_to_mode ($prefix) Maps the nick prefix (eg. '@') to the corresponding mode (eg. 'o'). Returns undef if no such prefix exists (on the connected server). =cut sub map_prefix_to_mode { my ($self, $prefix) = @_; $self->{prefix2mode}->{$prefix} } =item $cl->map_mode_to_prefix ($mode) Maps the nick mode (eg. 'o') to the corresponding prefix (eg. '@'). Returns undef if no such mode exists (on the connected server). =cut sub map_mode_to_prefix { my ($self, $mode) = @_; for (keys %{$self->{prefix2mode}}) { return $_ if $self->{prefix2mode}->{$_} eq $mode; } return undef; } =item $cl->available_nick_modes () Returns a list of possible modes on this IRC server. (eg. 'o' for op). =cut sub available_nick_modes { my ($self) = @_; map { $self->map_prefix_to_mode ($_) } split //, $self->{prefix_chars} } =item $cl->is_channel_name ($string) This return true if C<$string> is a channel name. It analyzes the prefix of the string (eg. if it is '#') and returns true if it finds a channel prefix. Those prefixes might be server specific, so ISUPPORT is checked for that too. =cut sub is_channel_name { my ($self, $string) = @_; my $cchrs = $self->{channel_chars}; $string =~ /^([\Q$cchrs\E]+)(.+)$/; } =item $cl->nick_ident ($nick) This method returns the whole ident of the C<$nick> if the information is available. If the nick's ident hasn't been seen yet, undef is returned. B If you want to rely on the C of your own nick you should make sure to enable the C option in the constructor. =cut sub nick_ident { my ($self, $nick) = @_; $self->{idents}->{$self->lower_case ($nick)} } =item my $bool = $cl->away_status Returns a true value if you are away or undef if you are not away. =cut sub away_status { $_[0]->{away_status} } =item $cl->ctcp_auto_reply ($ctcp_command, @msg) =item $cl->ctcp_auto_reply ($ctcp_command, $coderef) This method installs an auto-reply for the reception of the C<$ctcp_command> via PRIVMSG, C<@msg> will be used as argument to the C function of the L package. The replies will be sent with the NOTICE IRC command. If C<$coderef> was given and is a code reference, it will called each time a C<$ctcp_command> is received, this is useful for eg. CTCP PING reply generation. The arguments will be the same arguments that the C event callbacks get. (See also C event description above). The return value of the called subroutine should be a list of arguments for C. Currently you can only configure one auto-reply per C<$ctcp_command>. Example: $cl->ctcp_auto_reply ('VERSION', ['VERSION', 'ScriptBla:0.1:Perl']); $cl->ctcp_auto_reply ('PING', sub { my ($cl, $src, $target, $tag, $msg, $type) = @_; ['PING', $msg] }); =cut sub ctcp_auto_reply { my ($self, $ctcp_command, @msg) = @_; $self->{ctcp_auto_replies}->{$ctcp_command} = \@msg; } sub _setup_internal_dcc_handlers { my ($self) = @_; $self->reg_cb (ctcp_dcc => sub { my ($self, $src, $target, $msg, $type) = @_; if ($self->is_my_nick ($target)) { my ($dcc_type, $arg, $addr, $port) = split /\x20/, $msg; $dcc_type = lc $dcc_type; if ($dcc_type eq 'send') { if ($msg =~ /SEND (.*?) (\d+) (\d+)/) { ($arg, $addr, $port) = ($1, $2, $3); $arg =~ s/^\"(.*)\"$/\1/; } } $addr = format_address (pack "N", $addr); my $id = ++$self->{dcc_id}; $self->{dcc}->{$id} = { type => lc ($dcc_type), dest => $self->lower_case ($src), ip => $addr, port => $port, arg => $arg, }; $self->event (dcc_request => $id, $src, $dcc_type, $arg, $addr, $port); } }); $self->reg_cb (dcc_ready => sub { my ($self, $id, $dest, $type, $local_ip, $local_port) = @_; $local_ip = unpack ("N", parse_address ($local_ip)); if ($type eq 'chat') { $self->send_msg ( PRIVMSG => $dest, encode_ctcp ([DCC => "CHAT", "CHAT", $local_ip, $local_port])); } elsif ($type eq 'send') { $self->send_msg ( PRIVMSG => $dest, encode_ctcp ([DCC => "SEND", "NOTHING", $local_ip, $local_port])); } }); $self->reg_cb (dcc_accepted => 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); }); }); } }); $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 event is emitted. When the receiver connects to the socket the C event is emitted. And whenever a dcc connection is closed the C event is emitted. For canceling the DCC offer or closing the connection see C 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, C or C. =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 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 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 event. The C event will be emitted when we successfully connected. And the C 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) = @_; $self->lower_case (prefix_nick ($msg)) eq $self->lower_case ($self->nick ()) } sub update_ident { my ($self, $ident) = @_; my ($n, $u, $h) = split_prefix ($ident); my $old = $self->{idents}->{$self->lower_case ($n)}; $self->{idents}->{$self->lower_case ($n)} = $ident; if ($old ne $ident) { $self->event (ident_change => $n, $ident); } #d# warn "IDENTS:\n".(join "\n", map { "\t$_\t=>\t$self->{idents}->{$_}" } keys %{$self->{idents}})."\n"; } ################################################################################ # Channel utility functions ################################################################################ sub channel_remove { my ($self, $msg, $chan, $nicks) = @_; for my $nick (@$nicks) { if ($self->lower_case ($nick) eq $self->lower_case ($self->nick ())) { delete $self->{chan_queue}->{$self->lower_case ($chan)}; delete $self->{channel_list}->{$self->lower_case ($chan)}; last; } else { delete $self->{channel_list}->{$self->lower_case ($chan)}->{$nick}; } } } sub channel_add { my ($self, $msg, $chan, $nicks, $modes) = @_; my @mods = @$modes; for my $nick (@$nicks) { my $mode = shift @mods; if ($self->is_my_nick ($nick)) { for (@{$self->{chan_queue}->{$self->lower_case ($chan)}}) { $self->send_msg (@$_); } $self->clear_chan_queue ($chan); } my $ch = $self->{channel_list}->{$self->lower_case ($chan)} ||= { }; if (defined $mode) { $ch->{$nick} = $mode; $self->event (channel_nickmode_update => $chan, $nick); } else { $ch->{$nick} = { } unless defined $ch->{$nick}; } } } sub channel_mode_change { my ($self, $chan, $op, $mode, $nick) = @_; my $nickmode = $self->nick_modes ($chan, $nick); defined $nickmode or return; $op eq '+' ? $nickmode->{$mode} = 1 : delete $nickmode->{$mode}; } sub _filter_new_nicks_from_channel { my ($self, $chan, @nicks) = @_; grep { not exists $self->{channel_list}->{$self->lower_case ($chan)}->{$_} } @nicks; } ################################################################################ # Callbacks ################################################################################ sub anymsg_cb { my ($self, $msg) = @_; my $cmd = lc $msg->{command}; if ($cmd =~ /^\d\d\d$/ && not ($cmd >= 400 && $cmd <= 599)) { $self->event (statmsg => $msg); } elsif (($cmd >= 400 && $cmd <= 599) || $cmd eq 'error') { $self->event (error => $msg->{command}, (@{$msg->{params}} ? $msg->{params}->[-1] : ''), $msg); } } sub privmsg_cb { my ($self, $msg) = @_; my ($trail, $ctcp) = decode_ctcp ($msg->{params}->[-1]); for (@$ctcp) { $self->event (ctcp => prefix_nick ($msg), $msg->{params}->[0], $_->[0], $_->[1], $msg->{command}); $self->event ("ctcp_".lc ($_->[0]), prefix_nick ($msg), $msg->{params}->[0], $_->[1], $msg->{command}); } $msg->{params}->[-1] = $trail; if ($msg->{params}->[-1] ne '') { my $targ = $msg->{params}->[0]; if ($self->is_channel_name ($targ)) { $self->event (publicmsg => $targ, $msg); } else { $self->event (privatemsg => $targ, $msg); } } } sub welcome_cb { my ($self, $msg) = @_; if ($self->{registered}) { return; } $self->{registered} = 1; $self->event ('registered'); } sub registered_cb { my ($self, $msg) = @_; $self->send_srv (WHOIS => $self->nick) if $self->{send_initial_whois}; for (@{$self->{con_queue}}) { $self->send_msg (@$_); } $self->clear_srv_queue (); } sub isupport_cb { my ($self, $msg) = @_; foreach (@{$msg->{params}}) { if (/([A-Z]+)(?:=(.+))?/) { $self->{isupport}->{$1} = defined $2 ? $2 : 1; } } if (defined (my $casemap = $self->{isupport}->{CASEMAPPING})) { if (defined (my $func = $LOWER_CASEMAP{$casemap})) { $self->{casemap_func} = $func; } else { $self->{casemap_func} = $LOWER_CASEMAP{rfc1459}; } } if (defined (my $nick_prefixes = $self->{isupport}->{PREFIX})) { if ($nick_prefixes =~ /^\(([^)]+)\)(.+)$/) { my ($modes, $prefixes) = ($1, $2); $self->{prefix_chars} = $prefixes; my @prefixes = split //, $prefixes; $self->{prefix2mode} = { }; for (split //, $modes) { $self->{prefix2mode}->{shift @prefixes} = $_; } } } if ($self->{isupport}->{NAMESX} && !$self->{protoctl}->{NAMESX}) { $self->send_srv (PROTOCTL => 'NAMESX'); $self->{protoctl}->{NAMESX} = 1; } if ($self->{isupport}->{UHNAMES} && !$self->{protoctl}->{UHNAMES}) { $self->send_srv (PROTOCTL => 'UHNAMES'); $self->{protoctl}->{UHNAMES} = 1; } if (defined (my $chan_prefixes = $self->{isupport}->{CHANTYPES})) { $self->{channel_chars} = $chan_prefixes; } } sub ping_cb { my ($self, $msg) = @_; $self->send_msg ("PONG", $msg->{params}->[0]); } sub pong_cb { my ($self, $msg) = @_; $self->{last_pong_recv} = time; } sub nick_cb { my ($self, $msg) = @_; my $nick = prefix_nick ($msg); my $newnick = $msg->{params}->[0]; my $wasme = $self->_was_me ($msg); if ($wasme) { $self->{nick} = $newnick } my @chans; for my $channame (keys %{$self->{channel_list}}) { my $chan = $self->{channel_list}->{$channame}; if (exists $chan->{$nick}) { $chan->{$newnick} = delete $chan->{$nick}; push @chans, $channame; } } $self->event (nick_change => $nick, $newnick, $wasme); for (@chans) { $self->event (channel_change => $msg, $_, $nick, $newnick, $wasme); } } sub namereply_cb { my ($self, $msg) = @_; my @nicks = split / /, $msg->{params}->[-1]; push @{$self->{_tmp_namereply}}, @nicks; } sub endofnames_cb { my ($self, $msg) = @_; my $chan = $msg->{params}->[1]; my @names_result = @{delete $self->{_tmp_namereply}}; my @modes = map { ($self->split_nick_mode ($_))[0] } @names_result; my @nicks = map { ($self->split_nick_mode ($_))[1] } @names_result; my @idents = grep { defined } map { ($self->split_nick_mode ($_))[2] } @names_result; my @new_nicks = $self->_filter_new_nicks_from_channel ($chan, @nicks); $self->channel_add ($msg, $chan, \@nicks, \@modes); $self->update_ident ($_) for @idents; $self->event (channel_add => $msg, $chan, @new_nicks) if @new_nicks; } sub whoreply_cb { my ($self, $msg) = @_; my (undef, $channel, $user, $host, $server, $nick) = @{$msg->{params}}; $self->update_ident (join_prefix ($nick, $user, $host)); } sub whoisuser_cb { my ($self, $msg) = @_; my (undef, $nick, $user, $host) = @{$msg->{params}}; $self->update_ident (join_prefix ($nick, $user, $host)); } sub join_cb { my ($self, $msg) = @_; my $chan = $msg->{params}->[0]; my $nick = prefix_nick ($msg); my @new_nicks = $self->_filter_new_nicks_from_channel ($chan, $nick); $self->channel_add ($msg, $chan, [$nick], [undef]); $self->event (channel_add => $msg, $chan, @new_nicks) if @new_nicks; $self->event (join => $nick, $chan, $self->_was_me ($msg)); if ($self->_was_me ($msg) && !$self->isupport ('UHNAMES')) { $self->send_srv (WHO => $chan); } } sub part_cb { my ($self, $msg) = @_; my $chan = $msg->{params}->[0]; my $nick = prefix_nick ($msg); $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) = @_; my $oldid = $self->nick_ident ($old); return unless defined $oldid; my ($n, $u, $h) = split_prefix ($oldid); $self->update_ident (join_prefix ($new, $u, $h)); } sub ctcp_auto_reply_cb { my ($self, $src, $targ, $tag, $msg, $type) = @_; return if $type ne 'PRIVMSG'; my $ctcprepl = $self->{ctcp_auto_replies}->{$tag} or return; if (ref ($ctcprepl->[0]) eq 'CODE') { $ctcprepl = [$ctcprepl->[0]->($self, $src, $targ, $tag, $msg, $type)] } $self->send_msg (NOTICE => $src, encode_ctcp (@$ctcprepl)); } =back =head1 EXAMPLES See samples/anyeventirccl and other samples in samples/ for some examples on how to use AnyEvent::IRC::Client. =head1 AUTHOR Robin Redeker, C<< >> =head1 SEE ALSO L RFC 1459 - Internet Relay Chat: Client Protocol =head1 COPYRIGHT & LICENSE Copyright 2006-2009 Robin Redeker, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; AnyEvent-IRC-0.97/lib/AnyEvent/IRC/Connection.pm0000644000000000000000000002000411665643041017666 0ustar rootrootpackage AnyEvent::IRC::Connection; use common::sense; use AnyEvent; use POSIX; use AnyEvent::Socket; use AnyEvent::Handle; use AnyEvent::IRC::Util qw/mk_msg parse_irc_msg/; use Object::Event; use Scalar::Util qw/weaken/; use base Object::Event::; =head1 NAME AnyEvent::IRC::Connection - An IRC connection abstraction =head1 SYNOPSIS use AnyEvent; use AnyEvent::IRC::Connection; my $c = AnyEvent->condvar; my $con = new AnyEvent::IRC::Connection; $con->connect ("localhost", 6667); $con->reg_cb ( connect => sub { my ($con) = @_; $con->send_msg (NICK => 'testbot'); $con->send_msg (USER => 'testbot', '*', '0', 'testbot'); }, irc_001 => sub { my ($con) = @_; print "$_[1]->{prefix} says I'm in the IRC: $_[1]->{params}->[-1]!\n"; $c->broadcast; } ); $c->wait; =head1 DESCRIPTION The connection class. Here the actual interesting stuff can be done, such as sending and receiving IRC messages. And it also handles TCP connecting and even enabling of TLS. Please note that CTCP support is available through the functions C and C provided by L. =head2 METHODS =over 4 =item $con = AnyEvent::IRC::Connection->new () This constructor doesn't take any arguments. B You are free to use the hash member C (which contains a hash) to store any associated data with this object. For example retry timers or anything else. You can also access that member via the C method. =cut sub new { my $this = shift; my $class = ref($this) || $this; my $self = $class->SUPER::new (@_, heap => { }); bless $self, $class; $self->reg_cb ( ext_after_send => sub { my ($self, $mkmsg_args) = @_; $self->send_raw (mk_msg (@$mkmsg_args)); } ); return $self; } =item $con->connect ($host, $port [, $prepcb_or_timeout]) Tries to open a socket to the host C<$host> and the port C<$port>. If an error occurred it will die (use eval to catch the exception). If you want to connect via TLS/SSL you have to call the C method before to enable it. C<$prepcb_or_timeout> can either be a callback with the semantics of a prepare callback for the function C in L or a simple number which stands for a timeout. =cut sub connect { my ($self, $host, $port, $prep) = @_; if ($self->{socket}) { $self->disconnect ("reconnect requested."); } $self->{con_guard} = tcp_connect $host, $port, sub { my ($fh) = @_; delete $self->{socket}; unless ($fh) { $self->event (connect => $!); return; } $self->{host} = $host; $self->{port} = $port; $self->{socket} = AnyEvent::Handle->new ( fh => $fh, ($self->{enable_ssl} ? (tls => 'connect') : ()), on_eof => sub { $self->disconnect ("EOF from server $host:$port"); }, on_error => sub { $self->disconnect ("error in connection to server $host:$port: $!"); }, on_read => sub { my ($hdl) = @_; # \015* for some broken servers, which might have an extra # carriage return in their MOTD. $hdl->push_read (line => qr{\015*\012}, sub { $self->_feed_irc_data ($_[1]); }); }, on_drain => sub { $self->event ('buffer_empty'); } ); $self->{connected} = 1; $self->event ('connect'); }, (defined $prep ? (ref $prep ? $prep : sub { $prep }) : ()); } =item $con->enable_ssl () This method will enable SSL for new connections that are initiated by C. =cut sub enable_ssl { my ($self) = @_; $self->{enable_ssl} = 1; } =item $con->disconnect ($reason) Unregisters the connection in the main AnyEvent::IRC object, closes the sockets and send a 'disconnect' event with C<$reason> as argument. =cut sub disconnect { my ($self, $reason) = @_; delete $self->{con_guard}; delete $self->{socket}; $self->event (disconnect => $reason); } =item $con->is_connected Returns true when this connection is connected. Otherwise false. =cut sub is_connected { my ($self) = @_; $self->{socket} && $self->{connected} } =item $con->heap () Returns the hash reference stored in the C member, that is local to this connection object that lets you store any information you want. =cut sub heap { my ($self) = @_; return $self->{heap}; } =item $con->send_raw ($ircline) This method sends C<$ircline> straight to the server without any further processing done. =cut sub send_raw { my ($self, $ircline) = @_; return unless $self->{socket}; $self->{socket}->push_write ($ircline . "\015\012"); } =item $con->send_msg ($command, @params) This function sends a message to the server. C<@ircmsg> is the argument list for C. =cut sub send_msg { my ($self, @msg) = @_; $self->event (send => [undef, @msg]); $self->event (sent => undef, @msg); } sub _feed_irc_data { my ($self, $line) = @_; #d# warn "LINE:[" . $line . "][".length ($line)."]"; my $m = parse_irc_msg ($line); #d# warn "MESSAGE{$m->{params}->[-1]}[".(length $m->{params}->[-1])."]\n"; #d# warn "HEX:" . join ('', map { sprintf "%2.2x", ord ($_) } split //, $line) #d# . "\n"; $self->event (read => $m); $self->event ('irc_*' => $m); $self->event ('irc_' . (lc $m->{command}), $m); } =back =head2 EVENTS Following events are emitted by this module and shouldn't be emitted from a module user call to C. See also the documents L about registering event callbacks. =over 4 =item connect => $error This event is generated when the socket was successfully connected or an error occurred while connecting. The error is given as second argument (C<$error>) to the callback then. =item disconnect => $reason This event will be generated if the connection is somehow terminated. It will also be emitted when C is called. The second argument to the callback is C<$reason>, a string that contains a clue about why the connection terminated. If you want to reestablish a connection, call C again. =item send => $ircmsg Emitted when a message is about to be sent. C<$ircmsg> is an array reference to the arguments of C (see L). You may modify the array reference to change the message or even intercept it completely by calling C (see L API): $con->reg_cb ( send => sub { my ($con, $ircmsg) = @_; if ($ircmsg->[1] eq 'NOTICE') { $con->stop_event; # prevent any notices from being sent. } elsif ($ircmsg->[1] eq 'PRIVMSG') { $ircmsg->[-1] =~ s/sex/XXX/i; # censor any outgoing private messages. } } ); =item sent => @ircmsg Emitted when a message (C<@ircmsg>) was sent to the server. C<@ircmsg> are the arguments to C. =item irc_* => $msg =item irc_ => $msg =item read => $msg Emitted when a message (C<$msg>) was read from the server. C<$msg> is the hash reference returned by C; Note: '' stands for the command of the message in (ASCII) lower case. =item buffer_empty This event is emitted when the write buffer of the underlying connection is empty and all data has been given to the kernel. See also C about a usage example. Please note that this buffer is NOT the queue mentioned in L! =back =head1 AUTHOR Robin Redeker, C<< >> =head1 SEE ALSO L L =head1 COPYRIGHT & LICENSE Copyright 2006-2009 Robin Redeker, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; AnyEvent-IRC-0.97/lib/AnyEvent/IRC/Util.pm0000644000000000000000000003364511556523502016521 0ustar rootrootpackage AnyEvent::IRC::Util; use common::sense; use Exporter; use Encode; our @ISA = qw/Exporter/; our @EXPORT_OK = qw(mk_msg parse_irc_msg split_prefix prefix_nick decode_ctcp encode_ctcp filter_ctcp_text_attr prefix_user prefix_host rfc_code_to_name filter_colors is_nick_prefix join_prefix split_unicode_string); =head1 NAME AnyEvent::IRC::Util - Common utilities that help with IRC protocol handling =head1 SYNOPSIS use AnyEvent::IRC::Util qw/parse_irc_msg mk_msg/; my $msgdata = mk_msg (undef, PRIVMSG => "mcmanus", "my hands glow!"); =head1 FUNCTIONS These are some utility functions that might come in handy when handling the IRC protocol. You can export these with eg.: use AnyEvent::IRC::Util qw/parse_irc_msg/; =over 4 =item B This method parses the C<$ircline>, which is one line of the IRC protocol without the trailing "\015\012". It returns a hash which has the following entrys: =over 4 =item prefix The message prefix. =item command The IRC command. =item params The parameters to the IRC command in a array reference, this includes the trailing parameter (the one after the ':' or the 14th parameter). =back =cut sub parse_irc_msg { my ($msg) = @_; $msg =~ s/^(?::([^ ]+)[ ])?([A-Za-z]+|\d{3})// or return undef; my %msg; ($msg{prefix}, $msg{command}, $msg{params}) = ($1, $2, []); my $cnt = 0; while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) { push @{$msg{params}}, $1 if defined $1; last if ++$cnt > 13; } if ($cnt == 14) { if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) { push @{$msg{params}}, $1 if defined $1; } } else { if ($msg =~ s/^[ ]:([^\015\012\0]*)//) { push @{$msg{params}}, $1 if defined $1; } } \%msg } =item B This function assembles a IRC message. The generated message will look like (pseudo code!) : : Please refer to RFC 1459 how IRC messages normally look like. The prefix will be omitted if they are C. Please note that only the last parameter may contain spaces, and if it contains spaces it will be quoted as the trailing part of the IRC message. NOTE: The trailing "\015\012" is NOT added by this function! EXAMPLES: mk_msg (undef, "PRIVMSG", "magnus", "you suck!"); # will return: "PRIVMSG magnus :you suck!" mk_msg (undef, "PRIVMSG", "magnus", "Hi!"); # will return: "PRIVMSG magnus :Hi!" mk_msg (undef, "JOIN", "#test"); # will return: "JOIN #test" =cut sub mk_msg { my ($prefix, $command, @params) = @_; my $msg = ""; $msg .= defined $prefix ? ":$prefix " : ""; $msg .= "$command"; my $trail; if (@params && ($params[-1] =~ /\x20/ || $params[-1] =~ /^:/)) { $trail = pop @params; } # FIXME: params must be counted, and if > 13 they have to be # concationated with $trail map { $msg .= " $_" } @params; $msg .= defined $trail ? " :$trail" : ""; return $msg; } my @_ctcp_lowlevel_escape = ("\000", "0", "\012", "n", "\015", "r", "\020", "\020"); sub unescape_lowlevel { my ($data) = @_; my %map = reverse @_ctcp_lowlevel_escape; $data =~ s/\020(.)/defined $map{$1} ? $map{$1} : $1/ge; $data } sub escape_lowlevel { my ($data) = @_; my %map = @_ctcp_lowlevel_escape; $data =~ s/([\000\012\015\020])/"\020$map{$1}"/ge; $data } sub unescape_ctcp { my ($data) = @_; $data =~ s/\\(.)/$1 eq 'a' ? "\001" : ($1 eq "\\" ? "\\" : $1)/eg; $data } sub escape_ctcp { my ($data) = @_; $data =~ s/([\\\001])/$1 eq "\001" ? "\\a" : "\\\\"/eg; $data } =item B This function decodes CTCP messages contained in an IRC message. C<$data> should be the last parameter of a IRC PRIVMSG or NOTICE. It will first unescape the lower layer, extract CTCP messages and then return a list with two elements: the line without the CTCP messages and an array reference which contains array references of CTCP messages. Those CTCP message array references will have the CTCP message tag as first element (eg. "VERSION") and the rest of the CTCP message as the second element. =cut sub decode_ctcp { my ($line) = @_; $line = unescape_lowlevel ($line); my @ctcp; while ($line =~ /\G\001([^\001]*)\001/g) { my $msg = unescape_ctcp ($1); my ($tag, $data) = split / /, $msg, 2; push @ctcp, [$tag, $data]; } $line =~ s/\001[^\001]*\001//g; # try to parse broken ctcp messages anyway if ($line =~ s/\001([^\001]*)$//) { my $msg = unescape_ctcp ($1); my ($tag, $data) = split / /, $msg, 2; push @ctcp, [$tag, $data]; } return ($line, \@ctcp) } =item B This function encodes a CTCP message for the transmission via the NOTICE or PRIVMSG command. C<@msg> is an array of strings or array references. If an array reference occurs in the C<@msg> array it's first element will be interpreted as CTCP TAG (eg. one of PING, VERSION, .. whatever) the rest of the array ref will be appended to the tag and separated by spaces. All parts of the message will be concatenated and lowlevel quoted. That means you can embed _any_ character from 0 to 255 in this message (thats what the lowlevel quoting allows). =cut sub encode_ctcp { my (@args) = @_; escape_lowlevel ( join "", map { ref $_ ? "\001" . escape_ctcp (join " ", @$_) . "\001" : $_ } @args ) } =item B This function will filter out any mIRC colors and (most) ansi escape sequences. Unfortunately the mIRC color coding will destroy improper colored numbers. So this function may destroy the message in some occasions a bit. =cut sub filter_colors($) { my ($line) = @_; $line =~ s/\x1B\[.*?[\x00-\x1F\x40-\x7E]//g; # see ECMA-48 + advice by urxvt author $line =~ s/\x03\d\d?(?:,\d\d?)?//g; # see http://www.mirc.co.uk/help/color.txt $line =~ s/[\x03\x16\x02\x1f\x0f]//g; # see some undefined place :-) $line } # implemented after the below CTCP spec, but # doesnt seem to be used by anyone... so it's untested. sub filter_ctcp_text_attr_bogus { my ($line, $cb) = @_; return unless $cb; $line =~ s/\006([BVUSI])/{warn "FIL\n"; my $c = $cb->($1); defined $c ? $c : "\006$1"}/ieg; $line =~ s/\006CA((?:I[0-9A-F]|#[0-9A-F]{3}){2})/{my $c = $cb->($1); defined $c ? $c : "\006CA$1"}/ieg; $line =~ s/\006C([FB])(I[0-9A-F]|#[0-9A-F]{3})/{my $c = $cb->($1, $2); defined $c ? $c : "\006C$1$2"}/ieg; $line =~ s/\006CX([AFB])/{my $c = $cb->($1); defined $c ? $c : "\006CX$1"}/ieg; return $line; } =item B This function splits an IRC user prefix as described by RFC 2817 into the three parts: nickname, user and host. Which will be returned as a list with that order. C<$prefix> can also be a hash like it is returned by C. =cut sub split_prefix { my ($prfx) = @_; if (ref ($prfx) eq 'HASH') { $prfx = $prfx->{prefix}; } # this splitting does indeed use the servername as nickname, but there # is no way for a client to distinguish. $prfx =~ m/^\s*([^!]*)(?:!([^@]*))?(?:@(.*?))?\s*$/; return ($1, $2, $3); } =item B Returns true if the prefix is a nick prefix, containing user and host. =cut sub is_nick_prefix { my ($prfx) = @_; $prfx =~ m/^\s*([^!]+)!([^@]+)@(.+)?\s*$/; } =item B Joins C<$nick>, C<$user> and C<$host> together to form a prefix. =cut sub join_prefix { my ($n, $u, $h) = @_; "$n!$u\@$h" } =item B A shortcut to extract the nickname from the C<$prefix>. C<$prefix> can also be a hash like it is returned by C. =cut sub prefix_nick { my ($prfx) = @_; return (split_prefix ($prfx))[0]; } =item B A shortcut to extract the username from the C<$prefix>. C<$prefix> can also be a hash like it is returned by C. =cut sub prefix_user { my ($prfx) = @_; return (split_prefix ($prfx))[1]; } =item B A shortcut to extract the hostname from the C<$prefix>. C<$prefix> can also be a hash like it is returned by C. =cut sub prefix_host { my ($prfx) = @_; return (split_prefix ($prfx))[2]; } =item B This function is a interface to the internal mapping or numeric replies to the reply name in RFC 2812 (which you may also consult). C<$code> is returned if no name for C<$code> exists (as some server may extended the protocol). =cut our %RFC_NUMCODE_MAP = ( '001' => 'RPL_WELCOME', '002' => 'RPL_YOURHOST', '003' => 'RPL_CREATED', '004' => 'RPL_MYINFO', '005' => 'RPL_BOUNCE', '200' => 'RPL_TRACELINK', '201' => 'RPL_TRACECONNECTING', '202' => 'RPL_TRACEHANDSHAKE', '203' => 'RPL_TRACEUNKNOWN', '204' => 'RPL_TRACEOPERATOR', '205' => 'RPL_TRACEUSER', '206' => 'RPL_TRACESERVER', '207' => 'RPL_TRACESERVICE', '208' => 'RPL_TRACENEWTYPE', '209' => 'RPL_TRACECLASS', '210' => 'RPL_TRACERECONNECT', '211' => 'RPL_STATSLINKINFO', '212' => 'RPL_STATSCOMMANDS', '219' => 'RPL_ENDOFSTATS', '221' => 'RPL_UMODEIS', '233' => 'RPL_SERVICE', '234' => 'RPL_SERVLIST', '235' => 'RPL_SERVLISTEND', '242' => 'RPL_STATSUPTIME', '243' => 'RPL_STATSOLINE', '250' => 'RPL_STATSDLINE', '251' => 'RPL_LUSERCLIENT', '252' => 'RPL_LUSEROP', '253' => 'RPL_LUSERUNKNOWN', '254' => 'RPL_LUSERCHANNELS', '255' => 'RPL_LUSERME', '256' => 'RPL_ADMINME', '257' => 'RPL_ADMINLOC1', '258' => 'RPL_ADMINLOC2', '259' => 'RPL_ADMINEMAIL', '261' => 'RPL_TRACELOG', '262' => 'RPL_TRACEEND', '263' => 'RPL_TRYAGAIN', '301' => 'RPL_AWAY', '302' => 'RPL_USERHOST', '303' => 'RPL_ISON', '305' => 'RPL_UNAWAY', '306' => 'RPL_NOWAWAY', '311' => 'RPL_WHOISUSER', '312' => 'RPL_WHOISSERVER', '313' => 'RPL_WHOISOPERATOR', '314' => 'RPL_WHOWASUSER', '315' => 'RPL_ENDOFWHO', '317' => 'RPL_WHOISIDLE', '318' => 'RPL_ENDOFWHOIS', '319' => 'RPL_WHOISCHANNELS', '321' => 'RPL_LISTSTART', '322' => 'RPL_LIST', '323' => 'RPL_LISTEND', '324' => 'RPL_CHANNELMODEIS', '325' => 'RPL_UNIQOPIS', '331' => 'RPL_NOTOPIC', '332' => 'RPL_TOPIC', '341' => 'RPL_INVITING', '342' => 'RPL_SUMMONING', '346' => 'RPL_INVITELIST', '347' => 'RPL_ENDOFINVITELIST', '348' => 'RPL_EXCEPTLIST', '349' => 'RPL_ENDOFEXCEPTLIST', '351' => 'RPL_VERSION', '352' => 'RPL_WHOREPLY', '353' => 'RPL_NAMREPLY', '364' => 'RPL_LINKS', '365' => 'RPL_ENDOFLINKS', '366' => 'RPL_ENDOFNAMES', '367' => 'RPL_BANLIST', '368' => 'RPL_ENDOFBANLIST', '369' => 'RPL_ENDOFWHOWAS', '371' => 'RPL_INFO', '372' => 'RPL_MOTD', '374' => 'RPL_ENDOFINFO', '375' => 'RPL_MOTDSTART', '376' => 'RPL_ENDOFMOTD', '381' => 'RPL_YOUREOPER', '382' => 'RPL_REHASHING', '383' => 'RPL_YOURESERVICE', '384' => 'RPL_MYPORTIS', '391' => 'RPL_TIME', '392' => 'RPL_USERSSTART', '393' => 'RPL_USERS', '394' => 'RPL_ENDOFUSERS', '395' => 'RPL_NOUSERS', '401' => 'ERR_NOSUCHNICK', '402' => 'ERR_NOSUCHSERVER', '403' => 'ERR_NOSUCHCHANNEL', '404' => 'ERR_CANNOTSENDTOCHAN', '405' => 'ERR_TOOMANYCHANNELS', '406' => 'ERR_WASNOSUCHNICK', '407' => 'ERR_TOOMANYTARGETS', '408' => 'ERR_NOSUCHSERVICE', '409' => 'ERR_NOORIGIN', '411' => 'ERR_NORECIPIENT', '412' => 'ERR_NOTEXTTOSEND', '413' => 'ERR_NOTOPLEVEL', '414' => 'ERR_WILDTOPLEVEL', '415' => 'ERR_BADMASK', '421' => 'ERR_UNKNOWNCOMMAND', '422' => 'ERR_NOMOTD', '423' => 'ERR_NOADMININFO', '424' => 'ERR_FILEERROR', '431' => 'ERR_NONICKNAMEGIVEN', '432' => 'ERR_ERRONEUSNICKNAME', '433' => 'ERR_NICKNAMEINUSE', '436' => 'ERR_NICKCOLLISION', '437' => 'ERR_UNAVAILRESOURCE', '441' => 'ERR_USERNOTINCHANNEL', '442' => 'ERR_NOTONCHANNEL', '443' => 'ERR_USERONCHANNEL', '444' => 'ERR_NOLOGIN', '445' => 'ERR_SUMMONDISABLED', '446' => 'ERR_USERSDISABLED', '451' => 'ERR_NOTREGISTERED', '461' => 'ERR_NEEDMOREPARAMS', '462' => 'ERR_ALREADYREGISTRED', '463' => 'ERR_NOPERMFORHOST', '464' => 'ERR_PASSWDMISMATCH', '465' => 'ERR_YOUREBANNEDCREEP', '466' => 'ERR_YOUWILLBEBANNED', '467' => 'ERR_KEYSET', '471' => 'ERR_CHANNELISFULL', '472' => 'ERR_UNKNOWNMODE', '473' => 'ERR_INVITEONLYCHAN', '474' => 'ERR_BANNEDFROMCHAN', '475' => 'ERR_BADCHANNELKEY', '476' => 'ERR_BADCHANMASK', '477' => 'ERR_NOCHANMODES', '478' => 'ERR_BANLISTFULL', '481' => 'ERR_NOPRIVILEGES', '482' => 'ERR_CHANOPRIVSNEEDED', '483' => 'ERR_CANTKILLSERVER', '484' => 'ERR_RESTRICTED', '485' => 'ERR_UNIQOPPRIVSNEEDED', '491' => 'ERR_NOOPERHOST', '492' => 'ERR_NOSERVICEHOST', '501' => 'ERR_UMODEUNKNOWNFLAG', '502' => 'ERR_USERSDONTMATCH', ); sub rfc_code_to_name { my ($code) = @_; return $RFC_NUMCODE_MAP{$code} || $code; } =item my (@lines) = split_unicode_string ($encoding, $string, $maxlinebytes) This function splits up C<$string> into multiple C<@lines> which are not longer than C<$maxlinebytes> bytes. Encoding can be given in C<$encoding>. (eg. 'utf-8'). But the output will not be encoded. This function takes care that your characters are not garbled. =cut sub split_unicode_string { my ($enc, $str, $maxlen) = @_; return $str unless length (encode ($enc, $str)) > $maxlen; my $cur_out = ''; my @lines; while (length ($str) > 0) { while (length (encode ($enc, $cur_out)) <= $maxlen && length ($str) > 0) { $cur_out .= substr $str, 0, 1, ''; } push @lines, $cur_out; $cur_out = ''; } @lines } =back =head1 AUTHOR Robin Redeker, C<< >> =head1 SEE ALSO Internet Relay Chat Client To Client Protocol from February 2, 1997 http://www.invlogic.com/irc/ctcp.html RFC 1459 - Internet Relay Chat: Client Protocol =head1 COPYRIGHT & LICENSE Copyright 2006-2009 Robin Redeker, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; AnyEvent-IRC-0.97/lib/AnyEvent/IRC.pm0000644000000000000000000001102712121404746015567 0ustar rootrootpackage AnyEvent::IRC; use common::sense; use AnyEvent; =head1 NAME AnyEvent::IRC - An event based IRC protocol client API =head1 VERSION Version 0.97 =cut our $VERSION = '0.97'; =head1 SYNOPSIS Using the simplistic L: use AnyEvent; use AnyEvent::IRC::Connection; my $c = AnyEvent->condvar; my $con = new AnyEvent::IRC::Connection; $con->connect ("localhost", 6667); $con->reg_cb ( connect => sub { my ($con) = @_; $con->send_msg (NICK => 'testbot'); $con->send_msg (USER => 'testbot', '*', '0', 'testbot'); }, irc_001 => sub { my ($con) = @_; print "$_[1]->{prefix} says I'm in the IRC: $_[1]->{params}->[-1]!\n"; $c->broadcast; } ); $c->wait; Using the more sophisticated L: use AnyEvent; use AnyEvent::IRC::Client; my $c = AnyEvent->condvar; my $timer; my $con = new AnyEvent::IRC::Client; $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 The L module consists of L, L and L. L is just a module that holds this overview over the other modules. L can be viewed as toolbox for handling IRC connections and communications. It won't do everything for you, and you still need to know a few details of the IRC protocol. L is a more highlevel IRC connection that already processes some messages for you and will generated some events that are maybe useful to you. It will also do PING replies for you, manage channels a bit, nicknames and CTCP. L is a lowlevel connection that only connects to the server and will let you send and receive IRC messages. L does not imply any client behaviour, you could also use it to implement an IRC server. Note that these modules use L as it's IO event subsystem. You can integrate them into any application with a event system that L has support for (eg. L or L). =head1 EXAMPLES See the samples/ directory for some examples on how to use AnyEvent::IRC. =head1 AUTHOR Robin Redeker, C<< >> =head1 SEE ALSO L L L L RFC 1459 - Internet Relay Chat: Client Protocol RFC 2812 - Internet Relay Chat: Client Protocol =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc AnyEvent::IRC You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS Thanks to Marc Lehmann for the new AnyEvent module! And these people have helped to work on L: * Maximilian Gass - Added support for ISUPPORT and CASEMAPPING. * Zaba - Thanks for the useful input about IRC. * tokuhirom - Thanks for patches for the kick event. * Kazuhiro Osawa - Thanks for the documenation fix. * Angel Abad - Thanks for the spelling fixes. * Lee Aylward - Thanks for bug spotting and fixing. =head1 COPYRIGHT & LICENSE Copyright 2006-2009 Robin Redeker, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; AnyEvent-IRC-0.97/Changes0000644000000000000000000001414412121404750013606 0ustar rootrootRevision history for AnyEvent::IRC 0.97 Sun Mar 17 19:20:30 CET 2013 - corrected minor spelling fixes thanks to an rt patch. - fixed AnyEvent::IRC::Connection::is_connected to actually return true when connected. - AE::IRC::Client::connect can now also connect only with a timeout without having to register. - Server reply of 001 is now also considered as "successfully registered". Thanks for Lee to spot this. - "quit" event gets the right parameter from the message now. Thanks to Lee! 0.96 Tue Mar 1 08:23:09 CET 2011 - fixed pod in AE::IRC::Util. - applied patches from tokuhirom for the kick event. - small fix in anymsg_cb. - fixed documentation problems, for example w.r.t. channel_change. - added "support" for broken IRC servers, which send multiple carriage returns on line endings. 0.95 Thu Nov 5 00:15:55 CET 2009 - added away_status method and events for tracking your away status. - implemented send_long_message. - added send_initial_whois option to ::Client constructor. - added dependency to Encode. - fixed a bug in ident handling, it now also detects nick changes. 0.9 Mon Sep 28 14:51:29 CEST 2009 - made AnyEvent::IRC::Client connection object reusable. - documented that the 'heap' member of the AE::IRC::* objects can be used to store any data. 0.81 Mon Aug 10 09:43:29 CEST 2009 - fixed some sample scripts. - added 'common::sense' to all the scripts and module files. 0.8 Fri Jun 26 15:29:06 CEST 2009 - added enable_ssl to AnyEvent::IRC::Connection to enable TLS handshake after TCP connect. - added send event for hooking into sending a message. - Implemented DCC in AnyEvent::IRC::Client. - Implemented the DCC CHAT protocol. - fixed bug in AnyEvent::IRC::Client::nick_modes. - added dcc chat test. 0.7 Wed Jan 21 20:46:39 CET 2009 - removed autocork hack, as AnyEvent ignores SIGPIPE now. - removed maintainer tests from distribution. - removed JSON dependency. 0.6 Tue Sep 23 14:41:43 CEST 2008 - deprecated Net::IRC3, use this module in future! - connect is done non blocking - major semantic change: you can't reuse a connection object, after the 'disconnect' event has been issued you have to recreate it and reconnect the new object. All event handlers are cleared after the 'disconnect' event has been issued too. - major api change for channel_add and channel_remove - added CTCP support - implemented automatic pinging (on user request) see Net::IRC3::Client::Connection::enable_ping - Changed mk_msg, send_msg and send_srv and parse_irc_msg considerably, no reversed arguments anymore! - Added support for ISUPPORT and CASEMAPPING - Renamed from Net::IRC3 to AnyEvent::IRC - Using Object::Event, AnyEvent::Socket and AnyEvent::Handle - added buffer_empty event, to detect when the write buffer is empty. - changed send_msg() in that way that the prefix can't be given anymore, as AnyEvent::IRC is specialized on clients anyway. - Renamed AnyEvent::IRC::Client::Connection to AnyEvent::IRC::Client - Implemented prefix<=>mode mapping for nicks - Added test utility module and first automated connect test - Added debug_console example - Added mode tracking for users on channels, with NAMESX support - channel_list() now also optionally accepts the channel as first argument - the connect method of AnyEvent::IRC::Client now accepts an additional parameter where you can pass the register information for automatic registration. - the 'registered' event is now only emitted when the irc commands 376 or 422 have been seen. - added ctcp_auto_reply() method to AnyEvent::IRC::Client interface. - Util::mk_msg does NOT append "\015\012" anymore. - send_srv queue is now flushed in an event callback. 0.5 Sun Mar 11 23:54:10 CET 2007 - added server password support - fixed a bug with nick-changing - added topic support - fixed problem in prefix matching - fixed a bug where channel_add was called with already joined nicks, these duplicates are now prevented. - found a bug in prefix_host with the tests - added some tests - disconnect now also does send channel_add/remove events - enhanced connection handling a bit - added connect and connect_error events to Net::IRC3::Connection - fixed a bug where too many channel_remove events were generated on QUIT - fixed case handling with channels - added functionality to change the nick automatically when it is already taken when registering an IRC connection. (Net::IRC3::Client::Connection) - added reply number <=> reply name mapping to Net::IRC3::Util accessible through rfc_code_to_name - added error event to Net::IRC3::Client::Connection - fixed bugs in nick handling and added support for the NICK change command in Net::IRC3::Client::Connection - Net::IRC3::Client::Connection->channel_list now returns channel and nick information in the servers cAsE. - fixed a bug in send_srv and send_chan where messages could have been sent twice. 0.4 Tue Nov 28 17:13:01 CET 2006 - fixed broken PONG reply before 001 - made channel_list return an empty hash instead undef when no channel is joined 0.3 Mon Jul 17 13:43:13 UTC 2006 - Refactored the code: Remove Client.pm, and make the connections to standalone objects. - Added nickname tracing for channels 0.2 Sun Jul 16 12:58:06 CEST 2006 - Code got a little bit refactored and wrote documentation. It seems ready for a first release. 0.1 Sat Jul 15 23:46:49 UTC 2006 - First version, released on an unsuspecting world. AnyEvent-IRC-0.97/t/0000755000000000000000000000000012121404774012560 5ustar rootrootAnyEvent-IRC-0.97/t/00_load.t0000644000000000000000000000041311444066626014170 0ustar rootroot#!perl -T use Test::More tests => 4; BEGIN { use_ok( 'AnyEvent::IRC' ); use_ok( 'AnyEvent::IRC::Util' ); use_ok( 'AnyEvent::IRC::Connection' ); use_ok( 'AnyEvent::IRC::Client' ); } diag( "Testing AnyEvent::IRC $AnyEvent::IRC::VERSION, Perl $], $^X" ); AnyEvent-IRC-0.97/t/01_util.t0000644000000000000000000001047011444066626014233 0ustar rootroot#!perl use common::sense; use Test::More; use AnyEvent::IRC::Util qw/parse_irc_msg mk_msg split_prefix rfc_code_to_name prefix_nick prefix_user prefix_host filter_colors/; our @ircmsg_tests = ( ['full message' => ":nick!user\@host PRIVMSG #test :test message\015\012" => { prefix => 'nick!user@host', prefix_ar => ['nick', 'user', 'host'], command => 'PRIVMSG', params => ['#test', 'test message'], } ], ['quoted colon' => ":nick!user\@host PRIVMSG #test ::)\015\012" => { prefix => 'nick!user@host', prefix_ar => ['nick', 'user', 'host'], command => 'PRIVMSG', params => ['#test', ':)'], } ], ['without prefix' => "PART #test :i'm gone\015\012" => { prefix => undef, command => 'PART', params => ['#test', 'i\'m gone'], } ], ['without params' => "QUIT\015\012" => { prefix => undef, command => 'QUIT', params => [], } ], ); our @ircmodes = ( [qw/461 ERR_NEEDMOREPARAMS/], [qw/491 ERR_NOOPERHOST/], [qw/324 RPL_CHANNELMODEIS/], [qw/209 RPL_TRACECLASS/], [qw/001 RPL_WELCOME/], [qw/502 ERR_USERSDONTMATCH/] ); plan tests => (4 * scalar @ircmsg_tests) + (6 * scalar grep { $_->[2]->{prefix} } @ircmsg_tests) + scalar @ircmodes + 3; { sub undef_or_eq { my ($what, $it) = @_; if (not defined $what) { return not defined $it; } else { return 0 unless defined $it; return $what eq $it; } } sub cmp_msg { my ($name, $msg, $cmp) = @_; ok (undef_or_eq ($cmp->{prefix}, $msg->{prefix}), "$name: message prefix"); ok (undef_or_eq ($cmp->{command}, $msg->{command}), "$name: message command"); my $params_ok = 1; if ($cmp->{params}) { my @msgp = @{$msg->{params}}; for (@{$cmp->{params}}) { my $p = shift @msgp; unless (undef_or_eq ($_, $p)) { $params_ok = 0; last } } } ok ($params_ok, "$name: message params"); } for (@ircmsg_tests) { my $msg = parse_irc_msg ($_->[1]); cmp_msg ($_->[0], $msg, $_->[2]); } } { for (@ircmsg_tests) { my $name = $_->[0]; my $msg = $_->[1]; my $pmsg = parse_irc_msg ($msg); my @params = @{$pmsg->{params}}; my $omsg = mk_msg ($pmsg->{prefix}, $pmsg->{command}, @params) . "\015\012"; is ($omsg, $msg, "$name: message parse and making succeed"); } } { for (@ircmsg_tests) { my $name = $_->[0]; my $msg = $_->[1]; my $cmp = $_->[2]; if ($cmp->{prefix}) { $msg = parse_irc_msg ($msg); my @prfx = split_prefix ($msg->{prefix}); for (0..2) { is ($prfx[$_], $cmp->{prefix_ar}->[$_], "'$name': prefix ($_)") } is (prefix_nick ($msg), $cmp->{prefix_ar}->[0], "$name: nick prefix"); is (prefix_user ($msg), $cmp->{prefix_ar}->[1], "$name: user prefix"); is (prefix_host ($msg), $cmp->{prefix_ar}->[2], "$name: host prefix"); } } } for (@ircmodes) { is (rfc_code_to_name ($_->[0]), $_->[1], "rfc_code_to_name: $_->[0]"); } is (filter_colors ('2007-06-30 12:14:36 +0200 | IRC RECV{cmd: 332, params: elmex, #Jav-Fans, 8,1::7[ 0JAVFANS 7]8:: 8:: 7( 8Recruiting 7)0'), '2007-06-30 12:14:36 +0200 | IRC RECV{cmd: 332, params: elmex, #Jav-Fans, ::[ JAVFANS ]:: :: ( Recruiting )', 'mirc color filter ok'); is (filter_colors ('2007-08-04 22:01:04 +0200 | IRC RECV{cmd: PRIVMSG, params: #welcome, cocommlymeca: what is the biggest contemporan brake to the evolution of humankind towards Communism?, prefix: anonymous!anonymous@psyced.org}'), '2007-08-04 22:01:04 +0200 | IRC RECV{cmd: PRIVMSG, params: #welcome, cocommlymeca: what is the biggest contemporan brake to the evolution of humankind towards Communism?, prefix: anonymous!anonymous@psyced.org}', 'filter ansi sequences'); is (filter_colors ('2007-08-07 19:15:27 +0200 | IRC RECV{cmd: PRIVMSG, params: #ccc, ~[5~[5~[5~[6~[6~[6~[5~[6~, prefix: schneider!~schneider@blinkenlichts.net}'), '2007-08-07 19:15:27 +0200 | IRC RECV{cmd: PRIVMSG, params: #ccc, ~, prefix: schneider!~schneider@blinkenlichts.net}', 'filter ansi sequences 2'); AnyEvent-IRC-0.97/MANIFEST0000644000000000000000000000072012121404774013445 0ustar rootrootChanges MANIFEST README Makefile.PL lib/AnyEvent/IRC.pm lib/AnyEvent/IRC/Util.pm lib/AnyEvent/IRC/Client.pm lib/AnyEvent/IRC/Connection.pm samples/test_connect samples/notify samples/anyeventirccl samples/debug_console samples/version_dump samples/anyeventirc samples/dcc t/00_load.t t/01_util.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) AnyEvent-IRC-0.97/Makefile.PL0000644000000000000000000000145611444066626014304 0ustar rootrootuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'AnyEvent::IRC', AUTHOR => 'Robin Redeker ', LICENSE => 'perl', VERSION_FROM => 'lib/AnyEvent/IRC.pm', ABSTRACT_FROM => 'lib/AnyEvent/IRC.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'AnyEvent' => '5.111', 'Object::Event' => '0.6', 'common::sense' => 0, 'Scalar::Util' => 0, 'Encode' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', PREOP => 'pod2text lib/AnyEvent/IRC.pm | tee README >$(DISTVNAME)/README; chmod -R u=rwX,go=rX . ;', }, clean => { FILES => 'AnyEvent-IRC-*' }, ); AnyEvent-IRC-0.97/README0000644000000000000000000001125012121404774013174 0ustar rootrootNAME AnyEvent::IRC - An event based IRC protocol client API VERSION Version 0.97 SYNOPSIS Using the simplistic AnyEvent::IRC::Connection: use AnyEvent; use AnyEvent::IRC::Connection; my $c = AnyEvent->condvar; my $con = new AnyEvent::IRC::Connection; $con->connect ("localhost", 6667); $con->reg_cb ( connect => sub { my ($con) = @_; $con->send_msg (NICK => 'testbot'); $con->send_msg (USER => 'testbot', '*', '0', 'testbot'); }, irc_001 => sub { my ($con) = @_; print "$_[1]->{prefix} says I'm in the IRC: $_[1]->{params}->[-1]!\n"; $c->broadcast; } ); $c->wait; Using the more sophisticated AnyEvent::IRC::Client: use AnyEvent; use AnyEvent::IRC::Client; my $c = AnyEvent->condvar; my $timer; my $con = new AnyEvent::IRC::Client; $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; DESCRIPTION The AnyEvent::IRC module consists of AnyEvent::IRC::Connection, AnyEvent::IRC::Client and AnyEvent::IRC::Util. AnyEvent::IRC is just a module that holds this overview over the other modules. AnyEvent::IRC can be viewed as toolbox for handling IRC connections and communications. It won't do everything for you, and you still need to know a few details of the IRC protocol. AnyEvent::IRC::Client is a more highlevel IRC connection that already processes some messages for you and will generated some events that are maybe useful to you. It will also do PING replies for you, manage channels a bit, nicknames and CTCP. AnyEvent::IRC::Connection is a lowlevel connection that only connects to the server and will let you send and receive IRC messages. AnyEvent::IRC::Connection does not imply any client behaviour, you could also use it to implement an IRC server. Note that these modules use AnyEvent as it's IO event subsystem. You can integrate them into any application with a event system that AnyEvent has support for (eg. Gtk2 or Event). EXAMPLES See the samples/ directory for some examples on how to use AnyEvent::IRC. AUTHOR Robin Redeker, "" SEE ALSO AnyEvent::IRC::Util AnyEvent::IRC::Connection AnyEvent::IRC::Client AnyEvent RFC 1459 - Internet Relay Chat: Client Protocol RFC 2812 - Internet Relay Chat: Client Protocol BUGS Please report any bugs or feature requests to "bug-net-irc3 at rt.cpan.org", or through the web interface at . I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. SUPPORT You can find documentation for this module with the perldoc command. perldoc AnyEvent::IRC You can also look for information at: * AnnoCPAN: Annotated CPAN documentation * CPAN Ratings * RT: CPAN's request tracker * Search CPAN ACKNOWLEDGEMENTS Thanks to Marc Lehmann for the new AnyEvent module! And these people have helped to work on AnyEvent::IRC: * Maximilian Gass - Added support for ISUPPORT and CASEMAPPING. * Zaba - Thanks for the useful input about IRC. * tokuhirom - Thanks for patches for the kick event. * Kazuhiro Osawa - Thanks for the documenation fix. * Angel Abad - Thanks for the spelling fixes. * Lee Aylward - Thanks for bug spotting and fixing. COPYRIGHT & LICENSE Copyright 2006-2009 Robin Redeker, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. AnyEvent-IRC-0.97/META.yml0000644000000000000000000000111112121404774013560 0ustar rootroot--- abstract: 'An event based IRC protocol client API' author: - 'Robin Redeker ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.112621' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: AnyEvent-IRC no_index: directory: - t - inc requires: AnyEvent: 5.111 Encode: 0 Object::Event: 0.6 Scalar::Util: 0 Test::More: 0 common::sense: 0 version: 0.97 AnyEvent-IRC-0.97/META.json0000644000000000000000000000202112121404774013731 0ustar rootroot{ "abstract" : "An event based IRC protocol client API", "author" : [ "Robin Redeker " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.112621", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "AnyEvent-IRC", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : 0 } }, "runtime" : { "requires" : { "AnyEvent" : "5.111", "Encode" : 0, "Object::Event" : "0.6", "Scalar::Util" : 0, "Test::More" : 0, "common::sense" : 0 } } }, "release_status" : "stable", "version" : "0.97" }