ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/lib/Net/IRC3/Util.pm
Revision: 1.7
Committed: Tue Jan 16 19:39:17 2007 UTC (17 years, 10 months ago) by elmex
Branch: MAIN
Changes since 1.6: +162 -2 lines
Log Message:
Net::IRC3:
        - fixed case handling with channels
        - added functionality to change the nick automatically
          when it is already taken when registering an IRC connection.
          (Net::IRC3::Client::Connection)
        - added reply number <=> reply name mapping to Net::IRC3::Util
          accessible through rfc_code_to_name
        - added error event to Net::IRC3::Client::Connection
json chat framework:
        - client history
        - nick listing more correct
        - improved completion (added nick completion)
        - further improvement of the protocol
        - finally got the id handling correct
        - added logging to jsonsrv
        - many other changes i forgot.

File Contents

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