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 METHODS

=over 4

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

This function registers all the callbacks it needs and
then sends the IRC registration commands NICK and USER.

=cut

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

   $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_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->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 key value list of all channels this connection is currently JOINed.
The keys are the channel name and the values are hash references.

=cut

sub channel_list {
   my ($self) = @_;
   return keys %{$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}->{$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} = [];
}

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

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;

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

   1;
}

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

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

}

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

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

   my $chan = lc $msg->{params}->[0];

   $self->{channels}->{$chan} = {};

   if (lc Net::IRC3::prefix_nick ($msg) eq lc $self->{nick}) {

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

      $self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 1);

   } else {
      $self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 0);
   }

   1;
}

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

   my $chan = lc $msg->{params}->[0];
   my $nick = lc Net::IRC3::prefix_nick ($msg);

   if ($self->{nick} eq $nick) {

      delete $self->{chan_queue}->{$chan};
      delete $self->{channels}->{$chan};
      $self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 1, $msg->{params}->[1]);

   } else {
      $self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 0, $msg->{params}->[1]);
   }

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

=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.1
Committed:	Sun Jul 16 11:11:17 2006 UTC (20 years, 3 months ago) by elmex
Branch:	MAIN
Log Message:	version 0.2. added documentation and refactored code a bit.
#	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			=head1 METHODS
33
34			=over 4
35
36			=item B<register ($nick, $user, $real)>
37
38			This function registers all the callbacks it needs and
39			then sends the IRC registration commands NICK and USER.
40
41			=cut
42
43			sub register {
44			my ($self, $nick, $user, $real) = @_;
45
46			$self->reg_cb (irc_001 => \&welcome_cb);
47			$self->reg_cb (irc_join => \&join_cb);
48			$self->reg_cb (irc_part => \&part_cb);
49			$self->reg_cb (irc_353 => \&namereply_cb);
50			$self->reg_cb (irc_366 => \&endofnames_cb);
51			$self->reg_cb (irc_ping => \&ping_cb);
52
53			$self->reg_cb (irc_privmsg => \&privmsg_cb);
54			$self->reg_cb (irc_notice => \&privmsg_cb);
55
56			$self->reg_cb ('irc_*' => \&debug_cb)
57			if $DEBUG;
58			$self->reg_cb ('irc_*' => \&anymsg_cb);
59
60			$self->send_msg (undef, "NICK", undef, $nick);
61			$self->send_msg (undef, "USER", $real \|\| $nick, $user \|\| $nick, "*", "0");
62
63			$self->{nick} = $nick;
64			$self->{user} = $user;
65			$self->{real} = $real;
66			}
67
68			=item B<nick ()>
69
70			Returns the current nickname, under which this connection
71			is registered at the IRC server. It might be different from the
72			one that was passed to C<register> as a nick-collision might happened
73			on login.
74
75			=cut
76
77			sub nick { $_[0]->{nick} }
78
79			=item B<channel_list ()>
80
81			This returns a key value list of all channels this connection is currently JOINed.
82			The keys are the channel name and the values are hash references.
83
84			=cut
85
86			sub channel_list {
87			my ($self) = @_;
88			return keys %{$self->{channels}};
89			}
90
91			=item B<send_srv (@ircmsg)>
92
93			This function sends an IRC message that is constructed by C<mk_msg (@ircmsg)> (see L<Net::IRC3>).
94			If the connection isn't yet registered (for example if the connection is slow) and hasn't got a
95			welcome (IRC command 001) from the server yet, the IRC message is queued until it gets a welcome.
96
97			=cut
98
99			sub send_srv {
100			my ($self, @msg) = @_;
101
102			if ($self->{connected}) {
103			$self->send_msg (undef, @msg);
104
105			} else {
106			push @{$self->{con_queue}}, \@msg;
107			}
108			}
109
110			=item B<clear_srv_queue>
111
112			Clears the server send queue.
113
114			=cut
115
116			sub clear_srv_queue {
117			my ($self) = @_;
118			$self->{con_queue} = [];
119			}
120
121			=item B<send_chan ($channel, @ircmsg)>
122
123			This function sends a message to server, like C<send_srv> only that it will queue the messages
124			if it hasn't joined the channel C<$channel> yet. The queued messages will be send once
125			the connection successfully joined the C<$channel>.
126
127			=cut
128
129			sub send_chan {
130			my ($self, $chan, @msg) = @_;
131
132			if ($self->{channels}->{$chan}) {
133			$self->send_msg (undef, @msg);
134
135			} else {
136			push @{$self->{chan_queue}->{lc $chan}}, \@msg;
137			}
138			}
139
140			=item B<clear_chan_queue ($channel)>
141
142			Clears the channel queue of the channel C<$channel>.
143
144			=cut
145
146			sub clear_chan_queue {
147			my ($self, $chan) = @_;
148			$self->{chan_queue}->{lc $chan} = [];
149			}
150
151			################################################################################
152			# Callbacks
153			################################################################################
154
155			sub anymsg_cb {
156			my ($self, $msg) = @_;
157
158			my $cmd = lc $msg->{command};
159
160			if ( $cmd ne "privmsg"
161			and $cmd ne "notice"
162			and $cmd ne "part"
163			and $cmd ne "join"
164			)
165			{
166			$self->event (statmsg => $msg);
167			}
168
169			1;
170			}
171
172			sub privmsg_cb {
173			my ($self, $msg) = @_;
174
175			if ($msg->{params}->[0] =~ m/^[#!]/) {
176			$self->event (chanmsg => $msg->{params}->[0], $msg);
177
178			} else {
179			$self->event (querymsg => $msg->{params}->[0], $msg);
180			}
181
182			1;
183			}
184
185			sub welcome_cb {
186			my ($self, $msg) = @_;
187
188			$self->{connected} = 1;
189
190			for (@{$self->{con_queue}}) {
191			$self->send_msg (undef, @$_);
192			$self->event (connected => $chan);
193			}
194
195			1;
196			}
197
198			sub ping_cb {
199			my ($self, $msg) = @_;
200			$self->send_srv ("PONG", $msg->{params}->[0]);
201			}
202
203			sub namereply_cb {
204			my ($self, $msg) = @_;
205
206			}
207
208			sub endofnames_cb {
209			my ($self, $msg) = @_;
210			}
211
212			sub join_cb {
213			my ($self, $msg) = @_;
214
215			my $chan = lc $msg->{params}->[0];
216
217			$self->{channels}->{$chan} = {};
218
219			if (lc Net::IRC3::prefix_nick ($msg) eq lc $self->{nick}) {
220
221			for (@{$self->{chan_queue}->{$chan}}) {
222			$self->send_msg (undef, @$_);
223			}
224
225			$self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 1);
226
227			} else {
228			$self->event (join => Net::IRC3::prefix_nick ($msg), $chan, 0);
229			}
230
231			1;
232			}
233
234			sub part_cb {
235			my ($self, $msg) = @_;
236
237			my $chan = lc $msg->{params}->[0];
238			my $nick = lc Net::IRC3::prefix_nick ($msg);
239
240			if ($self->{nick} eq $nick) {
241
242			delete $self->{chan_queue}->{$chan};
243			delete $self->{channels}->{$chan};
244			$self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 1, $msg->{params}->[1]);
245
246			} else {
247			$self->event (part => Net::IRC3::prefix_nick ($msg), $chan, 0, $msg->{params}->[1]);
248			}
249
250			1;
251			}
252
253			sub debug_cb {
254			my ($self, $msg) = @_;
255			print "$self->{h}:$self->{p} > ";
256			my $par = delete $msg->{params};
257			print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
258			print " params:";
259			print (join ",", @$par);
260			print "\n";
261			}
262
263			=back
264
265			=head1 EXAMPLES
266
267			See samples/netirc3cl and other samples in samples/ for some examples on how to use Net::IRC3::Client::Connection.
268
269			=head1 AUTHOR
270
271			Robin Redeker, C<< <elmex@ta-sa.org> >>
272
273			=head1 SEE ALSO
274
275			L<Net::IRC3>
276
277			L<Net::IRC3::Client>
278
279			L<Net::IRC3::Client::Connection>
280
281			RFC 2812 - Internet Relay Chat: Client Protocol
282
283			=head1 COPYRIGHT & LICENSE
284
285			Copyright 2006 Robin Redker, all rights reserved.
286
287			This program is free software; you can redistribute it and/or modify it
288			under the same terms as Perl itself.
289
290			=cut
291
292			1;