| 1 | package Net::IRC3; |
1 | package Net::IRC3; |
| 2 | use strict; |
2 | use strict; |
| 3 | use AnyEvent; |
3 | use AnyEvent; |
| 4 | use IO::Socket::INET; |
4 | use IO::Socket::INET; |
| 5 | use Exporter; |
|
|
| 6 | our @ISA = qw/Exporter/; |
|
|
| 7 | our @EXPORT_OK = |
|
|
| 8 | qw(mk_msg parse_irc_msg split_prefix prefix_nick |
|
|
| 9 | decode_ctcp prefix_user prefix_host); |
|
|
| 10 | |
5 | |
| 11 | our $ConnectionClass = 'Net::IRC3::Connection'; |
6 | our $ConnectionClass = 'Net::IRC3::Connection'; |
| 12 | |
7 | |
| 13 | =head1 NAME |
8 | =head1 NAME |
| 14 | |
9 | |
| … | |
… | |
| 145 | } |
140 | } |
| 146 | } |
141 | } |
| 147 | |
142 | |
| 148 | =back |
143 | =back |
| 149 | |
144 | |
| 150 | =head1 FUNCTIONS |
|
|
| 151 | |
|
|
| 152 | These are some utility functions that might come in handy when |
|
|
| 153 | handling the IRC protocol. |
|
|
| 154 | |
|
|
| 155 | You can export these with eg.: |
|
|
| 156 | |
|
|
| 157 | use Net::IRC3 qw/parse_irc_msg/; |
|
|
| 158 | |
|
|
| 159 | =over 4 |
|
|
| 160 | |
|
|
| 161 | =item B<parse_irc_msg ($ircline)> |
|
|
| 162 | |
|
|
| 163 | This method parses the C<$ircline>, which is one line of the IRC protocol |
|
|
| 164 | without the trailing "\015\012". |
|
|
| 165 | |
|
|
| 166 | It returns a hash which has the following entrys: |
|
|
| 167 | |
|
|
| 168 | =over 4 |
|
|
| 169 | |
|
|
| 170 | =item prefix |
|
|
| 171 | |
|
|
| 172 | The message prefix. |
|
|
| 173 | |
|
|
| 174 | =item command |
|
|
| 175 | |
|
|
| 176 | The IRC command. |
|
|
| 177 | |
|
|
| 178 | =item params |
|
|
| 179 | |
|
|
| 180 | The parameters to the IRC command in a array reference, |
|
|
| 181 | this includes the trailing parameter (the one after the ':' or |
|
|
| 182 | the 14th parameter). |
|
|
| 183 | |
|
|
| 184 | =item trailing |
|
|
| 185 | |
|
|
| 186 | This is set if there was a trailing parameter (the one after the ':' or |
|
|
| 187 | the 14th parameter). |
|
|
| 188 | |
|
|
| 189 | =back |
|
|
| 190 | |
|
|
| 191 | =cut |
|
|
| 192 | |
|
|
| 193 | sub parse_irc_msg { |
|
|
| 194 | my ($msg) = @_; |
|
|
| 195 | |
|
|
| 196 | my $cmd; |
|
|
| 197 | my $pref; |
|
|
| 198 | my $t; |
|
|
| 199 | my @a; |
|
|
| 200 | |
|
|
| 201 | my $p = $msg =~ s/^(:([^ ]+)[ ])?([A-Za-z]+|\d{3})//; |
|
|
| 202 | $pref = $2; |
|
|
| 203 | $cmd = $3; |
|
|
| 204 | |
|
|
| 205 | my $i = 0; |
|
|
| 206 | |
|
|
| 207 | while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) { |
|
|
| 208 | |
|
|
| 209 | push @a, $1 if defined $1; |
|
|
| 210 | if (++$i > 13) { last; } |
|
|
| 211 | } |
|
|
| 212 | |
|
|
| 213 | if ($i == 14) { |
|
|
| 214 | |
|
|
| 215 | if ($msg =~ s/^[ ]:?([^\015\012\0]*)//) { |
|
|
| 216 | $t = $1 if $1 ne ""; |
|
|
| 217 | } |
|
|
| 218 | |
|
|
| 219 | } else { |
|
|
| 220 | |
|
|
| 221 | if ($msg =~ s/^[ ]:([^\015\012\0]*)//) { |
|
|
| 222 | $t = $1 if $1 ne ""; |
|
|
| 223 | } |
|
|
| 224 | } |
|
|
| 225 | |
|
|
| 226 | push @a, $t if defined $t; |
|
|
| 227 | |
|
|
| 228 | my $m = { prefix => $pref, command => $cmd, params => \@a, trailing => $t }; |
|
|
| 229 | return $p ? $m : undef; |
|
|
| 230 | } |
|
|
| 231 | |
|
|
| 232 | =item B<mk_msg ($prefix, $command, $trailing, @params)> |
|
|
| 233 | |
|
|
| 234 | This function assembles a IRC message. The generated |
|
|
| 235 | message will look like (pseudo code!) |
|
|
| 236 | |
|
|
| 237 | :<prefix> <command> <params> :<trail> |
|
|
| 238 | |
|
|
| 239 | Please refer to RFC 2812 how IRC messages normally look like. |
|
|
| 240 | |
|
|
| 241 | The prefix and the trailing string will be omitted if they are C<undef>. |
|
|
| 242 | |
|
|
| 243 | EXAMPLES: |
|
|
| 244 | |
|
|
| 245 | mk_msg (undef, "PRIVMSG", "you suck!", "magnus"); |
|
|
| 246 | # will return: "PRIVMSG magnus :you suck!\015\012" |
|
|
| 247 | |
|
|
| 248 | mk_msg (undef, "JOIN", undef, "#test"); |
|
|
| 249 | # will return: "JOIN #magnus\015\012" |
|
|
| 250 | |
|
|
| 251 | =cut |
|
|
| 252 | |
|
|
| 253 | sub mk_msg { |
|
|
| 254 | my ($prefix, $command, $trail, @params) = @_; |
|
|
| 255 | my $msg = ""; |
|
|
| 256 | |
|
|
| 257 | $msg .= defined $prefix ? ":$prefix " : ""; |
|
|
| 258 | $msg .= "$command"; |
|
|
| 259 | |
|
|
| 260 | # FIXME: params must be counted, and if > 13 they have to be |
|
|
| 261 | # concationated with $trail |
|
|
| 262 | map { $msg .= " $_" } @params; |
|
|
| 263 | |
|
|
| 264 | $msg .= defined $trail ? " :$trail" : ""; |
|
|
| 265 | $msg .= "\015\012"; |
|
|
| 266 | |
|
|
| 267 | return $msg; |
|
|
| 268 | } |
|
|
| 269 | |
|
|
| 270 | |
|
|
| 271 | =item B<decode_ctcp ($ircmsg)> or B<decode_ctcp ($line)> |
|
|
| 272 | |
|
|
| 273 | =cut |
|
|
| 274 | |
|
|
| 275 | sub decode_ctcp { |
|
|
| 276 | my ($self, $msg) = @_; |
|
|
| 277 | my $line = ref $msg ? $msg->{trailing} : $msg; |
|
|
| 278 | my $msg = ref $msg ? $msg : { }; |
|
|
| 279 | |
|
|
| 280 | if ($line =~ m/^\001(.*?)\001$/) { |
|
|
| 281 | my $ctcpdata = $1; |
|
|
| 282 | |
|
|
| 283 | # XXX: implement! |
|
|
| 284 | |
|
|
| 285 | } else { |
|
|
| 286 | return { trailing => $line }; |
|
|
| 287 | } |
|
|
| 288 | |
|
|
| 289 | |
|
|
| 290 | return $msg; |
|
|
| 291 | } |
|
|
| 292 | |
|
|
| 293 | =item B<split_prefix ($prefix)> |
|
|
| 294 | |
|
|
| 295 | This function splits an IRC user prefix as described by RFC 2817 |
|
|
| 296 | into the three parts: nickname, user and host. Which will be |
|
|
| 297 | returned as a list with that order. |
|
|
| 298 | |
|
|
| 299 | C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>. |
|
|
| 300 | |
|
|
| 301 | =cut |
|
|
| 302 | |
|
|
| 303 | sub split_prefix { |
|
|
| 304 | my ($prfx) = @_; |
|
|
| 305 | |
|
|
| 306 | if (ref ($prfx) eq 'HASH') { |
|
|
| 307 | $prfx = $prfx->{prefix}; |
|
|
| 308 | } |
|
|
| 309 | |
|
|
| 310 | $prfx =~ m/^\s*([^!]*)!([^@]*)@(.*?)\s*$/; |
|
|
| 311 | return ($1, $2, $3); |
|
|
| 312 | } |
|
|
| 313 | |
|
|
| 314 | =item B<prefix_nick ($prefix)> |
|
|
| 315 | |
|
|
| 316 | A shortcut to extract the nickname from the C<$prefix>. |
|
|
| 317 | |
|
|
| 318 | C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>. |
|
|
| 319 | |
|
|
| 320 | =cut |
|
|
| 321 | |
|
|
| 322 | sub prefix_nick { |
|
|
| 323 | my ($prfx) = @_; |
|
|
| 324 | return (split_prefix ($prfx))[0]; |
|
|
| 325 | } |
|
|
| 326 | |
|
|
| 327 | =item B<prefix_user ($prefix)> |
|
|
| 328 | |
|
|
| 329 | A shortcut to extract the username from the C<$prefix>. |
|
|
| 330 | |
|
|
| 331 | C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>. |
|
|
| 332 | |
|
|
| 333 | =cut |
|
|
| 334 | |
|
|
| 335 | sub prefix_user { |
|
|
| 336 | my ($prfx) = @_; |
|
|
| 337 | return (split_prefix ($prfx))[1]; |
|
|
| 338 | } |
|
|
| 339 | |
|
|
| 340 | =item B<prefix_host ($prefix)> |
|
|
| 341 | |
|
|
| 342 | A shortcut to extract the hostname from the C<$prefix>. |
|
|
| 343 | |
|
|
| 344 | C<$prefix> can also be a hash like it is returned by C<parse_irc_msg>. |
|
|
| 345 | |
|
|
| 346 | =cut |
|
|
| 347 | |
|
|
| 348 | sub prefix_host { |
|
|
| 349 | my ($self, $prfx) = @_; |
|
|
| 350 | return (split_prefix ($prfx))[2]; |
|
|
| 351 | } |
|
|
| 352 | |
|
|
| 353 | =back |
|
|
| 354 | |
|
|
| 355 | =head1 EXAMPLES |
145 | =head1 EXAMPLES |
| 356 | |
146 | |
| 357 | See the samples/ directory for some examples on how to use Net::IRC3. |
147 | See the samples/ directory for some examples on how to use Net::IRC3. |
| 358 | |
148 | |
| 359 | =head1 AUTHOR |
149 | =head1 AUTHOR |
