view release on metacpan or  search on metacpan

t/corpus-stack/PSGI-Handy/lib/PSGI/Handy/Request.pm  view on Meta::CPAN

                # Perl 5.005_03 compatibility for historical toolchains
# use 5.008001; # Lancaster Consensus 2013 for toolchains

use strict;
BEGIN { if ($] < 5.006 && !defined(&warnings::import)) { $INC{'warnings.pm'} = 'stub'; eval 'package warnings; sub import {}' } }
use warnings; local $^W = 1;
BEGIN { pop @INC if $INC[-1] eq '.' }
use vars qw($VERSION);
$VERSION = '0.01';
$VERSION = $VERSION;
# $VERSION self-assignment suppresses "used only once" warning under strict.
use Carp;

# --------------------------------------------------------------------
# new($env) - wrap a PSGI environment hash reference
# --------------------------------------------------------------------
sub new {
    my ($class, $env) = @_;
    ref($env) eq 'HASH' or 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.