IRC3/Client/Connection.pm

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

our $DEBUG;

=head1 NAME

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

=head1 SYNOPSIS

   use Net::IRC3::Client;

   my $irc3 = new Net::IRC3::Client;

   my $con = $irc3->connect ("test.not.at.irc.net", 6667);

   $con->register ("fancybot", "fancybot", "Mr. Fancybot");

   ...

=head1 DESCRIPTION

L<Net::IRC3> itself is a simple building block for an IRC client.
It manages connections and parses and constructs IRC messages.

L<Net::IRC3> is I<very> simple, if you don't want to care about
all the other things that a client still has to do (like replying to
PINGs and remembering who is on a channel), I recommend to read
the L<Net::IRC3::Client> page instead.

=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<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<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>.

=back

=head1 METHODS

=over 4

=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_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);
   $self->reg_cb (channel_add    => \&channel_add_event);

   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->send_msg (undef, "NICK", undef, $nick);
   $self->send_msg (undef, "USER", $real || $nick, $user || $nick, "*", "0");

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

=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<channel_list ()>

This returns a hash reference. The keys are the currently joined channels. The values
are hash references which contain the joined nicks as key.

=cut

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

=item B<send_srv (@ircmsg)>

This function sends an IRC message that is constructed by C<mk_msg (@ircmsg)> (see L<Net::IRC3>).
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, @ircmsg)>

This function sends a message to 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>.

=cut

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

   if ($self->{channels}->{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 {
   my ($self, $chan, @nicks) = @_;

   $chan = lc $chan;
   for my $nick (@nicks) {
      $nick = lc $nick;

      if ($nick eq lc $self->nick ()) {
         delete $self->{chan_queue}->{$chan};
         delete $self->{channels}->{$chan};
         last;
      } else {
         delete $self->{channels}->{$chan}->{$nick};
      }
   }

   1;
}

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

   for my $nick (@nicks) {
      $nick = lc $nick;

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

      $self->{channels}->{$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"
      ) 
   {
      $self->event (statmsg => $msg);
   }

   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;

   $self->event ('registered');

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

   1;
}

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

   1;
}

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

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

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

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

   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->{channels}}) {
      $self->event (channel_remove => $_, $nick);
   }
}

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

=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>

L<Net::IRC3::Client>

L<Net::IRC3::Client::Connection>

RFC 2812 - Internet Relay Chat: Client Protocol

=head1 COPYRIGHT & LICENSE

Copyright 2006 Robin Redker, 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.4
Committed:	Sun Jul 16 19:44:50 2006 UTC (20 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+8 -7 lines
Log Message:	moved utilitys to Util.pm and fixed a bug in nick chasing
#	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.1
5	elmex	1.4	our $DEBUG;
6	elmex	1.1
7			=head1 NAME
8
9			Net::IRC3::Client::Connection - A highlevel IRC connection
10
11			=head1 SYNOPSIS
12
13			use Net::IRC3::Client;
14
15			my $irc3 = new Net::IRC3::Client;
16
17			my $con = $irc3->connect ("test.not.at.irc.net", 6667);
18
19			$con->register ("fancybot", "fancybot", "Mr. Fancybot");
20
21			...
22
23			=head1 DESCRIPTION
24
25			L<Net::IRC3> itself is a simple building block for an IRC client.
26			It manages connections and parses and constructs IRC messages.
27
28			L<Net::IRC3> is I<very> simple, if you don't want to care about
29			all the other things that a client still has to do (like replying to
30			PINGs and remembering who is on a channel), I recommend to read
31			the L<Net::IRC3::Client> page instead.
32
33	elmex	1.2	=head1 EVENTS
34
35			The following events are emitted by L<Net::IRC3::Client::Connection>.
36			Use C<reg_cb> as described in L<Net::IRC3::Connection> to register to such an
37			event.
38	elmex	1.1
39			=over 4
40
41	elmex	1.3	=item B<registered>
42
43			Emitted when the connection got successfully registered.
44
45	elmex	1.2	=item B<channel_add $channel @nicks>
46
47			Emitted when C<@nicks> are added to the channel C<$channel>,
48			this happens for example when someone JOINs a channel or when you
49			get a RPL_NAMREPLY (see RFC2812).
50
51			=item B<channel_remove $channel @nicks>
52
53			Emitted when C<@nicks> are removed from the channel C<$channel>,
54			happens for example when they PART, QUIT or get KICKed.
55
56			=item B<join $nick $channel $is_myself>
57
58			Emitted when C<$nick> enters the channel C<$channel> by JOINing.
59			C<$is_myself> is true if youself are the one who JOINs.
60
61			=item B<part $nick $channel $is_myself $msg>
62
63			Emitted when C<$nick> PARTs the channel C<$channel>.
64			C<$is_myself> is true if youself are the one who PARTs.
65			C<$msg> is the PART message.
66	elmex	1.1
67	elmex	1.3	=item B<quit $nick $msg>
68
69			Emitted when the nickname C<$nick> QUITs with the message C<$msg>.
70
71			=item B<publicmsg $channel $ircmsg>
72
73			Emitted for NOTICE and PRIVMSG where the target C<$channel> is a channel.
74			C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.
75
76			=item B<privatemsg $nick $ircmsg>
77
78			Emitted for NOTICE and PRIVMSG where the target C<$nick> (most of the time you) is a nick.
79			C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.
80
81	elmex	1.2	=back
82
83			=head1 METHODS
84
85			=over 4
86	elmex	1.1
87			=cut
88
89	elmex	1.2	sub new {
90			my $this = shift;
91			my $class = ref($this) \|\| $this;
92			my $self = $class->SUPER::new (@_);
93	elmex	1.1	$self->reg_cb (irc_001 => \&welcome_cb);
94			$self->reg_cb (irc_join => \&join_cb);
95			$self->reg_cb (irc_part => \&part_cb);
96	elmex	1.2	$self->reg_cb (irc_kick => \&kick_cb);
97			$self->reg_cb (irc_quit => \&quit_cb);
98	elmex	1.1	$self->reg_cb (irc_353 => \&namereply_cb);
99			$self->reg_cb (irc_366 => \&endofnames_cb);
100			$self->reg_cb (irc_ping => \&ping_cb);
101
102			$self->reg_cb (irc_privmsg => \&privmsg_cb);
103			$self->reg_cb (irc_notice => \&privmsg_cb);
104
105			$self->reg_cb ('irc_*' => \&debug_cb)
106			if $DEBUG;
107			$self->reg_cb ('irc_*' => \&anymsg_cb);
108
109	elmex	1.2	$self->reg_cb (channel_remove => \&channel_remove_event);
110			$self->reg_cb (channel_add => \&channel_add_event);
111
112			return $self;
113			}
114
115			=item B<register ($nick, $user, $real)>
116
117			Sends the IRC registration commands NICK and USER.
118
119			=cut
120
121			sub register {
122			my ($self, $nick, $user, $real) = @_;
123
124	elmex	1.1	$self->send_msg (undef, "NICK", undef, $nick);
125			$self->send_msg (undef, "USER", $real \|\| $nick, $user \|\| $nick, "*", "0");
126
127			$self->{nick} = $nick;
128			$self->{user} = $user;
129			$self->{real} = $real;
130			}
131
132			=item B<nick ()>
133
134			Returns the current nickname, under which this connection
135			is registered at the IRC server. It might be different from the
136			one that was passed to C<register> as a nick-collision might happened
137			on login.
138
139			=cut
140
141			sub nick { $_[0]->{nick} }
142
143			=item B<channel_list ()>
144
145	elmex	1.2	This returns a hash reference. The keys are the currently joined channels. The values
146			are hash references which contain the joined nicks as key.
147	elmex	1.1
148			=cut
149
150			sub channel_list {
151			my ($self) = @_;
152	elmex	1.2	return $self->{channels};
153	elmex	1.1	}
154
155			=item B<send_srv (@ircmsg)>
156
157			This function sends an IRC message that is constructed by C<mk_msg (@ircmsg)> (see L<Net::IRC3>).
158			If the connection isn't yet registered (for example if the connection is slow) and hasn't got a
159			welcome (IRC command 001) from the server yet, the IRC message is queued until it gets a welcome.
160
161			=cut
162
163			sub send_srv {
164			my ($self, @msg) = @_;
165
166			if ($self->{connected}) {
167			$self->send_msg (undef, @msg);
168
169			} else {
170			push @{$self->{con_queue}}, \@msg;
171			}
172			}
173
174			=item B<clear_srv_queue>
175
176			Clears the server send queue.
177
178			=cut
179
180			sub clear_srv_queue {
181			my ($self) = @_;
182			$self->{con_queue} = [];
183			}
184
185			=item B<send_chan ($channel, @ircmsg)>
186
187			This function sends a message to server, like C<send_srv> only that it will queue the messages
188			if it hasn't joined the channel C<$channel> yet. The queued messages will be send once
189			the connection successfully joined the C<$channel>.
190
191			=cut
192
193			sub send_chan {
194			my ($self, $chan, @msg) = @_;
195
196	elmex	1.2	if ($self->{channels}->{lc $chan}) {
197	elmex	1.1	$self->send_msg (undef, @msg);
198
199			} else {
200			push @{$self->{chan_queue}->{lc $chan}}, \@msg;
201			}
202			}
203
204			=item B<clear_chan_queue ($channel)>
205
206			Clears the channel queue of the channel C<$channel>.
207
208			=cut
209
210			sub clear_chan_queue {
211			my ($self, $chan) = @_;
212			$self->{chan_queue}->{lc $chan} = [];
213			}
214
215			################################################################################
216	elmex	1.2	# Private utility functions
217			################################################################################
218
219			sub _was_me {
220			my ($self, $msg) = @_;
221	elmex	1.4	lc prefix_nick ($msg) eq lc $self->nick ()
222	elmex	1.2	}
223
224			################################################################################
225	elmex	1.1	# Callbacks
226			################################################################################
227
228	elmex	1.2	sub channel_remove_event {
229			my ($self, $chan, @nicks) = @_;
230
231			$chan = lc $chan;
232			for my $nick (@nicks) {
233			$nick = lc $nick;
234
235			if ($nick eq lc $self->nick ()) {
236			delete $self->{chan_queue}->{$chan};
237			delete $self->{channels}->{$chan};
238			last;
239			} else {
240			delete $self->{channels}->{$chan}->{$nick};
241			}
242			}
243
244			1;
245			}
246
247			sub channel_add_event {
248			my ($self, $chan, @nicks) = @_;
249			$chan = lc $chan;
250
251			for my $nick (@nicks) {
252			$nick = lc $nick;
253
254			if ($nick eq lc $self->nick ()) {
255			for (@{$self->{chan_queue}->{$chan}}) {
256			$self->send_msg (undef, @$_);
257			}
258			}
259
260			$self->{channels}->{$chan}->{$nick} = 1;
261			}
262
263
264			1;
265			}
266
267	elmex	1.1	sub anymsg_cb {
268			my ($self, $msg) = @_;
269
270			my $cmd = lc $msg->{command};
271
272			if ( $cmd ne "privmsg"
273			and $cmd ne "notice"
274			and $cmd ne "part"
275			and $cmd ne "join"
276			)
277			{
278			$self->event (statmsg => $msg);
279			}
280
281			1;
282			}
283
284			sub privmsg_cb {
285			my ($self, $msg) = @_;
286
287	elmex	1.3	my $targ = $msg->{params}->[0];
288			if ($targ =~ m/^(?:[#+&]\|![A-Z0-9]{5})/) {
289			$self->event (publicmsg => $targ, $msg);
290	elmex	1.1
291			} else {
292	elmex	1.3	$self->event (privatemsg => $targ, $msg);
293	elmex	1.1	}
294
295			1;
296			}
297
298			sub welcome_cb {
299			my ($self, $msg) = @_;
300
301			$self->{connected} = 1;
302
303	elmex	1.2	$self->event ('registered');
304
305	elmex	1.1	for (@{$self->{con_queue}}) {
306			$self->send_msg (undef, @$_);
307			}
308
309			1;
310			}
311
312			sub ping_cb {
313			my ($self, $msg) = @_;
314			$self->send_srv ("PONG", $msg->{params}->[0]);
315	elmex	1.2
316			1;
317	elmex	1.1	}
318
319			sub namereply_cb {
320			my ($self, $msg) = @_;
321	elmex	1.2	my @nicks = split / /, $msg->{trailing};
322			push @{$self->{_tmp_namereply}}, @nicks;
323	elmex	1.1	}
324
325			sub endofnames_cb {
326			my ($self, $msg) = @_;
327	elmex	1.2	my $chan = lc $msg->{params}->[1];
328	elmex	1.4	$self->event (channel_add => $chan, map { s/^[@\+]//; $_ } @{delete $self->{_tmp_namereply}});
329	elmex	1.1	}
330
331			sub join_cb {
332			my ($self, $msg) = @_;
333	elmex	1.2	my $chan = $msg->{params}->[0];
334	elmex	1.4	my $nick = prefix_nick ($msg);
335	elmex	1.1
336	elmex	1.2	$self->event (join => $nick, $chan, $self->_was_me ($msg));
337			$self->event (channel_add => $chan, $nick);
338	elmex	1.1
339	elmex	1.2	1;
340			}
341
342			sub part_cb {
343			my ($self, $msg) = @_;
344			my $chan = $msg->{params}->[0];
345	elmex	1.4	my $nick = prefix_nick ($msg);
346	elmex	1.1
347	elmex	1.2	$self->event (part => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
348			$self->event (channel_remove => $chan, $nick);
349	elmex	1.1
350	elmex	1.2	1;
351			}
352	elmex	1.1
353	elmex	1.2	sub kick_cb {
354			my ($self, $msg) = @_;
355			my $chan = $msg->{params}->[0];
356			my $kicked_nick = $msg->{params}->[1];
357	elmex	1.1
358	elmex	1.2	$self->event (channel_remove => $chan, $kicked_nick);
359	elmex	1.1
360			1;
361			}
362
363	elmex	1.2	sub quit_cb {
364	elmex	1.1	my ($self, $msg) = @_;
365	elmex	1.4	my $nick = prefix_nick ($msg);
366	elmex	1.1
367	elmex	1.2	$self->event (quit => $nick, $msg->{params}->[1]);
368	elmex	1.1
369	elmex	1.2	for (keys %{$self->{channels}}) {
370			$self->event (channel_remove => $_, $nick);
371	elmex	1.1	}
372			}
373
374			sub debug_cb {
375			my ($self, $msg) = @_;
376			print "$self->{h}:$self->{p} > ";
377			my $par = delete $msg->{params};
378			print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
379			print " params:";
380			print (join ",", @$par);
381			print "\n";
382			}
383
384			=back
385
386			=head1 EXAMPLES
387
388			See samples/netirc3cl and other samples in samples/ for some examples on how to use Net::IRC3::Client::Connection.
389
390			=head1 AUTHOR
391
392			Robin Redeker, C<< <elmex@ta-sa.org> >>
393
394			=head1 SEE ALSO
395
396			L<Net::IRC3>
397
398			L<Net::IRC3::Client>
399
400			L<Net::IRC3::Client::Connection>
401
402			RFC 2812 - Internet Relay Chat: Client Protocol
403
404			=head1 COPYRIGHT & LICENSE
405
406			Copyright 2006 Robin Redker, all rights reserved.
407
408			This program is free software; you can redistribute it and/or modify it
409			under the same terms as Perl itself.
410
411			=cut
412
413			1;