ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/lib/Net/IRC3/Util.pm
Revision: 1.5
Committed: Mon Jul 17 18:44:08 2006 UTC (18 years, 4 months ago) by elmex
Branch: MAIN
Changes since 1.4: +1 -1 lines
Log Message:
*** empty log message ***

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