The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
<Perl>
  {
   package My::Test;
   use strict;
   use warnings;

   use Apache2::RequestRec ();
   use Apache2::RequestIO ();
   use Apache2::Const -compile=>qw/OK/;

   use ModPerl2::Tools;

   sub spawn1 {
     pipe my ($rd, $wr);
     my $pid=ModPerl2::Tools::spawn +{keep_fd=>[fileno $wr]},
                                    sub {warn "TESTTESTTEST\n";print $wr "$$"};
     close $wr;
     $_[0]->print("$pid:$$:".readline $rd);

     return Apache2::Const::OK;
   }

   sub spawn2 {
     local $^F=1_000_000_000;	# prevent close-on-exec on $wr
     pipe my ($rd, $wr);
     my $fd=fileno $wr;
     my $pid=ModPerl2::Tools::spawn +{keep_fd=>[$fd]},
	                            qw/perl -e/,
				    'warn "TESTTESTTEST\n";
                                     open F, ">&='.$fd.'";
                                     print F "$$"',
				    fileno($wr);
     close $wr;
     $_[0]->print("$pid:$$:".readline $rd);

     return Apache2::Const::OK;
   }

   sub data {
     my $n=$_[0]->args || 1;
     $_[0]->headers_out->{'Content-Length'}=$n*80;
     while($n--) {
       $_[0]->print(("x"x79)."\n");
       $_[0]->rflush;
     }
     return Apache2::Const::OK;
   }

   sub fetch1 {
     $_[0]->print(length $_[0]->fetch_url('/data?'.$_[0]->args));
     return Apache2::Const::OK;
   }

   sub fetch2 {
     use Data::Dumper;
     local $Data::Dumper::Useqq=1;
     local $Data::Dumper::Indent=1;
     $_[0]->print(Dumper($_[0]->fetch_url($_[0]->args)));
     return Apache2::Const::OK;
   }

   sub fetch3 {
     my ($r)=@_;
     my $nchunks=0;
     my $totallen=0;
     my $cl;
     my $status;
     my $data='';
     my ($s, $hdr)=$r->fetch_url($r->args, sub {
       my ($subr, @chunk)=@_;
       if( $nchunks==0 ) {
         $cl=$subr->headers_out->{'Content-Length'};
         $status=$subr->status;
       }
       $nchunks+=@chunk;
       $totallen+=length for (@chunk);
       $data.=join '', @chunk;
     });
     no warnings 'uninitialized';
     $r->print(<<"EOF");
nchunks=$nchunks
totallen=$totallen
cl=$cl
CL=$hdr->{'content-length'}
status=$status
s='$s'

$data
EOF

     return Apache2::Const::OK;
   }

   sub fetch4 {
     use Apache::TestRequest ();
     my ($r)=@_;
     my $url='/hdrs';
     $url=Apache::TestRequest::resolve_url($url) if $r->args eq 'use_proxy';
     $r->print("including $url\n");     
     $r->fetch_url($url, [qw/X-MyHdr my-hdr/], sub {shift; $r->print(@_)});
     return Apache2::Const::OK;
   }

   sub hdrs {
     my ($r)=@_;
     use APR::Table ();
     $r->headers_in->do(sub {$r->print("$_[0]: $_[1]\n"); 1});
     return Apache2::Const::OK;
   }

   sub req_die {
     $_[0]->safe_die(410);
     my $n=10;
     while($n--) {
       $_[0]->print(("x"x79)."\n");
       $_[0]->rflush;
     }
     return Apache2::Const::OK;
   }
  }

  {
    package My::Filter;
    use strict;
    use warnings;

    use ModPerl2::Tools;
    use base 'Apache2::Filter';

    sub handler : FilterRequestHandler {
      my ($f, $bb)=@_;
      return $f->safe_die(410);
    }
  }
</Perl>

<Location /spawn1>
  SetHandler modperl
  PerlResponseHandler My::Test::spawn1
</Location>

<Location /spawn2>
  SetHandler modperl
  PerlResponseHandler My::Test::spawn2
</Location>

<Location /data>
  SetHandler modperl
  PerlResponseHandler My::Test::data
</Location>

<Location /fetch1>
  SetHandler modperl
  PerlResponseHandler My::Test::fetch1
</Location>

<Location /fetch2>
  SetHandler modperl
  PerlResponseHandler My::Test::fetch2
</Location>

<Location /fetch3>
  SetHandler modperl
  PerlResponseHandler My::Test::fetch3
</Location>

<Location /fetch4>
  SetHandler modperl
  PerlResponseHandler My::Test::fetch4
</Location>

<Location /hdrs>
  SetHandler modperl
  PerlResponseHandler My::Test::hdrs
</Location>

PerlModule ModPerl::Registry
Alias /perl @DocumentRoot@/perl
<Location /perl>
  SetHandler perl-script
  PerlResponseHandler ModPerl::Registry
  PerlOptions +ParseHeaders
  Options +ExecCGI
</Location>

<Location /filter_die>
  SetHandler modperl
  PerlResponseHandler My::Test::data
  PerlOutputFilterHandler My::Filter::handler
</Location>

<Location /req_die>
  SetHandler modperl
  PerlResponseHandler My::Test::req_die
</Location>

<Location /dir>
    Options +Indexes
</Location>