ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/lib/Net/IRC3/Util.pm
Revision: 1.9
Committed: Sat Feb 24 10:24:55 2007 UTC (17 years, 9 months ago) by elmex
Branch: MAIN
Changes since 1.8: +1 -0 lines
Log Message:
added further tests and improved modules

File Contents

# User Rev Content
1 elmex 1.1 package Net::IRC3::Util;
2     use strict;
3 elmex 1.9 no warnings;
4 elmex 1.1 use Exporter;
5     our @ISA = qw/Exporter/;
6     our @EXPORT_OK =
7     qw(mk_msg parse_irc_msg split_prefix prefix_nick
8 elmex 1.7 decode_ctcp filter_ctcp_text_attr prefix_user prefix_host
9     rfc_code_to_name);
10 elmex 1.1
11     =head1 NAME
12    
13     Net::IRC3::Util - Common utilities that help with IRC protocol handling
14    
15 elmex 1.2 =head1 SYNOPSIS
16    
17     use Net::IRC3 qw/parse_irc_msg mk_msg/;
18    
19 elmex 1.7 my $msgdata = mk_msg (undef, PRIVMSG => "my hands glow!", "mcmanus");
20 elmex 1.2
21 elmex 1.1 =head1 FUNCTIONS
22    
23     These are some utility functions that might come in handy when
24     handling the IRC protocol.
25    
26     You can export these with eg.:
27    
28     use Net::IRC3 qw/parse_irc_msg/;
29    
30     =over 4
31    
32     =item B<parse_irc_msg ($ircline)>
33    
34     This method parses the C<$ircline>, which is one line of the IRC protocol
35     without the trailing "\015\012".
36    
37     It returns a hash which has the following entrys:
38    
39     =over 4
40    
41     =item prefix
42    
43     The message prefix.
44    
45     =item command
46    
47     The IRC command.
48    
49     =item params
50    
51     The parameters to the IRC command in a array reference,
52     this includes the trailing parameter (the one after the ':' or
53     the 14th parameter).
54    
55     =item trailing
56    
57     This is set if there was a trailing parameter (the one after the ':' or
58     the 14th parameter).
59    
60     =back
61    
62     =cut
63    
64     sub parse_irc_msg {
65     my ($msg) = @_;
66    
67     my $cmd;
68     my $pref;
69     my $t;
70     my @a;
71    
72     my $p = $msg =~ s/^(:([^ ]+)[ ])?([A-Za-z]+|\d{3})//;
73     $pref = $2;
74     $cmd = $3;
75    
76     my $i = 0;
77    
78     while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) {
79    
80     push @a, $1 if defined $1;
81     if (++$i > 13) { last; }
82     }
83    
84     if ($i == 14) {
85    
86     if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) {
87     $t = $1 if $1 ne "";
88     }
89    
90     } else {
91    
92     if ($msg =~ s/^[ ]:([^\015\012\0]*)//) {
93     $t = $1 if $1 ne "";
94     }
95     }
96    
97     push @a, $t if defined $t;
98    
99     my $m = { prefix => $pref, command => $cmd, params => \@a, trailing => $t };
100     return $p ? $m : undef;
101     }
102    
103     =item B<mk_msg ($prefix, $command, $trailing, @params)>
104    
105     This function assembles a IRC message. The generated
106     message will look like (pseudo code!)
107    
108     :<prefix> <command> <params> :<trail>
109    
110     Please refer to RFC 2812 how IRC messages normally look like.
111    
112     The prefix and the trailing string will be omitted if they are C<undef>.
113    
114     EXAMPLES:
115    
116     mk_msg (undef, "PRIVMSG", "you suck!", "magnus");
117     # will return: "PRIVMSG magnus :you suck!\015\012"
118    
119     mk_msg (undef, "JOIN", undef, "#test");
120 elmex 1.5 # will return: "JOIN #test\015\012"
121 elmex 1.1
122     =cut
123    
124     sub mk_msg {
125     my ($prefix, $command, $trail, @params) = @_;
126     my $msg = "";
127    
128     $msg .= defined $prefix ? ":$prefix " : "";
129     $msg .= "$command";
130    
131     # FIXME: params must be counted, and if > 13 they have to be
132     # concationated with $trail
133     map { $msg .= " $_" } @params;
134    
135     $msg .= defined $trail ? " :$trail" : "";
136     $msg .= "\015\012";
137    
138     return $msg;
139     }
140    
141    
142 elmex 1.8 =item B<decode_ctcp ($line)>
143    
144     TODO
145 elmex 1.1
146     =cut
147    
148     sub decode_ctcp {
149 elmex 1.6 my ($line) = @_;
150 elmex 1.1
151 elmex 1.6 while ($line =~ /\G\001([^\001]*)\001/g) {
152     my $req = $1;
153     }
154 elmex 1.1
155 elmex 1.6 $line =~ s/\001[^\001]*\001//g;
156 elmex 1.1
157 elmex 1.6 return $line;
158     }
159 elmex 1.1
160 elmex 1.8 =item B<filter_ctcp_text_attr ($line, $cb)>
161    
162     TODO
163    
164     =cut
165 elmex 1.6 # implemented after the below CTCP spec, but
166     # doesnt seem to be used by anyone... so it's untested.
167     sub filter_ctcp_text_attr {
168     my ($line, $cb) = @_;
169     $cb ||= sub { '' };
170     $line =~ s/\006([BVUSI])/{warn "FIL\n"; my $c = $cb->($1); defined $c ? $c : "\006$1"}/ieg;
171     $line =~ s/\006CA((?:I[0-9A-F]|#[0-9A-F]{3}){2})/{my $c = $cb->($1); defined $c ? $c : "\006CA$1"}/ieg;
172     $line =~ s/\006C([FB])(I[0-9A-F]|#[0-9A-F]{3})/{my $c = $cb->($1, $2); defined $c ? $c : "\006C$1$2"}/ieg;
173     $line =~ s/\006CX([AFB])/{my $c = $cb->($1); defined $c ? $c : "\006CX$1"}/ieg;
174     return $line;
175 elmex 1.1 }
176    
177     =item B<split_prefix ($prefix)>
178    
179     This function splits an IRC user prefix as described by RFC 2817
180     into the three parts: nickname, user and host. Which will be
181     returned as a list with that order.
182    
183     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
184    
185     =cut
186    
187     sub split_prefix {
188     my ($prfx) = @_;
189    
190     if (ref ($prfx) eq 'HASH') {
191     $prfx = $prfx->{prefix};
192     }
193    
194     $prfx =~ m/^\s*([^!]*)!([^@]*)@(.*?)\s*$/;
195     return ($1, $2, $3);
196     }
197    
198     =item B<prefix_nick ($prefix)>
199    
200     A shortcut to extract the nickname from the C<$prefix>.
201    
202     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
203    
204     =cut
205    
206     sub prefix_nick {
207     my ($prfx) = @_;
208     return (split_prefix ($prfx))[0];
209     }
210    
211     =item B<prefix_user ($prefix)>
212    
213     A shortcut to extract the username from the C<$prefix>.
214    
215     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
216    
217     =cut
218    
219     sub prefix_user {
220     my ($prfx) = @_;
221     return (split_prefix ($prfx))[1];
222     }
223    
224     =item B<prefix_host ($prefix)>
225    
226     A shortcut to extract the hostname from the C<$prefix>.
227    
228     C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>.
229    
230     =cut
231    
232     sub prefix_host {
233 elmex 1.8 my ($prfx) = @_;
234 elmex 1.1 return (split_prefix ($prfx))[2];
235     }
236    
237    
238 elmex 1.7 =item B<rfc_code_to_name ($code)>
239    
240     This function is a interface to the internal mapping or numeric
241     replies to the reply name in RFC 2812 (which you may also consult).
242    
243     C<$code> is returned if no name for C<$code> exists
244     (as some server may extended the protocol).
245    
246 elmex 1.8 =back
247    
248 elmex 1.7 =cut
249    
250     our %RFC_NUMCODE_MAP = (
251     '001' => 'RPL_WELCOME',
252     '002' => 'RPL_YOURHOST',
253     '003' => 'RPL_CREATED',
254     '004' => 'RPL_MYINFO',
255     '005' => 'RPL_BOUNCE',
256     '200' => 'RPL_TRACELINK',
257     '201' => 'RPL_TRACECONNECTING',
258     '202' => 'RPL_TRACEHANDSHAKE',
259     '203' => 'RPL_TRACEUNKNOWN',
260     '204' => 'RPL_TRACEOPERATOR',
261     '205' => 'RPL_TRACEUSER',
262     '206' => 'RPL_TRACESERVER',
263     '207' => 'RPL_TRACESERVICE',
264     '208' => 'RPL_TRACENEWTYPE',
265     '209' => 'RPL_TRACECLASS',
266     '210' => 'RPL_TRACERECONNECT',
267     '211' => 'RPL_STATSLINKINFO',
268     '212' => 'RPL_STATSCOMMANDS',
269     '219' => 'RPL_ENDOFSTATS',
270     '221' => 'RPL_UMODEIS',
271     '233' => 'RPL_SERVICE',
272     '234' => 'RPL_SERVLIST',
273     '235' => 'RPL_SERVLISTEND',
274     '242' => 'RPL_STATSUPTIME',
275     '243' => 'RPL_STATSOLINE',
276     '250' => 'RPL_STATSDLINE',
277     '251' => 'RPL_LUSERCLIENT',
278     '252' => 'RPL_LUSEROP',
279     '253' => 'RPL_LUSERUNKNOWN',
280     '254' => 'RPL_LUSERCHANNELS',
281     '255' => 'RPL_LUSERME',
282     '256' => 'RPL_ADMINME',
283     '257' => 'RPL_ADMINLOC1',
284     '258' => 'RPL_ADMINLOC2',
285     '259' => 'RPL_ADMINEMAIL',
286     '261' => 'RPL_TRACELOG',
287     '262' => 'RPL_TRACEEND',
288     '263' => 'RPL_TRYAGAIN',
289     '301' => 'RPL_AWAY',
290     '302' => 'RPL_USERHOST',
291     '303' => 'RPL_ISON',
292     '305' => 'RPL_UNAWAY',
293     '306' => 'RPL_NOWAWAY',
294     '311' => 'RPL_WHOISUSER',
295     '312' => 'RPL_WHOISSERVER',
296     '313' => 'RPL_WHOISOPERATOR',
297     '314' => 'RPL_WHOWASUSER',
298     '315' => 'RPL_ENDOFWHO',
299     '317' => 'RPL_WHOISIDLE',
300     '318' => 'RPL_ENDOFWHOIS',
301     '319' => 'RPL_WHOISCHANNELS',
302     '321' => 'RPL_LISTSTART',
303     '322' => 'RPL_LIST',
304     '323' => 'RPL_LISTEND',
305     '324' => 'RPL_CHANNELMODEIS',
306     '325' => 'RPL_UNIQOPIS',
307     '331' => 'RPL_NOTOPIC',
308     '332' => 'RPL_TOPIC',
309     '341' => 'RPL_INVITING',
310     '342' => 'RPL_SUMMONING',
311     '346' => 'RPL_INVITELIST',
312     '347' => 'RPL_ENDOFINVITELIST',
313     '348' => 'RPL_EXCEPTLIST',
314     '349' => 'RPL_ENDOFEXCEPTLIST',
315     '351' => 'RPL_VERSION',
316     '352' => 'RPL_WHOREPLY',
317     '353' => 'RPL_NAMREPLY',
318     '364' => 'RPL_LINKS',
319     '365' => 'RPL_ENDOFLINKS',
320     '366' => 'RPL_ENDOFNAMES',
321     '367' => 'RPL_BANLIST',
322     '368' => 'RPL_ENDOFBANLIST',
323     '369' => 'RPL_ENDOFWHOWAS',
324     '371' => 'RPL_INFO',
325     '372' => 'RPL_MOTD',
326     '374' => 'RPL_ENDOFINFO',
327     '375' => 'RPL_MOTDSTART',
328     '376' => 'RPL_ENDOFMOTD',
329     '381' => 'RPL_YOUREOPER',
330     '382' => 'RPL_REHASHING',
331     '383' => 'RPL_YOURESERVICE',
332     '384' => 'RPL_MYPORTIS',
333     '391' => 'RPL_TIME',
334     '392' => 'RPL_USERSSTART',
335     '393' => 'RPL_USERS',
336     '394' => 'RPL_ENDOFUSERS',
337     '395' => 'RPL_NOUSERS',
338     '401' => 'ERR_NOSUCHNICK',
339     '402' => 'ERR_NOSUCHSERVER',
340     '403' => 'ERR_NOSUCHCHANNEL',
341     '404' => 'ERR_CANNOTSENDTOCHAN',
342     '405' => 'ERR_TOOMANYCHANNELS',
343     '406' => 'ERR_WASNOSUCHNICK',
344     '407' => 'ERR_TOOMANYTARGETS',
345     '408' => 'ERR_NOSUCHSERVICE',
346     '409' => 'ERR_NOORIGIN',
347     '411' => 'ERR_NORECIPIENT',
348     '412' => 'ERR_NOTEXTTOSEND',
349     '413' => 'ERR_NOTOPLEVEL',
350     '414' => 'ERR_WILDTOPLEVEL',
351     '415' => 'ERR_BADMASK',
352     '421' => 'ERR_UNKNOWNCOMMAND',
353     '422' => 'ERR_NOMOTD',
354     '423' => 'ERR_NOADMININFO',
355     '424' => 'ERR_FILEERROR',
356     '431' => 'ERR_NONICKNAMEGIVEN',
357     '432' => 'ERR_ERRONEUSNICKNAME',
358     '433' => 'ERR_NICKNAMEINUSE',
359     '436' => 'ERR_NICKCOLLISION',
360     '437' => 'ERR_UNAVAILRESOURCE',
361     '441' => 'ERR_USERNOTINCHANNEL',
362     '442' => 'ERR_NOTONCHANNEL',
363     '443' => 'ERR_USERONCHANNEL',
364     '444' => 'ERR_NOLOGIN',
365     '445' => 'ERR_SUMMONDISABLED',
366     '446' => 'ERR_USERSDISABLED',
367     '451' => 'ERR_NOTREGISTERED',
368     '461' => 'ERR_NEEDMOREPARAMS',
369     '462' => 'ERR_ALREADYREGISTRED',
370     '463' => 'ERR_NOPERMFORHOST',
371     '464' => 'ERR_PASSWDMISMATCH',
372     '465' => 'ERR_YOUREBANNEDCREEP',
373     '466' => 'ERR_YOUWILLBEBANNED',
374     '467' => 'ERR_KEYSET',
375     '471' => 'ERR_CHANNELISFULL',
376     '472' => 'ERR_UNKNOWNMODE',
377     '473' => 'ERR_INVITEONLYCHAN',
378     '474' => 'ERR_BANNEDFROMCHAN',
379     '475' => 'ERR_BADCHANNELKEY',
380     '476' => 'ERR_BADCHANMASK',
381     '477' => 'ERR_NOCHANMODES',
382     '478' => 'ERR_BANLISTFULL',
383     '481' => 'ERR_NOPRIVILEGES',
384     '482' => 'ERR_CHANOPRIVSNEEDED',
385     '483' => 'ERR_CANTKILLSERVER',
386     '484' => 'ERR_RESTRICTED',
387     '485' => 'ERR_UNIQOPPRIVSNEEDED',
388     '491' => 'ERR_NOOPERHOST',
389     '492' => 'ERR_NOSERVICEHOST',
390     '501' => 'ERR_UMODEUNKNOWNFLAG',
391     '502' => 'ERR_USERSDONTMATCH',
392     );
393    
394     sub rfc_code_to_name {
395     my ($code) = @_;
396     return $RFC_NUMCODE_MAP{$code} || $code;
397     }
398    
399 elmex 1.1 =head1 AUTHOR
400    
401     Robin Redeker, C<< <elmex@ta-sa.org> >>
402    
403     =head1 SEE ALSO
404    
405 elmex 1.6 Internet Relay Chat Client To Client Protocol from February 2, 1997
406     http://www.invlogic.com/irc/ctcp.html
407    
408 elmex 1.1 RFC 2812 - Internet Relay Chat: Client Protocol
409    
410     =head1 COPYRIGHT & LICENSE
411    
412 elmex 1.3 Copyright 2006 Robin Redeker, all rights reserved.
413 elmex 1.1
414     This program is free software; you can redistribute it and/or modify it
415     under the same terms as Perl itself.
416    
417     =cut
418    
419     1;