perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject svn commit: r169395 - in /perl/modperl/trunk/t/filter: TestFilter/out_str_buffer.pm out_str_buffer.t
Date Tue, 10 May 2005 02:08:51 GMT
Author: stas
Date: Mon May  9 19:08:49 2005
New Revision: 169395

URL: http://svn.apache.org/viewcvs?rev=169395&view=rev
Log:
add a test which demonstrates the buffering of data, modifying its length and 
setting the correct C-L header before sending it out

Added:
    perl/modperl/trunk/t/filter/TestFilter/out_str_buffer.pm   (with props)
    perl/modperl/trunk/t/filter/out_str_buffer.t   (with props)

Added: perl/modperl/trunk/t/filter/TestFilter/out_str_buffer.pm
URL: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/out_str_buffer.pm?rev=169395&view=auto
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/out_str_buffer.pm (added)
+++ perl/modperl/trunk/t/filter/TestFilter/out_str_buffer.pm Mon May  9 19:08:49 2005
@@ -0,0 +1,98 @@
+package TestFilter::out_str_buffer;
+
+# in this test we want to buffer the data, modify the length of the
+# response, set the c-l header and make sure that the client sees the
+# right thing
+#
+# notice that a bucket brigades based filter must be used. The streaming
+# API lets FLUSH buckets through which causes an early flush of HTTP
+# response headers
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+
+use APR::Table ();
+use APR::Bucket ();
+use APR::Brigade ();
+
+use TestCommon::Utils ();
+
+use base qw(Apache2::Filter);
+
+use Apache2::Const -compile => qw(OK M_POST);
+use APR::Const     -compile => ':common';
+
+sub flatten_bb {
+    my ($bb) = shift;
+
+    my $seen_eos = 0;
+
+    my @data;
+    for (my $b = $bb->first; $b; $b = $bb->next($b)) {
+        $seen_eos++, last if $b->is_eos;
+        $b->read(my $bdata);
+        push @data, $bdata;
+    }
+    return (join('', @data), $seen_eos);
+}
+
+sub handler {
+    my($filter, $bb) = @_;
+
+    my $ctx = $filter->ctx;
+
+    # no need to unset the C-L header, since this filter makes sure to
+    # correct it before any headers go out.
+    #unless ($ctx) {
+    #    $filter->r->headers_out->unset('Content-Length');
+    #}
+
+    my $data = exists $ctx->{data} ? $ctx->{data} : '';
+    $ctx->{invoked}++;
+    my($bdata, $seen_eos) = flatten_bb($bb);
+    $bdata =~ s/-//g;
+    $data .= $bdata if $bdata;
+
+    if ($seen_eos) {
+        my $len = length $data;
+        $filter->r->headers_out->set('Content-Length', $len);
+        $filter->print($data) if $data;
+    }
+    else {
+        # store context for all but the last invocation
+        $ctx->{data} = $data;
+        $filter->ctx($ctx);
+    }
+
+    return Apache2::Const::OK;
+}
+
+sub response {
+    my $r = shift;
+
+    $r->content_type('text/plain');
+
+    my $data = '';
+    if ($r->method_number == Apache2::Const::M_POST) {
+        $data = TestCommon::Utils::read_post($r);
+        $r->headers_out->set('Content-Length' => length $data);
+    }
+
+    for my $chunk (split /0/, $data) {
+        $r->print($chunk);
+        $r->rflush; # so the filter reads a chunk at a time
+    }
+
+    return Apache2::Const::OK;
+}
+
+1;
+__DATA__
+
+SetHandler modperl
+PerlModule          TestFilter::out_str_buffer
+PerlResponseHandler TestFilter::out_str_buffer::response
+

Propchange: perl/modperl/trunk/t/filter/TestFilter/out_str_buffer.pm
------------------------------------------------------------------------------
    svn:eol-style = native

Added: perl/modperl/trunk/t/filter/out_str_buffer.t
URL: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/out_str_buffer.t?rev=169395&view=auto
==============================================================================
--- perl/modperl/trunk/t/filter/out_str_buffer.t (added)
+++ perl/modperl/trunk/t/filter/out_str_buffer.t Mon May  9 19:08:49 2005
@@ -0,0 +1,22 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+
+plan tests => 2;
+
+my $sep = "-0-";
+my $data = join $sep, "aa" .. "zz";
+
+(my $expected = $data) =~ s/$sep//g;
+my $expected_len = length $expected;
+
+my $location = '/TestFilter__out_str_buffer';
+my $res = POST $location, content => $data;
+#t_debug $res->as_string;
+my $received_len = $res->header('Content-Length') || 0;
+ok t_cmp $received_len, $expected_len, "Content-Length header";
+ok t_cmp $res->content, $expected, "filtered data";
+

Propchange: perl/modperl/trunk/t/filter/out_str_buffer.t
------------------------------------------------------------------------------
    svn:eol-style = native



Mime
View raw message