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
      prefix_user prefix_host);

require Net::IRC3::Connection;

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

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

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