perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject rfc: Apache::DebugFilter
Date Thu, 15 May 2003 09:07:30 GMT
At some point this should end up at CPAN. Comments on this module and requests 
for other filter debug handlers/functions are welcome.

I've temporary added this code to t/conf/modperl_extra.pl as I find it quite 
useful to debug filter tests.

package Apache::DebugFilter;

require 5.006;
require mod_perl 1.99;

use strict;
use warnings FATAL => 'all';

$Apache::DebugFilter::VERSION = '0.01';

use base qw(Apache::Filter);
use Apache::FilterRec ();
use APR::Brigade ();
use APR::Bucket ();

use Apache::Const -compile => qw(OK DECLINED);
use APR::Const -compile => ':common';


sub snoop_connection : FilterConnectionHandler { snoop("connection", @_) }
sub snoop_request    : FilterRequestHandler    { snoop("request",    @_) }

sub snoop {
     my $type = shift;
     my($filter, $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 = $filter->next->get_brigade($bb, $mode, $block, $readbytes);
         return $rv unless $rv == APR::SUCCESS;
         _snoop_bb_dump($type, $stream, $bb, \*STDERR);
     }
     else {
         # output filter
         _snoop_bb_dump($type, $stream, $bb, \*STDERR);
         my $rv = $filter->next->pass_brigade($bb);
         return $rv unless $rv == APR::SUCCESS;
     }
     #if ($bb->empty) {
     #    return -1;
     #}

     return Apache::OK;
}

sub _snoop_bb_dump {
     my($type, $stream, $bb, $fh) = @_;

     # send the sniffed info to STDERR so not to interfere with normal
     # output
     my $direction = $stream eq 'output' ? ">>>" : "<<<";
     print $fh "\n$direction $type $stream filter\n";

     bb_dump($bb, $fh);

}

sub bb_dump {
     my($bb, $fh) = @_;

     my @data;
     for (my $b = $bb->first; $b; $b = $bb->next($b)) {
         $b->read(my $bdata);
         $bdata = '' unless defined $bdata;
         push @data, $b->type->name, $bdata;
     }

     return \@data unless $fh;

     unless (@data) {
         print $fh "  No buckets\n";
         return;
     }

     my $c = 1;
     while (my($btype, $data) = splice @data, 0, 2) {
         print $fh "    o bucket $c: $btype\n";
         print $fh "[$data]\n";
         $c++;
     }
}


1;
__END__

=head1 NAME

Apache::DebugFilter - Get/Set/Unset Environment Variables on the C level

=head1 Synopsis

   # httpd.conf
   # ----------
   PerlModule Apache::DebugFilter
   # Connection snooping (everything)
   PerlInputFilterHandler  Apache::DebugFilter::snoop_connection
   PerlOutputFilterHandler Apache::DebugFilter::snoop_connection

   # HTTP Request snooping (only HTTP request body)
   <Location /foo>
       PerlInputFilterHandler  Apache::DebugFilter::snoop_request
       PerlOutputFilterHandler Apache::DebugFilter::snoop_request
   </Location>

   # in handlers
   #------------
   use Apache::DebugFilter;
   # convert bb to an array of bucket_type => data pairs
   my $ra_data = bb_dump($bb);
   while (my($btype, $data) = splice @data, 0, 2) {
       print "$btype => $data\n";
   }

   # dump pretty formatted bb's content to a filehandle of your choice
   bb_dump($bb, \*STDERR);

=head1 Filter Handlers

=head2 C<snoop_connection()>

The C<snoop_connection()> filter handler snoops on request and
response data flow. For example if the HTTP protocol request is
filtered it'll show both the headers and the body of the request and
response.

Notice that in order to see request's input body, the response handler
must consume it.

The same handler is used for input and output filtering. It internally
figures out what kind of stream it's working on.

To configure the input snooper, add to the top level server or virtual
host configuration in httpd.conf:

   PerlInputFilterHandler  Apache::DebugFilter::snoop_connection

To snoop on response output, add:

   PerlOutputFilterHandler Apache::DebugFilter::snoop_connection

Both can be configured at the same time.

If you want to snoop on what an output filter MyApache::Filter::output
does, put the snooper filter after it:

   PerlOutputFilterHandler MyApache::Filter::output
   PerlOutputFilterHandler Apache::DebugFilter::snoop_connection

On the contrary, to snoop on what an input filter
MyApache::Filter::input does, put the snooper filter before it:

   PerlInputFilterHandler Apache::DebugFilter::snoop_connection
   PerlInputFilterHandler MyApache::Filter::input

This is because C<snoop_connection> is going to be invoked first and
immediately call C<MyApache::Filter::input> the input filter for
data. Only when the latter returns, C<snoop_connection> will do its
work.

=head2 C<snoop_request()>

The C<snoop_request()> filter handler snoops only on HTTP request and
response bodies. Otherwise it's similar to C<snoop_connection()>. Only
normally it's configured for a specific C<E<lt>LocationE<gt>>. For
example:

   <Location /foo>
       PerlInputFilterHandler  Apache::DebugFilter::snoop_request
       PerlOutputFilterHandler Apache::DebugFilter::snoop_request
   </Location>

=head1 Functions

=head2 C<bb_dump()>

   my $ra_data = bb_dump($bb);

If only a bucket brigade C<$bb> is passed, C<bb_dump> will convert bb
to an array of bucket_type => data pairs, and return a reference to
it. This later can be used as in the following example:

   while (my($btype, $data) = splice @data, 0, 2) {
       print "$btype => $data\n";
   }

If the second argument (expected to be an open filehandle) is passed,
as in:

   bb_dump($bb, \*STDERR);

C<bb_dump> will print pretty formatted bb's content to that
filehandle.


=head1 Author

Stas Bekman E<lt>stas@stason.orgE<gt>

=head1 See Also

L<perl>.

=cut

__________________________________________________________________
Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/     mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com


---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message