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

=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) = @_;

   if ($msg->{params}->[0] =~ m/^[#!]/) {
      $self->event (chanmsg => $msg->{params}->[0], $msg);

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