From modperl-cvs-return-3382-apmail-perl-modperl-cvs-archive=perl.apache.org@perl.apache.org Wed May 14 02:26:55 2003
Return-Path: <modperl-cvs-return-3382-apmail-perl-modperl-cvs-archive=perl.apache.org@perl.apache.org>
Delivered-To: apmail-perl-modperl-cvs-archive@perl.apache.org
Received: (qmail 98789 invoked by uid 500); 14 May 2003 02:26:55 -0000
Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm
Precedence: bulk
list-help: <mailto:modperl-cvs-help@perl.apache.org>
list-unsubscribe: <mailto:modperl-cvs-unsubscribe@perl.apache.org>
list-post: <mailto:modperl-cvs@perl.apache.org>
Reply-To: dev@perl.apache.org
Delivered-To: mailing list modperl-cvs@perl.apache.org
Received: (qmail 98776 invoked by uid 500); 14 May 2003 02:26:55 -0000
Delivered-To: apmail-modperl-2.0-cvs@apache.org
Date: 14 May 2003 02:26:54 -0000
Message-ID: <20030514022654.54450.qmail@icarus.apache.org>
From: stas@apache.org
To: modperl-2.0-cvs@apache.org
Subject: cvs commit: modperl-2.0/t/conf modperl_extra.pl
X-Spam-Rating: daedalus.apache.org 1.6.2 0/1000/N

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;