"Fossies" - the Fresh Open Source Software Archive

Member "mod_perl-2.0.11/t/filter/TestFilter/out_str_remove.pm" (5 Oct 2019, 1681 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_str_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::out_str_remove;
    3 
    4 use strict;
    5 use warnings FATAL => 'all';
    6 
    7 use Apache::Test;
    8 use Apache::TestUtil;
    9 
   10 use Apache2::RequestRec ();
   11 use Apache2::RequestIO ();
   12 
   13 use Apache2::Filter ();
   14 
   15 use Apache2::Const -compile => qw(OK);
   16 
   17 use constant READ_SIZE  => 1024;
   18 
   19 # this filter reads the first bb, upcases the data in it and removes itself
   20 sub upcase_n_remove {
   21       my $filter = shift;
   22 
   23       #warn "filter upcase_n_remove called\n";
   24       while ($filter->read(my $buffer, 1024)) {
   25           $filter->print(uc $buffer);
   26       }
   27 
   28       $filter->remove;
   29 
   30       return Apache2::Const::OK;
   31 }
   32 
   33 # this filter inserts underscores after each character it receives
   34 sub insert_underscores {
   35       my $filter = shift;
   36 
   37       #warn "filter insert_underscores called\n";
   38       while ($filter->read(my $buffer, 1024)) {
   39           $buffer =~ s/(.)/$1_/g;
   40           $filter->print($buffer);
   41       }
   42 
   43       return Apache2::Const::OK;
   44 }
   45 
   46 
   47 sub response {
   48     my $r = shift;
   49 
   50     # just to make sure that print() won't flush, or we would get the
   51     # count wrong
   52     local $| = 0;
   53 
   54     $r->content_type('text/plain');
   55     $r->print("Foo");
   56     $r->rflush;     # this sends the data in the buffer + flush bucket
   57     $r->print("bar");
   58 
   59     Apache2::Const::OK;
   60 }
   61 1;
   62 __DATA__
   63 SetHandler modperl
   64 PerlModule              TestFilter::out_str_remove
   65 PerlResponseHandler     TestFilter::out_str_remove::response
   66 PerlOutputFilterHandler TestFilter::out_str_remove::insert_underscores
   67 PerlOutputFilterHandler TestFilter::out_str_remove::upcase_n_remove