view release on metacpan or  search on metacpan

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

    }
}

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

# Apache2::Connection
sub connection { return( shift->_try( 'request', 'connection' ) ); }

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

sub content { return( ${ shift->request->slurp_filename } ); }

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

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

sub content_length { return( shift->headers( 'Content-Length' ) ); }

sub content_type
{
    my $self = shift( @_ );
    my $ct = $self->headers( 'Content-Type' );
    return( $ct ) if( !scalar( @_ ) );
    $self->error( "Warning only: caller is trying to use ", ref( $self ), " to set the content-type. Use Apache2::API::Response for that instead." ) if( @_ );
    return( $self->request->content_type( @_ ) );
}

# To get individual cookie sent. See APR::Request::Cookie
# APR::Request::Cookie
# sub cookie { return( shift->cookies->get( @_ ) ); }
sub cookie
{
    my $self = shift( @_ );
    my $name = shift( @_ );
    # An erro has occurred if this is undef
    my $jar = $self->cookies || return( $self->pass_error );
    # Cookie::Jar might return undef if there was no match
    my $v = $jar->get( $name );
    return( $v ) unless( $v );
    return( $v->value );
}

# To get all cookies; then we can fetch then with $jar->get( 'this_cookie' ) for example
# sub cookies { return( shift->request->jar ); }
# https://grokbase.com/t/modperl/modperl/06c91r49n4/apache2-cookie-apr-request-cookie
# sub cookies { return( APR::Request::Apache2->handle( shift->request->pool )->jar ); }

# my $req = APR::Request::Apache2->handle( $self->r );
# my %cookies;
# if ( $req->jar_status =~ /^(?:Missing input data|Success)$/ ) {
# my $jar = $req->jar;
# foreach my $key ( keys %$jar ) {
# $cookies{$key} = $jar->get($key);
# }
# }
# 
# # Send warning with headers to explain bad cookie
# else {
# warn( "COOKIE ERROR: "
# . $req->jar_status . "\n"
# . Data::Dumper::Dumper( $self->r->headers_in() ) );
# }

sub cookies
{
    my $self = shift( @_ );
    return( $self->{_jar} ) if( $self->{_jar} );
    my $jar = Cookie::Jar->new( request => $self->request, debug => $self->debug ) ||
        return( $self->error( "An error occurred while trying to instantiate a new Cookie::Jar object: ", Cookie::Jar->error ) );
    $jar->fetch;
    $self->{_jar} = $jar;
    return( $jar );
}

sub data
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    my $r    = $self->request;
    # Mutator mode
    if( $opts->{data} )
    {
        if( !defined( $opts->{data} ) ||
            !CORE::length( $opts->{data} // '' ) )
        {
            warn( "Warning only: you are setting a zero-length payload data." ) if( $self->_is_warnings_enabled( 'Apache2::API' ) );
        }
        $self->pnotes( REQUEST_BODY => $opts->{data} );
        # Optional: allow caller to mark as processed explicitly
        if( $opts->{processed} )
        {
            $self->pnotes( REQUEST_BODY_PROCESSED => 1 );
        }
        return( $opts->{data} );
    }

    # Accessor mode
    my $payload = $self->pnotes( 'REQUEST_BODY' );
    return( $payload ) if( $self->pnotes( 'REQUEST_BODY_PROCESSED' ) );
    my $ctype    = $self->type;
    my $max_size = 0;
    # The request payload has been set or processed, so we re-use it.
    if( defined( $payload ) )
    {
        # We do not set the 'REQUEST_BODY_PROCESSED' flag, because 1) we do not need to, and 2) it is an indicator if the request payload was processed at all. For example, one could force a different request payload by calling data() in mutator mode...
        return( $payload );
    }

    if( $opts->{max_size} )
    {
        $max_size = $opts->{max_size};
    }
    elsif( my $val = $self->max_size )
    {
        $max_size = $val;
    }
    elsif( $r->dir_config( 'PAYLOAD_MAX_SIZE' ) )
    {
        $max_size = $r->dir_config( 'PAYLOAD_MAX_SIZE' );
    }