view release on metacpan or  search on metacpan

lib/Kelp/Request.pm  view on Meta::CPAN

package Kelp::Request;

use Kelp::Base 'Plack::Request';

use Carp;
use Try::Tiny;
use Hash::MultiValue;
use Kelp::Util;

our @CARP_NOT = qw(Kelp);

attr -app => sub { croak "app is required" };

# The stash is used to pass values from one route to another
attr stash => sub { {} };

# The named hash contains the values of the named placeholders
attr named => sub { {} };

# charset which came with the request
attr -charset => sub {
    my $self = shift;

    return undef unless $self->content_type;
    return undef unless $self->content_type =~ m{
        ^(?:                  # only on some content-types
            text/ | application/
        )
        .+
        ;\s*charset=([^;\$]+) # get the charset
    }xi;
    return $1;
};

# The name of the matched route for this request
attr route_name => sub { undef };

attr query_parameters => sub {
    my $self = shift;

    $self->SUPER::query_parameters;
    my $decoded = $self->_charset_decode_array($self->env->{'plack.request.query_parameters'}, 1);
    return Hash::MultiValue->new(@{$decoded});
};

attr body_parameters => sub {
    my $self = shift;

    $self->SUPER::body_parameters;
    my $decoded = $self->_charset_decode_array($self->env->{'plack.request.body_parameters'});
    return Hash::MultiValue->new(@{$decoded});
};

attr parameters => sub {
    my $self = shift;

    $self->SUPER::parameters;
    my $decoded_query = $self->_charset_decode_array($self->env->{'plack.request.query_parameters'}, 1);
    my $decoded_body = $self->_charset_decode_array($self->env->{'plack.request.body_parameters'});
    return Hash::MultiValue->new(@{$decoded_query}, @{$decoded_body});
};

# Raw methods - methods in Plack::Request (without decoding)
# in Kelp::Request, they are replaced with decoding versions

sub raw_path
{
    my $self = shift;
    return $self->SUPER::path(@_);
}

sub raw_body
{
    my $self = shift;
    return $self->SUPER::content(@_);
}

sub raw_body_parameters
{
    my $self = shift;
    return $self->SUPER::body_parameters(@_);
}

sub raw_query_parameters
{
    my $self = shift;