Apache2-API
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
t/lib/Test/Apache2/Common.pm view on Meta::CPAN
package Test::Apache2::Common;
BEGIN
{
use strict;
use warnings;
use lib './lib';
use Apache2::Connection ();
use Apache2::Const -compile => qw( :common :http OK DECLINED );
use Apache2::RequestIO ();
use Apache2::RequestRec ();
# so we can get the request as a string
use Apache2::RequestUtil ();
use Apache::TestConfig;
use APR::URI ();
use Apache2::API;
use Module::Generic::File qw( file );
use Scalar::Util;
};
use strict;
use warnings;
our $config = Apache::TestConfig->thaw->httpd_config;
our $class2log = {};
sub handler : method
{
my( $class, $r ) = @_;
my $debug = $r->dir_config( 'API_DEBUG' );
$r->log_error( "${class}: Received request for uri \"", $r->uri, "\" matching file \"", $r->filename, "\": ", $r->as_string );
my $uri = APR::URI->parse( $r->pool, $r->uri );
my $path = [split( '/', $uri->path )]->[-1];
my $api = Apache2::API->new( $r, debug => $debug, compression_threshold => 102400 ) || do
{
$r->log_error( "$class: Error instantiating Apache2::API object: ", Apache2::API->error );
return( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
};
my $self = bless( { request => $r, api => $api, debug => int( $r->dir_config( 'API_DEBUG' ) ) } => $class );
my $code = $self->can( $path );
if( !defined( $code ) )
{
$r->log_error( "No method \"$path\" for testing." );
return( Apache2::Const::DECLINED );
}
$r->err_headers_out->set( 'Test-No' => $path );
my $rc = $code->( $self );
$r->log_error( "$class: Returning HTTP code '$rc' for method '$path'" );
if( $rc == Apache2::Const::HTTP_OK )
{
# https://perl.apache.org/docs/2.0/user/handlers/intro.html#item_RUN_FIRST
# return( Apache2::Const::DONE );
return( Apache2::Const::OK );
}
else
{
return( $rc );
}
# $r->connection->client_socket->close();
exit(0);
}
sub api { return( shift->{api} ); }
sub request { return( shift->{request} ); }
sub debug
{
my $self = shift( @_ );
$self->{debug} = shift( @_ ) if( @_ );
return( $self->{debug} );
}
sub error
{
my $self = shift( @_ );
my $r = $self->request;
$r->status( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
my $ref = [@_];
my $error = join( '', map( ( ref( $_ ) eq 'CODE' ) ? $_->() : ( $_ // '' ), @$ref ) );
warn( $error );
$r->log_error( $error );
$r->print( $error );
$r->rflush;
return;
}
sub failure { return( shift->reply( Apache2::Const::HTTP_EXPECTATION_FAILED => 'failed' ) ); }
sub is
{
my $self = shift( @_ );
my( $what, $expect ) = @_;
return( $self->success ) if( $what eq $expect );
return( $self->reply( Apache2::Const::HTTP_EXPECTATION_FAILED => "failed\nI was expecting \"$expect\", but got \"$what\"." ) );
}
sub message
{
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.307 second using v1.00-cache-2.02-grep-82fe00e-cpan-f73e49a70403 )