Net/IRC3/Util.pm

package Net::IRC3::Util;
use strict;
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);

=head1 NAME

Net::IRC3::Util - Common utilities that help with IRC protocol handling

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

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

=head1 SEE ALSO

L<Net::IRC3>

L<Net::IRC3::Client>

RFC 2812 - Internet Relay Chat: Client Protocol

=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 19:44:50 2006 UTC (18 years, 4 months ago) by elmex
Branch:	MAIN
Log Message:	moved utilitys to Util.pm and fixed a bug in nick chasing
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3::Util;
2			use strict;
3			use Exporter;
4			our @ISA = qw/Exporter/;
5			our @EXPORT_OK =
6			qw(mk_msg parse_irc_msg split_prefix prefix_nick
7			decode_ctcp prefix_user prefix_host);
8
9			=head1 NAME
10
11			Net::IRC3::Util - Common utilities that help with IRC protocol handling
12
13			=head1 FUNCTIONS
14
15			These are some utility functions that might come in handy when
16			handling the IRC protocol.
17
18			You can export these with eg.:
19
20			use Net::IRC3 qw/parse_irc_msg/;
21
22			=over 4
23
24			=item B<parse_irc_msg ($ircline)>
25
26			This method parses the C<$ircline>, which is one line of the IRC protocol
27			without the trailing "\015\012".
28
29			It returns a hash which has the following entrys:
30
31			=over 4
32
33			=item prefix
34
35			The message prefix.
36
37			=item command
38
39			The IRC command.
40
41			=item params
42
43			The parameters to the IRC command in a array reference,
44			this includes the trailing parameter (the one after the ':' or
45			the 14th parameter).
46
47			=item trailing
48
49			This is set if there was a trailing parameter (the one after the ':' or
50			the 14th parameter).
51
52			=back
53
54			=cut
55
56			sub parse_irc_msg {
57			my ($msg) = @_;
58
59			my $cmd;
60			my $pref;
61			my $t;
62			my @a;
63
64			my $p = $msg =~ s/^(:([^ ]+)[ ])?([A-Za-z]+\|\d{3})//;
65			$pref = $2;
66			$cmd = $3;
67
68			my $i = 0;
69
70			while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) {
71
72			push @a, $1 if defined $1;
73			if (++$i > 13) { last; }
74			}
75
76			if ($i == 14) {
77
78			if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) {
79			$t = $1 if $1 ne "";
80			}
81
82			} else {
83
84			if ($msg =~ s/^[ ]:([^\015\012\0]*)//) {
85			$t = $1 if $1 ne "";
86			}
87			}
88
89			push @a, $t if defined $t;
90
91			my $m = { prefix => $pref, command => $cmd, params => \@a, trailing => $t };
92			return $p ? $m : undef;
93			}
94
95			=item B<mk_msg ($prefix, $command, $trailing, @params)>
96
97			This function assembles a IRC message. The generated
98			message will look like (pseudo code!)
99
100			:<prefix> <command> <params> :<trail>
101
102			Please refer to RFC 2812 how IRC messages normally look like.
103
104			The prefix and the trailing string will be omitted if they are C<undef>.
105
106			EXAMPLES:
107
108			mk_msg (undef, "PRIVMSG", "you suck!", "magnus");
109			# will return: "PRIVMSG magnus :you suck!\015\012"
110
111			mk_msg (undef, "JOIN", undef, "#test");
112			# will return: "JOIN #magnus\015\012"
113
114			=cut
115
116			sub mk_msg {
117			my ($prefix, $command, $trail, @params) = @_;
118			my $msg = "";
119
120			$msg .= defined $prefix ? ":$prefix " : "";
121			$msg .= "$command";
122
123			# FIXME: params must be counted, and if > 13 they have to be
124			# concationated with $trail
125			map { $msg .= " $_" } @params;
126
127			$msg .= defined $trail ? " :$trail" : "";
128			$msg .= "\015\012";
129
130			return $msg;
131			}
132
133
134			=item B<decode_ctcp ($ircmsg)> or B<decode_ctcp ($line)>
135
136			=cut
137
138			sub decode_ctcp {
139			my ($self, $msg) = @_;
140			my $line = ref $msg ? $msg->{trailing} : $msg;
141			my $msg = ref $msg ? $msg : { };
142
143			if ($line =~ m/^\001(.*?)\001$/) {
144			my $ctcpdata = $1;
145
146			# XXX: implement!
147
148			} else {
149			return { trailing => $line };
150			}
151
152
153			return $msg;
154			}
155
156			=item B<split_prefix ($prefix)>
157
158			This function splits an IRC user prefix as described by RFC 2817
159			into the three parts: nickname, user and host. Which will be
160			returned as a list with that order.
161
162			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
163
164			=cut
165
166			sub split_prefix {
167			my ($prfx) = @_;
168
169			if (ref ($prfx) eq 'HASH') {
170			$prfx = $prfx->{prefix};
171			}
172
173			$prfx =~ m/^\s([^!])!([^@])@(.?)\s*$/;
174			return ($1, $2, $3);
175			}
176
177			=item B<prefix_nick ($prefix)>
178
179			A shortcut to extract the nickname from the C<$prefix>.
180
181			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
182
183			=cut
184
185			sub prefix_nick {
186			my ($prfx) = @_;
187			return (split_prefix ($prfx))[0];
188			}
189
190			=item B<prefix_user ($prefix)>
191
192			A shortcut to extract the username from the C<$prefix>.
193
194			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
195
196			=cut
197
198			sub prefix_user {
199			my ($prfx) = @_;
200			return (split_prefix ($prfx))[1];
201			}
202
203			=item B<prefix_host ($prefix)>
204
205			A shortcut to extract the hostname from the C<$prefix>.
206
207			C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
208
209			=cut
210
211			sub prefix_host {
212			my ($self, $prfx) = @_;
213			return (split_prefix ($prfx))[2];
214			}
215
216			=back
217
218			=head1 AUTHOR
219
220			Robin Redeker, C<< <elmex@ta-sa.org> >>
221
222			=head1 SEE ALSO
223
224			L<Net::IRC3>
225
226			L<Net::IRC3::Client>
227
228			RFC 2812 - Internet Relay Chat: Client Protocol
229
230			=head1 COPYRIGHT & LICENSE
231
232			Copyright 2006 Robin Redker, all rights reserved.
233
234			This program is free software; you can redistribute it and/or modify it
235			under the same terms as Perl itself.
236
237			=cut
238
239			1;