Net/IRC3/Connection.pm

package Net::IRC3::Connection;
use strict;
use AnyEvent;
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->{rw} =
      AnyEvent->io (poll => 'r', fh => $sock, cb => sub {
         my $l = sysread $sock, my $data, 1024;

         $self->feed_irc_data ($data);

         unless ($l) {

            if (defined $l) {
               $self->disconnect ("EOF from IRC server '$host:$port'");
               return;

            } else {
               $self->disconnect ("Error while reading from IRC server '$host:$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_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->{socket} or return;

   my $data = mk_msg (@msg);

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

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

            substr $self->{outbuf}, 0, $l, "";

            if (length ($self->{outbuf}) == 0) { delete $self->{ww} }

            unless ($l) {
               # XXX: is this behaviour correct or ok?
               $self->disconnect ("Error while writing to IRC server '$self->{host}:$self->{port}': $!");
               return;
            }
         });
   }
}

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

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