"Fossies" - the Fresh Open Source Software Archive

Member "mod_perl-2.0.11/t/filter/TestFilter/out_bbs_filebucket.pm" (5 Oct 2019, 1503 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 "out_bbs_filebucket.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::out_bbs_filebucket;
    3 
    4 # testing how the filter handles file buckets
    5 
    6 use strict;
    7 use warnings FATAL => 'all';
    8 
    9 use Apache2::RequestRec ();
   10 use Apache2::RequestIO ();
   11 use Apache2::Filter;
   12 use Apache2::URI ();
   13 
   14 use APR::Brigade ();
   15 use APR::Bucket ();
   16 
   17 use Apache::TestTrace;
   18 
   19 use Apache2::Const -compile => qw(OK);
   20 use APR::Const    -compile => qw(SUCCESS);
   21 
   22 use constant BLOCK_SIZE => 5003;
   23 
   24 sub handler {
   25     my ($filter, $bb) = @_;
   26 
   27     debug "FILTER INVOKED";
   28 
   29     my $cnt = 0;
   30     for (my $b = $bb->first; $b; $b = $bb->next($b)) {
   31 
   32         $cnt++;
   33         debug "reading bucket #$cnt";
   34 
   35         last if $b->is_eos;
   36 
   37         if (my $len = $b->read(my $data)) {
   38             my $nb = APR::Bucket->new($bb->bucket_alloc, uc $data);
   39             $b->insert_before($nb);
   40             $b->delete;
   41             $b = $nb;
   42         }
   43     }
   44 
   45     return $filter->next->pass_brigade($bb);
   46 }
   47 
   48 sub response {
   49     my $r = shift;
   50 
   51     debug "\n-------- new request ----------";
   52 
   53     $r->content_type('text/plain');
   54 
   55     my $file = $r->args;
   56     Apache2::URI::unescape_url($file);
   57     $r->sendfile($file);
   58 
   59     return Apache2::Const::OK;
   60 }
   61 
   62 1;
   63 __DATA__
   64 SetHandler modperl
   65 PerlModule              TestFilter::out_bbs_filebucket
   66 PerlResponseHandler     TestFilter::out_bbs_filebucket::response
   67 PerlOutputFilterHandler TestFilter::out_bbs_filebucket::handler