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/filter/TestFilter both_str_native_remove.pm
Date Wed, 27 Oct 2004 22:03:11 GMT
stas        2004/10/27 15:03:11

  Modified:    .        Changes
               xs/Apache/Filter Apache__Filter.h
  Added:       t/filter both_str_native_remove.t
               t/filter/TestFilter both_str_native_remove.pm
  Log:
  $filter->remove now works with native (non-modperl) filters + test
  Submitted by:	Torsten Förtsch <torsten.foertsch@gmx.net>
  
  Revision  Changes    Path
  1.519     +5 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.518
  retrieving revision 1.519
  diff -u -u -r1.518 -r1.519
  --- Changes	25 Oct 2004 23:38:56 -0000	1.518
  +++ Changes	27 Oct 2004 22:03:11 -0000	1.519
  @@ -16,6 +16,11 @@
     - Mistakenly skipping small entries of size 2 and less
     - Leave entries from other packages alone
   
  +$filter->remove now works with native (non-modperl) filters + test
  +[Torsten Förtsch <torsten.foertsch gmx.net>]
  +
  +
  +
   =item 1.99_17 - October 22, 2004
   
   Implement Apache->unescape_url_info in Apache::compat and drop it
  
  
  
  1.43      +24 -2     modperl-2.0/xs/Apache/Filter/Apache__Filter.h
  
  Index: Apache__Filter.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/Apache/Filter/Apache__Filter.h,v
  retrieving revision 1.42
  retrieving revision 1.43
  diff -u -u -r1.42 -r1.43
  --- Apache__Filter.h	1 Oct 2004 03:30:12 -0000	1.42
  +++ Apache__Filter.h	27 Oct 2004 22:03:11 -0000	1.43
  @@ -284,11 +284,33 @@
       modperl_filter_t *modperl_filter;
       ap_filter_t *f;
   
  -    mpxs_usage_va_1(modperl_filter, "$filter->remove()");
  +    if (items < 1) {
  +        Perl_croak(aTHX_ "usage: $filter->remove()");
  +    }
  +
  +    modperl_filter = mp_xs_sv2_modperl_filter(*MARK);
  +
  +    /* native filter */
  +    if (!modperl_filter) {
  +        f = (ap_filter_t*)SvIV(SvRV(*MARK));
  +        MP_TRACE_f(MP_FUNC,
  +                   "   %s\n\n\t non-modperl filter removes itself\n",
  +                   f->frec->name);
  +
  +        /* the filter can reside in only one chain. hence we try to
  +         * remove it from both, the input and output chains, since
  +         * unfortunately we can't tell what kind of filter is that and
  +         * whether the first call was successful
  +         */
  +        ap_remove_input_filter(f);
  +        ap_remove_output_filter(f);
  +        return;
  +    }
  +    
       f = modperl_filter->f;
   
       MP_TRACE_f(MP_FUNC, "   %s\n\n\tfilter removes itself\n",
  -               ((modperl_filter_ctx_t *)f->ctx)->handler->name);
  +        ((modperl_filter_ctx_t *)f->ctx)->handler->name);
       
       if (modperl_filter->mode == MP_INPUT_FILTER_MODE) {
           ap_remove_input_filter(f);
  
  
  
  1.1                  modperl-2.0/t/filter/both_str_native_remove.t
  
  Index: both_str_native_remove.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest;
  use Apache::TestUtil;
  
  plan tests => 8, need 'deflate', 'include',
      need_min_module_version("Compress::Zlib", "1.09");
  
  require Compress::Zlib;
  
  my $base = '/TestFilter__both_str_native_remove';
  
  # 1. check if DEFLATE input and INCLUDES output filter work
  {
      my $location = $base;
      my $received = POST_BODY $location,
          content => Compress::Zlib::memGzip('gzipped text'),
          'Content-Encoding' => "gzip";
  
      ok t_cmp $received, qr/xSSI OK/, "INCLUDES filter";
  
      ok t_cmp $received, qr/content: gzipped text/, "DEFLATE filter";
  }
  
  
  # 2. check if DEFLATE input and INCLUDES output filter can be removed
  {
      my $location = "$base?remove";
      my $received = POST_BODY $location, content => 'plain text';
  
      ok t_cmp $received,
          qr/input1: [\w,]+deflate/,
          "DEFLATE filter is present";
  
      ok !t_cmp $received,
          qr/input2: [\w,]+deflate/,
          "DEFLATE filter is removed";
  
      ok t_cmp $received,
          qr/content: plain text/,
          "DEFLATE filter wasn't invoked";
  
      ok t_cmp $received,
          qr/output1: modperl_request_output,includes,modperl_request_output,/,
          "INCLUDES filter is present";
  
      ok t_cmp $received,
          qr/output2: modperl_request_output,(?!includes)/,
          "INCLUDES filter is removed";
  
      ok t_cmp $received,
          qr/x<!--#echo var="SSI_TEST" -->x/,
          "INCLUDES filter wasn't invoked";
  
  }
  
  
  
  
  
  1.1                  modperl-2.0/t/filter/TestFilter/both_str_native_remove.pm
  
  Index: both_str_native_remove.pm
  ===================================================================
  package TestFilter::both_str_native_remove;
  
  # this tests verifies that we can remove input and output native
  # (non-mod_perl filters)
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  
  use Apache::Filter ();
  use Apache::FilterRec ();
  
  use Apache::Const -compile => qw(OK DECLINED);
  
  # this filter removes the next filter in chain and itself
  sub remove_includes {
        my $f = shift;
  
        my $args = $f->r->args || '';
        if ($args eq 'remove') {
            my $ff = $f->next;
            $ff->remove if $ff && $ff->frec->name eq 'includes';
        }
  
        $f->remove;
  
        return Apache::DECLINED;
  }
  
  # this filter removes the next filter in chain and itself
  sub remove_deflate {
        my $f = shift;
  
        my $args = $f->r->args || '';
        if ($args eq 'remove') {
            for (my $ff = $f->r->input_filters; $ff; $ff = $ff->next) {
                if ($ff->frec->name eq 'deflate') {
                    $ff->remove;
                    last;
                }
            }
        }
        $f->remove;
  
        return Apache::DECLINED;
  }
  
  # this filter appends the output filter list at eos
  sub print_out_flist {
        my $f = shift;
  
        unless ($f->ctx) {
            $f->ctx(1);
            $f->r->headers_out->unset('Content-Length');
        }
  
        while ($f->read(my $buffer, 1024)) {
            $f->print($buffer);
        }
  
        if ($f->seen_eos) {
            my $flist = join ',', get_flist($f->r->output_filters);
            $f->print("output2: $flist\n");
        }
  
        return Apache::OK;
  }
  
  sub store_in_flist {
        my $f = shift;
        my $r = $f->r;
  
        unless ($f->ctx) {
            my $x = $r->pnotes('INPUT_FILTERS') || [];
            push @$x, join ',', get_flist($f->r->input_filters);
            $r->pnotes('INPUT_FILTERS' => $x);
        }
  
        return Apache::DECLINED;
  }
  
  
  sub response {
      my $r = shift;
  
      # just to make sure that print() won't flush, or we would get the
      # count wrong
      local $| = 0;
  
      $r->content_type('text/plain');
      if ($r->method_number == Apache::M_POST) {
          $r->print("content: " . ModPerl::Test::read_post($r) ."\n");
      }
  
      my $i=1;
      for (@{ $r->pnotes('INPUT_FILTERS')||[] }) {
          $r->print("input$i: $_\n");
          $i++;
      }
  
      $r->subprocess_env(SSI_TEST => 'SSI OK');
      $r->printf("output1: %s\n", join ',', get_flist($r->output_filters));
  
      $r->rflush;     # this sends the data in the buffer + flush bucket
      $r->print('x<!--#echo var=');
      $r->rflush;     # this sends the data in the buffer + flush bucket
      $r->print('"SSI_TEST" -->x'."\n");
  
      Apache::OK;
  }
  
  sub get_flist {
      my $f = shift;
  
      my @flist = ();
      for (; $f; $f = $f->next) {
          push @flist, $f->frec->name;
      }
  
      return @flist;
  }
  
  1;
  __DATA__
  Options +Includes
  SetHandler modperl
  PerlModule              TestFilter::both_str_native_remove
  PerlResponseHandler     TestFilter::both_str_native_remove::response
  PerlOutputFilterHandler TestFilter::both_str_native_remove::remove_includes
  PerlSetOutputFilter     INCLUDES
  PerlOutputFilterHandler TestFilter::both_str_native_remove::print_out_flist
  PerlInputFilterHandler  TestFilter::both_str_native_remove::store_in_flist
  PerlInputFilterHandler  TestFilter::both_str_native_remove::remove_deflate
  PerlSetInputFilter      DEFLATE
  PerlInputFilterHandler  TestFilter::both_str_native_remove::store_in_flist
  
  
  

Mime
View raw message