view release on metacpan or  search on metacpan

lib/AnyEvent/IRC/Util.pm  view on Meta::CPAN

package AnyEvent::IRC::Util;
use common::sense;
use Exporter;
use Encode;
our @ISA = qw/Exporter/;
our @EXPORT_OK =
   qw(mk_msg parse_irc_msg split_prefix prefix_nick
      decode_ctcp encode_ctcp filter_ctcp_text_attr prefix_user prefix_host
      rfc_code_to_name filter_colors is_nick_prefix join_prefix
      split_unicode_string);

=head1 NAME

AnyEvent::IRC::Util - Common utilities that help with IRC protocol handling

=head1 SYNOPSIS

   use AnyEvent::IRC::Util qw/parse_irc_msg mk_msg/;

   my $msgdata = mk_msg (undef, PRIVMSG => "mcmanus", "my hands glow!");

=head1 FUNCTIONS

These are some utility functions that might come in handy when
handling the IRC protocol.

You can export these with eg.:

   use AnyEvent::IRC::Util 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).

=back

=cut

sub parse_irc_msg {
   my ($msg) = @_;

   $msg =~ s/^(?::([^ ]+)[ ])?([A-Za-z]+|\d{3})//
      or return undef;
   my %msg;
   ($msg{prefix}, $msg{command}, $msg{params}) = ($1, $2, []);

   my $cnt = 0;
   while ($msg =~ s/^[ ]([^ :\015\012\0][^ \015\012\0]*)//) {
      push @{$msg{params}}, $1 if defined $1;

lib/AnyEvent/IRC/Util.pm  view on Meta::CPAN

   '402' => 'ERR_NOSUCHSERVER',
   '403' => 'ERR_NOSUCHCHANNEL',
   '404' => 'ERR_CANNOTSENDTOCHAN',
   '405' => 'ERR_TOOMANYCHANNELS',
   '406' => 'ERR_WASNOSUCHNICK',
   '407' => 'ERR_TOOMANYTARGETS',
   '408' => 'ERR_NOSUCHSERVICE',
   '409' => 'ERR_NOORIGIN',
   '411' => 'ERR_NORECIPIENT',
   '412' => 'ERR_NOTEXTTOSEND',
   '413' => 'ERR_NOTOPLEVEL',
   '414' => 'ERR_WILDTOPLEVEL',
   '415' => 'ERR_BADMASK',
   '421' => 'ERR_UNKNOWNCOMMAND',
   '422' => 'ERR_NOMOTD',
   '423' => 'ERR_NOADMININFO',
   '424' => 'ERR_FILEERROR',
   '431' => 'ERR_NONICKNAMEGIVEN',
   '432' => 'ERR_ERRONEUSNICKNAME',
   '433' => 'ERR_NICKNAMEINUSE',
   '436' => 'ERR_NICKCOLLISION',
   '437' => 'ERR_UNAVAILRESOURCE',
   '441' => 'ERR_USERNOTINCHANNEL',
   '442' => 'ERR_NOTONCHANNEL',
   '443' => 'ERR_USERONCHANNEL',
   '444' => 'ERR_NOLOGIN',
   '445' => 'ERR_SUMMONDISABLED',
   '446' => 'ERR_USERSDISABLED',
   '451' => 'ERR_NOTREGISTERED',
   '461' => 'ERR_NEEDMOREPARAMS',
   '462' => 'ERR_ALREADYREGISTRED',
   '463' => 'ERR_NOPERMFORHOST',
   '464' => 'ERR_PASSWDMISMATCH',
   '465' => 'ERR_YOUREBANNEDCREEP',
   '466' => 'ERR_YOUWILLBEBANNED',
   '467' => 'ERR_KEYSET',
   '471' => 'ERR_CHANNELISFULL',
   '472' => 'ERR_UNKNOWNMODE',
   '473' => 'ERR_INVITEONLYCHAN',
   '474' => 'ERR_BANNEDFROMCHAN',
   '475' => 'ERR_BADCHANNELKEY',
   '476' => 'ERR_BADCHANMASK',
   '477' => 'ERR_NOCHANMODES',
   '478' => 'ERR_BANLISTFULL',
   '481' => 'ERR_NOPRIVILEGES',
   '482' => 'ERR_CHANOPRIVSNEEDED',
   '483' => 'ERR_CANTKILLSERVER',
   '484' => 'ERR_RESTRICTED',
   '485' => 'ERR_UNIQOPPRIVSNEEDED',
   '491' => 'ERR_NOOPERHOST',
   '492' => 'ERR_NOSERVICEHOST',
   '501' => 'ERR_UMODEUNKNOWNFLAG',
   '502' => 'ERR_USERSDONTMATCH',
);

sub rfc_code_to_name {
   my ($code) = @_;
   return $RFC_NUMCODE_MAP{$code} || $code;
}

=item my (@lines) = split_unicode_string ($encoding, $string, $maxlinebytes)

This function splits up C<$string> into multiple C<@lines> which are
not longer than C<$maxlinebytes> bytes. Encoding can be given in C<$encoding>.
(eg. 'utf-8'). But the output will not be encoded.

This function takes care that your characters are not garbled.

=cut

sub split_unicode_string {
   my ($enc, $str, $maxlen) = @_;

   return $str unless length (encode ($enc, $str)) > $maxlen;

   my $cur_out = '';
   my @lines;

   while (length ($str) > 0) {

      while (length (encode ($enc, $cur_out)) <= $maxlen
             && length ($str) > 0) {

         $cur_out .= substr $str, 0, 1, '';
      }

      push @lines, $cur_out;
      $cur_out = '';
   }

   @lines
}

=back

=head1 AUTHOR

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

=head1 SEE ALSO

Internet Relay Chat Client To Client Protocol from February 2, 1997
http://www.invlogic.com/irc/ctcp.html

RFC 1459 - Internet Relay Chat: Client Protocol

=head1 COPYRIGHT & LICENSE

Copyright 2006-2009 Robin Redeker, 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;