view release on metacpan or  search on metacpan

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

            else
            {
                $form->{ $name } = $up;
            }
        }
        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
sub parse_date { return( shift->datetime->parse_date( @_ ) ); }

# example: /bin:/usr/bin:/usr/local/bin
sub path { return( shift->env( 'PATH', @_ ) ); }

sub path_info { return( shift->_try( 'request', 'path_info', @_ ) ); }

sub payload { return( shift->_set_get_hash( 'payload', @_ ) ); }

sub per_dir_config { return( shift->_try( 'rquest', 'per_dir_config' ) ); }

sub pnotes { return( shift->_try( 'request', 'pnotes', @_ ) ); }

sub pool { return( shift->_try( 'connection', 'pool' ) ); }

sub preferred_language
{
    my $self = shift( @_ );
    my $ok_langs = [];
    if( @_ )
    {
        return( $self->error( "I was expecting a list of supported languages as array reference, but instead I received this '", join( "', '", @_ ), "'." ) ) if( !$self->_is_array( $_[0] ) );
        # Make a copy
        $ok_langs = [ @{$_[0]} ];
        # Make sure the languages provided are in web format (e.g. en-GB), not unix format (e.g. en_GB)
        for( my $i = 0; $i < scalar( @$ok_langs ); $i++ )
        {
            $ok_langs->[ $i ] =~ tr/_/-/;
        }
    }
    else
    {
        return( $self->error( "No supported languages list was provided as array reference." ) );
    }
    # No supported languages was provided
    return( '' ) if( !scalar( @$ok_langs ) );
    # The user has not set his/her preferred languages
    my $accept_langs = $self->accept_language || return( '' );
    my $al = HTTP::AcceptLanguage->new( $accept_langs );
    # Get the most suitable one
    my $ok = $al->match( @$ok_langs );
    return( $ok ) if( CORE::length( $ok // '' ) );
    # No match, we return empty. undef is for error only
    return( '' );
}

sub prev { return( shift->_try( 'request', 'prev' ) ); }

sub protocol { return( shift->_try( 'request', 'protocol' ) ); }

sub proxyreq { return( shift->_try( 'request', 'proxyreq', @_ ) ); }

sub psignature { return( shift->_try( 'request', 'psignature', @_ ) ); }

# push_handlers( PerlCleanupHandler => \&handler );
# $ok = $r->push_handlers($hook_name => \&handler);
# $ok = $r->push_handlers($hook_name => ['Foo::Bar::handler', \&handler2]);
# https://perl.apache.org/docs/2.0/api/Apache2/RequestUtil.html#C_push_handlers_
sub push_handlers { return( shift->_try( 'request', 'push_handlers', @_ ) ); }

# Maybe better to APR::Body->args
sub query
{
    my $self = shift( @_ );
    my $qs = $self->query_string;
    my $qq = Apache2::API::Query->new( $qs );
    my %hash = $qq->hash;
    return( \%hash );
}

# Set/get a query string
sub query_string { return( shift->_try( 'request', 'args', @_ ) ); }

# Apache2::RequestIO
sub read { return( shift->_try( 'request', 'read', @_ ) ); }

sub redirect_error_notes { return( shift->env( 'REDIRECT_ERROR_NOTES', @_ ) ); }

sub redirect_query_string { return( shift->env( 'REDIRECT_QUERY_STRING', @_ ) ); }

sub redirect_status { return( shift->env( 'REDIRECT_STATUS', @_ ) ); }

# https://httpd.apache.org/docs/2.4/custom-error.html
sub redirect_url { return( shift->env( 'REDIRECT_URL', @_ ) ); }