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_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->{socket} or return;

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

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

   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<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<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.9
Committed:	Tue Jan 16 19:39:17 2007 UTC (19 years, 9 months ago) by elmex
Branch:	MAIN
Changes since 1.8:	+25 -8 lines
Log Message:	Net::IRC3: - fixed case handling with channels - added functionality to change the nick automatically when it is already taken when registering an IRC connection. (Net::IRC3::Client::Connection) - added reply number <=> reply name mapping to Net::IRC3::Util accessible through rfc_code_to_name - added error event to Net::IRC3::Client::Connection json chat framework: - client history - nick listing more correct - improved completion (added nick completion) - further improvement of the protocol - finally got the id handling correct - added logging to jsonsrv - many other changes i forgot.
#	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	elmex	1.9	=item B<send_raw ($ircline)>
119	elmex	1.1
120	elmex	1.9	This method sends C<$ircline> straight to the server without any
121			further processing done.
122	elmex	1.1
123			=cut
124
125	elmex	1.9	sub send_raw {
126			my ($self, $ircline) = @_;
127			$self->_send_raw ("$ircline\015\012");
128			}
129	elmex	1.5
130	elmex	1.9	sub _send_raw {
131			my ($self, $data) = @_;
132	elmex	1.6
133	elmex	1.5	$self->{socket} or return;
134
135	elmex	1.9	$self->{outbuf} .= $data;
136	elmex	1.1
137	elmex	1.5	my ($host, $port) = ($self->{host}, $self->{port});
138	elmex	1.1
139			unless (defined $self->{ww}) {
140	elmex	1.5	my $sock = $self->{socket};
141	elmex	1.1	$self->{ww} =
142			AnyEvent->io (poll => 'w', fh => $sock, cb => sub {
143			my $l = syswrite $sock, $self->{outbuf};
144
145			substr $self->{outbuf}, 0, $l, "";
146
147			if (length ($self->{outbuf}) == 0) { delete $self->{ww} }
148
149			unless ($l) {
150			# XXX: is this behaviour correct or ok?
151	elmex	1.5	$self->disconnect ("Error while writing to IRC server '$self->{host}:$self->{port}': $!");
152	elmex	1.1	return;
153			}
154			});
155			}
156	elmex	1.9
157			}
158
159			=item B<send_msg (@ircmsg)>
160
161			This function sends a message to the server. C<@ircmsg> is the argumentlist
162			for C<Net::IRC3::Util::mk_msg>.
163
164			=cut
165
166			sub send_msg {
167			my ($self, @msg) = @_;
168
169			$self->event (sent => @msg);
170			$self->_send_raw (mk_msg (@msg));
171	elmex	1.1	}
172
173	elmex	1.3	=item B<reg_cb ($cmd, $cb)> or B<reg_cb ($cmd1, $cb1, $cmd2, $cb2, ..., $cmdN, $cbN)>
174	elmex	1.1
175			This registers a callback in the connection class.
176			These callbacks will be called by internal events and
177	elmex	1.3	by IRC protocol commands. You can also specify multiple callback registrations.
178	elmex	1.1
179			The first argument to the callbacks is always the connection object
180			itself.
181
182			If a callback returns a false value, it will be unregistered.
183
184			NOTE: I<A callback has to return true to stay alive>
185
186			If C<$cmd> starts with 'irc_' the callback C<$cb> will be registered
187			for a IRC protocol command. The command is the suffix of C<$cmd> then.
188			The second argument to the callback is the message hash reference
189	elmex	1.6	that has the layout that is returned by C<Net::IRC3::Util::parse_irc_msg>.
190	elmex	1.1
191			With the special C<$cmd> 'irc_*' the callback will be called on I<any>
192			IRC command that is received.
193
194			EXAMPLE:
195
196			$con->reg_cb (irc_privmsg => \&privmsg_handler);
197			# privmsg_handler will be called if an IRC message
198			# with the command 'PRIVMSG' arrives.
199
200			If C<$cmd> is not prefixed with a 'irc_' it will be called when an event
201			with the name C<$cmd> is emitted. The arguments to the callback depend
202			on the event that is emitted (but remember: the first argument will always be the
203			connection object)
204
205			Following events are emitted by this module and shouldn't be emitted
206			from a module user call to C<event>.
207
208			=over 4
209
210			=item B<disconnect $reason>
211
212			This event will be generated if the connection is somehow terminated.
213	elmex	1.2	It will also be emitted when C<disconnect> is called.
214	elmex	1.1	The second argument to the callback is C<$reason>, a string that contains
215			a clue about why the connection terminated.
216
217	elmex	1.5	If you want to reestablish a connection, call C<connect> again.
218	elmex	1.2
219	elmex	1.6	=item B<sent @ircmsg>
220
221			Emitted when a message (C<@ircmsg>) was sent to the server.
222			C<@ircmsg> are the arguments to C<Net::IRC3::Util::mk_msg>.
223
224			=item B<'*' $msg>
225			=item B<read $msg>
226
227			Emitted when a message (C<$msg>) was read from the server.
228			C<$msg> is the hash reference returned by C<Net::IRC3::Util::parse_irc_msg>;
229
230	elmex	1.1	=back
231
232			=cut
233
234			sub reg_cb {
235	elmex	1.3	my ($self, %regs) = @_;
236	elmex	1.1
237	elmex	1.3	for my $cmd (keys %regs) {
238			my $cb = $regs{$cmd};
239	elmex	1.1
240	elmex	1.3	if ($cmd =~ m/^irc_(\S+)/i) {
241			push @{$self->{cbs}->{lc $1}}, $cb;
242
243			} else {
244			push @{$self->{events}->{$cmd}}, $cb;
245			}
246	elmex	1.1	}
247
248			1;
249			}
250
251			=item B<event ($event, @args)>
252
253			This function emits an event with the name C<$event> and the arguments C<@args>.
254			The registerd callback that has been registered with C<reg_cb> will be called
255			with the first argument being the connection object and the rest of the arguments
256			being C<@args>.
257
258			EXAMPLE
259
260			$con->reg_cb (test_event => sub { print "Yay, i love $_[1]!!\n");
261			$con->event (test_event => "IRC");
262
263			# will print "Yay, i love IRC!!\n"
264
265			=cut
266
267			sub event {
268			my ($self, $ev, @arg) = @_;
269
270			my $nxt = [];
271
272			for (@{$self->{events}->{lc $ev}}) {
273			$_->($self, @arg) and push @$nxt, $_;
274			}
275
276			$self->{events}->{lc $ev} = $nxt;
277			}
278
279			# internal function, called by the read callbacks above.
280			sub feed_irc_data {
281			my ($self, $data) = @_;
282
283			$self->{buffer} .= $data;
284
285			my @msg;
286			while ($self->{buffer} =~ s/^([^\015\012]*)\015?\012//) {
287			push @msg, $1;
288			}
289
290			for (@msg) {
291			my $m = parse_irc_msg ($_);
292
293	elmex	1.6	$self->event (read => $m);
294
295	elmex	1.1	my $nxt = [];
296
297			for (@{$self->{cbs}->{lc $m->{command}}}) {
298			$_->($self, $m) and push @$nxt, $_;
299			}
300
301			$self->{cbs}->{lc $m->{command}} = $nxt;
302
303			$nxt = [];
304
305			for (@{$self->{cbs}->{'*'}}) {
306			$_->($self, $m) and push @$nxt, $_;
307			}
308
309			$self->{cbs}->{'*'} = $nxt;
310			}
311			}
312
313
314			=back
315
316			=head1 AUTHOR
317
318			Robin Redeker, C<< <elmex@ta-sa.org> >>
319
320			=head1 SEE ALSO
321
322			L<Net::IRC3>
323
324	elmex	1.8	L<Net::IRC3::Client::Connection>
325
326	elmex	1.1	=head1 COPYRIGHT & LICENSE
327
328	elmex	1.7	Copyright 2006 Robin Redeker, all rights reserved.
329	elmex	1.1
330			This program is free software; you can redistribute it and/or modify it
331			under the same terms as Perl itself.
332
333			=cut
334
335			1;