IRC3/Client/Connection.pm

package Net::IRC3::Client::Connection;
use base "Net::IRC3::Connection";
use Net::IRC3::Util qw/prefix_nick/;
use strict;

our $DEBUG;

=head1 NAME

Net::IRC3::Client::Connection - A highlevel IRC connection

=head1 SYNOPSIS

   use AnyEvent;
   use Net::IRC3::Client::Connection;

   my $c = AnyEvent->condvar;

   my $timer;
   my $con = new Net::IRC3::Client::Connection;

   $con->reg_cb (registered => sub { print "I'm in!\n"; 0 });
   $con->reg_cb (disconnect => sub { print "I'm out!\n"; 0 });
   $con->reg_cb (
      sent => sub {
         if ($_[2] eq 'PRIVMSG') {
            print "Sent message!\n";
            $timer = AnyEvent->timer (after => 1, cb => sub { $c->broadcast });
         }
         1
      }
   );

   $con->send_srv (PRIVMSG => "Hello there i'm the cool Net::IRC3 test script!", 'elmex');

   $con->connect ("localhost", 6667);
   $con->register (qw/testbot testbot testbot/);

   $c->wait;
   undef $timer;

   $con->disconnect;

=head1 DESCRIPTION

L<Net::IRC3::Client::Connection> is a 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.

=head2 A NOTE TO CASE MANAGEMENT

The case insensitivity of channelnames 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
Net::IRC3::Client::Connection passes to his user. But in the internal
structures i'm using lower case for the channel names.

The returned hash from C<channel_list> 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<Net::IRC3::Client::Connection>.
Use C<reg_cb> as described in L<Net::IRC3::Connection> to register to such an
event.

=over 4

=item B<registered>

Emitted when the connection got successfully registered.

=item B<channel_add $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 RFC2812).

=item B<channel_remove $channel @nicks>

Emitted when C<@nicks> are removed from the channel C<$channel>,
happens for example when they PART, QUIT or get KICKed.

=item B<channel_change $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
youself was the one who changed the nick.

=item B<join $nick $channel $is_myself>

Emitted when C<$nick> enters the channel C<$channel> by JOINing.
C<$is_myself> is true if youself are the one who JOINs.

=item B<part $nick $channel $is_myself $msg>

Emitted when C<$nick> PARTs the channel C<$channel>.
C<$is_myself> is true if youself are the one who PARTs.
C<$msg> is the PART message.

=item B<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 youself was the one who changed the nick.

=item B<quit $nick $msg>

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

=item B<publicmsg $channel $ircmsg>

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

=item B<privatemsg $nick $ircmsg>

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

=item B<error $code $message @params>

Emitted when any error occurs. C<$code> is the 3 digit error id string from RFC
2812 and C<$message> is a description of the error. C<@params> is the complete
parameter list of the error command, including the C<$message> at the end of
C<@params>.

You may use Net::IRC3::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'

=back

=head1 METHODS

=over 4

=item B<new>

This constructor takes no arguments.

=cut

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_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_353     => \&namereply_cb);
   $self->reg_cb (irc_366     => \&endofnames_cb);
   $self->reg_cb (irc_ping    => \&ping_cb);

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

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

   $self->reg_cb (channel_remove => \&channel_remove_event_cb);
   $self->reg_cb (channel_add    => \&channel_add_event_cb);
   $self->reg_cb (disconnect     => \&disconnect_cb);

   $self->reg_cb (irc_437        => \&change_nick_login_cb);
   $self->reg_cb (irc_433        => \&change_nick_login_cb);

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

   return $self;
}

=item B<register ($nick, $user, $real)>

Sends the IRC registration commands NICK and USER.

=cut

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

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

   $self->send_msg (undef, "NICK", undef, $nick);
   $self->send_msg (undef, "USER", $real || $nick, $user || $nick, "*", "0");
}

=item B<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 returnvalue of C<$callback> will then be used to change the nickname.

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

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

=cut

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

=item B<nick ()>

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

=cut

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

=item B<connected ()>

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

=cut

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

=item B<channel_list ()>

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.

NOTE: Future versions might preserve the case from the JOIN command to the channels.

=cut

sub channel_list {
   my ($self) = @_;
   return $self->{channel_list} || {};
}

=item B<send_srv ($command, $trailing, @params)>

This function sends an IRC message that is constructed by C<mk_msg (undef, $command, $trailing, @params)> (see L<Net::IRC3::Util>).
If the connection isn't yet registered (for example if the connection is slow) and hasn't got a
welcome (IRC command 001) from the server yet, the IRC message is queued until it gets a welcome.

=cut

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

   if ($self->{connected}) {
      $self->send_msg (undef, @msg);

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

=item B<clear_srv_queue>

Clears the server send queue.

=cut

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


=item B<send_chan ($channel, $command, $trailing, @params))>

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

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<clear_chan_queue> 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}->{lc $chan}) {
      $self->send_msg (undef, @msg);

   } else {
      push @{$self->{chan_queue}->{lc $chan}}, \@msg;
   }
}

=item B<clear_chan_queue ($channel)>

Clears the channel queue of the channel C<$channel>.

=cut

sub clear_chan_queue {
   my ($self, $chan) = @_;
   $self->{chan_queue}->{lc $chan} = [];
}

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

sub _was_me {
   my ($self, $msg) = @_;
   lc prefix_nick ($msg) eq lc $self->nick ()
}

################################################################################
# Callbacks
################################################################################

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

   for my $nick (@nicks) {
      if (lc ($nick) eq lc ($self->nick ())) {
         delete $self->{chan_queue}->{lc $chan};
         delete $self->{channel_list}->{lc $chan};
         last;
      } else {
         delete $self->{channel_list}->{lc $chan}->{$nick};
      }
   }

   1;
}

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

   for my $nick (@nicks) {
      if (lc ($nick) eq lc ($self->nick ())) {
         for (@{$self->{chan_queue}->{lc $chan}}) {
            $self->send_msg (undef, @$_);
         }
         $self->clear_chan_queue ($chan);
      }

      $self->{channel_list}->{lc $chan}->{$nick} = 1;
   }

   1;
}

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

   my $cmd = lc $msg->{command};

   if (    $cmd ne "privmsg"
       and $cmd ne "notice"
       and $cmd ne "part"
       and $cmd ne "join"
       and not ($cmd >= 400 and $cmd <= 599)
      )
   {
      $self->event (statmsg => $msg);
   } elsif ($cmd >= 400 and $cmd <= 599) {
      $self->event (error => $msg->{command}, $msg->{trailing}, @{$msg->{params}});
   }

   1;
}

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

   my $targ = $msg->{params}->[0];
   if ($targ =~ m/^(?:[#+&]|![A-Z0-9]{5})/) {
      $self->event (publicmsg => $targ, $msg);

   } else {
      $self->event (privatemsg => $targ, $msg);
   }

   1;
}

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

   $self->{connected} = 1;

   for (@{$self->{con_queue}}) {
      $self->send_msg (undef, @$_);
   }
   $self->clear_srv_queue ();

   $self->event ('registered');

   1;
}

sub ping_cb {
   my ($self, $msg) = @_;
   $self->send_msg (undef, "PONG", $msg->{params}->[0]);

   1;
}

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}) {
         delete $chan->{$nick};
         $chan->{$newnick} = 1;
         push @chans, $channame;
      }
   }

   for (@chans) {
      $self->event (channel_change => $_, $nick, $newnick, $wasme);
   }
   $self->event (nick_change => $nick, $newnick, $wasme);
}

sub namereply_cb {
   my ($self, $msg) = @_;
   my @nicks = split / /, $msg->{trailing};
   push @{$self->{_tmp_namereply}}, @nicks;

   1;
}

sub endofnames_cb {
   my ($self, $msg) = @_;
   my $chan = $msg->{params}->[1];
   $self->event (channel_add => $chan, map { s/^[@\+]//; $_ } @{delete $self->{_tmp_namereply}});

   1;
}

sub join_cb {
   my ($self, $msg) = @_;
   my $chan = $msg->{params}->[0];
   my $nick = prefix_nick ($msg);

   $self->event (channel_add => $chan, $nick);
   $self->event (join        => $nick, $chan, $self->_was_me ($msg));

   1;
}

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->event (channel_remove => $chan, $nick);

   1;
}

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

   $self->event (channel_remove => $chan, $kicked_nick);

   1;
}

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

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

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

   1;
}

sub debug_cb {
   my ($self, $msg) = @_;
   print "$self->{h}:$self->{p} > ";
   my $par = delete $msg->{params};
   print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
   print " params:";
   print (join ",", @$par);
   print "\n";

   1;
}

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

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

      if (lc $newnick eq lc $self->{nick}) {
         $self->disconnect;
         return 0;
      }

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

   not ($self->{connected}) # kill the cb when connected
}

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

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

   1
}

=back

=head1 EXAMPLES

See samples/netirc3cl and other samples in samples/ for some examples on how to use Net::IRC3::Client::Connection.

=head1 AUTHOR

Robin Redeker, C<< <elmex@ta-sa.org> >>

=head1 SEE ALSO

L<Net::IRC3::Connection>

RFC 2812 - Internet Relay Chat: Client Protocol

=head1 COPYRIGHT & LICENSE

Copyright 2006 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;
Revision:	1.16
Committed:	Fri Feb 23 20:14:58 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.15:	+12 -8 lines
Log Message:	added some tests and fixed quite some bugs and added missing documentation.
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3::Client::Connection;
2	elmex	1.4	use base "Net::IRC3::Connection";
3			use Net::IRC3::Util qw/prefix_nick/;
4	elmex	1.12	use strict;
5	elmex	1.1
6	elmex	1.4	our $DEBUG;
7	elmex	1.1
8			=head1 NAME
9
10			Net::IRC3::Client::Connection - A highlevel IRC connection
11
12			=head1 SYNOPSIS
13
14	elmex	1.5	use AnyEvent;
15			use Net::IRC3::Client::Connection;
16	elmex	1.1
17	elmex	1.5	my $c = AnyEvent->condvar;
18	elmex	1.1
19	elmex	1.5	my $timer;
20			my $con = new Net::IRC3::Client::Connection;
21	elmex	1.1
22	elmex	1.5	$con->reg_cb (registered => sub { print "I'm in!\n"; 0 });
23			$con->reg_cb (disconnect => sub { print "I'm out!\n"; 0 });
24			$con->reg_cb (
25			sent => sub {
26			if ($_[2] eq 'PRIVMSG') {
27			print "Sent message!\n";
28			$timer = AnyEvent->timer (after => 1, cb => sub { $c->broadcast });
29			}
30			1
31			}
32			);
33
34			$con->send_srv (PRIVMSG => "Hello there i'm the cool Net::IRC3 test script!", 'elmex');
35
36			$con->connect ("localhost", 6667);
37			$con->register (qw/testbot testbot testbot/);
38	elmex	1.1
39	elmex	1.5	$c->wait;
40			undef $timer;
41
42			$con->disconnect;
43	elmex	1.1
44			=head1 DESCRIPTION
45
46	elmex	1.5	L<Net::IRC3::Client::Connection> is a highlevel client connection,
47			that manages all the stuff that noone wants to implement again and again
48			when handling with IRC. For example it PONGs the server or keeps track
49			of the users on a channel.
50	elmex	1.1
51	elmex	1.13	=head2 A NOTE TO CASE MANAGEMENT
52
53			The case insensitivity of channelnames and nicknames can lead to headaches
54			when dealing with IRC in an automated client which tracks channels and nicknames.
55
56			I tried to preserve the case in all channel and nicknames
57			Net::IRC3::Client::Connection passes to his user. But in the internal
58			structures i'm using lower case for the channel names.
59
60			The returned hash from C<channel_list> for example has the lower case of the
61			joined channels as keys.
62
63			But i tried to preserve the case in all events that are emitted.
64			Please keep this in mind when handling the events.
65
66			For example a user might joins #TeSt and parts #test later.
67
68	elmex	1.2	=head1 EVENTS
69
70			The following events are emitted by L<Net::IRC3::Client::Connection>.
71			Use C<reg_cb> as described in L<Net::IRC3::Connection> to register to such an
72			event.
73	elmex	1.1
74			=over 4
75
76	elmex	1.3	=item B<registered>
77
78			Emitted when the connection got successfully registered.
79
80	elmex	1.2	=item B<channel_add $channel @nicks>
81
82			Emitted when C<@nicks> are added to the channel C<$channel>,
83			this happens for example when someone JOINs a channel or when you
84			get a RPL_NAMREPLY (see RFC2812).
85
86			=item B<channel_remove $channel @nicks>
87
88			Emitted when C<@nicks> are removed from the channel C<$channel>,
89			happens for example when they PART, QUIT or get KICKed.
90
91	elmex	1.13	=item B<channel_change $channel $old_nick $new_nick $is_myself>
92
93			Emitted when a nickname on a channel changes. This is emitted when a NICK
94			change occurs from C<$old_nick> to C<$new_nick> give the application a chance
95			to quickly analyze what channels were affected. C<$is_myself> is true when
96			youself was the one who changed the nick.
97
98	elmex	1.2	=item B<join $nick $channel $is_myself>
99
100			Emitted when C<$nick> enters the channel C<$channel> by JOINing.
101			C<$is_myself> is true if youself are the one who JOINs.
102
103			=item B<part $nick $channel $is_myself $msg>
104
105			Emitted when C<$nick> PARTs the channel C<$channel>.
106			C<$is_myself> is true if youself are the one who PARTs.
107			C<$msg> is the PART message.
108	elmex	1.1
109	elmex	1.13	=item B<nick_change $old_nick $new_nick $is_myself>
110	elmex	1.12
111			Emitted when C<$old_nick> is renamed to C<$new_nick>.
112			C<$is_myself> is true when youself was the one who changed the nick.
113
114	elmex	1.3	=item B<quit $nick $msg>
115
116			Emitted when the nickname C<$nick> QUITs with the message C<$msg>.
117
118			=item B<publicmsg $channel $ircmsg>
119
120			Emitted for NOTICE and PRIVMSG where the target C<$channel> is a channel.
121			C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.
122
123			=item B<privatemsg $nick $ircmsg>
124
125			Emitted for NOTICE and PRIVMSG where the target C<$nick> (most of the time you) is a nick.
126			C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.
127
128	elmex	1.13	=item B<error $code $message @params>
129
130			Emitted when any error occurs. C<$code> is the 3 digit error id string from RFC
131			2812 and C<$message> is a description of the error. C<@params> is the complete
132			parameter list of the error command, including the C<$message> at the end of
133			C<@params>.
134
135			You may use Net::IRC3::Util::rfc_code_to_name to convert C<$code> to the error
136			name from the RFC 2812. eg.:
137
138			rfc_code_to_name ('471') => 'ERR_CHANNELISFULL'
139
140	elmex	1.2	=back
141
142			=head1 METHODS
143
144			=over 4
145	elmex	1.1
146	elmex	1.16	=item B<new>
147
148			This constructor takes no arguments.
149
150	elmex	1.1	=cut
151
152	elmex	1.2	sub new {
153			my $this = shift;
154			my $class = ref($this) \|\| $this;
155			my $self = $class->SUPER::new (@_);
156	elmex	1.1	$self->reg_cb (irc_001 => \&welcome_cb);
157			$self->reg_cb (irc_join => \&join_cb);
158	elmex	1.12	$self->reg_cb (irc_nick => \&nick_cb);
159	elmex	1.1	$self->reg_cb (irc_part => \&part_cb);
160	elmex	1.2	$self->reg_cb (irc_kick => \&kick_cb);
161			$self->reg_cb (irc_quit => \&quit_cb);
162	elmex	1.1	$self->reg_cb (irc_353 => \&namereply_cb);
163			$self->reg_cb (irc_366 => \&endofnames_cb);
164			$self->reg_cb (irc_ping => \&ping_cb);
165
166			$self->reg_cb (irc_privmsg => \&privmsg_cb);
167			$self->reg_cb (irc_notice => \&privmsg_cb);
168
169			$self->reg_cb ('irc_*' => \&debug_cb)
170			if $DEBUG;
171			$self->reg_cb ('irc_*' => \&anymsg_cb);
172
173	elmex	1.16	$self->reg_cb (channel_remove => \&channel_remove_event_cb);
174			$self->reg_cb (channel_add => \&channel_add_event_cb);
175			$self->reg_cb (disconnect => \&disconnect_cb);
176	elmex	1.2
177	elmex	1.16	$self->reg_cb (irc_437 => \&change_nick_login_cb);
178			$self->reg_cb (irc_433 => \&change_nick_login_cb);
179	elmex	1.13
180			$self->{nick_change} = sub {
181			my ($old_nick) = @_;
182			"${old_nick}_"
183			};
184
185	elmex	1.2	return $self;
186			}
187
188			=item B<register ($nick, $user, $real)>
189
190			Sends the IRC registration commands NICK and USER.
191
192			=cut
193
194			sub register {
195			my ($self, $nick, $user, $real) = @_;
196
197	elmex	1.13	$self->{nick} = $nick;
198			$self->{user} = $user;
199			$self->{real} = $real;
200
201	elmex	1.1	$self->send_msg (undef, "NICK", undef, $nick);
202			$self->send_msg (undef, "USER", $real \|\| $nick, $user \|\| $nick, "*", "0");
203	elmex	1.13	}
204
205			=item B<set_nick_change_cb $callback>
206
207			This method lets you modify the nickname renaming mechanism when registering
208			the connection. C<$callback> is called with the current nickname as first
209			argument when a ERR_NICKNAMEINUSE or ERR_UNAVAILRESOURCE error occurs on login.
210			The returnvalue of C<$callback> will then be used to change the nickname.
211
212			The default callback appends '_' to the end of the nickname supplied in the
213			C<register> routine.
214
215			If the callback returns the same nickname that was given it the connection
216			will be terminated.
217	elmex	1.1
218	elmex	1.13	=cut
219
220			sub set_nick_change_cb {
221			my ($self, $cb) = @_;
222			$self->{nick_change} = $cb;
223	elmex	1.1	}
224
225			=item B<nick ()>
226
227			Returns the current nickname, under which this connection
228			is registered at the IRC server. It might be different from the
229			one that was passed to C<register> as a nick-collision might happened
230			on login.
231
232			=cut
233
234			sub nick { $_[0]->{nick} }
235
236	elmex	1.13	=item B<connected ()>
237
238			Returns a true value when the connection has been registered successfull and
239			you can send commands.
240
241			=cut
242
243			sub connected { $_[0]->{connected} }
244
245	elmex	1.1	=item B<channel_list ()>
246
247	elmex	1.13	This returns a hash reference. The keys are the currently joined channels in lower case.
248			The values are hash references which contain the joined nicks as key.
249
250			NOTE: Future versions might preserve the case from the JOIN command to the channels.
251	elmex	1.1
252			=cut
253
254			sub channel_list {
255			my ($self) = @_;
256	elmex	1.12	return $self->{channel_list} \|\| {};
257	elmex	1.1	}
258
259	elmex	1.5	=item B<send_srv ($command, $trailing, @params)>
260	elmex	1.1
261	elmex	1.5	This function sends an IRC message that is constructed by C<mk_msg (undef, $command, $trailing, @params)> (see L<Net::IRC3::Util>).
262	elmex	1.1	If the connection isn't yet registered (for example if the connection is slow) and hasn't got a
263			welcome (IRC command 001) from the server yet, the IRC message is queued until it gets a welcome.
264
265			=cut
266
267			sub send_srv {
268			my ($self, @msg) = @_;
269
270			if ($self->{connected}) {
271			$self->send_msg (undef, @msg);
272
273			} else {
274			push @{$self->{con_queue}}, \@msg;
275			}
276			}
277
278			=item B<clear_srv_queue>
279
280			Clears the server send queue.
281
282			=cut
283
284			sub clear_srv_queue {
285			my ($self) = @_;
286			$self->{con_queue} = [];
287			}
288
289
290	elmex	1.5	=item B<send_chan ($channel, $command, $trailing, @params))>
291
292	elmex	1.13	This function sends a message (constructed by C<mk_msg (undef, $command,
293			$trailing, @params)> to the server, like C<send_srv> only that it will queue
294			the messages if it hasn't joined the channel C<$channel> yet. The queued
295			messages will be send once the connection successfully JOINed the C<$channel>.
296	elmex	1.1
297	elmex	1.12	C<$channel> will be lowercased so that any case that comes from the server matches.
298			(Yes, IRC handles upper and lower case as equal :-(
299
300			Be careful with this, there are chances you might not join the channel you
301			wanted to join. You may wanted to join #bla and the server redirects that
302			and sends you that you joined #blubb. You may use C<clear_chan_queue> to
303			remove the queue after some timeout after joining, so that you don't end up
304			with a memory leak.
305
306	elmex	1.1	=cut
307
308			sub send_chan {
309			my ($self, $chan, @msg) = @_;
310
311	elmex	1.14	if ($self->{channel_list}->{lc $chan}) {
312	elmex	1.1	$self->send_msg (undef, @msg);
313
314			} else {
315			push @{$self->{chan_queue}->{lc $chan}}, \@msg;
316			}
317			}
318
319			=item B<clear_chan_queue ($channel)>
320
321			Clears the channel queue of the channel C<$channel>.
322
323			=cut
324
325			sub clear_chan_queue {
326			my ($self, $chan) = @_;
327			$self->{chan_queue}->{lc $chan} = [];
328			}
329
330			################################################################################
331	elmex	1.2	# Private utility functions
332			################################################################################
333
334			sub _was_me {
335			my ($self, $msg) = @_;
336	elmex	1.4	lc prefix_nick ($msg) eq lc $self->nick ()
337	elmex	1.2	}
338
339			################################################################################
340	elmex	1.1	# Callbacks
341			################################################################################
342
343	elmex	1.16	sub channel_remove_event_cb {
344	elmex	1.2	my ($self, $chan, @nicks) = @_;
345
346			for my $nick (@nicks) {
347	elmex	1.12	if (lc ($nick) eq lc ($self->nick ())) {
348			delete $self->{chan_queue}->{lc $chan};
349	elmex	1.13	delete $self->{channel_list}->{lc $chan};
350	elmex	1.2	last;
351			} else {
352	elmex	1.13	delete $self->{channel_list}->{lc $chan}->{$nick};
353	elmex	1.2	}
354			}
355
356			1;
357			}
358
359	elmex	1.16	sub channel_add_event_cb {
360	elmex	1.2	my ($self, $chan, @nicks) = @_;
361
362			for my $nick (@nicks) {
363	elmex	1.12	if (lc ($nick) eq lc ($self->nick ())) {
364			for (@{$self->{chan_queue}->{lc $chan}}) {
365	elmex	1.2	$self->send_msg (undef, @$_);
366			}
367	elmex	1.11	$self->clear_chan_queue ($chan);
368	elmex	1.2	}
369
370	elmex	1.13	$self->{channel_list}->{lc $chan}->{$nick} = 1;
371	elmex	1.2	}
372
373			1;
374			}
375
376	elmex	1.1	sub anymsg_cb {
377			my ($self, $msg) = @_;
378
379			my $cmd = lc $msg->{command};
380
381	elmex	1.13	if ( $cmd ne "privmsg"
382	elmex	1.1	and $cmd ne "notice"
383			and $cmd ne "part"
384			and $cmd ne "join"
385	elmex	1.13	and not ($cmd >= 400 and $cmd <= 599)
386			)
387	elmex	1.1	{
388			$self->event (statmsg => $msg);
389	elmex	1.13	} elsif ($cmd >= 400 and $cmd <= 599) {
390			$self->event (error => $msg->{command}, $msg->{trailing}, @{$msg->{params}});
391	elmex	1.1	}
392
393			1;
394			}
395
396			sub privmsg_cb {
397			my ($self, $msg) = @_;
398
399	elmex	1.3	my $targ = $msg->{params}->[0];
400			if ($targ =~ m/^(?:[#+&]\|![A-Z0-9]{5})/) {
401			$self->event (publicmsg => $targ, $msg);
402	elmex	1.1
403			} else {
404	elmex	1.3	$self->event (privatemsg => $targ, $msg);
405	elmex	1.1	}
406
407			1;
408			}
409
410			sub welcome_cb {
411			my ($self, $msg) = @_;
412
413			$self->{connected} = 1;
414
415			for (@{$self->{con_queue}}) {
416			$self->send_msg (undef, @$_);
417			}
418	elmex	1.11	$self->clear_srv_queue ();
419	elmex	1.1
420	elmex	1.12	$self->event ('registered');
421
422	elmex	1.1	1;
423			}
424
425			sub ping_cb {
426			my ($self, $msg) = @_;
427	elmex	1.8	$self->send_msg (undef, "PONG", $msg->{params}->[0]);
428	elmex	1.2
429			1;
430	elmex	1.1	}
431
432	elmex	1.12	sub nick_cb {
433			my ($self, $msg) = @_;
434			my $nick = prefix_nick ($msg);
435			my $newnick = $msg->{params}->[0];
436			my $wasme = $self->_was_me ($msg);
437
438	elmex	1.13	if ($wasme) { $self->{nick} = $newnick }
439	elmex	1.12
440	elmex	1.13	my @chans;
441	elmex	1.12
442	elmex	1.13	for my $channame (keys %{$self->{channel_list}}) {
443			my $chan = $self->{channel_list}->{$channame};
444	elmex	1.12	if (exists $chan->{$nick}) {
445			delete $chan->{$nick};
446			$chan->{$newnick} = 1;
447	elmex	1.13	push @chans, $channame;
448	elmex	1.12	}
449			}
450
451	elmex	1.13	for (@chans) {
452			$self->event (channel_change => $_, $nick, $newnick, $wasme);
453			}
454	elmex	1.12	$self->event (nick_change => $nick, $newnick, $wasme);
455			}
456
457	elmex	1.1	sub namereply_cb {
458			my ($self, $msg) = @_;
459	elmex	1.2	my @nicks = split / /, $msg->{trailing};
460			push @{$self->{_tmp_namereply}}, @nicks;
461	elmex	1.10
462			1;
463	elmex	1.1	}
464
465			sub endofnames_cb {
466			my ($self, $msg) = @_;
467	elmex	1.12	my $chan = $msg->{params}->[1];
468	elmex	1.4	$self->event (channel_add => $chan, map { s/^[@\+]//; $_ } @{delete $self->{_tmp_namereply}});
469	elmex	1.10
470			1;
471	elmex	1.1	}
472
473			sub join_cb {
474			my ($self, $msg) = @_;
475	elmex	1.2	my $chan = $msg->{params}->[0];
476	elmex	1.4	my $nick = prefix_nick ($msg);
477	elmex	1.1
478	elmex	1.12	$self->event (channel_add => $chan, $nick);
479	elmex	1.2	$self->event (join => $nick, $chan, $self->_was_me ($msg));
480	elmex	1.1
481	elmex	1.2	1;
482			}
483
484			sub part_cb {
485			my ($self, $msg) = @_;
486			my $chan = $msg->{params}->[0];
487	elmex	1.4	my $nick = prefix_nick ($msg);
488	elmex	1.1
489	elmex	1.2	$self->event (part => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
490			$self->event (channel_remove => $chan, $nick);
491	elmex	1.1
492	elmex	1.2	1;
493			}
494	elmex	1.1
495	elmex	1.2	sub kick_cb {
496			my ($self, $msg) = @_;
497			my $chan = $msg->{params}->[0];
498			my $kicked_nick = $msg->{params}->[1];
499	elmex	1.1
500	elmex	1.2	$self->event (channel_remove => $chan, $kicked_nick);
501	elmex	1.1
502			1;
503			}
504
505	elmex	1.2	sub quit_cb {
506	elmex	1.1	my ($self, $msg) = @_;
507	elmex	1.4	my $nick = prefix_nick ($msg);
508	elmex	1.1
509	elmex	1.2	$self->event (quit => $nick, $msg->{params}->[1]);
510	elmex	1.1
511	elmex	1.12	for (keys %{$self->{channel_list}}) {
512	elmex	1.14	$self->event (channel_remove => $_, $nick)
513			if $self->{channel_list}->{$_}->{$nick};
514	elmex	1.1	}
515	elmex	1.10
516			1;
517	elmex	1.1	}
518
519			sub debug_cb {
520			my ($self, $msg) = @_;
521			print "$self->{h}:$self->{p} > ";
522			my $par = delete $msg->{params};
523			print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
524			print " params:";
525			print (join ",", @$par);
526			print "\n";
527	elmex	1.10
528			1;
529	elmex	1.1	}
530
531	elmex	1.16	sub change_nick_login_cb {
532	elmex	1.13	my ($self, $msg) = @_;
533
534			unless ($self->{connected}) {
535			my $newnick = $self->{nick_change}->($self->nick);
536
537			if (lc $newnick eq lc $self->{nick}) {
538			$self->disconnect;
539			return 0;
540			}
541
542			$self->{nick} = $newnick;
543			$self->send_msg (undef, "NICK", undef, $newnick);
544			}
545
546			not ($self->{connected}) # kill the cb when connected
547			}
548
549	elmex	1.15	sub disconnect_cb {
550			my ($self) = @_;
551
552			for (keys %{$self->{channel_list}}) {
553			$self->event (channel_remove => $_, $self->nick)
554			}
555
556			1
557			}
558
559	elmex	1.1	=back
560
561			=head1 EXAMPLES
562
563			See samples/netirc3cl and other samples in samples/ for some examples on how to use Net::IRC3::Client::Connection.
564
565			=head1 AUTHOR
566
567			Robin Redeker, C<< <elmex@ta-sa.org> >>
568
569			=head1 SEE ALSO
570
571	elmex	1.7	L<Net::IRC3::Connection>
572	elmex	1.1
573			RFC 2812 - Internet Relay Chat: Client Protocol
574
575			=head1 COPYRIGHT & LICENSE
576
577	elmex	1.6	Copyright 2006 Robin Redeker, all rights reserved.
578	elmex	1.1
579			This program is free software; you can redistribute it and/or modify it
580			under the same terms as Perl itself.
581
582			=cut
583
584			1;