Apache2-API

 view release on metacpan or  search on metacpan

lib/Apache2/API/Query.pm  view on Meta::CPAN

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' )
            {
                @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( @_ );

lib/Apache2/API/Query.pm  view on Meta::CPAN

    # Remove all parameters except the given ones
    $qq->strip_except('pagesize', 'order');

    # Remove all empty/undefined parameters
    $qq->strip_null;

    # Replace all occurrences of the given parameters
    $qq->replace(page => $page, foo => 'bar');

    # Set the argument separator to use for output (default: unescaped '&')
    $qq->separator(';');

    # Output the current query string
    print "$qq";           # OR $qq->stringify;
    # Stringify with explicit argument separator
    $qq->stringify(';');

    # Output the current query string with a leading '?'
    $qq->qstringify;
    # Stringify with a leading '?' and an explicit argument separator

lib/Apache2/API/Query.pm  view on Meta::CPAN

    # Constructor - using an array of successive keys and values
    $qq = Apache2::API::Query->new(@params);

    # Constructor - using a hashref of key => value parameters,
    # where values are either scalars or arrayrefs of scalars
    $qq = Apache2::API::Query->new($cgi->Vars);

Apache2::API::Query also handles L<CGI.pm>-style hashrefs, where multiple values are packed into a single string, separated by the "\0" (null) character.

All keys and values are URI unescaped at construction time, and are stored and referenced unescaped. So a query string like:

    group=prod%2Cinfra%2Ctest&op%3Aset=x%3Dy

is stored as:

    'group'     => 'prod,infra,test'
    'op:set'    => 'x=y'

You should always use the unescaped/normal variants in methods i.e.

     $qq->replace('op:set'  => 'x=z');

NOT:

     $qq->replace('op%3Aset'  => 'x%3Dz');

You can also construct a new Apache2::API::Query object by cloning an existing one:

     $qq2 = $qq->clone;

lib/Apache2/API/Query.pm  view on Meta::CPAN

=head2 OUTPUT METHODS

=over 4

=item "$qq", stringify(), stringify($separator)

Return the current parameter set as a conventional param=value query string, using $separator as the separator if given. e.g.

    foo=1&bar=2&bar=3

Note that all parameters and values are URI escaped by stringify(), so that query-string reserved characters do not occur within elements. For instance, a parameter set of:

    'group'     => 'prod,infra,test'
    'op:set'    => 'x=y'

will be stringified as:

    group=prod%2Cinfra%2Ctest&op%3Aset=x%3Dy

=item qstringify(), qstringify($separator)

lib/Apache2/API/Response.pm  view on Meta::CPAN

    else
    {
        $r->subprocess_env;
    }
}

sub err_headers { return( shift->_headers( 'err_headers_out', @_ ) ); }

sub err_headers_out { return( shift->_headers( 'err_headers_out', @_ ) ); }

sub escape { return( URI::Escape::uri_escape( @_ ) ); }

sub etag { return( shift->headers( 'ETag', @_ ) ); }
# <https://perl.apache.org/docs/2.0/api/Apache2/Response.html#toc_C_set_etag_>
# sub etag { return( shift->_try( '_request', 'set_etag', @_ ) ); }

sub expires { return( shift->headers( 'Expires', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Access-Control-Expose-Headers>
# e.g.: Access-Control-Expose-Headers: Content-Encoding, X-Kuma-Revision
sub expose_headers { return( shift->_set_get_multi( 'Access-Control-Expose-Headers', @_ ) ); }

lib/Apache2/API/Response.pm  view on Meta::CPAN

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Timing-Allow-Origin>
sub timing_allow_origin { return( shift->_set_get_multi( 'Timing-Allow-Origin', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Trailer>
sub trailer { return( shift->_set_get_one( 'Trailer', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Transfer-Encoding>
sub transfer_encoding { return( shift->_set_get_one( 'Transfer-Encoding', @_ ) ); }

sub unescape { return( URI::Escape::uri_unescape( @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Upgrade>
sub upgrade { return( shift->_set_get_multi( 'Upgrade', @_ ) ); }

sub update_mtime { return( shift->_try( '_request', 'update_mtime', @_ ) ); }

sub uri_escape { return( shift->escape( @_ ) ); }

sub uri_unescape { return( shift->unescape( @_ ) ); }

sub url_decode { return( shift->decode( @_ ) ); }

sub url_encode { return( shift->encode( @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Vary>
sub vary { return( shift->_set_get_multi( 'Vary', @_ ) ); }

# <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Via>
sub via { return( shift->_set_get_multi( 'Via', @_ ) ); }

lib/Apache2/API/Response.pm  view on Meta::CPAN

    my $cspro = $resp->cspro;
    $resp->custom_response( Apache2::Const::AUTH_REQUIRED, "Authenticate please" );
    my $decoded = $resp->decode( $string );
    # Digest
    my $digest = $resp->digest;
    my $encoded = $resp->encode( $string );
    # APR::Table object
    my $env = $resp->env;
    my $headers = $resp->err_headers;
    my $headers = $resp->err_headers_out;
    my $escaped = $resp->escape( $string );
    my $etag = $resp->etag;
    # Expires
    my $expires = $resp->expires;
    # Access-Control-Expose-Headers
    my $expose_headers = $resp->expose_headers;
    $resp->flush;
    my $msg = $resp->get_http_message( 429 => 'ja_JP' );
    my $string = $resp->get_status_line;
    my $content_type = $resp->headers( 'Content-Type' );
    # or (since it is case insensitive)

lib/Apache2/API/Response.pm  view on Meta::CPAN

    my $status_line = $resp->status_line;
    # Strict-Transport-Security
    my $policy = $resp->strict_transport_security;
    # APR::Table object
    my $env = $resp->subprocess_env;
    # Timing-Allow-Origin
    my $origin = $resp->timing_allow_origin;
    # Trailer
    my $trailerv = $resp->trailer;
    my $enc = $resp->transfer_encoding;
    my $unescape = $resp->unescape( $string );
    # Upgrade
    my $upgrade = $resp->upgrade;
    $resp->update_mtime( $seconds );
    my $uri = $resp->uri_escape( $uri );
    my $uri = $resp->uri_unescape( $uri );
    my $decoded = $resp->url_decode( $uri );
    my $encoded = $resp->url_encode( $uri );
    # Vary
    my $vary = $resp->vary;
    # Via
    my $via = $resp->via;
    # Want-Digest
    my $want = $resp->want_digest;
    # Warning
    my $warn = $resp->warning;

lib/Apache2/API/Response.pm  view on Meta::CPAN

If the handler does:

    $resp->headers_out->add( 'Set-Cookie' => $cookie );
    return( Apache2::Const::NOT_FOUND );

the C<Set-Cookie> header will not be sent.

See L<Apache2::RequestRec> for more information.

=head2 escape

Provided with a value and this will return it uri escaped by calling L<URI::Escape/uri_escape>.

=head2 etag

Sets or gets the HTTP header field C<Etag>

=head2 expires

Sets or gets the HTTP header field C<Expires>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Expires>

lib/Apache2/API/Response.pm  view on Meta::CPAN

Sets or gets the HTTP header field C<Trailer>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Trailer>

=head2 transfer_encoding

Sets or gets the HTTP header field C<Transfer-Encoding>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Transfer-Encoding>

=head2 unescape

Unescape the given data chunk by calling L<URI::Escape/uri_unescape>

=head2 update_mtime

Set the C<< $resp->mtime >> field to the specified value if it is later than what is already there, by calling L<Apache2::Response/update_mtime>

    $resp->update_mtime( $mtime );

=head2 upgrade

Sets or gets the HTTP header field C<Upgrade>

See L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Upgrade>

=head2 uri_escape

Provided with a string and this uses L<URI::Escape> to return an uri-escaped string.

=head2 uri_unescape

Provided with an uri-escaped string and this will decode it and return its original string, by calling L<URI::Escape/uri_unescape>

=head2 url_decode

Provided with an url-encoded string and this will return its decoded version, by calling L<APR::Request/decode>

=head2 url_encode

Provided with a string and this will return an url-encoded version, by calling L<APR::Request/encode>

=head2 vary

t/03.query.t  view on Meta::CPAN

    ok( $qq2 = Apache2::API::Query->new( 'foo=1&bar=3&foo=2' ), 'object from query string' );
    is( $qq1, $qq2, 'eq' );
    ok( $qq2 = Apache2::API::Query->new( 'bar=3&foo=1&foo=2' ), 'object from query string' );
    is( $qq1, $qq2, 'eq' );
    ok( $qq2 = Apache2::API::Query->new( 'bar=3&foo=2&foo=1' ), 'object from query string' );
    isnt( $qq1, $qq2, 'ne ok (value ordering preserved)' );
    ok( $qq2 = Apache2::API::Query->new( 'bar=3' ), 'object from query string' );
    isnt( $qq1, $qq2, 'ne ok' );
};

subtest 'unescape' => sub
{
    my $data_esc =
    {
    group     => 'prod%2Cinfra%2Ctest',
    'op%3Aset'  => 'x%3Dy',
    };
    my $data_unesc =
    {
    group     => 'prod,infra,test',
    'op:set'  => 'x=y',
    };
    my $qs_esc = 'group=prod%2Cinfra%2Ctest&op%3Aset=x%3Dy';
    my( $qq, $qs );

    ok( $qq = Apache2::API::Query->new( $qs_esc ), 'object from unescaped query string' );
    is_deeply( scalar( $qq->hash ), $data_unesc, '$qq->hash keys and values are unescaped' );
    is( "$qq", $qs_esc, 'stringification escapes keys/values' );

    ok( $qq = Apache2::API::Query->new( $data_esc ), 'object from unescaped hash reference' );
    is_deeply( scalar $qq->hash, $data_unesc, '$qq->hash keys and values are unescaped' );
    is( "$qq", $qs_esc, 'stringification escapes keys/values' );

    ok( $qq = Apache2::API::Query->new( %$data_esc ), 'object from unescaped hash' );
    is_deeply( scalar $qq->hash, $data_unesc, '$qq->hash keys and values are unescaped' );
    is( "$qq", $qs_esc, 'stringification escapes keys/values' );
};

subtest 'has_changed' => sub
{
    my $qq;
    ok( $qq = Apache2::API::Query->new( 'foo=1&foo=2&bar=3;bog=;bar=7;fluffy=3'), 'object from query string' );
    ok( !$qq->has_changed, 'has_changed returns false' );

    # strip
    $qq->strip( qw(bogus) );

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

# cross_origin_opener_policy
# cross_origin_resource_policy
# cspro
# custom_response
# decode
# digest
# encode
# env
# err_headers
# err_headers_out
# escape
# etag
# expires
# expose_headers
# flush
# get_http_message
# get_status_line

sub headers { return( shift->_test({ method => 'headers', expect => 'APR::Table', type => 'isa' }) ); }

sub headers_out { return( shift->_test({ method => 'headers_out', expect => 'APR::Table', type => 'isa' }) ); }

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

sub socket { return( shift->_test({ method => 'socket', expect => 'APR::Socket', type => 'isa' }) ); }

# sourcemap
# status
# status_line
# strict_transport_security
# subprocess_env
# timing_allow_origin
# trailer
# transfer_encoding
# unescape
# upgrade
# update_mtime
# uri_escape
# uri_unescape
# url_decode
# url_encode
# vary
# via
# want_digest
# warning
# write
# www_authenticate
# x_content_type_options
# x_dns_prefetch_control