AnyEvent-IRC
view release on metacpan or search on metacpan
lib/AnyEvent/IRC/Util.pm view on Meta::CPAN
# FIXME: params must be counted, and if > 13 they have to be
# concationated with $trail
map { $msg .= " $_" } @params;
$msg .= defined $trail ? " :$trail" : "";
return $msg;
}
my @_ctcp_lowlevel_escape = ("\000", "0", "\012", "n", "\015", "r", "\020", "\020");
sub unescape_lowlevel {
my ($data) = @_;
my %map = reverse @_ctcp_lowlevel_escape;
$data =~ s/\020(.)/defined $map{$1} ? $map{$1} : $1/ge;
$data
}
sub escape_lowlevel {
my ($data) = @_;
my %map = @_ctcp_lowlevel_escape;
$data =~ s/([\000\012\015\020])/"\020$map{$1}"/ge;
$data
}
sub unescape_ctcp {
my ($data) = @_;
$data =~ s/\\(.)/$1 eq 'a' ? "\001" : ($1 eq "\\" ? "\\" : $1)/eg;
$data
}
sub escape_ctcp {
my ($data) = @_;
$data =~ s/([\\\001])/$1 eq "\001" ? "\\a" : "\\\\"/eg;
$data
}
=item B<decode_ctcp ($data)>
This function decodes CTCP messages contained in an IRC message.
C<$data> should be the last parameter of a IRC PRIVMSG or NOTICE.
It will first unescape the lower layer, extract CTCP messages
and then return a list with two elements: the line without the CTCP messages
and an array reference which contains array references of CTCP messages.
Those CTCP message array references will have the CTCP message tag as
first element (eg. "VERSION") and the rest of the CTCP message as the second
element.
=cut
sub decode_ctcp {
my ($line) = @_;
$line = unescape_lowlevel ($line);
my @ctcp;
while ($line =~ /\G\001([^\001]*)\001/g) {
my $msg = unescape_ctcp ($1);
my ($tag, $data) = split / /, $msg, 2;
push @ctcp, [$tag, $data];
}
$line =~ s/\001[^\001]*\001//g;
# try to parse broken ctcp messages anyway
if ($line =~ s/\001([^\001]*)$//) {
my $msg = unescape_ctcp ($1);
my ($tag, $data) = split / /, $msg, 2;
push @ctcp, [$tag, $data];
}
return ($line, \@ctcp)
}
=item B<encode_ctcp (@msg)>
This function encodes a CTCP message for the transmission via the NOTICE
lib/AnyEvent/IRC/Util.pm view on Meta::CPAN
spaces.
All parts of the message will be concatenated and lowlevel quoted.
That means you can embed _any_ character from 0 to 255 in this message (thats
what the lowlevel quoting allows).
=cut
sub encode_ctcp {
my (@args) = @_;
escape_lowlevel (
join "", map {
ref $_
? "\001" . escape_ctcp (join " ", @$_) . "\001"
: $_
} @args
)
}
=item B<filter_colors ($line)>
This function will filter out any mIRC colors and (most) ansi escape sequences.
Unfortunately the mIRC color coding will destroy improper colored numbers. So this
function may destroy the message in some occasions a bit.
=cut
sub filter_colors($) {
my ($line) = @_;
$line =~ s/\x1B\[.*?[\x00-\x1F\x40-\x7E]//g; # see ECMA-48 + advice by urxvt author
$line =~ s/\x03\d\d?(?:,\d\d?)?//g; # see http://www.mirc.co.uk/help/color.txt
$line =~ s/[\x03\x16\x02\x1f\x0f]//g; # see some undefined place :-)
( run in 0.613 second using v1.01-cache-2.11-cpan-c21f80fb71c )