Apache2-API
view release on metacpan or search on metacpan
lib/Apache2/API/Request.pm view on Meta::CPAN
sub init
{
my $self = shift( @_ );
my $r;
$r = shift( @_ ) if( @_ % 2 );
$self->{request} = $r;
$self->{checkonly} = 0;
$self->SUPER::init( @_ ) || return( $self->pass_error );
$r ||= $self->{request};
$self->{accept_charset} = undef;
$self->{auth} = undef;
$self->{charset} = undef;
$self->{client_api_version} = undef;
$self->{_server_version} = undef;
# Which is an Apache2::Request, but inherits everything from Apache2::RequestRec and APR::Request::Apache2
unless( $self->{checkonly} )
{
return( $self->error( "No Apache2::RequestRec was provided." ) ) if( !$r );
return( $self->error( "Apache2::RequestRec provided ($r) is not an object!" ) ) if( !Scalar::Util::blessed( $r ) );
return( $self->error( "I was expecting an Apache2::RequestRec, but instead I got \"$r\"." ) ) if( !$r->isa( 'Apache2::RequestRec' ) );
$self->{request} = $r;
# Important as few other methods rely on this
$self->{apr} = APR::Request::Apache2->handle( $r );
my $headers = $self->headers;
# rfc 6750 <https://tools.ietf.org/html/rfc6750>
my $auth = $headers->{Authorization};
$self->auth( $auth ) if( length( $auth ) );
# Content-Type: application/json; charset=utf-8
my $ctype_raw = $self->content_type;
# Accept: application/json; version=1.0; charset=utf-8
my $accept_raw = $self->accept;
# Returns an array of Module::Generic::HeaderValue objects
my $accept_all = $self->acceptables;
my( $ctype_def, $ctype );
if( defined( $ctype_raw ) && CORE::length( $ctype_raw // '' ) )
{
$ctype_def = Module::Generic::HeaderValue->new_from_header( $ctype_raw );
$ctype = lc( $ctype_def->value->first // '' );
$self->type( $ctype );
my $enc = $ctype_def->param( 'charset' );
$self->charset( $enc ) if( defined( $enc ) && length( $enc ) );
}
if( defined( $accept_all ) && !$accept_all->is_empty )
{
my $accept_def = $accept_all->first;
$self->accept_type( $accept_def->value->first );
$self->client_api_version( $accept_def->param( 'version' ) );
$self->accept_charset( $accept_def->param( 'charset' ) );
}
my $json = $self->json;
my $payload = $self->data;
# An error occurred while reading the payload, because even empty, data would return an empty string.
return( $self->pass_error ) if( !defined( $payload ) );
if( defined( $ctype ) &&
$ctype eq 'application/json' &&
CORE::length( $payload ) )
{
lib/Apache2/API/Request.pm view on Meta::CPAN
}
return( $self );
}
# Tells whether the connection has been aborted or not
sub aborted { return( shift->_try( 'connection', 'aborted' ) ); }
# e.g. text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
sub accept { return( shift->headers->{ 'Accept' } ); }
sub accept_charset { return( shift->_set_get_scalar( 'accept_charset', @_ ) ); }
# e.g. gzip, deflate, br
sub accept_encoding { return( shift->headers->{ 'Accept-Encoding' } ); }
# e.g.: en-GB,fr-FR;q=0.8,fr;q=0.6,ja;q=0.4,en;q=0.2
sub accept_language { return( shift->headers->{ 'Accept-Language' } ); }
sub accept_type { return( shift->_set_get_scalar( 'accept_type', @_ ) ); }
sub accept_version { return( shift->client_api_version( @_ ) ); }
lib/Apache2/API/Request.pm view on Meta::CPAN
# See APR::Request
# sub body { return( shift->_try( 'request', 'body', @_ ) ); }
sub body { return( shift->_try( 'apr', 'body', @_ ) ); }
sub body_status { return( shift->_try( 'apr', 'body_status', @_ ) ); }
sub brigade_limit { return( shift->_try( 'apr', 'brigade_limit', @_ ) ); }
sub call { return( shift->_try( 'request', @_ ) ); }
sub charset { return( shift->_set_get_scalar( 'charset', @_ ) ); }
sub checkonly { return( shift->_set_get_scalar( 'checkonly', @_ ) ); }
sub child_terminate { return( shift->_try( 'request', 'child_terminate' ) ); }
sub client_api_version
{
my $self = shift( @_ );
if( @_ )
{
lib/Apache2/API/Request.pm view on Meta::CPAN
{
1 while( $r->read( $payload, 1096, CORE::length( $payload ) ) );
}
}
# try-catch
local $@;
eval
{
# This is set during the init() phase
my $charset = $self->charset;
if( defined( $charset ) && $charset )
{
$payload = Encode::decode( $charset, $payload, Encode::FB_CROAK );
}
else
{
$payload = Encode::decode_utf8( $payload, Encode::FB_CROAK );
}
};
if( $@ )
{
return( $self->error({ code => Apache2::Const::HTTP_BAD_REQUEST, message => "Error while decoding payload received from http client: $@" }) );
}
lib/Apache2/API/Request.pm view on Meta::CPAN
sub type
{
my $self = shift( @_ );
if( @_ )
{
# Something like text/html, text/plain or application/json, etc...
$self->{type} = shift( @_ );
}
elsif( !CORE::length( $self->{type} ) )
{
# Content-Type: application/json; charset=utf-8
my $ctype_raw = $self->content_type;
if( defined( $ctype_raw ) )
{
my $ctype_def = Module::Generic::HeaderValue->new_from_header( $ctype_raw ) ||
return( $self->pass_error( Module::Generic::HeaderValue->error ) );
# Accept: application/json; version=1.0; charset=utf-8
my $ctype = lc( $ctype_def->value->first // '' );
$self->{type} = $ctype if( $ctype );
my $enc = $ctype_def->param( 'charset' );
$enc = lc( $enc ) if( defined( $enc ) );
$self->charset( $enc );
}
}
return( $self->{type} );
}
sub unparsed_uri
{
my $self = shift( @_ );
my $uri = $self->uri;
my $unparseed_path = $self->request->unparsed_uri;
lib/Apache2/API/Request.pm view on Meta::CPAN
# e.g.: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
my $accept = $req->accept;
# Returns an array object
my $all = $req->acceptable;
$req->acceptable( $array_ref );
# Returns an array object
my $all = $req->acceptables;
my $charset = $req->accept_charset;
# e.g.: gzip, deflate, br
my $encoding = $req->accept_encoding;
# en-GB,fr-FR;q=0.8,fr;q=0.6,ja;q=0.4,en;q=0.2
my $lang = $req->accept_language;
my $type = $req->accept_type;
my $version = $req->accept_version;
lib/Apache2/API/Request.pm view on Meta::CPAN
$req->auto_header(1);
# returns an APR::Request::Param::Table object similar to APR::Table
my $body = $req->body;
my $status = $req->body_status;
my $limit = $req->brigade_limit;
my $charset = $req->charset;
$req->child_terminate;
my $api_version = $req->client_api_version;
# close client connection
$req->close;
my $status_code = $req->code;
lib/Apache2/API/Request.pm view on Meta::CPAN
=head2 aborted
Tells whether the connection has been aborted or not, by calling L<Apache2::Connection/aborted>
=head2 accept
Returns the HTTP C<Accept> header value, such as C<text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8>
See also L</headers>
=head2 accept_charset
Sets or gets the acceptable character set. This is computed upon object instantiation by looking at the C<Accept> header:
Accept: application/json; version=1.0; charset=utf-8
Here, it would be C<utf-8>
=head2 accept_encoding
Returns the HTTP C<Accept-Encoding> header value.
Accept-Encoding: gzip, deflate;q=1.0, *;q=0.5
Accept-Encoding: gzip, deflate, br
lib/Apache2/API/Request.pm view on Meta::CPAN
=head2 accept_language
Returns the HTTP C<Accept-Language> header value such as C<en-GB,fr-FR;q=0.8,fr;q=0.6,ja;q=0.4,en;q=0.2>
See also L</headers>
=head2 accept_type
Sets or gets the acceptable content type. This is computed upon object instantiation by looking at the C<Accept> header:
Accept: application/json; version=1.0; charset=utf-8
Here, it would be C<application/json>
=head2 accept_version
Sets or gets the version of the api being queried. This is computed upon object instantiation by looking at the C<Accept> header:
Accept: application/json; version=1.0; charset=utf-8
Here, it would be C<1.0>
=head2 acceptable
This method parse the request header C<Accept>, by calling L</acceptables>, which could be, for example:
application/json, text/javascript, */*
And return an L<array object|Module::Generic::Array> of acceptable content types.
lib/Apache2/API/Request.pm view on Meta::CPAN
Provided with an Apache2 API method name, and optionally with some additional arguments, and this will call that Apache2 method and return its result.
This is designed to allow you to call arbitrary Apache2 method that, possibly, are not covered here.
For example:
my $bitmask = $req->call( 'allow_override_opts' );
It returns whatever value this call returns.
=head2 charset
Returns the charset, if any, found in the HTTP request received and processed upon initialisation of this module object.
So for example, if the HTTP request C<Content-type> is
Content-Type: application/json; charset=utf-8
Then, L</charset> would return C<utf-8>
See also L</type> to retrieve only the content type, i.e without other information such as charset.
See also L</client_api_version> which would contain the requested api version, if any.
See also L<charset> for the charset provided, if any. For example C<utf-8>
=head2 checkonly
This is also an object initialisation property.
If true, this will discard the normal processing of incoming HTTP request under modperl.
This is useful and intended when testing this module offline.
=head2 child_terminate
lib/Apache2/API/Request.pm view on Meta::CPAN
This is not supported in threaded MPMs.
See L<Apache2::RequestUtil> for more information.
=head2 client_api_version
Returns the client api version requested, if provided. This is set during the object initialisation phase.
An example header to require api version C<1.0> would be:
Accept: application/json; version=1.0; charset=utf-8
In this case, this would return C<1.0>
=head2 close
This close the client connection, by calling L<Apache2::Connection/socket>, which returns a L<APR::Socket>
This is not implemented in by L<APR::Socket>, so this is an efficient work around.
If the socket is writable, it is closed and returns the value from closing it, otherwise returns C<0>
lib/Apache2/API/Request.pm view on Meta::CPAN
Returns the length in byte of the request body, by getting the header C<Content-Length> value.
See also L</headers>
=head2 content_type
Retrieves the value of the C<Content-type> header value. See L<Apache2::RequestRec> for more information.
For example:
application/json; charset=utf-8
See also L</type> to retrieve only the content type, i.e without other information such as charset.
See also L</client_api_version> which would contain the requested api version, if any.
See also L<charset> for the charset provided, if any. For example C<utf-8>
=head2 cookie
Returns the current value for the given cookie name, which may be C<undef> if nothing is found.
This works by calling the L</cookies> method, which returns a L<cookie jar object|Cookie::Jar>.
=head2 cookies
Returns a L<Cookie::Jar> object acting as a jar with various methods to access, manipulate and create cookies.
lib/Apache2/API/Request.pm view on Meta::CPAN
This method reads the data sent by the client. It takes an optional hash or hash reference of the following options:
=over 4
=item * C<max_size>
The maximum size of the data that can be transmitted to us over HTTP. By default, there is no limit.
=back
Finally, if a charset is specified, this will also decode it from its encoded charset into perl internal utf8.
This is specifically designed for C<JSON> payload.
It returns a string of data upon success, or sets an L<error|Module::Generic/error> and return C<undef> or an empty list depending on the context.
You can also set a maximum size to read by setting the attribute C<PAYLOAD_MAX_SIZE> in Apache configuration file.
For example:
<Directory /home/john/www>
lib/Apache2/API/Request.pm view on Meta::CPAN
=head2 time2str
Alias to L<Apache2::API::DateTime/time2str>
=head2 type
Returns the content type of the request received. This value is set at object initiation phase.
So for example, if the HTTP request C<Content-type> is
Content-Type: application/json; charset=utf-8
Then, L</type> would return C<application/json>
=head2 unparsed_uri
The URI without any parsing performed.
If for example the request was:
GET /foo/bar/my_path_info?args=3 HTTP/1.0
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
use warnings;
use parent qw( APR::Request::Param );
use version;
use APR::Request::Param;
our $VERSION = 'v0.1.0';
};
sub bucket { return( shift->upload( @_ ) ); }
# This one is not very useful, since the charaset value here is an integer: 0, 1, 2, 8
# sub charset
sub fh { return( shift->upload_fh( @_ ) ); }
sub filename { return( shift->upload_filename( @_ ) ); }
# The header for this field
# sub info
sub io { return( shift->upload_io( @_ ) ); }
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
# or more simply
use parent qw( Apache2::API )
# in your sub
my $self = shift( @_ );
my $file = $self->request->upload( 'file_upload' );
# or
my $file = $self->request->param( 'file_upload' );
print( "No check done on data? ", $file->is_tainted ? 'no' : 'yes', "\n" );
print( "Is it encoded in utf8? ", $file->charset == 8 ? 'yes' : 'no', "\n" );
my $field_header = $file->info;
# Returns the APR::Brigade object content for file_upload
my $brigade = $field->bucket
printf( "File name provided by client is: %s\n", $file->filename );
# link to the temporary file or make a copy if on different file system
$file->link( '/to/my/temp/file.png' );
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
This is a module that inherits from L<APR::Request::Param> to deal with data upload leveraging directly Apache mod_perl's methods making it fast and powerful.
=head1 METHODS
=head2 bucket
Get or set the L<APR::Brigade> file-upload content for this param.
May also be called as B<upload>
=head2 charset
$param->charset();
$param->charset( $set );
Get or sets the param's internal charset. The charset is a number between 0 and 255; the current recognized values are
=over 4
=item 0 APREQ_CHARSET_ASCII
7-bit us-ascii
=item 1 APREQ_CHARSET_LATIN1
8-bit iso-8859-1
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
=item 2 APREQ_CHARSET_CP1252
8-bit Windows-1252
=item 8 APREQ_CHARSET_UTF8
utf8 encoded Unicode
=back
my $charset = $up->charset;
$up->charset( 8 );
print( "Data in utf8 ? ", $up->charset == 8 ? 'yes' : 'no', "\n" );
=head2 filename
Returns the client-side filename associated with this param.
Depending on the user agent, this may be the file full path name or just the file base name.
=head2 fh
Returns a seekable filehandle representing the file-upload content.
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
Get or set the L<APR::Table> headers for this param.
my $info = $up->info;
while( my( $hdr_name, $hdr_value ) = each( %$info ) )
{
# etc
}
printf( "Content type is: %s\n", $up->info->{'Content-type'} );
# could yield for example: application/json; charset=utf-8
See also L</type>, but be careful C<< $up->info->{'Content-type'} >> is not necessarily the same.
=head2 io
Returns an L<APR::Request::Brigade::IO> object, which can be treated as a non-seekable IO stream.
This is more efficient than L</fh>
This object has the B<read> and B<readline> methods corresponding to the methods B<READ> and B<READLINE> from L<APR::Request::Brigade>
lib/Apache2/API/Status.pm view on Meta::CPAN
HTTP/1.1 103 Early Hints
Link: </style.css>; rel=preload; as=style
Link: </script.js>; rel=preload; as=script
then, a few seconds, or minutes later:
HTTP/1.1 200 OK
Date: Mon, 16 Apr 2022 02:15:12 GMT
Content-Length: 1234
Content-Type: text/html; charset=utf-8
Link: </style.css>; rel=preload; as=style
Link: </script.js>; rel=preload; as=script
=head2 HTTP_OK (200)
See L<rfc7231, section 6.3.1|https://datatracker.ietf.org/doc/html/rfc7231#section-6.3.1>
This is returned to inform the request has succeeded. It can also alternatively be C<204 No Content> when there is no response body.
For example:
HTTP/1.1 200 OK
Content-Type: text/html; charset=utf-8
Content-Length: 184
Connection: keep-alive
Cache-Control: s-maxage=300, public, max-age=0
Content-Language: en-US
Date: Mon, 18 Apr 2022 17:37:18 GMT
ETag: "2e77ad1dc6ab0b53a2996dfd4653c1c3"
Server: Apache/2.4
Strict-Transport-Security: max-age=63072000
X-Content-Type-Options: nosniff
X-Frame-Options: DENY
X-XSS-Protection: 1; mode=block
Vary: Accept-Encoding,Cookie
Age: 7
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>A simple webpage</title>
</head>
<body>
<h1>Simple HTML5 webpage</h1>
<p>Hello, world!</p>
</body>
</html>
=head2 HTTP_CREATED (201)
lib/Apache2/API/Status.pm view on Meta::CPAN
Content-Range: bytes 1048576-2097152/3145728
Content-Type: video/mp4
=head2 HTTP_MULTI_STATUS (207)
See L<rfc 4918 on WebDAV|https://tools.ietf.org/html/rfc4918>
This is returned predominantly under the WebDav protocol, when multiple operations occurred. For example:
HTTP/1.1 207 Multi-Status
Content-Type: application/xml; charset="utf-8"
Content-Length: 637
<d:multistatus xmlns:d="DAV:">
<d:response>
<d:href>/calendars/johndoe/home/132456762153245.ics</d:href>
<d:propstat>
<d:prop>
<d:getetag>"xxxx-xxx"</d:getetag>
</d:prop>
<d:status>HTTP/1.1 200 OK</d:status>
lib/Apache2/API/Status.pm view on Meta::CPAN
However, because there is no standard way to have the user choose, this response code is never used.
=head2 HTTP_MOVED_PERMANENTLY (301)
See L<rfc 7231, section 6.4.2|https://tools.ietf.org/html/rfc7231#section-6.4.2>
This is returned to indicate the target resource can now be found at a different location and all pointers should be updated accordingly. For example:
HTTP/1.1 301 Moved Permanently
Server: Apache/2.4
Content-Type: text/html; charset=utf-8
Date: Mon, 18 Apr 2022 17:33:08 GMT
Location: https://example.org/some/where/else.html
Keep-Alive: timeout=15, max=98
Accept-Ranges: bytes
Via: Moz-Cache-zlb05
Connection: Keep-Alive
Content-Length: 212
<!DOCTYPE html>
<html><head>
lib/Apache2/API/Status.pm view on Meta::CPAN
For example:
GET / HTTP/1.1
Host: example.org
Then, the server would respond something like:
HTTP/1.1 308 Permanent Redirect
Server: Apache/2.4
Content-Type: text/html; charset=UTF-8
Location: https://example.org/some/where/else.html
Content-Length: 393
<!DOCTYPE HTML>
<html>
<head>
<title>Permanent Redirect</title>
<meta http-equiv="refresh"
content="0; url=https://example.org/some/where/else.html">
</head>
{
my $config = Apache::Test::config();
$hostport = Apache::TestRequest::hostport( $config ) || '';
( $host, $port ) = split( ':', ( $hostport ) );
$mp_host = 'www.example.org';
our @ua_args = (
agent => 'Test-Apache2-API/' . $VERSION,
cookie_jar => {},
default_headers => HTTP::Headers->new(
Host => "${mp_host}:${port}",
Accept => 'application/json; version=1.0; charset=utf-8, text/javascript, */*',
Accept_Encoding => 'gzip, deflate, br',
Accept_Language => 'en-GB,fr-FR;q=0.8,fr;q=0.6,ja;q=0.4,en;q=0.2',
),
keep_alive => 1,
);
Apache::TestRequest::user_agent( @ua_args, reset => 1 );
$ua = Apache::TestRequest->new( @ua_args );
# 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(
is( $ref->{message}, 'ok', 'reply message' );
&simple_test({ target => 'api', name => 'server', code => Apache2::Const::HTTP_OK });
&simple_test({ target => 'api', name => 'server_version', code => Apache2::Const::HTTP_OK });
};
subtest 'request' => sub
{
my @tests = qw(
aborted accept accept_charset accept_encoding accept_language accept_type
accept_version acceptable acceptables allowed as_string auto_header
charset client_api_version connection decode encode document_root
document_uri env finfo gateway_interface global_request has_auth header_only
headers headers_as_hashref headers_as_json headers_in is_secure json local_addr
method mod_perl_version no_cache notes path_info
preferred_language protocol remote_addr request_time server
socket subprocess_env the_request time2str type uri user_agent
);
foreach my $test ( @tests )
{
&simple_test({ target => 'request', name => $test, code => Apache2::Const::HTTP_OK });
&simple_test({ target => 'request', name => 'body', code => Apache2::Const::HTTP_OK, headers => [Content_Type => "application/x-www-form-urlencoded"], body => q{a=a1&b=b1&b=b2&c=foo+&tengu=%E5%A4%A9%E7%8B%97}, http_method => 'post' });
&simple_test({ target => 'request', name => 'cookie', code => Apache2::Const::HTTP_OK, headers => [Cookie => "my_session=foo"] });
my $data_body = <<EOT;
{
"id": 123,
"client_id": "37c58138-e259-44aa-9eee-baf3cbecca75"
}
EOT
&simple_test({ target => 'request', name => 'data', code => Apache2::Const::HTTP_OK, headers => [Content_Type => 'application/json; charset=utf-8'], body => $data_body, http_method => 'post' });
&simple_test({ target => 'request', name => 'param', code => Apache2::Const::HTTP_OK, query => 'foo=bar&lang=ja_JP' });
&simple_test({ target => 'request', name => 'params', code => Apache2::Const::HTTP_OK, query => 'foo=bar&lang=ja_JP' });
&simple_test({ target => 'request', name => 'payload', code => Apache2::Const::HTTP_OK, headers => [Content_Type => 'application/json; charset=utf-8'], body => $data_body, http_method => 'post' });
&simple_test({ target => 'request', name => 'query', code => Apache2::Const::HTTP_OK, query => 'foo=1&bar=3&lang=ja_JP' });
# 最高ã ï¼
&simple_test({ target => 'request', name => 'query_string', code => Apache2::Const::HTTP_OK, query => 'foo=bar&lang=ja-JP&q=%E6%9C%80%E9%AB%98%E3%81%A0%EF%BC%81' });
&simple_test({ target => 'request', name => 'referer', code => Apache2::Const::HTTP_OK, headers => [Referer => 'https://example.org/some/where.html'] });
};
subtest 'response' => sub
);
if( $opts->{query} )
{
my $u = URI->new( $req->uri );
$u->query( $opts->{query} );
$req->uri( $u );
}
unless( $req->header( 'Content-Type' ) )
{
$req->header( Content_Type => 'text/plain; charset=utf-8' );
}
# $req->header( Host => "${mp_host}:${port}" );
diag( "Request for $path is: ", $req->as_string ) if( $DEBUG );
my $resp = $ua->request( $req );
diag( "Server response for $path is: ", $resp->as_string ) if( $DEBUG );
return( $resp );
}
sub simple_test
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
};
use strict;
use warnings;
our $config = Apache::TestConfig->thaw->httpd_config;
our $port = $config->{vars}->{port} || 0;
sub aborted { return( shift->_test({ method => 'aborted', expect => 0, type => 'boolean' }) ); }
# text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
# application/json; version=1.0; charset=utf-8, text/javascript, */*
sub accept { return( shift->_test({ method => 'accept', expect => 'application/json; version=1.0; charset=utf-8, text/javascript, */*' }) ); }
# application/json; version=1.0; charset=utf-8
sub accept_charset { return( shift->_test({ method => 'accept_charset', expect => 'utf-8' }) ); }
# gzip, deflate;q=1.0, *;q=0.5
# gzip, deflate, br
sub accept_encoding { return( shift->_test({ method => 'accept_encoding', expect => 'gzip, deflate, br' }) ); }
sub accept_language { return( shift->_test({ method => 'accept_language', expect => 'en-GB,fr-FR;q=0.8,fr;q=0.6,ja;q=0.4,en;q=0.2' }) ); }
# application/json
sub accept_type { return( shift->_test({ method => 'accept_type', expect => 'application/json' }) ); }
# application/json; version=1.0; charset=utf-8
# sub accept_version { return( shift->_test({ method => 'accept_version', expect => '1.0' }) ); }
sub accept_version { return( shift->_test({ method => 'accept_version', expect => '1.0' }) ); }
# Check array reference of acceptable types:
# application/json; version=1.0; charset=utf-8, text/javascript, */*
sub acceptable { return( shift->_test({ method => 'acceptable', expect => sub
{
my $acceptable = shift( @_ );
my $opts = shift( @_ );
my $cnt = 0;
$opts->{log}->( "\$acceptable is '", ( $acceptable // 'undef' ), "' and contains: ", ( Scalar::Util::reftype( $acceptable ) eq 'ARRAY' ? join( ', ', @$acceptable ) : 'not an array' ) );
$cnt++ if( Scalar::Util::reftype( $acceptable // '' ) eq 'ARRAY' );
$cnt++ if( scalar( @$acceptable ) == 3 );
$cnt++ if( $acceptable->[0] eq 'application/json' && $acceptable->[1] eq 'text/javascript' && $acceptable->[2] eq '*/*' );
return( $cnt == 3 );
} }) ); }
# application/json; charset=utf-8; version=2, text/javascript, */*
sub acceptables { return( shift->_test({ method => 'acceptables', expect => sub
{
my $ref = shift( @_ );
my $opts = shift( @_ );
my $cnt = 0;
if( Scalar::Util::blessed( $ref // '' ) &&
$ref->isa( 'Module::Generic::Array' ) )
{
$cnt++ if( scalar( @$ref ) == 3 );
my $def = $ref->[0];
if( Scalar::Util::blessed( $def // '' ) && $def->isa( 'Module::Generic::HeaderValue' ) )
{
$opts->{log}->( "\$ref->[0] value is '", $def->value->first, "' and charset is '", $def->param( 'charset' ), "' and version is '", $def->param( 'version' ), "'" );
if( $def->value->first eq 'application/json' &&
$def->param( 'charset' ) eq 'utf-8' &&
$def->param( 'version' ) == 2 )
{
$cnt++;
}
}
else
{
$opts->{log}->( "\$ref->[0] is not an Module::Generic::HeaderValue object." );
}
$cnt++ if( Scalar::Util::blessed( $ref->[1] ) && $ref->[1]->isa( 'Module::Generic::HeaderValue' ) && $ref->[1]->value->first eq 'text/javascript' );
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
my $opts = shift( @_ );
my @vals = Scalar::Util::blessed( $ref ) ? $ref->get( 'foo' ) : ();
$opts->{log}->( "\@vals is '@vals', and foo = '$ref->{foo}', bar = '$ref->{bar}' and lang is '$ref->{lang}'" );
return( $ref->{foo} == 1 && $ref->{bar} == 3 && $ref->{lang} eq 'ja_JP' && "@vals" eq '1 2' );
} }) ); }
# my $as_string_request = <<EOT;
# GET /tests/request/as_string HTTP/1.1
# TE: deflate,gzip;q=0.3
# Connection: TE
# Accept: application/json; version=1.0; charset=utf-8, text/javascript, */*
# Accept-Encoding: gzip, deflate, br
# Accept-Language: en-GB,fr-FR;q=0.8,fr;q=0.6,ja;q=0.4,en;q=0.2
# Host: www.example.org:${port}
# User-Agent: Test-Apache2-API/v0.1.0
#
# HTTP/1.1 (null)
# Test-No: as_string
# EOT
sub as_string { return( shift->_test({ method => 'as_string', expect => sub
{
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
# return( $str eq $as_string_request );
return( $str =~ m,^GET[[:blank:]]+/tests/request/as_string[[:blank:]]+HTTP/\d.\d, );
} }) ); }
sub auth { return( shift->_test({ method => 'auth', expect => q{Bearer: eyJleHAiOjE2MzYwNzEwMzksImFsZyI6IkhTMjU2In0.eyJqdGkiOiJkMDg2Zjk0OS1mYWJmLTRiMzgtOTE1ZC1hMDJkNzM0Y2ZmNzAiLCJmaXJzdF9uYW1lIjoiSm9obiIsImlhdCI6MTYzNTk4NDYzOSwiYXpwIjoiNGQ0YWFiYWQtYm...
sub auto_header { return( shift->_test({ method => 'auto_header', expect => 0, type => 'boolean' }) ); }
sub body { return( shift->_test({ method => 'body', expect => 'APR::Request::Param::Table', type => 'isa' }) ); }
sub charset { return( shift->_test({ method => 'charset', expect => 'utf-8' }) ); }
sub client_api_version { return( shift->_test({ method => 'client_api_version', expect => '1.0' }) ); }
sub connection { return( shift->_test({ method => 'connection', expect => 'Apache2::Connection', type => 'isa' }) ); }
# sub cookie { return( shift->_test({ method => 'cookie', expect => 'Cookie', type => 'isa', args => ['my_session'] }) ); }
sub cookie { return( shift->_test({ method => 'cookie', expect => 'foo', args => ['my_session'] }) ); }
my $sample_data = <<EOT;
{
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
=head1 DESCRIPTION
This is a package for testing the L<Apache2::API> module under Apache2/modperl2 and inherits from C<Test::Apache::Common>
=head1 TESTS
=head2 aborted
=head2 accept
=head2 accept_charset
=head2 accept_encoding
=head2 accept_language
=head2 accept_type
=head2 accept_version
=head2 acceptable
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
=head2 args
=head2 as_string
=head2 auth
=head2 auto_header
=head2 body
=head2 charset
=head2 client_api_version
=head2 connection
=head2 cookie
=head2 data
=head2 decode
( run in 0.253 second using v1.01-cache-2.11-cpan-4d50c553e7e )