← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libapache2-mod-perl2/edgy

« back to all changes in this revision

Viewing changes to t/filter/TestFilter/both_str_native_remove.pm

  • Committer: Bazaar Package Importer
  • Author(s): Andres Salomon
  • Date: 2005-08-12 01:40:38 UTC
  • mfrom: (1.1.2 upstream) (2.1.1 sarge)
  • Revision ID: james.westby@ubuntu.com-20050812014038-gjigefs55pqx4qc8
Tags: 2.0.1-3
Grr.  Really include perl.conf file; it got lost due to diff not
wanting to add an empty file.

Show diffs side-by-side

added added

removed removed

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