lib/Net/IRC3.pm

package Net::IRC3;
use strict;
use AnyEvent;
use IO::Socket::INET;
use Exporter;
our @ISA = qw/Exporter/;
our @EXPORT_OK =
   qw(mk_msg parse_irc_msg split_prefix prefix_nick
      decode_ctcp prefix_user prefix_host);

our $ConnectionClass = 'Net::IRC3::Connection';

=head1 NAME

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

=head1 VERSION

Version 0.21

=cut

our $VERSION = '0.21';

=head1 SYNOPSIS

   use Net::IRC3;

   my $irc3 = new Net::IRC3;

   my $con = $irc3->connect ("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.

Note that this module uses AnyEvent as it's IO event subsystem.
You can integrate Net::IRC3 into any application with a event system
that AnyEvent has support for (eg. L<Gtk2> or L<Event>).

=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 ($host, $port)>

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

=cut

sub connect {
   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";;

   eval "require $ConnectionClass";
   my $con = $ConnectionClass->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 ("EOF from IRC server '$host:$port'");
               return;

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

   return $con;
}

=item B<connections ()>

Returns a key value list, where the key is C<"$host:$port"> and the
value is the connection object. Only 'active' connections are returned.
That means, if a connection is terminated somehow, it will also disappear
from this list.

=cut

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

=item B<connection ($host, $port)> or B<connection ("$host:$port")>

Returns the L<Net::IRC3::Connection> object for the C<$host> C<$port>
pair. If no such connection exists, undef is returned.

=cut

sub connection {
   my ($self, $host, $port) = @_;
   if ($host =~ m/^[^:]+:(\d+)$/) {
      return $self->{connections}->{$host}
   } else {
      return $self->{connections}->{$host.':'.$port}
   }
}

=back

=head1 FUNCTIONS

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

You can export these with eg.:

   use Net::IRC3 qw/parse_irc_msg/;

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

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

   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<decode_ctcp ($ircmsg)> or B<decode_ctcp ($line)>

=cut

sub decode_ctcp {
   my ($self, $msg) = @_;
   my $line = ref $msg ? $msg->{trailing} : $msg;
   my $msg = ref $msg ? $msg : { };

   if ($line =~ m/^\001(.*?)\001$/) {
      my $ctcpdata = $1;

      # XXX: implement!

   } else {
      return { trailing => $line };
   }


   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];
}

=back

=head1 EXAMPLES

See the samples/ directory for some examples on how to use Net::IRC3.

=head1 AUTHOR

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

=head1 SEE ALSO

L<Net::IRC3::Connection>

L<Net::IRC3::Client>

L<AnyEvent>

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.5
Committed:	Sun Jul 16 13:41:52 2006 UTC (20 years, 2 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+24 -1 lines
Log Message:	added documentation and began with decode_ctcp
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3;
2			use strict;
3			use AnyEvent;
4			use IO::Socket::INET;
5	elmex	1.2	use Exporter;
6			our @ISA = qw/Exporter/;
7			our @EXPORT_OK =
8			qw(mk_msg parse_irc_msg split_prefix prefix_nick
9	elmex	1.5	decode_ctcp prefix_user prefix_host);
10	elmex	1.2
11	elmex	1.3	our $ConnectionClass = 'Net::IRC3::Connection';
12	elmex	1.2
13	elmex	1.1	=head1 NAME
14
15			Net::IRC3 - An IRC Protocol module which is event system independend
16
17			=head1 VERSION
18
19	elmex	1.4	Version 0.21
20	elmex	1.1
21			=cut
22
23	elmex	1.4	our $VERSION = '0.21';
24	elmex	1.1
25			=head1 SYNOPSIS
26
27			use Net::IRC3;
28
29			my $irc3 = new Net::IRC3;
30
31	elmex	1.3	my $con = $irc3->connect ("test.not.at.irc.net", 6667);
32	elmex	1.1
33			...
34
35			=head1 DESCRIPTION
36
37			L<Net::IRC3> itself is a simple building block for an IRC client.
38			It manages connections and parses and constructs IRC messages.
39
40			L<Net::IRC3> is I<very> simple, if you don't want to care about
41			all the other things that a client still has to do (like replying to
42			PINGs and remembering who is on a channel), I recommend to read
43			the L<Net::IRC3::Client> page instead.
44
45	elmex	1.4	Note that this module uses AnyEvent as it's IO event subsystem.
46			You can integrate Net::IRC3 into any application with a event system
47			that AnyEvent has support for (eg. L<Gtk2> or L<Event>).
48
49	elmex	1.1	=head1 METHODS
50
51			=over 4
52
53			=item B<new ()>
54
55			This just creates a L<Net::IRC3> object, which is a management
56			class for creating and managing connections.
57
58			=cut
59
60			sub new
61			{
62			my $this = shift;
63			my $class = ref($this) \|\| $this;
64
65			my $self = { };
66
67			bless $self, $class;
68
69			return $self;
70			}
71
72	elmex	1.3	=item B<connect ($host, $port)>
73	elmex	1.1
74			Tries to open a socket to the host C<$host> and the port C<$port>.
75	elmex	1.2	If successfull it will return a L<Net::IRC3::Connection> object.
76	elmex	1.1	If an error occured it will die (use eval to catch the exception).
77
78			=cut
79
80	elmex	1.3	sub connect {
81	elmex	1.1	my ($self, $host, $port) = @_;
82
83			defined $self->{connections}->{"$host:$port"}
84			and return;
85
86			my $sock = IO::Socket::INET->new (
87			PeerAddr => $host,
88			PeerPort => $port,
89			Proto => 'tcp',
90			Blocking => 0
91			) or die "couldn't connect to irc server '$host:$port': $!\n";;
92
93	elmex	1.3	eval "require $ConnectionClass";
94			my $con = $ConnectionClass->new ($self, $sock, $host, $port);
95	elmex	1.1
96			$con->{rw} =
97			AnyEvent->io (poll => 'r', fh => $sock, cb => sub {
98			my $l = sysread $sock, my $data, 1024;
99
100			$con->feed_irc_data ($data);
101
102			unless ($l) {
103
104			if (defined $l) {
105	elmex	1.3	$con->disconnect ("EOF from IRC server '$host:$port'");
106	elmex	1.1	return;
107
108			} else {
109	elmex	1.3	$con->disconnect ("Error while reading from IRC server '$host:$port': $!");
110	elmex	1.1	return;
111			}
112			}
113			});
114
115			return $con;
116			}
117
118	elmex	1.3	=item B<connections ()>
119
120			Returns a key value list, where the key is C<"$host:$port"> and the
121			value is the connection object. Only 'active' connections are returned.
122			That means, if a connection is terminated somehow, it will also disappear
123			from this list.
124
125			=cut
126
127			sub connections {
128			my ($self) = @_;
129			return %{$self->{connections}};
130			}
131
132			=item B<connection ($host, $port)> or B<connection ("$host:$port")>
133
134			Returns the L<Net::IRC3::Connection> object for the C<$host> C<$port>
135			pair. If no such connection exists, undef is returned.
136
137			=cut
138
139			sub connection {
140			my ($self, $host, $port) = @_;
141			if ($host =~ m/^[^:]+:(\d+)$/) {
142			return $self->{connections}->{$host}
143			} else {
144			return $self->{connections}->{$host.':'.$port}
145			}
146			}
147
148	elmex	1.1	=back
149
150			=head1 FUNCTIONS
151
152			These are some utility functions that might come in handy when
153			handling the IRC protocol.
154
155	elmex	1.2	You can export these with eg.:
156
157			use Net::IRC3 qw/parse_irc_msg/;
158
159	elmex	1.1	=over 4
160
161			=item B<parse_irc_msg ($ircline)>
162
163			This method parses the C<$ircline>, which is one line of the IRC protocol
164			without the trailing "\015\012".
165
166			It returns a hash which has the following entrys:
167
168			=over 4
169
170			=item prefix
171
172			The message prefix.
173
174			=item command
175
176			The IRC command.
177
178			=item params
179
180			The parameters to the IRC command in a array reference,
181			this includes the trailing parameter (the one after the ':' or
182			the 14th parameter).
183
184			=item trailing
185
186			This is set if there was a trailing parameter (the one after the ':' or
187			the 14th parameter).
188
189			=back
190
191			=cut
192
193			sub parse_irc_msg {
194			my ($msg) = @_;
195
196			my $cmd;
197			my $pref;
198			my $t;
199			my @a;
200
201			my $p = $msg =~ s/^(:([^ ]+)[ ])?([A-Za-z]+\|\d{3})//;
202			$pref = $2;
203			$cmd = $3;
204
205			my $i = 0;
206
207			while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) {
208
209			push @a, $1 if defined $1;
210			if (++$i > 13) { last; }
211			}
212
213			if ($i == 14) {
214
215			if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) {
216			$t = $1 if $1 ne "";
217			}
218
219			} else {
220
221			if ($msg =~ s/^[ ]:([^\015\012\0]*)//) {
222			$t = $1 if $1 ne "";
223			}
224			}
225
226			push @a, $t if defined $t;
227
228			my $m = { prefix => $pref, command => $cmd, params => \@a, trailing => $t };
229			return $p ? $m : undef;
230			}
231
232			=item B<mk_msg ($prefix, $command, $trailing, @params)>
233
234			This function assembles a IRC message. The generated
235			message will look like (pseudo code!)
236
237			:<prefix> <command> <params> :<trail>
238
239			Please refer to RFC 2812 how IRC messages normally look like.
240
241			The prefix and the trailing string will be omitted if they are C<undef>.
242
243			EXAMPLES:
244
245	elmex	1.2	mk_msg (undef, "PRIVMSG", "you suck!", "magnus");
246	elmex	1.1	# will return: "PRIVMSG magnus :you suck!\015\012"
247
248	elmex	1.2	mk_msg (undef, "JOIN", undef, "#test");
249	elmex	1.1	# will return: "JOIN #magnus\015\012"
250
251			=cut
252
253			sub mk_msg {
254			my ($prefix, $command, $trail, @params) = @_;
255			my $msg = "";
256
257			$msg .= defined $prefix ? ":$prefix " : "";
258			$msg .= "$command";
259
260			# FIXME: params must be counted, and if > 13 they have to be
261			# concationated with $trail
262			map { $msg .= " $_" } @params;
263
264			$msg .= defined $trail ? " :$trail" : "";
265			$msg .= "\015\012";
266
267			return $msg;
268			}
269
270	elmex	1.5
271			=item B<decode_ctcp ($ircmsg)> or B<decode_ctcp ($line)>
272
273			=cut
274
275			sub decode_ctcp {
276			my ($self, $msg) = @_;
277			my $line = ref $msg ? $msg->{trailing} : $msg;
278			my $msg = ref $msg ? $msg : { };
279
280			if ($line =~ m/^\001(.*?)\001$/) {
281			my $ctcpdata = $1;
282
283			# XXX: implement!
284
285			} else {
286			return { trailing => $line };
287			}
288
289
290			return $msg;
291			}
292
293	elmex	1.1	=item B<split_prefix ($prefix)>
294
295			This function splits an IRC user prefix as described by RFC 2817
296			into the three parts: nickname, user and host. Which will be
297			returned as a list with that order.
298
299			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
300
301			=cut
302
303			sub split_prefix {
304			my ($prfx) = @_;
305
306			if (ref ($prfx) eq 'HASH') {
307			$prfx = $prfx->{prefix};
308			}
309
310			$prfx =~ m/^\s([^!])!([^@])@(.?)\s*$/;
311			return ($1, $2, $3);
312			}
313
314			=item B<prefix_nick ($prefix)>
315
316			A shortcut to extract the nickname from the C<$prefix>.
317
318			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
319
320			=cut
321
322			sub prefix_nick {
323			my ($prfx) = @_;
324			return (split_prefix ($prfx))[0];
325			}
326
327			=item B<prefix_user ($prefix)>
328
329			A shortcut to extract the username from the C<$prefix>.
330
331			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
332
333			=cut
334
335			sub prefix_user {
336			my ($prfx) = @_;
337			return (split_prefix ($prfx))[1];
338			}
339
340			=item B<prefix_host ($prefix)>
341
342			A shortcut to extract the hostname from the C<$prefix>.
343
344			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
345
346			=cut
347
348			sub prefix_host {
349			my ($self, $prfx) = @_;
350			return (split_prefix ($prfx))[2];
351			}
352
353			=back
354
355	elmex	1.2	=head1 EXAMPLES
356	elmex	1.1
357	elmex	1.2	See the samples/ directory for some examples on how to use Net::IRC3.
358	elmex	1.1
359			=head1 AUTHOR
360
361			Robin Redeker, C<< <elmex@ta-sa.org> >>
362
363			=head1 SEE ALSO
364
365	elmex	1.2	L<Net::IRC3::Connection>
366
367			L<Net::IRC3::Client>
368
369	elmex	1.4	L<AnyEvent>
370
371	elmex	1.1	RFC 2812 - Internet Relay Chat: Client Protocol
372
373			=head1 BUGS
374
375			Please report any bugs or feature requests to
376			C<bug-net-irc3 at rt.cpan.org>, or through the web interface at
377			L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-IRC3>.
378			I will be notified, and then you'll automatically be notified of progress on
379			your bug as I make changes.
380
381			=head1 SUPPORT
382
383			You can find documentation for this module with the perldoc command.
384
385			perldoc Net::IRC3
386
387			You can also look for information at:
388
389			=over 4
390
391			=item * AnnoCPAN: Annotated CPAN documentation
392
393			L<http://annocpan.org/dist/Net-IRC3>
394
395			=item * CPAN Ratings
396
397			L<http://cpanratings.perl.org/d/Net-IRC3>
398
399			=item * RT: CPAN's request tracker
400
401			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-IRC3>
402
403			=item * Search CPAN
404
405			L<http://search.cpan.org/dist/Net-IRC3>
406
407			=back
408
409			=head1 ACKNOWLEDGEMENTS
410
411			Thanks to Marc Lehmann for the new AnyEvent module!
412
413			=head1 COPYRIGHT & LICENSE
414
415			Copyright 2006 Robin Redker, all rights reserved.
416
417			This program is free software; you can redistribute it and/or modify it
418			under the same terms as Perl itself.
419
420			=cut
421
422			1;