"Fossies" - the Fresh Open Source Software Archive

Member "mod_perl-2.0.11/t/filter/TestFilter/both_str_native_remove.pm" (5 Oct 2019, 3562 Bytes) of package /linux/www/apache_httpd_modules/mod_perl-2.0.11.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "both_str_native_remove.pm": 2.0.8_vs_2.0.9.

    1 # please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
    2 package TestFilter::both_str_native_remove;
    3 
    4 # this tests verifies that we can remove input and output native
    5 # (non-mod_perl filters)
    6 
    7 use strict;
    8 use warnings FATAL => 'all';
    9 
   10 use Apache2::RequestRec ();
   11 use Apache2::RequestIO ();
   12 
   13 use Apache2::Filter ();
   14 use Apache2::FilterRec ();
   15 
   16 use APR::Table ();
   17 
   18 use TestCommon::Utils ();
   19 
   20 use Apache2::Const -compile => qw(OK DECLINED M_POST);
   21 
   22 # this filter removes the next filter in chain and itself
   23 sub remove_includes {
   24     my $f = shift;
   25 
   26     my $args = $f->r->args || '';
   27     if ($args eq 'remove') {
   28         my $ff = $f->next;
   29         $ff->remove if $ff && $ff->frec->name eq 'includes';
   30     }
   31 
   32     $f->remove;
   33 
   34     return Apache2::Const::DECLINED;
   35 }
   36 
   37 # this filter removes the next filter in chain and itself
   38 sub remove_deflate {
   39     my $f = shift;
   40 
   41     my $args = $f->r->args || '';
   42     if ($args eq 'remove') {
   43         for (my $ff = $f->r->input_filters; $ff; $ff = $ff->next) {
   44             if ($ff->frec->name eq 'deflate') {
   45                 $ff->remove;
   46                 last;
   47             }
   48         }
   49     }
   50     $f->remove;
   51 
   52     return Apache2::Const::DECLINED;
   53 }
   54 
   55 # this filter appends the output filter list at eos
   56 sub print_out_flist {
   57     my $f = shift;
   58 
   59     unless ($f->ctx) {
   60         $f->ctx(1);
   61         $f->r->headers_out->unset('Content-Length');
   62     }
   63 
   64     while ($f->read(my $buffer, 1024)) {
   65         $f->print($buffer);
   66     }
   67 
   68     if ($f->seen_eos) {
   69         my $flist = join ',', get_flist($f->r->output_filters);
   70         $f->print("output2: $flist\n");
   71     }
   72 
   73     return Apache2::Const::OK;
   74 }
   75 
   76 sub store_in_flist {
   77     my $f = shift;
   78     my $r = $f->r;
   79 
   80     unless ($f->ctx) {
   81         my $x = $r->pnotes('INPUT_FILTERS') || [];
   82         push @$x, join ',', get_flist($f->r->input_filters);
   83         $r->pnotes('INPUT_FILTERS' => $x);
   84     }
   85 
   86     return Apache2::Const::DECLINED;
   87 }
   88 
   89 
   90 sub response {
   91     my $r = shift;
   92 
   93     # just to make sure that print() won't flush, or we would get the
   94     # count wrong
   95     local $| = 0;
   96 
   97     $r->content_type('text/plain');
   98     if ($r->method_number == Apache2::Const::M_POST) {
   99         $r->print("content: " . TestCommon::Utils::read_post($r) ."\n");
  100     }
  101 
  102     my $i=1;
  103     for (@{ $r->pnotes('INPUT_FILTERS')||[] }) {
  104         $r->print("input$i: $_\n");
  105         $i++;
  106     }
  107 
  108     $r->subprocess_env(SSI_TEST => 'SSI OK');
  109     $r->printf("output1: %s\n", join ',', get_flist($r->output_filters));
  110 
  111     $r->rflush;     # this sends the data in the buffer + flush bucket
  112     $r->print('x<!--#echo var=');
  113     $r->rflush;     # this sends the data in the buffer + flush bucket
  114     $r->print('"SSI_TEST" -->x'."\n");
  115 
  116     Apache2::Const::OK;
  117 }
  118 
  119 sub get_flist {
  120     my $f = shift;
  121 
  122     my @flist = ();
  123     for (; $f; $f = $f->next) {
  124         push @flist, $f->frec->name;
  125     }
  126 
  127     return @flist;
  128 }
  129 
  130 1;
  131 __DATA__
  132 Options +Includes
  133 SetHandler modperl
  134 PerlModule              TestFilter::both_str_native_remove
  135 PerlResponseHandler     TestFilter::both_str_native_remove::response
  136 PerlOutputFilterHandler TestFilter::both_str_native_remove::remove_includes
  137 PerlSetOutputFilter     INCLUDES
  138 PerlOutputFilterHandler TestFilter::both_str_native_remove::print_out_flist
  139 PerlInputFilterHandler  TestFilter::both_str_native_remove::store_in_flist
  140 PerlInputFilterHandler  TestFilter::both_str_native_remove::remove_deflate
  141 PerlSetInputFilter      DEFLATE
  142 PerlInputFilterHandler  TestFilter::both_str_native_remove::store_in_flist