← 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/out_str_buffer.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/out_str_buffer.pm
 
1
package TestFilter::out_str_buffer;
 
2
 
 
3
# in this test we want to buffer the data, modify the length of the
 
4
# response, set the c-l header and make sure that the client sees the
 
5
# right thing
 
6
#
 
7
# notice that a bucket brigades based filter must be used. The streaming
 
8
# API lets FLUSH buckets through which causes an early flush of HTTP
 
9
# response headers
 
10
 
 
11
use strict;
 
12
use warnings FATAL => 'all';
 
13
 
 
14
use Apache2::RequestRec ();
 
15
use Apache2::RequestIO ();
 
16
 
 
17
use APR::Table ();
 
18
use APR::Bucket ();
 
19
use APR::Brigade ();
 
20
 
 
21
use TestCommon::Utils ();
 
22
 
 
23
use base qw(Apache2::Filter);
 
24
 
 
25
use Apache2::Const -compile => qw(OK M_POST);
 
26
use APR::Const     -compile => ':common';
 
27
 
 
28
sub flatten_bb {
 
29
    my ($bb) = shift;
 
30
 
 
31
    my $seen_eos = 0;
 
32
 
 
33
    my @data;
 
34
    for (my $b = $bb->first; $b; $b = $bb->next($b)) {
 
35
        $seen_eos++, last if $b->is_eos;
 
36
        $b->read(my $bdata);
 
37
        push @data, $bdata;
 
38
    }
 
39
    return (join('', @data), $seen_eos);
 
40
}
 
41
 
 
42
sub handler {
 
43
    my($filter, $bb) = @_;
 
44
 
 
45
    my $ctx = $filter->ctx;
 
46
 
 
47
    # no need to unset the C-L header, since this filter makes sure to
 
48
    # correct it before any headers go out.
 
49
    #unless ($ctx) {
 
50
    #    $filter->r->headers_out->unset('Content-Length');
 
51
    #}
 
52
 
 
53
    my $data = exists $ctx->{data} ? $ctx->{data} : '';
 
54
    $ctx->{invoked}++;
 
55
    my($bdata, $seen_eos) = flatten_bb($bb);
 
56
    $bdata =~ s/-//g;
 
57
    $data .= $bdata if $bdata;
 
58
 
 
59
    if ($seen_eos) {
 
60
        my $len = length $data;
 
61
        $filter->r->headers_out->set('Content-Length', $len);
 
62
        $filter->print($data) if $data;
 
63
    }
 
64
    else {
 
65
        # store context for all but the last invocation
 
66
        $ctx->{data} = $data;
 
67
        $filter->ctx($ctx);
 
68
    }
 
69
 
 
70
    return Apache2::Const::OK;
 
71
}
 
72
 
 
73
sub response {
 
74
    my $r = shift;
 
75
 
 
76
    $r->content_type('text/plain');
 
77
 
 
78
    my $data = '';
 
79
    if ($r->method_number == Apache2::Const::M_POST) {
 
80
        $data = TestCommon::Utils::read_post($r);
 
81
        $r->headers_out->set('Content-Length' => length $data);
 
82
    }
 
83
 
 
84
    for my $chunk (split /0/, $data) {
 
85
        $r->print($chunk);
 
86
        $r->rflush; # so the filter reads a chunk at a time
 
87
    }
 
88
 
 
89
    return Apache2::Const::OK;
 
90
}
 
91
 
 
92
1;
 
93
__DATA__
 
94
 
 
95
SetHandler modperl
 
96
PerlModule          TestFilter::out_str_buffer
 
97
PerlResponseHandler TestFilter::out_str_buffer::response
 
98