Apache2-API
view release on metacpan or search on metacpan
"Module::Generic" : "v0.35.3",
"Regexp::Common" : "0",
"Scalar::Util" : "1.50",
"URI" : "0",
"URI::Escape" : "3.31",
"URI::Query" : "0.16",
"Want" : "0.29",
"parent" : "0",
"perl" : "5.026001",
"strict" : "0",
"utf8" : "0",
"version" : "0",
"warnings" : "0"
}
},
"test" : {
"requires" : {
"File::Find" : "0",
"File::Spec" : "0",
"File::Which" : "0",
"Test2::V0" : "0.000145",
"Test::Mock::Apache2" : "0.05",
"Test::MockObject" : "1.20180705",
"Test::More" : "0",
"Test::Pod" : "0",
"Test::Time" : "0",
"lib" : "0",
"utf8" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://gitlab.com/jackdeguest/Apache2-API/issues"
},
"repository" : {
"type" : "git",
File::Find: '0'
File::Spec: '0'
File::Which: '0'
Test2::V0: '0.000145'
Test::Mock::Apache2: '0.05'
Test::MockObject: '1.20180705'
Test::More: '0'
Test::Pod: '0'
Test::Time: '0'
lib: '0'
utf8: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Apache2-API
no_index:
Module::Generic: v0.35.3
Regexp::Common: '0'
Scalar::Util: '1.50'
URI: '0'
URI::Escape: '3.31'
URI::Query: '0.16'
Want: '0.29'
parent: '0'
perl: '5.026001'
strict: '0'
utf8: '0'
version: '0'
warnings: '0'
resources:
bugtracker: https://gitlab.com/jackdeguest/Apache2-API/issues
repository: https://gitlab.com/jackdeguest/Apache2-API
version: v0.3.1
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Makefile.PL view on Meta::CPAN
my %WriteMakefileArgs = (
NAME => 'Apache2::API',
AUTHOR => 'Jacques Deguest <jack@deguest.jp>',
VERSION_FROM => 'lib/Apache2/API.pm',
ABSTRACT_FROM => 'lib/Apache2/API.pm',
PL_FILES => {},
PREREQ_PM => {
'parent' => 0,
'strict' => 0,
'utf8' => 0,
'version' => 0,
'warnings' => 0,
'Apache2::Connection' => 0,
'Apache2::Const' => 0,
'Apache2::Log' => 0,
'Apache2::Reload' => 0,
'Apache2::Request' => 0,
'Apache2::RequestIO' => 0,
'Apache2::RequestRec' => 0,
'Apache2::RequestUtil' => 0,
Makefile.PL view on Meta::CPAN
'lib' => 0,
'File::Find' => 0,
'File::Spec' => 0,
'File::Which' => 0,
'Test::Mock::Apache2' => '0.05',
'Test::MockObject' => '1.20180705',
'Test::More' => 0,
'Test::Pod' => 0,
'Test::Time' => 0,
'Test2::V0' => '0.000145',
'utf8' => 0,
},
LICENSE => 'perl_5',
MIN_PERL_VERSION => 'v5.26.1',
(MM->can('signature_target') ? (SIGN => 1) : ()),
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', DIST_CP => 'cp' },
clean => { FILES => 'Apache2-API-*' },
( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? ( META_MERGE => {
'meta-spec' => { version => 2 },
dynamic_config => 1,
resources => {
compression_threshold( $integer )
The number of bytes threshold beyond which, the "reply" method will gzip
compress the data returned to the client.
decode_base64( $data )
Given some data, this will decode it using base64 algorithm. It uses
"decode" in APR::Base64 in the background.
decode_json( $data )
This decode from utf8 some data into a perl structure using JSON
If an error occurs, it will return undef and set an exception that can
be accessed with the error method.
decode_url( $string )
Given a url-encoded string, this returns the decoded string using
"decode" in APR::Request
decode_utf8( $data )
Decode some data from ut8 into perl internal utf8 representation using
Encode
If an error occurs, it will return undef and set an exception that can
be accessed with the error method.
encode_base64( $data )
Given some data, this will encode it using base64 algorithm. It uses
"encode" in APR::Base64.
encode_json( $hash_reference )
Given a hash reference, this will encode it into a json data
representation.
However, this will not utf8 encode it, because this is done upon
printing the data and returning it to the client.
The JSON object has the following properties enabled: "allow_nonref",
"allow_blessed", "convert_blessed" and "relaxed"
encode_url( $string )
Given a string, this returns its url-encoded version using "encode" in
APR::Request
encode_utf8( $data )
This encode in ut8 the data provided and return it.
If an error occurs, it will return undef and set an exception that can
be accessed with the error method.
generate_uuid()
Generates an uuid string and return it. This uses APR::UUID
get_auth_bearer()
Checks whether an "Authorization" http header was provided, and get the
## compression\_threshold( $integer )
The number of bytes threshold beyond which, the ["reply"](#reply) method will gzip compress the data returned to the client.
## decode\_base64( $data )
Given some data, this will decode it using base64 algorithm. It uses ["decode" in APR::Base64](https://metacpan.org/pod/APR%3A%3ABase64#decode) in the background.
## decode\_json( $data )
This decode from utf8 some data into a perl structure using [JSON](https://metacpan.org/pod/JSON)
If an error occurs, it will return undef and set an exception that can be accessed with the [error](https://metacpan.org/pod/Module%3A%3AGeneric#error) method.
## decode\_url( $string )
Given a url-encoded string, this returns the decoded string using ["decode" in APR::Request](https://metacpan.org/pod/APR%3A%3ARequest#decode)
## decode\_utf8( $data )
Decode some data from ut8 into perl internal utf8 representation using [Encode](https://metacpan.org/pod/Encode)
If an error occurs, it will return undef and set an exception that can be accessed with the [error](https://metacpan.org/pod/Module%3A%3AGeneric#errir) method.
## encode\_base64( $data )
Given some data, this will encode it using base64 algorithm. It uses ["encode" in APR::Base64](https://metacpan.org/pod/APR%3A%3ABase64#encode).
## encode\_json( $hash\_reference )
Given a hash reference, this will encode it into a json data representation.
However, this will not utf8 encode it, because this is done upon printing the data and returning it to the client.
The JSON object has the following properties enabled: `allow_nonref`, `allow_blessed`, `convert_blessed` and `relaxed`
## encode\_url( $string )
Given a string, this returns its url-encoded version using ["encode" in APR::Request](https://metacpan.org/pod/APR%3A%3ARequest#encode)
## encode\_utf8( $data )
This encode in ut8 the data provided and return it.
If an error occurs, it will return undef and set an exception that can be accessed with the **error** method.
## generate\_uuid()
Generates an uuid string and return it. This uses [APR::UUID](https://metacpan.org/pod/APR%3A%3AUUID)
## get\_auth\_bearer()
lib/Apache2/API.pm view on Meta::CPAN
sub decode_json
{
my $self = shift( @_ );
my $raw = shift( @_ ) || return( $self->error( "No json data was provided to decode." ) );
my $json = $self->json;
my $hash;
# try-catch
local $@;
eval
{
$hash = $json->utf8->decode( $raw );
};
if( $@ )
{
return( $self->error( "An error occurred while trying to decode json payload: $@" ) );
}
return( $hash );
}
sub decode_url
{
my $self = shift( @_ );
return( APR::Request::decode( shift( @_ ) ) );
}
sub decode_utf8
{
my $self = shift( @_ );
my $v = shift( @_ );
my $rv = eval
{
## utf8 is more lax than the strict standard of utf-8; see Encode man page
Encode::decode( 'utf8', $v, Encode::FB_CROAK );
};
if( $@ )
{
$self->error( "Error while decoding text: $@" );
return( $v );
}
return( $rv );
}
# https://perl.apache.org/docs/2.0/api/APR/Base64.html#toc_C_encode_
lib/Apache2/API.pm view on Meta::CPAN
}
return( $data );
}
sub encode_url
{
my $self = shift( @_ );
return( APR::Request::encode( shift( @_ ) ) );
}
sub encode_utf8
{
my $self = shift( @_ );
my $v = shift( @_ );
my $rv = eval
{
## utf8 is more lax than the strict standard of utf-8; see Encode man page
Encode::encode( 'utf8', $v, Encode::FB_CROAK );
};
if( $@ )
{
$self->error( "Error while encoding text: $@" );
return( $v );
}
return( $rv );
}
# <https://perl.apache.org/docs/2.0/api/APR/UUID.html>
lib/Apache2/API.pm view on Meta::CPAN
$dt = shift( @_ );
}
$dt = DateTime->now if( !defined( $dt ) );
my $fmt = Apache2::API::DateTime->new;
$dt->set_formatter( $fmt );
return( $dt );
}
sub is_perl_option_enabled { return( shift->_try( 'request', 'is_perl_option_enabled', @_ ) ); }
# We return a new object each time, because if we cached it, some routine might set the utf8 bit flagged on while some other would not want it
sub json
{
my $self = shift( @_ );
my $opts = $self->_get_args_as_hash( @_ );
my $j = JSON->new;
my $equi =
{
ordered => 'canonical',
sorted => 'canonical',
sort => 'canonical',
lib/Apache2/API.pm view on Meta::CPAN
# $r->send_http_header;
$z->print( $json );
$z->close;
}
else
{
$self->response->headers->unset( 'Content-Encoding' );
# $self->response->content_encoding( undef() );
# $r->send_http_header;
# $r->print( $json );
# $json = Encode::encode_utf8( $json ) if( utf8::is_utf8( $json ) );
# try-catch
local $@;
eval
{
my $bytes = $r->print( $json );
};
if( $@ )
{
}
}
lib/Apache2/API.pm view on Meta::CPAN
elsif( ref( $_[0] ) eq 'HASH' )
{
$ref = shift( @_ );
$code = $ref->{code} if( CORE::length( $ref->{code} ) );
}
my $r = $self->apache_request;
if( $code !~ /^[0-9]+$/ )
{
$self->response->code( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
$self->response->rflush;
$self->response->print( $self->json->utf8->encode({ error => 'An unexpected server error occured', code => 500 }) );
$self->error( "http code to be used '$code' is invalid. It should be only integers." );
return( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
}
if( ref( $ref ) ne 'HASH' )
{
$self->response->code( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
$self->response->rflush;
# $r->send_http_header;
$self->response->print( $self->json->utf8->encode({ error => 'An unexpected server error occured', code => 500 }) );
$self->error( "Data provided to send is not an hash ref." );
return( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
}
my $msg;
if( CORE::exists( $ref->{success} ) )
{
$msg = $ref->{success};
}
# Maybe error is a string, or maybe it is already an error hash like { error => { message => '', code => '' } }
lib/Apache2/API.pm view on Meta::CPAN
defined( $ref->{cleanup} ) &&
ref( $ref->{cleanup} ) eq 'CODE' )
{
my $cleanup = CORE::delete( $ref->{cleanup} );
# See <https://perl.apache.org/docs/2.0/user/handlers/http.html#PerlCleanupHandler>
$self->request->request->pool->cleanup_register( $cleanup, $self );
# $r->push_handlers( PerlCleanupHandler => $cleanup );
}
# Our print() will possibly change the HTTP headers, so we do not flush now just yet.
my $json = $self->json->utf8->relaxed(0)->allow_blessed->convert_blessed->encode( $ref );
# Before we use this, we have to make sure all Apache module that deal with content encoding are de-activated because they would interfere
$self->print( $json ) || do
{
return( Apache2::Const::HTTP_INTERNAL_SERVER_ERROR );
};
return( $code );
}
sub request { return( shift->_set_get_object( 'request', 'Apache2::API::Request', @_ ) ); }
lib/Apache2/API.pm view on Meta::CPAN
public_message => "An unexpected error occurred.",
}) );
# or
return( $api->bailout( @some_reasons ) );
# 100kb
$api->compression_threshold(102400);
my $decoded = $api->decode_base64( $b64_string );
my $ref = $api->decode_json( $json_data );
my $decoded = $api->decode_url;
my $perl_utf8 = $api->decode_utf8( $data );
my $b64_string = $api->encode_base64( $data );
my $json_data = $api->encode_json( $ref );
my $encoded = $api->encode_url( $uri );
my $utf8 = $api->encode_utf8( $data );
my $uuid = $api->generate_uuid;
my $auth = $api->get_auth_bearer;
my $handlers = $api->get_handlers;
my $dt = $api->header_datetime( $http_datetime );
my $bool = $api->is_perl_option_enabled;
# JSON object
my $json = $api->json( pretty => 1, sorted => 1, relaxed => 1 );
my $lang = $api->lang( 'en_GB' );
# en_GB
my $lang = $api->lang_unix;
lib/Apache2/API.pm view on Meta::CPAN
=head2 compression_threshold( $integer )
The number of bytes threshold beyond which, the L</reply> method will gzip compress the data returned to the client.
=head2 decode_base64( $data )
Given some data, this will decode it using base64 algorithm. It uses L<APR::Base64/decode> in the background.
=head2 decode_json( $data )
This decode from utf8 some data into a perl structure using L<JSON>
If an error occurs, it will return undef and set an exception that can be accessed with the L<error|Module::Generic/error> method.
=head2 decode_url( $string )
Given a url-encoded string, this returns the decoded string using L<APR::Request/decode>
=head2 decode_utf8( $data )
Decode some data from ut8 into perl internal utf8 representation using L<Encode>
If an error occurs, it will return undef and set an exception that can be accessed with the L<error|Module::Generic/errir> method.
=head2 encode_base64( $data )
Given some data, this will encode it using base64 algorithm. It uses L<APR::Base64/encode>.
=head2 encode_json( $hash_reference )
Given a hash reference, this will encode it into a json data representation.
However, this will not utf8 encode it, because this is done upon printing the data and returning it to the client.
The JSON object has the following properties enabled: C<allow_nonref>, C<allow_blessed>, C<convert_blessed> and C<relaxed>
=head2 encode_url( $string )
Given a string, this returns its url-encoded version using L<APR::Request/encode>
=head2 encode_utf8( $data )
This encode in ut8 the data provided and return it.
If an error occurs, it will return undef and set an exception that can be accessed with the B<error> method.
=head2 generate_uuid
Generates an uuid string and return it. This uses L<APR::UUID>
=head2 get_auth_bearer
lib/Apache2/API/DateTime.pm view on Meta::CPAN
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
# NOTE: sub THAW is inherited
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::DateTime - HTTP DateTime Manipulation and Formatting
=head1 SYNOPSIS
use Apache2::API::DateTime;
my $d = Apache2::API::DateTime->new( debug => 3 );
my $dt = DateTime->now;
lib/Apache2/API/Query.pm view on Meta::CPAN
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Apache2::API::Query;
BEGIN
{
use strict;
use warnings;
use parent qw( URI::Query );
use vars qw( $VERSION );
use utf8 ();
use Encode ();
use URI::Escape;
our $VERSION = 'v0.1.0';
};
use strict;
use warnings;
sub _parse_qs
{
my $self = shift( @_ );
my $qs = shift( @_ );
for( split( /[&;]/, $qs ) )
{
my( $key, $value ) = map{ URI::Escape::uri_unescape( $_ ) } split( /=/, $_, 2 );
$key = Encode::decode_utf8( $key ) if( !utf8::is_utf8( $key ) );
$value = Encode::decode_utf8( $value ) if( !utf8::is_utf8( $value ) );
$self->{qq}->{$key} ||= [];
push( @{$self->{qq}->{$key}}, $value ) if( defined( $value ) && $value ne '' );
}
$self
}
sub _init_from_arrayref
{
my( $self, $arrayref ) = @_;
while( @$arrayref )
{
my $key = shift( @$arrayref );
my $value = shift( @$arrayref );
my $key_unesc = URI::Escape::uri_unescape( $key );
$key_unesc = Encode::decode_utf8( $key_unesc ) if( !utf8::is_utf8( $key_unesc ) );
$self->{qq}->{$key_unesc} ||= [];
if( defined( $value ) && $value ne '' )
{
my @values;
if( !ref( $value ) )
{
@values = split( "\0", $value );
}
elsif( ref( $value ) eq 'ARRAY' )
lib/Apache2/API/Query.pm view on Meta::CPAN
@values = @$value;
}
else
{
die( "Invalid value found: $value. Not string or arrayref!" );
}
# push @{$self->{qq}->{$key_unesc}}, map { uri_unescape($_) } @values;
for( @values )
{
$_ = URI::Escape::uri_unescape( $_ );
$_ = Encode::decode_utf8( $_ ) if( !utf8::is_utf8( $_ ) );
push( @{$self->{qq}->{$key_unesc}}, $_ );
}
}
}
}
sub FREEZE
{
my $self = CORE::shift( @_ );
my $serialiser = CORE::shift( @_ ) // '';
lib/Apache2/API/Query.pm view on Meta::CPAN
{
$new = bless( $hash => $class );
}
CORE::return( $new );
}
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::Query - utf8 compliant URI query string manipulation
=head1 SYNOPSIS
# Constructor - using a GET query string
$qq = Apache2::API::Query->new($query_string);
# OR Constructor - using a hashref of key => value parameters
$qq = Apache2::API::Query->new($cgi->Vars);
# OR Constructor - using an array of successive keys and values
$qq = Apache2::API::Query->new(@params);
lib/Apache2/API/Query.pm view on Meta::CPAN
if ($qq->has_changed) {
print "changed version: $qq\n";
}
=head1 VERSION
v0.1.0
=head1 DESCRIPTION
This module simply inherits from L<URI::Query> and changed 2 subroutines to make them compliant with utf8 strings being fed to L<URI::Query>.
The 2 subroutines modified are: B<_parse_qs> and B<_init_from_arrayref>
L<URI::Query> does, otherwise, a very good job, but does not utf8 decode data from query strings after having url decoded it.
When, encoding data as query string, it does utf8 encode it before url encoding them, but not the other way around. So this module provides a temporary fix and is likely to be removed in the future when the module maintainer will have fixed this.
The rest below is taken from L<URI::Query> documentation and is copied here for convenience.
=head2 CONSTRUCTOR
Apache2::API::Query objects can be constructed from scalar query strings ('foo=1&bar=2&bar=3'), from a hashref which has parameters as keys, and values either as scalars or arrayrefs of scalars (to handle the case of parameters with multiple values e...
# Constructor - using a GET query string
$qq = Apache2::API::Query->new($query_string);
lib/Apache2/API/Request.pm view on Meta::CPAN
## This program is free software; you can redistribute it and/or modify it
## under the same terms as Perl itself.
##----------------------------------------------------------------------------
package Apache2::API::Request;
BEGIN
{
use strict;
use warnings;
use parent qw( Module::Generic );
use vars qw( $ERROR $VERSION $SERVER_VERSION );
use utf8 ();
use version;
use Apache2::Access;
use Apache2::Const -compile => qw( :common :http );
use Apache2::Connection ();
use Apache2::Log ();
use Apache2::Request;
use Apache2::RequestRec ();
use Apache2::RequestUtil ();
use Apache2::ServerUtil ();
use Apache2::RequestIO ();
lib/Apache2/API/Request.pm view on Meta::CPAN
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: $@" }) );
}
$self->{data} = $payload;
$self->{_data_processed}++;
return( $payload );
}
lib/Apache2/API/Request.pm view on Meta::CPAN
sub headers_as_json
{
my $self = shift( @_ );
my $ref = $self->headers_as_hashref;
my $json;
# try-catch
local $@;
eval
{
# Non-utf8 encoded, because this resulting data may be sent over http or stored in a database which would typically encode data on the fly, and double encoding will damage data
$json = $self->json->encode( $ref );
};
if( $@ )
{
return( $self->error( "An error occured while encoding the headers hash reference into json: $@" ) );
}
return( $json );
}
sub headers_in { return( shift->request->headers_in ); }
lib/Apache2/API/Request.pm view on Meta::CPAN
}
sub params
{
my $self = shift( @_ );
return( $self->query ) if( $self->method eq 'GET' );
# my $r = Apache2::Request->new( $self->request );
my $r = Apache2::API::Request::Params->new( request => $self->request );
# https://perl.apache.org/docs/1.0/guide/snippets.html#Reusing_Data_from_POST_request
# my %params = $r->method eq 'POST' ? $r->content : $r->args;
# Data are in pure utf8; not perl's internal, so it is up to us to decode them
my( @params ) = $r->param;
my( @uploads ) = $r->upload;
my $upload_fields = {};
# To make it easy to check if it exists
if( scalar( @uploads ) )
{
@$upload_fields{ @uploads } = ( 1 ) x scalar( @uploads );
}
my $form = {};
#my $io = IO::File->new( ">/tmp/form_data.txt" );
#my $io2 = IO::File->new( ">/tmp/form_data_after_our_decoding.txt" );
#my $raw = IO::File->new( ">/tmp/raw_form_data.txt" );
#$io->binmode( ':utf8' );
#$io2->binmode( ':utf8' );
foreach my $k ( @params )
{
my( @values ) = $r->param( $k );
#$raw->print( "$k => " );
#$io->print( "$k => " );
my $name = utf8::is_utf8( $k ) ? $k : Encode::decode_utf8( $k );
#$io2->print( "$name => " );
$form->{ $name } = scalar( @values ) > 1 ? \@values : $values[0];
if( CORE::exists( $upload_fields->{ $name } ) )
{
my $up = $r->upload( $name );
if( !$up )
{
CORE::warn( "Error: could not get the Apache2::API::Params::Upload object for this upload field \"$name\".\n" );
next;
}
lib/Apache2/API/Request.pm view on Meta::CPAN
}
elsif( ref( $form->{ $name } ) )
{
#$raw->print( "[\n" );
#$io->print( "[\n" );
#$io2->print( "[\n" );
for( my $i = 0; $i < scalar( @{$form->{ $name }} ); $i++ )
{
#$raw->print( "\t[$i]: ", $form->{ $name }->[ $i ], "\n" );
#$io->print( "\t[$i]: ", $form->{ $name }->[ $i ], "\n" );
$form->{ $name }->[ $i ] = utf8::is_utf8( $form->{ $name }->[ $i ] ) ? $form->{ $name }->[ $i ] : Encode::decode_utf8( $form->{ $name }->[ $i ] );
#$io2->print( "\t[$i]: ", $form->{ $name }->[ $i ], "\n" );
}
#$raw->print( "];\n" );
#$io->print( "];\n" );
#$io2->print( "];\n" );
}
else
{
#$raw->print( $form->{ $name }, "\n" );
#$io->print( $form->{ $name }, "\n" );
$form->{ $name } = utf8::is_utf8( $form->{ $name } ) ? $form->{ $name } : Encode::decode_utf8( $form->{ $name } );
#$io2->print( $form->{ $name }, "\n" );
}
}
#$raw->close;
#$io->close;
#$io2->close;
return( $form );
}
# NOTE: parse_date for compatibility
lib/Apache2/API/Request.pm view on Meta::CPAN
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
# NOTE: sub THAW is inherited
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::Request - Apache2 Incoming Request Access and Manipulation
=head1 SYNOPSIS
use Apache2::API::Request;
# $r is the Apache2::RequestRec object
my $req = Apache2::API::Request->new( request => $r, debug => 1 );
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
my $path_info = $req->path_info();
my $prev_path_info = $req->path_info( $path_info );
Get or set the C<PATH_INFO>, what is left in the path after the C<< URI --> filename >> translation, by calling L<Apache2::RequestRec/path_info>
Return a string as the current value.
=head2 payload
Returns the JSON data decoded into a perl structure. This is set at object initiation phase and calls the L</data> method to read the incoming data and decoded it into perl internal utf8.
=head2 per_dir_config
Get the dir config vector, by calling L<Apache2::RequestRec/per_dir_config>. Returns a L<Apache2::ConfVector> object.
For an in-depth discussion, refer to the Apache Server Configuration Customization in Perl chapter.
=head2 pnotes
Share Perl variables between Perl HTTP handlers, using L<Apache2::RequestUtil/pnotes>.
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
}
# So further call on this object will be handled by Apache2::API::Request::Params::Field below
$body->param_class( __PACKAGE__ . '::Field' );
return( $body->uploads( $self->pool ) );
}
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::Request::Params - Apache2 Request Fields Object
=head1 SYNOPSIS
use Apache2::API::Request::Params;
## $r is the Apache2::RequestRec object
my $req = Apache2::API::Request::Params->new(
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
# Returns an APR::Brigade, if any
# upload
# sub value
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::Request::Upload - Apache2 Request Upload Object
=head1 SYNOPSIS
use Apache2::API::Request::Params;
## $r is the Apache2::RequestRec object
my $req = Apache2::API::Request::Params->new(
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
=item 1 APREQ_CHARSET_LATIN1
8-bit iso-8859-1
=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/Response.pm view on Meta::CPAN
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
# NOTE: sub THAW is inherited
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::Response - Apache2 Outgoing Response Access and Manipulation
=head1 SYNOPSIS
use Apache2::API::Response;
# $r is the Apache2::RequestRec object
my $resp = Apache2::API::Response->new( request => $r, debug => 1 );
lib/Apache2/API/Status.pm view on Meta::CPAN
our %EXPORT_TAGS = (
all => [@EXPORT_OK],
common => [qw( HTTP_NETWORK_AUTHENTICATION_REQUIRED HTTP_FORBIDDEN HTTP_NOT_FOUND HTTP_OK HTTP_TEMPORARY_REDIRECT HTTP_INTERNAL_SERVER_ERROR )],
);
our $VERSION = 'v0.1.0';
};
use strict;
use warnings;
use utf8;
# Ref:
# <https://datatracker.ietf.org/doc/html/rfc7231#section-8.2>
# <http://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml>
our $CODES =
{
# Info 1xx
100 => Apache2::Const::HTTP_CONTINUE,
101 => Apache2::Const::HTTP_SWITCHING_PROTOCOLS,
102 => Apache2::Const::HTTP_PROCESSING,
# Success 2xx
lib/Apache2/API/Status.pm view on Meta::CPAN
sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
# NOTE: sub THAW is inherited
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::Status - Apache2 Status Codes
=head1 SYNOPSIS
use Apache2::API::Status ':common';
use Apache2::API::Status ':all';
say Apache2::API::Status::HTTP_TOO_MANY_REQUESTS;
is( $opts->{code}, Apache2::Const::HTTP_OK, $opts->{name} ) ||
diag( "Error with test \"$opts->{name}\". See log content below:\n", &get_log( $opts ) );
}
sub get_log
{
my $opts = shift( @_ );
my $log_file = $target2path->{ $opts->{target} }->child( $opts->{name} . '.log' );
if( $log_file->exists )
{
return( $log_file->load_utf8 );
}
else
{
diag( "Test $opts->{target} -> $opts->{name} seems to have failed, but there is no log file \"$log_file\"" );
}
}
done_testing();
__END__
t/02.datetime.t view on Meta::CPAN
#!/usr/local/bin/perl
BEGIN
{
use strict;
use warnings;
use lib './lib';
use open ':std' => ':utf8';
use vars qw( $DEBUG );
use Test2::V0;
# 2021-11-1T167:12:10+0900
use Test::Time time => 1635754330;
use ok( 'Apache2::API::DateTime' );
use ok( 'DateTime' ) || bail_out( "No DateTime module installed" );
our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
require( "./t/env.pl" ) if( -e( "t/env.pl" ) );
};
t/03.query.t view on Meta::CPAN
#!/usr/local/bin/perl
BEGIN
{
use strict;
use warnings;
use lib './lib';
use open ':std' => ':utf8';
# use Test2::V0;
use Test::More;
use Devel::Confess;
use vars qw( $DEBUG );
use ok( 'Apache2::API::Query' ) || bail_out( "Cannot load Apache2::API::Query" );
our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
require( "./t/env.pl" ) if( -e( "t/env.pl" ) );
};
use strict;
t/03.query.t view on Meta::CPAN
isnt( $qq->clone->strip( 'fluffy' )->stringify, $qq->stringify, 'changed clone stringifies differently' );
# Identical changes stringify identically
is( $qq->clone->strip( 'fluffy' )->qstringify, $qq->strip('fluffy')->qstringify, 'same changes qstringify identically' );
};
subtest 'japanese' => sub
{
my $qs = 'lang=ja_JP&name=%E3%83%AA%E3%83%BC%E3%82%AC%E3%83%AB%E3%83%86%E3%83%83%E3%82%AF%E3%83%97%E3%83%AC%E3%83%9F%E3%82%A2%E3%83%A0';
use utf8;
my $test_string = 'リーガルテックプレミアム';
my $q = Apache2::API::Query->new( $qs );
isa_ok( $q, 'Apache2::API::Query' );
my $h = $q->hash;
is( $h->{name}, $test_string );
};
done_testing();
__END__
t/lib/Test/Apache2/API.pm view on Meta::CPAN
sub is_perl_option_enabled { return( shift->_test({ method => 'is_perl_option_enabled', expect => 1, type => 'boolean', args => ['GlobalRequest'] }) ); }
sub json { return( shift->_test({ method => 'header_datetime', expect => sub
{
my $json = shift( @_ );
return( Scalar::Util::blessed( $json ) &&
$json->isa( 'JSON' ) &&
$json->canonical &&
$json->get_relaxed &&
$json->get_utf8 &&
$json->get_allow_nonref &&
$json->get_allow_blessed &&
$json->get_convert_blessed );
}, args => [pretty => 1, ordered => 1, relaxed => 1, utf8 => 1, allow_nonref => 1, allow_blessed => 1, convert_blessed => 1] }) ); }
sub reply
{
return( shift->api->reply( Apache2::Const::HTTP_OK => {
message => "ok",
}) );
}
sub server { return( shift->_test({ method => 'server', expect => 'Apache2::ServerRec', type => 'isa' }) ); }
sub server_version { return( shift->_test({ method => 'server_version', expect => 'version', type => 'isa' }) ); }
sub _target { return( shift->api ); }
1;
# NOTE: POD
# Use this to generate the tests list:
# egrep -E '^sub ' ./t/lib/Test/Apache2/API.pm | perl -lnE 'my $m = [split(/\s+/, $_)]->[1]; say "=head2 $m\n"'
__END__
=encoding utf8
=head1 NAME
Test::Apache2::API - Apache2::API Testing Class
=head1 SYNOPSIS
In the Apache test conf:
PerlModule Apache2::API
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
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';
t/lib/Test/Apache2/API/Response.pm view on Meta::CPAN
# x_xss_protection
sub _target { return( shift->api->response ); }
1;
# NOTE: POD
# Use this to generate the tests list:
# egrep -E '^sub ' ./t/lib/Test/Apache2/API/Response.pm | perl -lnE 'my $m = [split(/\s+/, $_)]->[1]; say "=head2 $m\n"'
__END__
=encoding utf8
=head1 NAME
Test::Apache2::API::Response - Apache2::API::Response Testing Class
=head1 SYNOPSIS
my $hostport = Apache::TestRequest::hostport( $config ) || '';
my( $host, $port ) = split( ':', ( $hostport ) );
my $mp_host = 'www.example.org';
t/lib/Test/Apache2/Common.pm view on Meta::CPAN
unless( $base_path = $class2log->{ ref( $obj ) } )
{
my @parts = split( /::/, ref( $obj ) );
my $parent_path = $config->{vars}->{t_logs} || die( "No 't_logs' variable in Apache::TestConfig->thaw->httpd_config" );
$parent_path = file( $parent_path );
$base_path = $parent_path->child( join( '/', map( lc( $_ ), split( /::/, ref( $obj ) ) ) ) );
$base_path->mkpath if( !$base_path->exists );
$class2log->{ ref( $obj ) } = $base_path;
}
my $log_file = $base_path->child( "${meth}.log" );
my $io = $log_file->open( '>', { autoflush => 1, binmode => 'utf8' } ) ||
die( "Unable to open test log file \"$log_file\" in write mode: $!" );
my $val = $args ? $code->( $obj, @$args ) : $code->( $obj );
my $rv;
if( ref( $expect ) eq 'CODE' )
{
$rv = $expect->( $val, { object => $self, log => sub{ $io->print( @_, "\n" ) } } );
}
elsif( $opts->{type} eq 'boolean' )
{
t/lib/Test/Apache2/Common.pm view on Meta::CPAN
$io->close;
$log_file->remove if( $log_file->is_empty );
$r->log_error( "$[class}: ${meth}() -> ", ( $rv ? 'ok' : 'not ok' ) ) if( $debug );
return( $self->ok( $rv ) );
}
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Test::Apache2::Common - Apache2::API Testing Common Class
=head1 SYNOPSIS
package Test::Apache2::API;
use parent qw( Test::Apache2::Common );
# etc.
( run in 1.732 second using v1.01-cache-2.11-cpan-49f99fa48dc )