view release on metacpan or  search on metacpan

lib/Apache2/FakeRequest.pm  view on Meta::CPAN

package Apache2::FakeRequest;

use base 'Apache2::Request';
use strict;

our $VERSION = '0.04';

sub new {
    my $class = shift;
    bless {@_}, $class;
}

sub print { shift; CORE::print(@_) }

#dummy method stubs
my @methods = qw{
  allow_options
  as_string auth_name auth_type
  basic_http_header bootstrap bytes_sent
  can_stack_handlers cgi_env cgi_header_out
  cgi_var clear_rgy_endav connection
  content content_encoding content_language
  content_type dir_config document_root
  err_header_out err_headers_out exit
  filename get_basic_auth_pw get_remote_host
  get_remote_logname handler hard_timeout
  header_in header_only header_out
  headers_in headers_out hostname import
  internal_redirect_handler is_initial_req is_main
  kill_timeout log_error log_reason
  lookup_file lookup_uri main
  max_requests_per_child method method_number
  module next no_cache
  note_basic_auth_failure notes
  path_info perl_hook post_connection prev
  protocol proxyreq push_handlers
  query_string read read_client_block
  read_length register_cleanup request
  requires reset_timeout rflush
  send_cgi_header send_fd send_http_header
  sent_header seqno server
  server_root_relative soft_timeout status
  status_line subprocess_env taint
  the_request translate_name unescape_url
  unescape_url_info untaint uri warn
  write_client 
};

sub elem {
    my($self, $key, $val) = @_;
    return
        unless ref($self) eq 'Apache2::FakeRequest';

    $self->{$key} = $val if $val;
    $self->{$key};
}

sub parse_args {
    my($wantarray,$string) = @_;
    return unless defined $string and $string;
    if(defined $wantarray and $wantarray) {
        return map { 
	    s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
	    $_;
	} split /[=&;]/, $string, -1;
    }
    $string;
}

sub args {
    my($r,$val) = @_;
    $r->{args} = $val if $val;
    parse_args(wantarray, $r->{args});
}

sub param {
    my $self = shift;
    my $param = shift;
    return
        if ( !exists $self->{param} || ( $param && !exists $self->{param}{$param} ) );

    return $param ? $self->{param}{$param} || $self->{param} : $self->{param};
}


{
    my @code;
    for my $meth (@methods) {
	push @code, "sub $meth { shift->elem('$meth', \@_) };";
    }
    eval "@code";
    die $@ if $@;
}


package Apache2::Const;

sub OK          		{  0 }
sub DECLINED    		{ -1 }
sub DONE        		{ -2 }

sub CONTINUE                    { 100 }
sub DOCUMENT_FOLLOWS            { 200 }
sub NOT_AUTHORITATIVE           { 203 }
sub HTTP_NO_CONTENT             { 204 }