Net/IRC3/Connection.pm

package Net::IRC3::Connection;
use strict;
use AnyEvent;
use POSIX;
use IO::Socket::INET;
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

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

=head2 METHODS

=over 4

=cut

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

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

  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 => $sock, cb => sub {
         # FIXME: handle EAGAIN ?
         delete $self->{cw};
         if ($! = $sock->sockopt (SO_ERROR)) {
            $self->event ('connect_error' => $!);
         } else {
            $self->{connected} = 1;
            $self->event ('connect');
            $self->start_reader;
            $self->start_writer;
         }
      });
}

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

   $self->{rw} =
      AnyEvent->io (poll => 'r', fh => $sock, cb => sub {
         my $l = sysread $sock, my $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);

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

   eval { $self->{socket}->close };
   delete $self->{socket};
}

=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}->{lc $ev}}) {
      $_->($self, @arg) and push @$nxt, $_;
   }

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