ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/lib/Net/IRC3/Connection.pm
Revision: 1.19
Committed: Tue Sep 23 10:32:59 2008 UTC (16 years, 2 months ago) by elmex
Branch: MAIN
CVS Tags: HEAD
Changes since 1.18: +5 -0 lines
Log Message:
last release: 0.6

File Contents

# Content
1 package Net::IRC3::Connection;
2 use strict;
3 no warnings;
4 use AnyEvent;
5 use POSIX;
6 use IO::Socket::INET;
7 use IO::Handle;
8 use Net::IRC3::Util qw/mk_msg parse_irc_msg/;
9
10 =head1 NAME
11
12 Net::IRC3::Connection - An IRC connection abstraction
13
14 =head1 SYNOPSIS
15
16 #...
17 $con->send_msg (undef, "PRIVMSG", "Hello there!", "yournick");
18 #...
19
20 =head1 DESCRIPTION
21
22 B<NOTE:> This module is B<DEPRECATED>, please use L<AnyEvent::IRC> for new programs,
23 and possibly port existing L<Net::IRC3> applications to L<AnyEvent::IRC>. Though the
24 API of L<AnyEvent::IRC> has incompatible changes, it's still fairly similar.
25
26
27 The connection class. Here the actual interesting stuff can be done,
28 such as sending and receiving IRC messages.
29
30 Please note that CTCP support is available through the functions
31 C<encode_ctcp> and C<decode_ctcp> provided by L<Net::IRC3::Util>.
32
33 =head2 METHODS
34
35 =over 4
36
37 =item B<new>
38
39 This constructor does take no arguments.
40
41 =cut
42
43 sub new
44 {
45 my $this = shift;
46 my $class = ref($this) || $this;
47
48 my $self = {
49 cbs => {},
50 heap => {},
51 outbuf => ''
52 };
53
54 bless $self, $class;
55
56 return $self;
57 }
58
59 =item B<connect ($host, $port)>
60
61 Tries to open a socket to the host C<$host> and the port C<$port>.
62 If an error occured it will die (use eval to catch the exception).
63
64 =cut
65
66 sub connect {
67 my ($self, $host, $port) = @_;
68
69 $self->{socket}
70 and return;
71
72 my $sock = IO::Socket::INET->new (
73 PeerAddr => $host,
74 PeerPort => $port,
75 Proto => 'tcp',
76 Blocking => 0
77 ) or die "couldn't connect to irc server '$host:$port': $!\n";;
78
79 $self->{socket} = $sock;
80 $self->{host} = $host;
81 $self->{port} = $port;
82
83 $self->{cw} =
84 AnyEvent->io (poll => 'w', fh => $self->{socket}, cb => sub {
85 my ($w) = @_;
86 # FIXME: handle EAGAIN ?
87 delete $self->{cw};
88
89 if ($! = $sock->sockopt (SO_ERROR)) {
90 $self->event ('connect_error' => $!);
91 $self->_clear_me;
92 } else {
93 $self->use_socket ($host, $port, $self->{socket});
94 }
95 0
96 });
97 1
98 }
99
100 =item B<use_socket ($host, $port, $socket)>
101
102 This method can be used instead of C<connect> to handle IRC messages
103 that are received and sent over the C<$socket>.
104
105 In this case C<$host> and C<$port> are just documentation for the error messages.
106
107 =cut
108
109 sub use_socket {
110 my ($self, $host, $port, $socket) = @_;
111
112 $self->{host} = $host;
113 $self->{port} = $port;
114 $self->{socket} = $socket;
115 $socket->blocking (0);
116
117 $self->{connected} = 1;
118 $self->event ('connect');
119 $self->_start_reader;
120 $self->_start_writer;
121 }
122
123 sub _start_reader {
124 my ($self) = @_;
125 my ($host, $port) = ($self->{host}, $self->{port});
126
127 return if $self->{rw};
128 return unless $self->{socket};
129
130 $self->{rw} =
131 AnyEvent->io (poll => 'r', fh => $self->{socket}, cb => sub {
132 my $data;
133 my $l = $self->{socket}->sysread ($data, 1024);
134
135 # FIXME: handle EAGAIN
136 if (defined $l) {
137 if ($l == 0) {
138 $self->disconnect ("EOF from IRC server '$host:$port'");
139 return
140 } else {
141 $self->_feed_irc_data ($data);
142 }
143
144 } else {
145 if ($! == EAGAIN()) {
146 return;
147
148 } else {
149 $self->disconnect ("Error while reading from IRC server '$host:$port': $!");
150 return;
151 }
152 }
153 });
154 }
155
156
157 sub _start_writer {
158 my ($self) = @_;
159
160 return unless $self->{socket} && $self->{connected} && length ($self->{outbuf}) > 0;
161
162 my ($host, $port) = ($self->{host}, $self->{port});
163
164 unless (defined $self->{ww}) {
165 $self->{ww} =
166 AnyEvent->io (poll => 'w', fh => $self->{socket}, cb => sub {
167 my $l = syswrite $self->{socket}, $self->{outbuf};
168
169 if (defined $l) {
170 substr $self->{outbuf}, 0, $l, "";
171 if (length ($self->{outbuf}) == 0) { delete $self->{ww} }
172
173 } else {
174 if ($! == EAGAIN()) {
175
176 return;
177 } else {
178 $self->disconnect ("Error while writing to IRC server '$self->{host}:$self->{port}': $!");
179 return;
180 }
181 }
182 });
183 }
184 }
185
186 =item B<disconnect ($reason)>
187
188 Unregisters the connection in the main Net::IRC3 object, closes
189 the sockets and send a 'disconnect' event with C<$reason> as argument.
190
191 =cut
192
193 sub disconnect {
194 my ($self, $reason) = @_;
195
196 $self->event (disconnect => $reason);
197 $self->_clear_me;
198
199 }
200
201 =item B<is_connected>
202
203 Returns true when this connection is connected.
204 Otherwise false.
205
206 =cut
207
208 sub is_connected {
209 my ($self) = @_;
210 $self->{socket} && $self->{connected}
211 }
212
213 sub _clear_me {
214 my ($self) = @_;
215
216 delete $self->{connected};
217
218 delete $self->{rw};
219 delete $self->{ww};
220 delete $self->{cw};
221
222 delete $self->{socket};
223
224 delete $self->{cbs};
225 delete $self->{events};
226 }
227
228 =item B<heap ()>
229
230 Returns a hash reference that is local to this connection object
231 that lets you store any information you want.
232
233 =cut
234
235 sub heap {
236 my ($self) = @_;
237 return $self->{heap};
238 }
239
240 =item B<send_raw ($ircline)>
241
242 This method sends C<$ircline> straight to the server without any
243 further processing done.
244
245 =cut
246
247 sub send_raw {
248 my ($self, $ircline) = @_;
249 $self->_send_raw ("$ircline\015\012");
250 }
251
252 sub _send_raw {
253 my ($self, $data) = @_;
254
255 $self->{outbuf} .= $data;
256 $self->_start_writer;
257 }
258
259 =item B<send_msg (@ircmsg)>
260
261 This function sends a message to the server. C<@ircmsg> is the argumentlist
262 for C<Net::IRC3::Util::mk_msg>.
263
264 =cut
265
266 sub send_msg {
267 my ($self, @msg) = @_;
268
269 $self->event (sent => @msg);
270 $self->_send_raw (mk_msg (@msg));
271 }
272
273 =item B<reg_cb ($cmd, $cb)> or B<reg_cb ($cmd1, $cb1, $cmd2, $cb2, ..., $cmdN, $cbN)>
274
275 This registers a callback in the connection class.
276 These callbacks will be called by internal events and
277 by IRC protocol commands. You can also specify multiple callback registrations.
278
279 The first argument to the callbacks is always the connection object
280 itself.
281
282 If a callback returns a false value, it will be unregistered.
283
284 NOTE: I<A callback has to return true to stay alive>
285
286 If C<$cmd> starts with 'irc_' the callback C<$cb> will be registered
287 for a IRC protocol command. The command is the suffix of C<$cmd> then.
288 The second argument to the callback is the message hash reference
289 that has the layout that is returned by C<Net::IRC3::Util::parse_irc_msg>.
290
291 With the special C<$cmd> 'irc_*' the callback will be called on I<any>
292 IRC command that is received.
293
294 EXAMPLE:
295
296 $con->reg_cb (irc_privmsg => \&privmsg_handler);
297 # privmsg_handler will be called if an IRC message
298 # with the command 'PRIVMSG' arrives.
299
300 If C<$cmd> is not prefixed with a 'irc_' it will be called when an event
301 with the name C<$cmd> is emitted. The arguments to the callback depend
302 on the event that is emitted (but remember: the first argument will always be the
303 connection object)
304
305 Following events are emitted by this module and shouldn't be emitted
306 from a module user call to C<event>.
307
308 =over 4
309
310 =item B<connect>
311
312 This event is generated when the socket was successfully connected.
313
314 =item B<connect_error $error>
315
316 This event is generated when the socket couldn't be connected successfully.
317
318 =item B<disconnect $reason>
319
320 This event will be generated if the connection is somehow terminated.
321 It will also be emitted when C<disconnect> is called.
322 The second argument to the callback is C<$reason>, a string that contains
323 a clue about why the connection terminated.
324
325 If you want to reestablish a connection, call C<connect> again.
326
327 =item B<sent @ircmsg>
328
329 Emitted when a message (C<@ircmsg>) was sent to the server.
330 C<@ircmsg> are the arguments to C<Net::IRC3::Util::mk_msg>.
331
332 =item B<'*' $msg>
333
334 =item B<read $msg>
335
336 Emitted when a message (C<$msg>) was read from the server.
337 C<$msg> is the hash reference returned by C<Net::IRC3::Util::parse_irc_msg>;
338
339 =back
340
341 =cut
342
343 sub reg_cb {
344 my ($self, %regs) = @_;
345
346 for my $cmd (keys %regs) {
347 my $cb = $regs{$cmd};
348
349 if ($cmd =~ m/^irc_(\S+)/i) {
350 push @{$self->{cbs}->{lc $1}}, $cb;
351
352 } else {
353 push @{$self->{events}->{$cmd}}, $cb;
354 }
355 }
356
357 1;
358 }
359
360 =item B<event ($event, @args)>
361
362 This function emits an event with the name C<$event> and the arguments C<@args>.
363 The registerd callback that has been registered with C<reg_cb> will be called
364 with the first argument being the connection object and the rest of the arguments
365 being C<@args>.
366
367 EXAMPLE
368
369 $con->reg_cb (test_event => sub { print "Yay, i love $_[1]!!\n");
370 $con->event (test_event => "IRC");
371
372 # will print "Yay, i love IRC!!\n"
373
374 =cut
375
376 sub event {
377 my ($self, $ev, @arg) = @_;
378
379 my $nxt = [];
380
381 for (@{$self->{events}->{$ev}}) {
382 $_->($self, @arg) and push @$nxt, $_;
383 }
384
385 $self->{events}->{$ev} = $nxt;
386 }
387
388 # internal function, called by the read callbacks above.
389 sub _feed_irc_data {
390 my ($self, $data) = @_;
391
392 $self->{buffer} .= $data;
393
394 my @msg;
395 while ($self->{buffer} =~ s/^([^\015\012]*)\015?\012//) {
396 push @msg, $1;
397 }
398
399 for (@msg) {
400 my $m = parse_irc_msg ($_);
401
402 $self->event (read => $m);
403
404 my $nxt = [];
405
406 for (@{$self->{cbs}->{lc $m->{command}}}) {
407 $_->($self, $m) and push @$nxt, $_;
408 }
409
410 $self->{cbs}->{lc $m->{command}} = $nxt;
411
412 $nxt = [];
413
414 for (@{$self->{cbs}->{'*'}}) {
415 $_->($self, $m) and push @$nxt, $_;
416 }
417
418 $self->{cbs}->{'*'} = $nxt;
419 }
420 }
421
422
423 =back
424
425 =head1 AUTHOR
426
427 Robin Redeker, C<< <elmex@ta-sa.org> >>
428
429 =head1 SEE ALSO
430
431 L<Net::IRC3>
432
433 L<Net::IRC3::Client::Connection>
434
435 =head1 COPYRIGHT & LICENSE
436
437 Copyright 2006 Robin Redeker, all rights reserved.
438
439 This program is free software; you can redistribute it and/or modify it
440 under the same terms as Perl itself.
441
442 =cut
443
444 1;