IRC3/Client/Connection.pm

package Net::IRC3::Client::Connection;
use base Net::IRC3::Connection;

our $DEBUG = 0;

=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 Net::IRC3::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, @{delete $self->{_tmp_namereply}});
}

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