view release on metacpan or  search on metacpan

t/lib/Test/Apache2/API/Request.pm  view on Meta::CPAN

# 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' );
    }
} }) ); }

# The allowed methods, GET, POST, PUT, OPTIONS, HEAD, etc
sub allowed { return( shift->_test({ method => 'allowed', expect => sub
{
    my $bitmask = shift( @_ );
    my $opts = shift( @_ );
    my $self = $opts->{object};
    my $req = $self->api->request;
    my $r = $self->_request;
    my $cnt = 0;
    $opts->{log}->( "\$bitmask is '$bitmask'" );
    $opts->{log}->( "\$req->method_number = '" . $req->method_number . "'" );
    $cnt++ if( !$bitmask || ( $bitmask & Apache2::Const::M_POST ) );
    $cnt++ if( !$bitmask || ( $bitmask & $req->method_number ) );
    return( $cnt == 2 );
} }) ); }

# NOTE: special processing
sub args { return( shift->_test({ method => 'args', expect => sub
{
    my $ref = shift( @_ );
    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
{
    my $str = shift( @_ );
    my $opts = shift( @_ );
    my $self = $opts->{object};
    my $r = $self->request;
    $opts->{log}->( "request as a string is: $str" );
    # 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' }) ); }