perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/conf modperl_extra.pl
Date Wed, 14 May 2003 02:26:54 GMT
stas        2003/05/13 19:26:53

  Modified:    t/conf   modperl_extra.pl
  Log:
  make the filter snooping functionality available for filter tests
  
  Revision  Changes    Path
  1.29      +76 -0     modperl-2.0/t/conf/modperl_extra.pl
  
  Index: modperl_extra.pl
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
  retrieving revision 1.28
  retrieving revision 1.29
  diff -u -r1.28 -r1.29
  --- modperl_extra.pl	13 May 2003 09:38:03 -0000	1.28
  +++ modperl_extra.pl	14 May 2003 02:26:53 -0000	1.29
  @@ -129,4 +129,80 @@
       warn "END in modperl_extra.pl, pid=$$\n";
   }
   
  +package ModPerl::TestFilterDebug;
  +
  +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';
  +
  +# to use these functions add any or all of these filter handlers
  +# PerlInputFilterHandler  ModPerl::TestFilterDebug::snoop_request
  +# PerlInputFilterHandler  ModPerl::TestFilterDebug::snoop_connection
  +# PerlOutputFilterHandler ModPerl::TestFilterDebug::snoop_request
  +# PerlOutputFilterHandler ModPerl::TestFilterDebug::snoop_connection
  +#
  +
  +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;
  +        bb_dump($type, $stream, $bb);
  +    }
  +    else {
  +        # output filter
  +        bb_dump($type, $stream, $bb);
  +        my $rv = $filter->next->pass_brigade($bb);
  +        return $rv unless $rv == APR::SUCCESS;
  +    }
  +    #if ($bb->empty) {
  +    #    return -1;
  +    #}
  +
  +    return Apache::OK;
  +}
  +
  +sub bb_dump {
  +    my($type, $stream, $bb) = @_;
  +
  +    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;
  +    }
  +
  +    # 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";
  +
  +    unless (@data) {
  +        print STDERR "  No buckets\n";
  +        return;
  +    }
  +
  +    my $c = 1;
  +    while (my($btype, $data) = splice @data, 0, 2) {
  +        print STDERR "    o bucket $c: $btype\n";
  +        print STDERR "[$data]\n";
  +        $c++;
  +    }
  +}
  +
  +
   1;
  
  
  

Mime
View raw message