view release on metacpan or  search on metacpan

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

sub content_security_policy_report_only { return( shift->_set_get_one( 'Content-Security-Policy-Report-Only', @_ ) ); }

# Apache content_type method is special. It does not just set the content type
sub content_type { return( shift->_try( '_request', 'content_type', @_ ) ); }
# sub content_type { return( shift->headers( 'Content-Type', @_ ) ); }

sub cookie_new
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    return( $self->error( "Cookie name was not provided." ) ) if( !$opts->{name} );
    # No value is ok to remove a cookie, but it needs to be an empty string, not undef
    # return( $self->error( "No value was provided for cookie \"$opts->{name}\"." ) ) if( !length( $opts->{value} ) && !defined( $opts->{value} ) );
    my $c = $self->request->cookies->make( $opts ) || return( $self->pass_error( $self->request->cookies->error ) );
    return( $c );
}

# Add or replace a cookie, but because the headers function of Apache2 is based on APR::Table
# there is no replace method, AND because the value of the headers is a string and not an object
# we have to crawl each already set cookie, parse them, compare them en replace them or add them
sub cookie_replace
{
    my $self = shift( @_ );
    my $cookie = shift( @_ ) || return( $self->error( "No cookie to add to outgoing headers was provided." ) );
    # Expecting an APR::Request::Cookie object
    return( $self->error( "Cookie provided (", ref( $cookie ), ") is not an object." ) ) if( !Scalar::Util::blessed( $cookie ) );
    return( $self->error( "Cookie object provided (", ref( $cookie ), ") does not seem to have an \"as_string\" method." ) ) if( !$cookie->can( 'as_string' ) );
    # We use err_headers_out() which makes it also possible to set cookies upon error (regular headers_out method cannot)
    my( @cookie_headers ) = $self->err_headers->get( 'Set-Cookie' );
    if( !scalar( @cookie_headers ) )
    {
        $self->err_headers->set( 'Set-Cookie' => $cookie->as_string );
    }
    else
    {
        my $jar = Cookie::Jar->new;
        # Check each cookie header set to see if ours is one of them
        my $found = 0;
        for( my $i = 0; $i < scalar( @cookie_headers ); $i++ )
        {
            my $c = $jar->extract_one( $cookie_headers[ $i ] ) || do
            {
                warn( "Error parsing cookie string '", $cookie_headers[ $i ], "': ", $jar->error, "\n" ) if( $self->_is_warnings_enabled( 'Apache2::API' ) );
                next;
            };
            
            if( $c->name eq $cookie->name )
            {
                $cookie_headers[ $i ] = $cookie->as_string;
                $found = 1;
            }
        }
        if( !$found )
        {
            $self->err_headers->add( 'Set-Cookie' => $cookie->as_string );
        }
        else
        {
            # Remove all Set-Cookie headers
            $self->err_headers->unset( 'Set-Cookie' );
            # Now, re-add our updated set
            foreach my $cookie_str ( @cookie_headers )
            {
                $self->err_headers->add( 'Set-Cookie' => $cookie_str );
            }
        }
    }
    return( $cookie );
}

sub cookie_set
{
    my $self = shift( @_ );
    my $cookie = shift( @_ ) || return( $self->error( "No cookie to add to outgoing headers was provided." ) );
    # Expecting an APR::Request::Cookie object
    return( $self->error( "Cookie provided (", ref( $cookie ), ") is not an object." ) ) if( !Scalar::Util::blessed( $cookie ) );
    return( $self->error( "Cookie object provided (", ref( $cookie ), ") does not seem to have an \"as_string\" method." ) ) if( !$cookie->can( 'as_string' ) );
    $self->err_headers->set( 'Set-Cookie' => $cookie->as_string );
    return( $cookie );
}

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

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

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

sub cspro { return( shift->content_security_policy_report_only( @_ ) ); }

# e.g. custom_response( $status, $string );
# e.g. custom_response( Apache2::Const::AUTH_REQUIRED, "Authenticate please" );
#  package MyApache2::MyShop;
#  use Apache2::Response ();
#  use Apache2::Const -compile => qw(FORBIDDEN OK);
#  sub access {
#    my $r = shift;
# 
#    if (MyApache2::MyShop::tired_squirrels()) {
#        $r->custom_response(Apache2::Const::FORBIDDEN,
#            "It is siesta time, please try later");
#        return Apache2::Const::FORBIDDEN;
#    }
# 
#    return Apache2::Const::OK;
#  }
sub custom_response { return( shift->_try( '_request', 'custom_response', @_ ) ); }

sub decode
{
    my $self = shift( @_ );
    return( APR::Request::decode( shift( @_ ) ) );
}

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

sub encode
{