view release on metacpan or  search on metacpan

t/01.api.t  view on Meta::CPAN

{
    my( $req, $resp );
    &simple_test({ target => 'api', name => 'compression_threshold', code => Apache2::Const::HTTP_OK });

    &simple_test({ target => 'api', name => 'decode_json', code => Apache2::Const::HTTP_OK });

    &simple_test({ target => 'api', name => 'encode_decode_url', code => Apache2::Const::HTTP_OK });

    &simple_test({ target => 'api', name => 'auth', code => Apache2::Const::HTTP_OK, headers => [Authorization => "Bearer: $jwt"] });

    &simple_test({ target => 'api', name => 'header_datetime', code => Apache2::Const::HTTP_OK });

    &simple_test({ target => 'api', name => 'is_perl_option_enabled', code => Apache2::Const::HTTP_OK });

    &simple_test({ target => 'api', name => 'json', code => Apache2::Const::HTTP_OK });
    
    $resp = &make_request( api => 'reply' );
    my $j = JSON->new;
    my $content = $resp->decoded_content;
    diag( "test 'reply' decoded_content is '$content'" ) if( $DEBUG );
    my $ref;
    eval
    {
        $ref = $j->decode( $content );
    };
    
    ok( ref( $ref ) eq 'HASH', 'reply -> JSON decoded content is an hash reference' );
    is( $resp->code, Apache2::Const::HTTP_OK, 'reply code' );
    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 });
    }
    
    my( $req, $resp );
    &simple_test({ target => 'request', name => 'args', code => Apache2::Const::HTTP_OK, query => 'foo=1&foo=2&bar=3&lang=ja_JP' });

    &simple_test({ target => 'request', name => 'auth', code => Apache2::Const::HTTP_OK, headers => [Authorization => "Bearer: $jwt"] });

    &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
{
    my @tests = qw(
        headers headers_out make_etag no_cache no_local_copy sendfile set_last_modified
        socket 
    );
    
    foreach my $test ( @tests )
    {
        &simple_test({ target => 'response', name => $test, code => Apache2::Const::HTTP_OK });
    }
};

sub make_request
{
    my( $type, $path, $opts ) = @_;
    
    my $http_meth = uc( $opts->{http_method} // 'GET' );
    my $req = HTTP::Request->new( $http_meth => "${proto}://${hostport}/tests/${type}/${path}",
        ( exists( $opts->{headers} ) ? $opts->{headers} : () ),
        ( ( exists( $opts->{body} ) && length( $opts->{body} // '' ) ) ? $opts->{body} : () ),
    );
    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 );