perl -c fails with FilterSnoop example in docs
am 22.02.2011 21:32:18 von Mark HedgesI copied this useful debugging filter at
http://perl.apache.org/docs/2.0/user/handlers/filters.html#A ll_in_One_Filter
It works fine, but I can't `perl -c` :
hedges@vm5:~/foo$ perl -c Lame.pm
Invalid CODE attribute: FilterConnectionHandler at Lame.pm line 26
BEGIN failed--compilation aborted at Lame.pm line 26.
If I comment those subs out it checks fine, so
Apache2::Filter is loading. It doesn't help if I also do
"use Apache2::Filter ()" first. Any ideas how to make this
check okay for my build test to include it? --mark--
#file:MyApache2/FilterSnoop.pm
#----------------------------
package Lame;
=head1 SEE ALSO
Search for L
http://perl.apache.org/.
=head1 METHODS
=cut
use strict;
use warnings;
use base qw(Apache2::Filter);
use Apache2::FilterRec ();
use APR::Brigade ();
use APR::Bucket ();
use APR::BucketType ();
use Apache2::Const -compile => qw(OK DECLINED);
use APR::Const -compile => ':common';
sub connection : FilterConnectionHandler { snoop("connection", @_) }
sub request : FilterRequestHandler { snoop("request", @_) }
=head2 snoop
snoop the buckets
=cut
sub snoop {
my $type = shift;
my ($f, $bb, $mode, $block, $readbytes) = @_; # filter args
# $mode, $block, $readbytes are passed only for input filters
my $stream = defined $mode ? "input" : "output";
# read the data and pass-through the bucket brigades unchanged
if (defined $mode) {
# input filter
my $rv = $f->next->get_brigade($bb, $mode, $block, $readbytes);
return $rv unless $rv == APR::Const::SUCCESS;
bb_dump($type, $stream, $bb);
}
else {
# output filter
bb_dump($type, $stream, $bb);
my $rv = $f->next->pass_brigade($bb);
return $rv unless $rv == APR::Const::SUCCESS;
}
return Apache2::Const::OK;
}
=head2 bb_dump
dump the buckets
=cut
sub bb_dump {
my ($type, $stream, $bb) = @_;
my @data;
for (my $b = $bb->first; $b; $b = $bb->next($b)) {
$b->read(my $bdata);
push @data, $b->type->name, $bdata;
}
# send the sniffed info to STDERR so not to interfere with normal
# output
my $direction = $stream eq 'output' ? ">>>" : "<<<";
print STDERR "\n$direction $type $stream filter\n";
my $c = 1;
while (my ($btype, $data) = splice @data, 0, 2) {
print STDERR " o bucket $c: $btype\n";
print STDERR "[$data]\n";
$c++;
}
}
1;