Skip Menu |
 

This queue is for tickets about the POE-Component-IRC CPAN distribution.

Report information
The Basics
Id: 32279
Status: resolved
Worked: 10 min
Priority: 0/
Queue: POE-Component-IRC

People
Owner: BINGOS [...] cpan.org
Requestors: hinrik.sig [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: (no value)
Fixed in: (no value)



Subject: Filter/CTCP.pm doesn't provide raw_line
Download (untitled) / with headers
text/plain 149b
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
Download CTCP.pm
text/x-perl 6.8k
# $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
From: hinrik.sig [...] gmail.com
Gah! Uploaded the wrong file. Here it is.
Download ctcp.diff
text/x-diff 358b
--- CTCP.pm 2008-01-13 16:30:58.000000000 +0000 +++ CTCP.pm.new 2008-01-13 16:33:09.000000000 +0000 @@ -66,7 +66,8 @@ } else { push @$events, { name => $type . '_' . lc $name, args => [ $who, [split /,/, $where], - (defined $args ? $args : '') ] + (defined $args ? $args : '') ], + raw_line => $line }; } }
Many thanks patch applied and new version released to CPAN.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.