package Prancer::Request;

use strict;
use warnings FATAL => 'all';

use Plack::Request;
use Storable qw(dclone);
use Hash::MultiValue;
use URI::Escape ();
use Prancer::Request::Upload;

sub new {
    my ($class, $env) = @_;
    my $self = bless({
        '_env' => $env,
        '_request' => Plack::Request->new($env),
    }, $class);

    # make instances of these and return those. these calls create new URI objects
    # with every invocation so this should avoid creating unnecessary objects later
    $self->{'_uri'} = $self->{'_request'}->uri();
    $self->{'_base'} = $self->{'_request'}->base();

    # other manipulation routines
    $self->{'_uploads'} = $self->_parse_uploads();
    $self->{'_cookies'} = $self->_parse_cookies();

    return $self;
}

sub _parse_uploads {
    my $self = shift;

    # turn all uploads into Prancer::Upload objects
    my $result = Hash::MultiValue->new();
    my $uploads = $self->{'_request'}->uploads();
    for my $key (keys %{$uploads}) {
        $result->add($key, map { Prancer::Request::Upload->new($_) } $uploads->get_all($key));
    }

    return $result;
}

sub _parse_cookies {
    my $self = shift;

    my $result = Hash::MultiValue->new();
    return $result unless defined($self->{'_env'}->{'HTTP_COOKIE'});

    # translate all cookies
    my @pairs = grep { m/=/x } split(/[;,]\s?/x, $self->{'_env'}->{'HTTP_COOKIE'});
    for my $pair (@pairs) {
        # trim leading and trailing whitespace
        $pair =~ s/^\s+|\s+$//xg;

        my ($key, $value) = map { URI::Escape::uri_unescape($_) } split(/=/x, $pair, 2);
        $result->add($key, { 'name' => $key, 'value' => $value });
    }

    return $result;
}

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

sub uri {
    my $self = shift;
    return $self->{'_uri'};
}

sub base {
    my $self = shift;
    return $self->{'_base'};
}

sub method {
    my $self = shift;
    return $self->{'_request'}->method();
}

sub protocol {
    my $self = shift;
    return $self->{'_request'}->protocol();
}

sub scheme {
    my $self = shift;
    return $self->{'_request'}->scheme();
}

sub secure {
    my $self = shift;
    return $self->{'_request'}->secure();
}

sub path {
    my $self = shift;
    return $self->{'_request'}->path();
}

sub body {
    my $self = shift;
    return $self->{'_request'}->body();
}

sub address {
    my $self = shift;
    return $self->{'_request'}->address();
}

sub user {
    my $self = shift;
    return $self->{'_request'}->user();
}

sub header {
    my $self = shift;

    # return the keys if nothing is asked for
    return keys(%{$self->headers()}) unless @_;

    my $key = shift;
    return $self->headers->{$key} unless wantarray;
    return $self->headers->get_all($key);
}

sub headers {
    my $self = shift;
    return $self->{'_request'}->headers();
}

sub param {
    my $self = shift;

    # return the keys if nothing is asked for
    return keys(%{$self->parameters()}) unless @_;

    my $key = shift;
    return $self->params->{$key} unless wantarray;
    return $self->params->get_all($key);
}

sub params {
    my $self = shift;
    return $self->{'_request'}->parameters();
}

sub cookie {
    my $self = shift;

    # return the keys if nothing is asked for
    return keys(%{$self->cookies()}) unless @_;

    my $key = shift;
    return $self->cookies->{$key} unless wantarray;
    return $self->cookies->get_all($key);
}

sub cookies {
    my $self = shift;
    return $self->{'_cookies'};
}

sub upload {
    my $self = shift;

    # return the keys if nothing is asked for
    return keys(%{$self->uploads()}) unless @_;

    my $key = shift;
    return $self->uploads->{$key} unless wantarray;
    return $self->uploads->get_all($key);
}

sub uploads {
    my $self = shift;
    return $self->{'_uploads'};
}

sub uri_for {
    my ($self, $path, $args) = @_;
    my $uri = URI->new($self->base());
    $uri->path($uri->path() . $path);
    $uri->query_form(@{$args}) if $args;
    return $uri;
}

1;

=head1 NAME

Prancer::Request

=head1 SYNOPSIS

    sub handle {
        my $self = shift;

        my $request = context->request();
        my $path = $request->path();
        my $cookie = $request->cookie("foo");
        my $param = $request->param("bar");
        my $cookie_names = $request->cookie();
        my $user_agent = $request->header("user-agent");

        ...
    }

=head1 ATTRIBUTES

=over 4

=item uri

Returns an URI object for the current request. The URI is constructed using
various environment values such as C<SCRIPT_NAME>, C<PATH_INFO>,
C<QUERY_STRING>, C<HTTP_HOST>, C<SERVER_NAME> and C<SERVER_PORT>.

=item base

Returns a URI object for the base path of current request. This is like C<uri>
but only contains up to C<SCRIPT_NAME> where your application is hosted at.

=item method

Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).

=item protocol

Returns the protocol (C<HTTP/1.0> or C<HTTP/1.1>) used for the current request.

=item scheme

Returns the scheme (C<http> or C<https>) of the request.

=item secure

Returns true or false, indicating whether the connection is secure (C<https>).

=item path

Returns B<PATH_INFO> in the environment but returns / in case it is empty.

=item body

Returns a handle to the input stream.

=item address

Returns the IP address of the client (C<REMOTE_ADDR>).

=item user

Returns C<REMOTE_USER> if it's set.

=item header

When called with no arguments this will return a list of all header names.
When called in scalar context this will return the last value for the given
key. When called in list context this will return all values for the given key.

=item headers

Returns an L<HTTP::Headers> object containing the headers for the current
request.

=item param

When called with no arguments this will return a list of all parameter names.
When called in scalar context this will return the last value for the given
key. When called in list context this will return all values for the given key.

=item params

Returns a L<Hash::MultiValue> hash reference containing the merged GET and POST
parameters.

=item cookie

When called with no arguments this will return a list of all cookie names.
When called in scalar context this will return the last cookie for the given
key. When called in list context this will return all cookies for the given
key. A cookie should look like this:

    {
        'name' => 'foo',
        'value' => 'bar',
    }

=item cookies

Returns an L<Hash::MultiValue> containing all cookies.

=item upload

When called with no arguments this will return a list of all upload names.
When called in scalar context this will return the last
L<Prancer::Request::Upload> object for the given key. When called in list
context this will return all L<Prancer::Request::Upload> objects for the given
key.

=item uploads

Returns an L<Hash::MultiValue> containing all uploads.

=item uri_for

Generates a URL to a new location in an easy to use manner. For example:

    my $link = $request->uri_for('/logout', [ signoff => 1 ]);

=back

=cut
