Apache2::ASP::Mock::RequestRec - Mimics the mod_perl2 Apache2::RequestRec object ($r)

  my $r = Apache2::ASP::HTTPContext->current->r;

  $r->filename( '/index.asp' );   # '/usr/local/projects/mysite.com/htdocs/index.asp

  $r->pnotes( foo => 'bar' );     # set foo = 'bar'
  my $foo = $r->pnotes( 'foo' );  # get foo

  my $output_buffer_contents = $r->buffer;

  my $mock_apr_pool = $r->pool;

  $r->status( '302 Found' );
  my $status = $r->status;

  my $uri = $r->uri;
  $r->uri('/new.asp');

  my $method = $r->method;  # get/post

  $r->content_type( 'text/html' );
  my $type = $r->content_type;

  my $mock_connection = $r->connection;

  $r->print( 'some string' );

  $r->rflush;

package Apache2::ASP::Mock::RequestRec;

use strict;
use warnings 'all';
use Carp 'confess';
use Apache2::ASP::Mock::Connection;
use Apache2::ASP::Mock::Pool;
use HTTP::Headers;


#==============================================================================
sub new
{
  my ($class) = shift;

  my $s = bless {
    buffer            => '',
    uri               => '',
    headers_out       => HTTP::Headers->new,
    headers_in        => { },
    pnotes            => { },
    status            => 200,
    cleanup_handlers  => [ ],
    pool              => Apache2::ASP::Mock::Pool->new(),
    connection        => Apache2::ASP::Mock::Connection->new(),
  }, $class;
  $s->{err_headers_out} = $s->{headers_out};
  return $s;
}# end new()


#==============================================================================
sub push_handlers
{
  my ($s, $ref, @args) = @_;
  
  push @{$s->{cleanup_handlers}}, {
    subref => $ref,
    args   => \@args,
  };
}# end push_handlers()


#==============================================================================
sub filename
{
  my $s = shift;
  
  my $config = Apache2::ASP::HTTPContext->current->config;
  
  return $config->web->www_root . $s->uri;
}# end filename()


#==============================================================================
sub pnotes
{
  my $s = shift;
  my $key = shift;
  
  @_ ? $s->{pnotes}->{$key} = shift : $s->{pnotes}->{$key};
}# end pnotes()


#==============================================================================
sub buffer
{
  $_[0]->{buffer};
}# end buffer()


#==============================================================================
sub pool
{
  $_[0]->{pool};
}# end buffer()


#==============================================================================
sub status
{
  my $s = shift;
  
  @_ ? $s->{status} = shift : $s->{status};
}# end status()


#==============================================================================
sub uri
{
  my $s = shift;
  
  if( @_ )
  {
    $s->{uri} = shift;
    # Should we also set $ENV{REQUEST_URI} here?
  }
  else
  {
    return $s->{uri};
  }# end if()
}# end uri()


#==============================================================================
sub args
{
  my $s = shift;
  @_ ? $s->{args} = shift : $s->{args};
}# end args()


#==============================================================================
sub method
{
  my $s = shift;
  @_ ? $s->{method} = shift : $s->{method};
}# end method()


#==============================================================================
#XXX Not documented.
sub headers_out
{
  $_[0]->{headers_out};
}# end headers_out()


#==============================================================================
#XXX Not documented.
sub err_headers_out
{
  $_[0]->{headers_out};
}# end err_headers_out()


#==============================================================================
#XXX Not documented.
sub headers_in
{
  $_[0]->{headers_in};
}# end headers_out()


#==============================================================================
#XXX Not documented.
sub send_headers
{
  my $s = shift;
  
  my $buffer = delete($s->{buffer});
  $s->print( join "\n", map { "$_: $s->{headers_out}->{$_}" } keys(%{$s->{headers_out}}) );
  $s->{buffer} = $buffer;
}# end send_headers()


#==============================================================================
sub content_type
{
  my $s = shift;
  @_ ? $s->{content_type} = shift : $s->{content_type};
}# end content_type()


#==============================================================================
sub print
{
  $_[0]->{buffer} .= $_[1];
}# end print()


#==============================================================================
sub rflush
{
  my $s = shift;
#warn "$s: rflush()";
}# end rflush()


#==============================================================================
sub connection
{
  $_[0]->{connection};
}# end connection()


#==============================================================================
sub document_root
{
  $ENV{DOCUMENT_ROOT};
}# end document_root()

1;# return true: