Net/IRC3/Connection.pm

package Net::IRC3::Connection;
use strict;
no warnings;
use AnyEvent;
use POSIX;
use IO::Socket::INET;
use IO::Handle;
use Net::IRC3::Util qw/mk_msg parse_irc_msg/;

=head1 NAME

Net::IRC3::Connection - An IRC connection abstraction

=head1 SYNOPSIS

   #...
   $con->send_msg (undef, "PRIVMSG", "Hello there!", "yournick");
   #...

=head1 DESCRIPTION

B<NOTE:> This module is B<DEPRECATED>, please use L<AnyEvent::IRC> for new programs,
and possibly port existing L<Net::IRC3> applications to L<AnyEvent::IRC>. Though the
API of L<AnyEvent::IRC> has incompatible changes, it's still fairly similar.


The connection class. Here the actual interesting stuff can be done,
such as sending and receiving IRC messages.

Please note that CTCP support is available through the functions
C<encode_ctcp> and C<decode_ctcp> provided by L<Net::IRC3::Util>.

=head2 METHODS

=over 4

=item B<new>

This constructor does take no arguments.

=cut

sub new
{
  my $this = shift;
  my $class = ref($this) || $this;

  my $self = {
     cbs  => {},
     heap => {},
     outbuf => ''
  };

  bless $self, $class;

  return $self;
}

=item B<connect ($host, $port)>

Tries to open a socket to the host C<$host> and the port C<$port>.
If an error occured it will die (use eval to catch the exception).

=cut

sub connect {
   my ($self, $host, $port) = @_;

   $self->{socket}
      and return;

   my $sock = IO::Socket::INET->new (
      PeerAddr => $host,
      PeerPort => $port,
      Proto    => 'tcp',
      Blocking => 0
   ) or die "couldn't connect to irc server '$host:$port': $!\n";;

   $self->{socket} = $sock;
   $self->{host}   = $host;
   $self->{port}   = $port;

   $self->{cw} =
      AnyEvent->io (poll => 'w', fh => $self->{socket}, cb => sub {
         my ($w) = @_;
         # FIXME: handle EAGAIN ?
         delete $self->{cw};

         if ($! = $sock->sockopt (SO_ERROR)) {
            $self->event ('connect_error' => $!);
            $self->_clear_me;
         } else {
            $self->use_socket ($host, $port, $self->{socket});
         }
         0
      });
   1
}

=item B<use_socket ($host, $port, $socket)>

This method can be used instead of C<connect> to handle IRC messages
that are received and sent over the C<$socket>.

In this case C<$host> and C<$port> are just documentation for the error messages.

=cut

sub use_socket {
   my ($self, $host, $port, $socket) = @_;

   $self->{host} = $host;
   $self->{port} = $port;
   $self->{socket} = $socket;
   $socket->blocking (0);

   $self->{connected} = 1;
   $self->event ('connect');
   $self->_start_reader;
   $self->_start_writer;
}

sub _start_reader {
   my ($self) = @_;
   my ($host, $port) = ($self->{host}, $self->{port});

   return if $self->{rw};
   return unless $self->{socket};

   $self->{rw} =
      AnyEvent->io (poll => 'r', fh => $self->{socket}, cb => sub {
         my $data;
         my $l = $self->{socket}->sysread ($data, 1024);

         # FIXME: handle EAGAIN
         if (defined $l) {
            if ($l == 0) {
               $self->disconnect ("EOF from IRC server '$host:$port'");
               return
            } else {
               $self->_feed_irc_data ($data);
            }

         } else {
            if ($! == EAGAIN()) {
               return;

            } else {
               $self->disconnect ("Error while reading from IRC server '$host:$port': $!");
               return;
            }
         }
      });
}


sub _start_writer {
   my ($self) = @_;

   return unless $self->{socket} && $self->{connected} && length ($self->{outbuf}) > 0;

   my ($host, $port) = ($self->{host}, $self->{port});

   unless (defined $self->{ww}) {
      $self->{ww} =
         AnyEvent->io (poll => 'w', fh => $self->{socket}, cb => sub {
            my $l = syswrite $self->{socket}, $self->{outbuf};

            if (defined $l) {
               substr $self->{outbuf}, 0, $l, "";
               if (length ($self->{outbuf}) == 0) { delete $self->{ww} }

            } else {
               if ($! == EAGAIN()) {

                  return;
               } else {
                  $self->disconnect ("Error while writing to IRC server '$self->{host}:$self->{port}': $!");
                  return;
               }
            }
         });
   }
}

=item B<disconnect ($reason)>

Unregisters the connection in the main Net::IRC3 object, closes
the sockets and send a 'disconnect' event with C<$reason> as argument.

=cut

sub disconnect {
   my ($self, $reason) = @_;

   $self->event (disconnect => $reason);
   $self->_clear_me;

}

=item B<is_connected>

Returns true when this connection is connected.
Otherwise false.

=cut

sub is_connected {
   my ($self) = @_;
   $self->{socket} && $self->{connected}
}

sub _clear_me {
   my ($self) = @_;

   delete $self->{connected};

   delete $self->{rw};
   delete $self->{ww};
   delete $self->{cw};

   delete $self->{socket};

   delete $self->{cbs};
   delete $self->{events};
}

=item B<heap ()>

Returns a hash reference that is local to this connection object
that lets you store any information you want.

=cut

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

=item B<send_raw ($ircline)>

This method sends C<$ircline> straight to the server without any
further processing done.

=cut

sub send_raw {
   my ($self, $ircline) = @_;
   $self->_send_raw ("$ircline\015\012");
}

sub _send_raw {
   my ($self, $data) = @_;

   $self->{outbuf} .= $data;
   $self->_start_writer;
}

=item B<send_msg (@ircmsg)>

This function sends a message to the server. C<@ircmsg> is the argumentlist
for C<Net::IRC3::Util::mk_msg>.

=cut

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

   $self->event (sent => @msg);
   $self->_send_raw (mk_msg (@msg));
}

=item B<reg_cb ($cmd, $cb)> or B<reg_cb ($cmd1, $cb1, $cmd2, $cb2, ..., $cmdN, $cbN)>

This registers a callback in the connection class.
These callbacks will be called by internal events and
by IRC protocol commands. You can also specify multiple callback registrations.

The first argument to the callbacks is always the connection object
itself.

If a callback returns a false value, it will be unregistered.

NOTE: I<A callback has to return true to stay alive>

If C<$cmd> starts with 'irc_' the callback C<$cb> will be registered
for a IRC protocol command. The command is the suffix of C<$cmd> then.
The second argument to the callback is the message hash reference
that has the layout that is returned by C<Net::IRC3::Util::parse_irc_msg>.

With the special C<$cmd> 'irc_*' the callback will be called on I<any>
IRC command that is received.

EXAMPLE:

   $con->reg_cb (irc_privmsg => \&privmsg_handler);
   # privmsg_handler will be called if an IRC message
   # with the command 'PRIVMSG' arrives.

If C<$cmd> is not prefixed with a 'irc_' it will be called when an event
with the name C<$cmd> is emitted. The arguments to the callback depend
on the event that is emitted (but remember: the first argument will always be the
connection object)

Following events are emitted by this module and shouldn't be emitted
from a module user call to C<event>.

=over 4

=item B<connect>

This event is generated when the socket was successfully connected.

=item B<connect_error $error>

This event is generated when the socket couldn't be connected successfully.

=item B<disconnect $reason>

This event will be generated if the connection is somehow terminated.
It will also be emitted when C<disconnect> is called.
The second argument to the callback is C<$reason>, a string that contains
a clue about why the connection terminated.

If you want to reestablish a connection, call C<connect> again.

=item B<sent @ircmsg>

Emitted when a message (C<@ircmsg>) was sent to the server.
C<@ircmsg> are the arguments to C<Net::IRC3::Util::mk_msg>.

=item B<'*' $msg>

=item B<read $msg>

Emitted when a message (C<$msg>) was read from the server.
C<$msg> is the hash reference returned by C<Net::IRC3::Util::parse_irc_msg>;

=back

=cut

sub reg_cb {
   my ($self, %regs) = @_;

   for my $cmd (keys %regs) {
      my $cb = $regs{$cmd};

      if ($cmd =~ m/^irc_(\S+)/i) {
         push @{$self->{cbs}->{lc $1}}, $cb;

      } else {
         push @{$self->{events}->{$cmd}}, $cb;
      }
   }

   1;
}

=item B<event ($event, @args)>

This function emits an event with the name C<$event> and the arguments C<@args>.
The registerd callback that has been registered with C<reg_cb> will be called
with the first argument being the connection object and the rest of the arguments
being C<@args>.

EXAMPLE

   $con->reg_cb (test_event => sub { print "Yay, i love $_[1]!!\n");
   $con->event (test_event => "IRC");

   # will print "Yay, i love IRC!!\n"

=cut

sub event {
   my ($self, $ev, @arg) = @_;

   my $nxt = [];

   for (@{$self->{events}->{$ev}}) {
      $_->($self, @arg) and push @$nxt, $_;
   }

   $self->{events}->{$ev} = $nxt;
}

# internal function, called by the read callbacks above.
sub _feed_irc_data {
   my ($self, $data) = @_;

   $self->{buffer} .= $data;

   my @msg;
   while ($self->{buffer} =~ s/^([^\015\012]*)\015?\012//) {
      push @msg, $1;
   }

   for (@msg) {
      my $m = parse_irc_msg ($_);

      $self->event (read => $m);

      my $nxt = [];

      for (@{$self->{cbs}->{lc $m->{command}}}) {
         $_->($self, $m) and push @$nxt, $_;
      }

      $self->{cbs}->{lc $m->{command}} = $nxt;

      $nxt = [];

      for (@{$self->{cbs}->{'*'}}) {
         $_->($self, $m) and push @$nxt, $_;
      }

      $self->{cbs}->{'*'} = $nxt;
   }
}


=back

=head1 AUTHOR

Robin Redeker, C<< <elmex@ta-sa.org> >>

=head1 SEE ALSO

L<Net::IRC3>

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

=head1 COPYRIGHT & LICENSE

Copyright 2006 Robin Redeker, 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.19
Committed:	Tue Sep 23 10:32:59 2008 UTC (18 years ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.18:	+5 -0 lines
Log Message:	last release: 0.6
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3::Connection;
2			use strict;
3	elmex	1.13	no warnings;
4	elmex	1.1	use AnyEvent;
5	elmex	1.10	use POSIX;
6	elmex	1.1	use IO::Socket::INET;
7	elmex	1.11	use IO::Handle;
8	elmex	1.4	use Net::IRC3::Util qw/mk_msg parse_irc_msg/;
9	elmex	1.1
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	elmex	1.19	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	elmex	1.1	The connection class. Here the actual interesting stuff can be done,
28			such as sending and receiving IRC messages.
29
30	elmex	1.15	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	elmex	1.1	=head2 METHODS
34
35			=over 4
36
37	elmex	1.12	=item B<new>
38
39			This constructor does take no arguments.
40
41	elmex	1.1	=cut
42
43			sub new
44			{
45			my $this = shift;
46			my $class = ref($this) \|\| $this;
47
48			my $self = {
49	elmex	1.5	cbs => {},
50	elmex	1.12	heap => {},
51			outbuf => ''
52	elmex	1.1	};
53
54			bless $self, $class;
55
56			return $self;
57			}
58
59	elmex	1.5	=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	elmex	1.18	Blocking => 0
77	elmex	1.5	) 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	elmex	1.10	$self->{cw} =
84	elmex	1.11	AnyEvent->io (poll => 'w', fh => $self->{socket}, cb => sub {
85			my ($w) = @_;
86	elmex	1.10	# FIXME: handle EAGAIN ?
87			delete $self->{cw};
88	elmex	1.11
89	elmex	1.10	if ($! = $sock->sockopt (SO_ERROR)) {
90			$self->event ('connect_error' => $!);
91	elmex	1.12	$self->_clear_me;
92	elmex	1.10	} else {
93	elmex	1.12	$self->use_socket ($host, $port, $self->{socket});
94	elmex	1.10	}
95	elmex	1.11	0
96	elmex	1.10	});
97	elmex	1.11	1
98	elmex	1.10	}
99
100	elmex	1.12	=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	elmex	1.10	my ($self) = @_;
125	elmex	1.11	my ($host, $port) = ($self->{host}, $self->{port});
126
127			return if $self->{rw};
128			return unless $self->{socket};
129	elmex	1.10
130	elmex	1.5	$self->{rw} =
131	elmex	1.11	AnyEvent->io (poll => 'r', fh => $self->{socket}, cb => sub {
132			my $data;
133			my $l = $self->{socket}->sysread ($data, 1024);
134	elmex	1.5
135	elmex	1.10	# 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	elmex	1.12	$self->_feed_irc_data ($data);
142	elmex	1.10	}
143	elmex	1.5
144	elmex	1.10	} else {
145			if ($! == EAGAIN()) {
146	elmex	1.5	return;
147
148			} else {
149			$self->disconnect ("Error while reading from IRC server '$host:$port': $!");
150			return;
151			}
152			}
153			});
154			}
155
156	elmex	1.10
157	elmex	1.12	sub _start_writer {
158	elmex	1.10	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	elmex	1.2	=item B<disconnect ($reason)>
187	elmex	1.1
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	elmex	1.2	sub disconnect {
194	elmex	1.1	my ($self, $reason) = @_;
195
196			$self->event (disconnect => $reason);
197	elmex	1.12	$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	elmex	1.1
216	elmex	1.11	delete $self->{connected};
217
218	elmex	1.1	delete $self->{rw};
219			delete $self->{ww};
220	elmex	1.11	delete $self->{cw};
221	elmex	1.1
222	elmex	1.5	delete $self->{socket};
223	elmex	1.17
224			delete $self->{cbs};
225			delete $self->{events};
226	elmex	1.1	}
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	elmex	1.9	=item B<send_raw ($ircline)>
241	elmex	1.1
242	elmex	1.9	This method sends C<$ircline> straight to the server without any
243			further processing done.
244	elmex	1.1
245			=cut
246
247	elmex	1.9	sub send_raw {
248			my ($self, $ircline) = @_;
249			$self->_send_raw ("$ircline\015\012");
250			}
251	elmex	1.5
252	elmex	1.9	sub _send_raw {
253			my ($self, $data) = @_;
254	elmex	1.6
255	elmex	1.9	$self->{outbuf} .= $data;
256	elmex	1.12	$self->_start_writer;
257	elmex	1.9	}
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	elmex	1.1	}
272
273	elmex	1.3	=item B<reg_cb ($cmd, $cb)> or B<reg_cb ($cmd1, $cb1, $cmd2, $cb2, ..., $cmdN, $cbN)>
274	elmex	1.1
275			This registers a callback in the connection class.
276			These callbacks will be called by internal events and
277	elmex	1.3	by IRC protocol commands. You can also specify multiple callback registrations.
278	elmex	1.1
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	elmex	1.6	that has the layout that is returned by C<Net::IRC3::Util::parse_irc_msg>.
290	elmex	1.1
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	elmex	1.10	=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	elmex	1.1	=item B<disconnect $reason>
319
320			This event will be generated if the connection is somehow terminated.
321	elmex	1.2	It will also be emitted when C<disconnect> is called.
322	elmex	1.1	The second argument to the callback is C<$reason>, a string that contains
323			a clue about why the connection terminated.
324
325	elmex	1.5	If you want to reestablish a connection, call C<connect> again.
326	elmex	1.2
327	elmex	1.6	=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	elmex	1.14
334	elmex	1.6	=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	elmex	1.1	=back
340
341			=cut
342
343			sub reg_cb {
344	elmex	1.3	my ($self, %regs) = @_;
345	elmex	1.1
346	elmex	1.3	for my $cmd (keys %regs) {
347			my $cb = $regs{$cmd};
348	elmex	1.1
349	elmex	1.3	if ($cmd =~ m/^irc_(\S+)/i) {
350			push @{$self->{cbs}->{lc $1}}, $cb;
351
352			} else {
353			push @{$self->{events}->{$cmd}}, $cb;
354			}
355	elmex	1.1	}
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	elmex	1.16	for (@{$self->{events}->{$ev}}) {
382	elmex	1.1	$_->($self, @arg) and push @$nxt, $_;
383			}
384
385	elmex	1.16	$self->{events}->{$ev} = $nxt;
386	elmex	1.1	}
387
388			# internal function, called by the read callbacks above.
389	elmex	1.12	sub _feed_irc_data {
390	elmex	1.1	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	elmex	1.6	$self->event (read => $m);
403
404	elmex	1.1	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	elmex	1.8	L<Net::IRC3::Client::Connection>
434
435	elmex	1.1	=head1 COPYRIGHT & LICENSE
436
437	elmex	1.7	Copyright 2006 Robin Redeker, all rights reserved.
438	elmex	1.1
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;