lib/Net/IRC3.pm

package Net::IRC3;
use strict;
use AnyEvent;
use IO::Socket::INET;

=head1 NAME

Net::IRC3 - An IRC Protocol module which is event system independend

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.1';

=head1 SYNOPSIS

   use Net::IRC3;

   my $irc3 = new Net::IRC3;

   my $con = $irc3->connect_server ("test.not.at.irc.net", 6667);

   ...

=head1 DESCRIPTION

L<Net::IRC3> itself is a simple building block for an IRC client.
It manages connections and parses and constructs IRC messages.

L<Net::IRC3> is I<very> simple, if you don't want to care about
all the other things that a client still has to do (like replying to
PINGs and remembering who is on a channel), I recommend to read
the L<Net::IRC3::Client> page instead.

=head1 METHODS

=over 4

=item B<new ()>

This just creates a L<Net::IRC3> object, which is a management
class for creating and managing connections.

=cut

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

  my $self = { };

  bless $self, $class;

  return $self;
}

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

Tries to open a socket to the host C<$host> and the port C<$port>.
If successfull it will return a Net::IRC3::Connection object.
If an error occured it will die (use eval to catch the exception).

=cut

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

   defined $self->{connections}->{"$host:$port"}
      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";;

   my $con = Net::IRC3::Connection->new ($self, $sock, $host, $port);

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

         $con->feed_irc_data ($data);

         unless ($l) {

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

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

   return $con;
}

=back

=head1 FUNCTIONS

These are some utility functions that might come in handy when
handling the IRC protocol.

=over 4

=item B<parse_irc_msg ($ircline)>

This method parses the C<$ircline>, which is one line of the IRC protocol
without the trailing "\015\012".

It returns a hash which has the following entrys:

=over 4

=item prefix

The message prefix.

=item command

The IRC command.

=item params

The parameters to the IRC command in a array reference,
this includes the trailing parameter (the one after the ':' or
the 14th parameter).

=item trailing

This is set if there was a trailing parameter (the one after the ':' or
the 14th parameter).

=back

=cut

sub parse_irc_msg {
  my ($msg) = @_;

  my $cmd;
  my $pref;
  my $t;
  my @a;

  my $p = $msg =~ s/^(:([^ ]+)[ ])?([A-Za-z]+|\d{3})//;
  $pref = $2;
  $cmd = $3;

  my $i = 0;

  while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) {

    push @a, $1 if defined $1;
    if (++$i > 13) { last; }
  }

  if ($i == 14) {

    if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) {
      $t = $1 if $1 ne "";
    }

  } else {

    if ($msg =~ s/^[ ]:([^\015\012\0]*)//) {
      $t = $1 if $1 ne "";
    }
  }

  push @a, $t if defined $t;

  my $m = { prefix => $pref, command => $cmd, params => \@a, trailing => $t };
  return $p ? $m : undef;
}

=item B<mk_msg ($prefix, $command, $trailing, @params)>

This function assembles a IRC message. The generated
message will look like (pseudo code!)

   :<prefix> <command> <params> :<trail>

Please refer to RFC 2812 how IRC messages normally look like.

The prefix and the trailing string will be omitted if they are C<undef>.

EXAMPLES:

   $con->mk_msg (undef, "PRIVMSG", "you suck!", "magnus");
   # will return: "PRIVMSG magnus :you suck!\015\012"

   $con->mk_msg (undef, "JOIN", undef, "#test");
   # will return: "JOIN #magnus\015\012"

=cut

sub mk_msg {
  my ($prefix, $command, $trail, @params) = @_;
  my $msg = "";

  $msg .= defined $prefix ? ":$prefix " : "";
  $msg .= "$command";

  # FIXME: params must be counted, and if > 13 they have to be
  # concationated with $trail
  map { $msg .= " $_" } @params;

  $msg .= defined $trail ? " :$trail" : "";
  $msg .= "\015\012";

  return $msg;
}

=item B<split_prefix ($prefix)>

This function splits an IRC user prefix as described by RFC 2817
into the three parts: nickname, user and host. Which will be
returned as a list with that order.

C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.

=cut

sub split_prefix {
   my ($prfx) = @_;

   if (ref ($prfx) eq 'HASH') {
      $prfx = $prfx->{prefix};
   }

   $prfx =~ m/^\s*([^!]*)!([^@]*)@(.*?)\s*$/;
   return ($1, $2, $3);
}

=item B<prefix_nick ($prefix)>

A shortcut to extract the nickname from the C<$prefix>.

C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.

=cut

sub prefix_nick {
   my ($prfx) = @_;
   return (split_prefix ($prfx))[0];
}

=item B<prefix_user ($prefix)>

A shortcut to extract the username from the C<$prefix>.

C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.

=cut

sub prefix_user {
   my ($prfx) = @_;
   return (split_prefix ($prfx))[1];
}

=item B<prefix_host ($prefix)>

A shortcut to extract the hostname from the C<$prefix>.

C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.

=cut

sub prefix_host {
   my ($self, $prfx) = @_;
   return (split_prefix ($prfx))[2];
}

=head1 Net::IRC3::Connection

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

=head2 METHODS

=over 4

=cut

package Net::IRC3::Connection;

use strict;
use AnyEvent;
use IO::Socket::INET;

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

  my $self = {
     pirc => $_[0],
     s => $_[1],
     h => $_[2],
     p => $_[3],
     cbs => {},
     heap => {}
  };

  bless $self, $class;

  return $self;
}

=item B<disconnect_server ($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_server {
   my ($self, $reason) = @_;

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

   delete $self->{rw};
   delete $self->{ww};
   delete $self->{pirc}->{connections}->{$self->{h} . ":" . $self->{p}};

   eval { $self->{s}->close }
}

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

=cut

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

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

   unless (defined $self->{ww}) {
      my $sock = $self->{s};
      $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_server ("Error while writing to IRC server '$host:$port': $!");
               return;
            }
         });
   }
}

=item B<reg_cb ($cmd, $cb)>

This registers a callback in the connection class.
These callbacks will be called by internal events and
by IRC protocol commands.

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<parse_irc_msg>.

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_server> is called.
The second argument to the callback is C<$reason>, a string that contains
a clue about why the connection terminated.

=back

=cut

sub reg_cb {
   my ($self, $cmd, $cb) = @_;

   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 ($_);

      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

RFC 2812 - Internet Relay Chat: Client Protocol

=head1 BUGS

Please report any bugs or feature requests to
C<bug-net-irc3 at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-IRC3>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::IRC3

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-IRC3>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-IRC3>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-IRC3>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-IRC3>

=back

=head1 ACKNOWLEDGEMENTS

Thanks to Marc Lehmann for the new AnyEvent module!

=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.1
Committed:	Sun Jul 16 02:09:12 2006 UTC (20 years, 2 months ago) by elmex
Branch:	MAIN
Log Message:	initial checkin
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3;
2			use strict;
3			use AnyEvent;
4			use IO::Socket::INET;
5
6			=head1 NAME
7
8			Net::IRC3 - An IRC Protocol module which is event system independend
9
10			=head1 VERSION
11
12			Version 0.01
13
14			=cut
15
16			our $VERSION = '0.1';
17
18			=head1 SYNOPSIS
19
20			use Net::IRC3;
21
22			my $irc3 = new Net::IRC3;
23
24			my $con = $irc3->connect_server ("test.not.at.irc.net", 6667);
25
26			...
27
28			=head1 DESCRIPTION
29
30			L<Net::IRC3> itself is a simple building block for an IRC client.
31			It manages connections and parses and constructs IRC messages.
32
33			L<Net::IRC3> is I<very> simple, if you don't want to care about
34			all the other things that a client still has to do (like replying to
35			PINGs and remembering who is on a channel), I recommend to read
36			the L<Net::IRC3::Client> page instead.
37
38			=head1 METHODS
39
40			=over 4
41
42			=item B<new ()>
43
44			This just creates a L<Net::IRC3> object, which is a management
45			class for creating and managing connections.
46
47			=cut
48
49			sub new
50			{
51			my $this = shift;
52			my $class = ref($this) \|\| $this;
53
54			my $self = { };
55
56			bless $self, $class;
57
58			return $self;
59			}
60
61			=item B<connect_server ($host, $port)>
62
63			Tries to open a socket to the host C<$host> and the port C<$port>.
64			If successfull it will return a Net::IRC3::Connection object.
65			If an error occured it will die (use eval to catch the exception).
66
67			=cut
68
69			sub connect_server {
70			my ($self, $host, $port) = @_;
71
72			defined $self->{connections}->{"$host:$port"}
73			and return;
74
75			my $sock = IO::Socket::INET->new (
76			PeerAddr => $host,
77			PeerPort => $port,
78			Proto => 'tcp',
79			Blocking => 0
80			) or die "couldn't connect to irc server '$host:$port': $!\n";;
81
82			my $con = Net::IRC3::Connection->new ($self, $sock, $host, $port);
83
84			$con->{rw} =
85			AnyEvent->io (poll => 'r', fh => $sock, cb => sub {
86			my $l = sysread $sock, my $data, 1024;
87
88			$con->feed_irc_data ($data);
89
90			unless ($l) {
91
92			if (defined $l) {
93			$con->disconnect_server ("EOF from IRC server '$host:$port'");
94			return;
95
96			} else {
97			$con->disconnect_server ("Error while reading from IRC server '$host:$port': $!");
98			return;
99			}
100			}
101			});
102
103			return $con;
104			}
105
106			=back
107
108			=head1 FUNCTIONS
109
110			These are some utility functions that might come in handy when
111			handling the IRC protocol.
112
113			=over 4
114
115			=item B<parse_irc_msg ($ircline)>
116
117			This method parses the C<$ircline>, which is one line of the IRC protocol
118			without the trailing "\015\012".
119
120			It returns a hash which has the following entrys:
121
122			=over 4
123
124			=item prefix
125
126			The message prefix.
127
128			=item command
129
130			The IRC command.
131
132			=item params
133
134			The parameters to the IRC command in a array reference,
135			this includes the trailing parameter (the one after the ':' or
136			the 14th parameter).
137
138			=item trailing
139
140			This is set if there was a trailing parameter (the one after the ':' or
141			the 14th parameter).
142
143			=back
144
145			=cut
146
147			sub parse_irc_msg {
148			my ($msg) = @_;
149
150			my $cmd;
151			my $pref;
152			my $t;
153			my @a;
154
155			my $p = $msg =~ s/^(:([^ ]+)[ ])?([A-Za-z]+\|\d{3})//;
156			$pref = $2;
157			$cmd = $3;
158
159			my $i = 0;
160
161			while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) {
162
163			push @a, $1 if defined $1;
164			if (++$i > 13) { last; }
165			}
166
167			if ($i == 14) {
168
169			if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) {
170			$t = $1 if $1 ne "";
171			}
172
173			} else {
174
175			if ($msg =~ s/^[ ]:([^\015\012\0]*)//) {
176			$t = $1 if $1 ne "";
177			}
178			}
179
180			push @a, $t if defined $t;
181
182			my $m = { prefix => $pref, command => $cmd, params => \@a, trailing => $t };
183			return $p ? $m : undef;
184			}
185
186			=item B<mk_msg ($prefix, $command, $trailing, @params)>
187
188			This function assembles a IRC message. The generated
189			message will look like (pseudo code!)
190
191			:<prefix> <command> <params> :<trail>
192
193			Please refer to RFC 2812 how IRC messages normally look like.
194
195			The prefix and the trailing string will be omitted if they are C<undef>.
196
197			EXAMPLES:
198
199			$con->mk_msg (undef, "PRIVMSG", "you suck!", "magnus");
200			# will return: "PRIVMSG magnus :you suck!\015\012"
201
202			$con->mk_msg (undef, "JOIN", undef, "#test");
203			# will return: "JOIN #magnus\015\012"
204
205			=cut
206
207			sub mk_msg {
208			my ($prefix, $command, $trail, @params) = @_;
209			my $msg = "";
210
211			$msg .= defined $prefix ? ":$prefix " : "";
212			$msg .= "$command";
213
214			# FIXME: params must be counted, and if > 13 they have to be
215			# concationated with $trail
216			map { $msg .= " $_" } @params;
217
218			$msg .= defined $trail ? " :$trail" : "";
219			$msg .= "\015\012";
220
221			return $msg;
222			}
223
224			=item B<split_prefix ($prefix)>
225
226			This function splits an IRC user prefix as described by RFC 2817
227			into the three parts: nickname, user and host. Which will be
228			returned as a list with that order.
229
230			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
231
232			=cut
233
234			sub split_prefix {
235			my ($prfx) = @_;
236
237			if (ref ($prfx) eq 'HASH') {
238			$prfx = $prfx->{prefix};
239			}
240
241			$prfx =~ m/^\s([^!])!([^@])@(.?)\s*$/;
242			return ($1, $2, $3);
243			}
244
245			=item B<prefix_nick ($prefix)>
246
247			A shortcut to extract the nickname from the C<$prefix>.
248
249			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
250
251			=cut
252
253			sub prefix_nick {
254			my ($prfx) = @_;
255			return (split_prefix ($prfx))[0];
256			}
257
258			=item B<prefix_user ($prefix)>
259
260			A shortcut to extract the username from the C<$prefix>.
261
262			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
263
264			=cut
265
266			sub prefix_user {
267			my ($prfx) = @_;
268			return (split_prefix ($prfx))[1];
269			}
270
271			=item B<prefix_host ($prefix)>
272
273			A shortcut to extract the hostname from the C<$prefix>.
274
275			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
276
277			=cut
278
279			sub prefix_host {
280			my ($self, $prfx) = @_;
281			return (split_prefix ($prfx))[2];
282			}
283
284			=head1 Net::IRC3::Connection
285
286			The connection class. Here the actual interesting stuff can be done,
287			such as sending and receiving IRC messages.
288
289			=head2 METHODS
290
291			=over 4
292
293			=cut
294
295			package Net::IRC3::Connection;
296
297			use strict;
298			use AnyEvent;
299			use IO::Socket::INET;
300
301			sub new
302			{
303			my $this = shift;
304			my $class = ref($this) \|\| $this;
305
306			my $self = {
307			pirc => $_[0],
308			s => $_[1],
309			h => $_[2],
310			p => $_[3],
311			cbs => {},
312			heap => {}
313			};
314
315			bless $self, $class;
316
317			return $self;
318			}
319
320			=item B<disconnect_server ($reason)>
321
322			Unregisters the connection in the main Net::IRC3 object, closes
323			the sockets and send a 'disconnect' event with C<$reason> as argument.
324
325			=cut
326
327			sub disconnect_server {
328			my ($self, $reason) = @_;
329
330			$self->event (disconnect => $reason);
331
332			delete $self->{rw};
333			delete $self->{ww};
334			delete $self->{pirc}->{connections}->{$self->{h} . ":" . $self->{p}};
335
336			eval { $self->{s}->close }
337			}
338
339			=item B<heap ()>
340
341			Returns a hash reference that is local to this connection object
342			that lets you store any information you want.
343
344			=cut
345
346			sub heap {
347			my ($self) = @_;
348			return $self->{heap};
349			}
350
351			=item B<send_msg (@ircmsg)>
352
353			This function sends a message to the server. C<@ircmsg> is the argumentlist
354			for C<mk_msg>.
355
356			=cut
357
358			sub send_msg {
359			my ($self, @msg) = @_;
360			my $data = mk_msg (@msg);
361
362			my ($host, $port) = ($self->{h}, $self->{p});
363			$self->{outbuf} .= $data;
364
365			unless (defined $self->{ww}) {
366			my $sock = $self->{s};
367			$self->{ww} =
368			AnyEvent->io (poll => 'w', fh => $sock, cb => sub {
369			my $l = syswrite $sock, $self->{outbuf};
370
371			substr $self->{outbuf}, 0, $l, "";
372
373			if (length ($self->{outbuf}) == 0) { delete $self->{ww} }
374
375			unless ($l) {
376			# XXX: is this behaviour correct or ok?
377			$self->disconnect_server ("Error while writing to IRC server '$host:$port': $!");
378			return;
379			}
380			});
381			}
382			}
383
384			=item B<reg_cb ($cmd, $cb)>
385
386			This registers a callback in the connection class.
387			These callbacks will be called by internal events and
388			by IRC protocol commands.
389
390			The first argument to the callbacks is always the connection object
391			itself.
392
393			If a callback returns a false value, it will be unregistered.
394
395			NOTE: I<A callback has to return true to stay alive>
396
397			If C<$cmd> starts with 'irc_' the callback C<$cb> will be registered
398			for a IRC protocol command. The command is the suffix of C<$cmd> then.
399			The second argument to the callback is the message hash reference
400			that has the layout that is returned by C<parse_irc_msg>.
401
402			EXAMPLE:
403
404			$con->reg_cb (irc_privmsg => \&privmsg_handler);
405			# privmsg_handler will be called if an IRC message
406			# with the command 'PRIVMSG' arrives.
407
408			If C<$cmd> is not prefixed with a 'irc_' it will be called when an event
409			with the name C<$cmd> is emitted. The arguments to the callback depend
410			on the event that is emitted (but remember: the first argument will always be the
411			connection object)
412
413			Following events are emitted by this module and shouldn't be emitted
414			from a module user call to C<event>.
415
416			=over 4
417
418			=item B<disconnect $reason>
419
420			This event will be generated if the connection is somehow terminated.
421			It will also be emitted when C<disconnect_server> is called.
422			The second argument to the callback is C<$reason>, a string that contains
423			a clue about why the connection terminated.
424
425			=back
426
427			=cut
428
429			sub reg_cb {
430			my ($self, $cmd, $cb) = @_;
431
432			if ($cmd =~ m/^irc_(\S+)/i) {
433			push @{$self->{cbs}->{lc $1}}, $cb;
434
435			} else {
436			push @{$self->{events}->{$cmd}}, $cb;
437			}
438
439			1;
440			}
441
442			=item B<event ($event, @args)>
443
444			This function emits an event with the name C<$event> and the arguments C<@args>.
445			The registerd callback that has been registered with C<reg_cb> will be called
446			with the first argument being the connection object and the rest of the arguments
447			being C<@args>.
448
449			EXAMPLE
450
451			$con->reg_cb (test_event => sub { print "Yay, i love $_[1]!!\n");
452			$con->event (test_event => "IRC");
453
454			# will print "Yay, i love IRC!!\n"
455
456			=cut
457
458			sub event {
459			my ($self, $ev, @arg) = @_;
460
461			my $nxt = [];
462
463			for (@{$self->{events}->{lc $ev}}) {
464			$_->($self, @arg) and push @$nxt, $_;
465			}
466
467			$self->{events}->{lc $ev} = $nxt;
468			}
469
470			# internal function, called by the read callbacks above.
471			sub feed_irc_data {
472			my ($self, $data) = @_;
473
474			$self->{buffer} .= $data;
475
476			my @msg;
477			while ($self->{buffer} =~ s/^([^\015\012]*)\015?\012//) {
478			push @msg, $1;
479			}
480
481			for (@msg) {
482			my $m = parse_irc_msg ($_);
483
484			my $nxt = [];
485
486			for (@{$self->{cbs}->{lc $m->{command}}}) {
487			$_->($self, $m) and push @$nxt, $_;
488			}
489
490			$self->{cbs}->{lc $m->{command}} = $nxt;
491
492			$nxt = [];
493
494			for (@{$self->{cbs}->{'*'}}) {
495			$_->($self, $m) and push @$nxt, $_;
496			}
497
498			$self->{cbs}->{'*'} = $nxt;
499			}
500			}
501
502
503			=back
504
505			=head1 AUTHOR
506
507			Robin Redeker, C<< <elmex@ta-sa.org> >>
508
509			=head1 SEE ALSO
510
511			RFC 2812 - Internet Relay Chat: Client Protocol
512
513			=head1 BUGS
514
515			Please report any bugs or feature requests to
516			C<bug-net-irc3 at rt.cpan.org>, or through the web interface at
517			L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-IRC3>.
518			I will be notified, and then you'll automatically be notified of progress on
519			your bug as I make changes.
520
521			=head1 SUPPORT
522
523			You can find documentation for this module with the perldoc command.
524
525			perldoc Net::IRC3
526
527			You can also look for information at:
528
529			=over 4
530
531			=item * AnnoCPAN: Annotated CPAN documentation
532
533			L<http://annocpan.org/dist/Net-IRC3>
534
535			=item * CPAN Ratings
536
537			L<http://cpanratings.perl.org/d/Net-IRC3>
538
539			=item * RT: CPAN's request tracker
540
541			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-IRC3>
542
543			=item * Search CPAN
544
545			L<http://search.cpan.org/dist/Net-IRC3>
546
547			=back
548
549			=head1 ACKNOWLEDGEMENTS
550
551			Thanks to Marc Lehmann for the new AnyEvent module!
552
553			=head1 COPYRIGHT & LICENSE
554
555			Copyright 2006 Robin Redker, all rights reserved.
556
557			This program is free software; you can redistribute it and/or modify it
558			under the same terms as Perl itself.
559
560			=cut
561
562			1;