view release on metacpan or  search on metacpan

lib/PSGI/Handy.pm  view on Meta::CPAN

    $s =~ s/([^A-Za-z0-9_\-.~])/sprintf('%%%02X', ord($1))/eg;
    return $s;
}

######################################################################
# PSGI::Handy::Request - tiny PSGI env wrapper
#
# Wraps a PSGI %env and exposes method, path, query/body parameters
# (merged), headers, cookies and the raw body. Query- and body-parameter
# parsing and percent-decoding are implemented here in pure Perl.
######################################################################
package PSGI::Handy::Request;

# --------------------------------------------------------------------
# new($env) - wrap a PSGI environment hash reference
# --------------------------------------------------------------------
sub new {
    my ($class, $env) = @_;
    ref($env) eq 'HASH' or Carp::croak "new: a PSGI env hash reference is required";
    my $self = { env => $env };
    return bless $self, $class;
}

# --- request line -----------------------------------------------------
sub method {
    my $self = shift;
    my $m = $self->{env}{REQUEST_METHOD};
    return defined $m ? $m : '';
}

sub path {
    my $self = shift;
    my $p = $self->{env}{PATH_INFO};
    return defined $p ? $p : '';
}

sub query_string {
    my $self = shift;
    my $q = $self->{env}{QUERY_STRING};
    return defined $q ? $q : '';
}

sub content_type {
    my $self = shift;
    my $t = $self->{env}{CONTENT_TYPE};
    return defined $t ? $t : '';
}

sub content_length {
    my $self = shift;
    my $l = $self->{env}{CONTENT_LENGTH};
    return (defined $l && $l ne '') ? int($l) : 0;
}

sub env {
    my $self = shift;
    return $self->{env};
}

# --- headers ----------------------------------------------------------
# Accepts 'Content-Type', 'content_type', 'X-Forwarded-For', etc.
sub header {
    my ($self, $name) = @_;
    return undef unless defined $name;
    my $key = uc($name);
    $key =~ s/-/_/g;
    if ($key eq 'CONTENT_TYPE' || $key eq 'CONTENT_LENGTH') {
        return $self->{env}{$key};
    }
    return $self->{env}{'HTTP_' . $key};
}

# --- raw body (read once from psgi.input, then cached) ---------------
sub body {
    my $self = shift;
    return $self->{_body} if exists $self->{_body};
    my $buf = '';
    my $len = $self->content_length;
    my $input = $self->{env}{'psgi.input'};
    if ($len > 0 && $input) {
        # psgi.input->read may return fewer bytes than requested, so loop
        # until CONTENT_LENGTH bytes are read or the stream ends.
        my $chunk;
        my $got = 0;
        while ($got < $len) {
            my $n = $input->read($chunk, $len - $got);
            last unless $n;        # EOF or error: keep what we have
            $buf .= $chunk;
            $got += $n;
        }
    }
    $self->{_body} = $buf;
    return $buf;
}

# --- parameters (query string merged with urlencoded body) -----------
sub param {
    my ($self, $name) = @_;
    $self->_build_params;
    return undef unless defined $name;
    my $v = $self->{_params}{$name};
    return undef unless $v;
    return $v->[0];
}

sub param_all {
    my ($self, $name) = @_;
    $self->_build_params;
    return () unless defined $name;
    my $v = $self->{_params}{$name};
    return () unless $v;
    return @$v;
}

sub param_names {
    my $self = shift;
    $self->_build_params;
    return keys %{ $self->{_params} };
}

# Flat hash reference: name => first value.