| Subject: | Filter/CTCP.pm doesn't provide raw_line |
CTCP.pm doesn't provide $event->{raw_line}, causing irc_raw events to be
fired off with no raw line to work with. The supplied patch fixes the issue.
| Subject: | CTCP.pm |
# $Id: CTCP.pm,v 1.1 2005/04/14 19:23:17 chris Exp $
#
# POE::Filter::CTCP, by Dennis Taylor <dennis@funkplanet.com>
#
# This module may be used, modified, and distributed under the same
# terms as Perl itself. Please see the license that came with your Perl
# distribution for details.
#
package POE::Filter::CTCP;
use strict;
use Carp;
use File::Basename ();
use POE::Filter::IRC;
# Create a new, empty POE::Filter::CTCP object.
sub new {
my $class = shift;
my %args = @_;
my $self = { 'irc_filter' => POE::Filter::IRC->new() };
bless $self, $class;
}
# Set/clear the 'debug' flag.
sub debug {
my $self = shift;
$self->{'debug'} = $_[0] if @_;
return( $self->{'debug'} );
}
# For each line of raw CTCP input data that we're fed, spit back the
# appropriate CTCP and normal message events.
sub get {
my ($self, $lineref) = @_;
my ($who, $type, $where, $ctcp, $text, $name, $args);
my $events = [];
LINE:
foreach my $line (@$lineref) {
($who, $type, $where, $ctcp, $text) = _ctcp_dequote( $line );
foreach (@$ctcp) {
($name, $args) = $_ =~ /^(\w+)(?: (.*))?/
or do { warn "Received malformed CTCP message: \"$_\"" if $self->{debug}; next LINE; };
if (lc $name eq 'dcc') {
$args =~ /^(\w+) (\S+) (\d+) (\d+)(?: (\d+))?$/
or do { warn "Received malformed DCC request: \"$_\"" if $self->{debug}; next LINE; };
my $basename = File::Basename::basename( $2 );
push @$events, { name => 'dcc_request',
args => [ $who, uc $1, $4, { open => undef,
nick => $who,
type => uc $1,
file => $basename,
size => $5,
done => 0,
addr => $3,
port => $4,
}, $basename, $5 ]
};
} else {
push @$events, { name => $type . '_' . lc $name,
args => [ $who, [split /,/, $where],
(defined $args ? $args : '') ],
raw_line => $line
};
}
}
if ($text and @$text > 0) {
$line =~ /^(:\S+ +\w+ +\S+ +)/ or warn "What the heck? \"$line\"";
$text = $1 . ':' . join '', @$text;
$text =~ s/\cP/^P/g;
warn "CTCP: $text\n" if $self->{'debug'};
push @$events, @{$self->{irc_filter}->get( [$text] )};
}
}
return $events;
}
# For each line of text we're fed, spit back a CTCP-quoted version of
# that line.
sub put {
my ($self, $lineref) = @_;
my $quoted = [];
foreach my $line (@$lineref) {
push @$quoted, _ctcp_quote( $line );
}
return $quoted;
}
# Quotes a string in a low-level, protocol-safe, utterly brain-dead
# fashion. Returns the quoted string.
sub _low_quote {
my $line = shift;
my %enquote = ("\012" => 'n', "\015" => 'r', "\0" => '0', "\cP" => "\cP");
unless (defined $line) {
die "Not enough arguments to POE::Filter::CTCP->_low_quote";
}
if ($line =~ tr/[\012\015\0\cP]//) { # quote \n, \r, ^P, and \0.
$line =~ s/([\012\015\0\cP])/\cP$enquote{$1}/g;
}
return $line;
}
# Does low-level dequoting on CTCP messages. I hate this protocol.
# Yes, I copied this whole section out of Net::IRC.
sub _low_dequote {
my $line = shift;
my %dequote = (n => "\012", r => "\015", 0 => "\0", "\cP" => "\cP");
unless (defined $line) {
die "Not enough arguments to POE::Filter::CTCP->_low_dequote";
}
# Thanks to Abigail (abigail@foad.org) for this clever bit.
if ($line =~ tr/\cP//) { # dequote \n, \r, ^P, and \0.
$line =~ s/\cP([nr0\cP])/$dequote{$1}/g;
}
return $line;
}
# Properly CTCP-quotes a message. Whoop.
sub _ctcp_quote {
my $line = shift;
$line = _low_quote( $line );
# $line =~ s/\\/\\\\/g;
$line =~ s/\001/\\a/g;
return "\001" . $line . "\001";
}
# Splits a message into CTCP and text chunks. This is gross. Most of
# this is also stolen from Net::IRC, but I wrote that too, so it's
# used with permission. ;-)
sub _ctcp_dequote {
my $line = shift;
my (@chunks, $ctcp, $text, $who, $type, $where, $msg);
# CHUNG! CHUNG! CHUNG!
unless (defined $line) {
die "Not enough arguments to POE::Filter::CTCP->_ctcp_dequote";
}
# Strip out any low-level quoting in the text.
$line = _low_dequote( $line );
# Filter misplaced \001s before processing... (Thanks, tchrist!)
substr($line, rindex($line, "\001"), 1) = '\\a'
unless ($line =~ tr/\001//) % 2 == 0;
return unless $line =~ tr/\001//;
($who, $type, $where, $msg) = ($line =~ /^:(\S+) +(\w+) +(\S+) +:?(.*)$/)
or return;
@chunks = split /\001/, $msg;
shift @chunks unless length $chunks[0]; # FIXME: Is this safe?
foreach (@chunks) {
# Dequote unnecessarily quoted chars, and convert escaped \'s and ^A's.
s/\\([^\\a])/$1/g;
s/\\\\/\\/g;
s/\\a/\001/g;
}
# If the line begins with a control-A, the first chunk is a CTCP
# message. Otherwise, it starts with text and alternates with CTCP
# messages. Really stupid protocol.
if ($msg =~ /^\001/) {
push @$ctcp, shift @chunks;
}
while (@chunks) {
push @$text, shift @chunks;
push @$ctcp, shift @chunks if @chunks;
}
# Is this a CTCP request or reply?
if ($type eq 'PRIVMSG') {
$type = 'ctcp';
} else {
$type = 'ctcpreply';
}
return ($who, $type, $where, $ctcp, $text);
}
1;
__END__
=head1 NAME
POE::Filter::CTCP -- A POE-based parser for the IRC protocol.
=head1 SYNOPSIS
my $filter = POE::Filter::IRC->new();
my @events = @{$filter->get( [ @lines ] )};
my @msgs = @{$filter->put( [ @messages ] )};
=head1 DESCRIPTION
POE::Filter::CTCP converts normal text into thoroughly CTCP-quoted
messages, and transmogrifies CTCP-quoted messages into their normal,
sane components. Rather what you'd expect a filter to do.
A note: the CTCP protocol sucks bollocks. If I ever meet the fellow who
came up with it, I'll shave their head and tattoo obscenities on it.
Just read the "specification" at
http://cs-pub.bu.edu/pub/irc/support/ctcp.spec and you'll hopefully see
what I mean. Quote this, quote that, quote this again, all in different
and weird ways... and who the hell needs to send mixed CTCP and text
messages? WTF? It looks like it's practically complexity for
complexity's sake -- and don't even get me started on the design of the
DCC protocol! Anyhow, enough ranting. Onto the rest of the docs...
=head1 CONSTRUCTOR
=over
=item new
Creates a new POE::Filter::CTCP object. Duh. :-) Takes no arguments.
=back
=head1 METHODS
=over
=item get
Takes an array reference containing one or more lines of CTCP-quoted
text. Returns an array reference of processed, pasteurized events.
=item put
Takes an array reference of CTCP messages to be properly quoted. This
doesn't support CTCPs embedded in normal messages, which is a
brain-dead hack in the protocol, so do it yourself if you really need
it. Returns an array reference of the quoted lines for sending.
=item debug
Takes a true/false value which enables/disbles debugging accordingly.
=back
=head1 AUTHOR
Dennis "fimmtiu" Taylor, E<lt>dennis@funkplanet.comE<gt>.
=head1 SEE ALSO
The documentation for POE and POE::Component::IRC.
=cut