Apache2-API
view release on metacpan or search on metacpan
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
sub payload { return( shift->_test({ method => 'payload', expect => sub
{
my $ref = shift( @_ );
my $opts = shift( @_ );
if( eval( 'require Data::Dump;' ) )
{
$opts->{log}->( "\$ref is (", ( $ref // 'undef' ), ") -> ", Data::Dump::dump( $ref ) );
}
return( ref( $ref ) eq 'HASH' && ( exists( $ref->{client_id} ) && $ref->{client_id} eq '37c58138-e259-44aa-9eee-baf3cbecca75' ) );
} }) ); }
# NOTE: en-GB,fr-FR;q=0.8,fr;q=0.6,ja;q=0.4,en;q=0.2 -> en-GB
sub preferred_language { return( shift->_test({ method => 'preferred_language', expect => 'en-GB', args => [[qw(fr-FR ja-JP en-GB en)]] }) ); }
sub protocol { return( shift->_test({ method => 'protocol', expect => 'HTTP/1.1' }) ); }
# NOTE: special processing
sub query { return( shift->_test({ method => 'query', expect => sub
{
my $ref = shift( @_ );
my $opts = shift( @_ );
if( eval( 'require Data::Dump;' ) )
{
$opts->{log}->( "\$ref is: ", Data::Dump::dump( $ref ) );
}
return(
( exists( $ref->{foo} ) && $ref->{foo} == 1 ) &&
( exists( $ref->{bar} ) && $ref->{bar} == 3 ) &&
( exists( $ref->{lang} ) && $ref->{lang} eq 'ja_JP' )
);
} }) ); }
# NOTE: special processing
sub query_string { return( shift->_test({ method => 'query_string', expect => 'foo=bar&lang=ja-JP&q=%E6%9C%80%E9%AB%98%E3%81%A0%EF%BC%81' }) ); }
sub referer { return( shift->_test({ method => 'referer', expect => 'https://example.org/some/where.html' }) ); }
sub remote_addr { return( shift->_test({ method => 'remote_addr', expect => 'APR::SockAddr', type => 'isa' }) ); }
sub request_time { return( shift->_test({ method => 'request_time', expect => 'DateTime::Lite', type => 'isa' }) ); }
# requires
# satisfies
# script_filename
# script_name
# script_uri
# script_url
# Apache2::ServerUtil->server
sub server { return( shift->_test({ method => 'server', expect => 'Apache2::ServerRec', type => 'isa' }) ); }
# server_addr
# server_admin
# server_hostname
# server_name
# server_port
# server_protocol
# server_signature
# server_software
# server_version
# set_basic_credentials
# set_handlers
# slurp_filename
sub socket { return( shift->_test({ method => 'socket', expect => 'APR::Socket', type => 'isa' }) ); }
# status
# status_line
# str2datetime
# str2time
# subnet_of
sub subprocess_env { return( shift->_test({ method => 'subprocess_env', expect => 'APR::Table', type => 'isa' }) ); }
sub the_request { return( shift->_test({ method => 'the_request', expect => 'GET /tests/request/the_request HTTP/1.1' }) ); }
# time2datetime
# 2021-11-1T167:12:10+0900
sub time2str { return( shift->_test({ method => 'time2str', expect => 'Mon, 01 Nov 2021 08:12:10 GMT', args => [1635754330] }) ); }
sub type { return( shift->_test({ method => 'type', expect => 'text/plain' }) ); }
# unparsed_uri
# uploads
sub uri { return( shift->_test({ method => 'uri', expect => 'URI', type => 'isa' }) ); }
# url_decode
# url_encode
# user
sub user_agent { return( shift->_test({ method => 'user_agent', expect => 'Test-Apache2-API/v0.1.0' }) ); }
sub _target { return( shift->api->request ); }
1;
# NOTE: POD
# Use this to generate the tests list:
# egrep -E '^sub ' ./t/lib/Test/Apache2/API/Request.pm | perl -lnE 'my $m = [split(/\s+/, $_)]->[1]; say "=head2 $m\n"'
__END__
=encoding utf8
=head1 NAME
Test::Apache2::API::Request - Apache2::API::Request Testing Class
=head1 SYNOPSIS
my $hostport = Apache::TestRequest::hostport( $config ) || '';
my( $host, $port ) = split( ':', ( $hostport ) );
my $mp_host = 'www.example.org';
Apache::TestRequest::user_agent(reset => 1, keep_alive => 1 );
my $ua = Apache::TestRequest->new;
# To get the fingerprint for the certificate in ./t/server.crt, do:
# echo "sha1\$$(openssl x509 -noout -in ./t/server.crt -fingerprint -sha1|perl -pE 's/^.*Fingerprint=|(\w{2})(?:\:?|$)/$1/g')"
$ua->ssl_opts(
# SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE,
# SSL_verify_mode => 0x00
# verify_hostname => 0,
( run in 2.064 seconds using v1.01-cache-2.11-cpan-140bd7fdf52 )