view release on metacpan or  search on metacpan

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

}

sub to_string {
    my ($self) = @_;
    return "[#" . $self->id . "] " . $self->method . " " . $self->path;
}

# helper for building a request object by hand
# with the given method, path, params, body and headers.
sub new_for_request {
    my ($class, $method, $uri, $params, $body, $headers, $extra_env) = @_;
    $params    ||= {};
    $extra_env ||= {};
    $method = uc($method);

    my ( $path, $query_string ) = ( $uri =~ /([^?]*)(?:\?(.*))?/s ); #from HTTP::Server::Simple

    my $env = {
        %ENV,
        %{$extra_env},
        PATH_INFO      => $path,
        QUERY_STRING   => $query_string || $ENV{QUERY_STRING} || '',
        REQUEST_METHOD => $method
    };
    $env->{CONTENT_LENGTH} = defined($body) ? length($body) : 0 if !exists $env->{CONTENT_LENGTH};
    my $req = $class->new(env => $env);
    $req->{params}        = {%{$req->{params}}, %{$params}};
    $req->_build_params();
    $req->{_query_params} = $req->{params};
    my $store_raw_body = setting('raw_request_body_in_ram');
    $store_raw_body = defined $store_raw_body ? $store_raw_body : 1;
    if ($store_raw_body) {
        $req->{body} = $body;
    }
    $req->{headers}       = $headers || HTTP::Headers->new;

    return $req;
}

#Create a new request which is a clone of the current one, apart
#from the path location, which points instead to the new location
sub forward {
    my ($class, $request, $to_data) = @_;

    my $env = $request->env;
    $env->{PATH_INFO} = $to_data->{to_url};

    my $new_request = $class->new(env => $env, is_forward => 1);
    my $new_params  = _merge_params(scalar($request->params),
                                    $to_data->{params} || {});

    if (exists($to_data->{options}{method})) {
        die unless _valid_method($to_data->{options}{method});
        $new_request->{method} = uc $to_data->{options}{method};
    }

    $new_request->{params}  = $new_params;
    $new_request->{_body_params}  = $request->{_body_params};
    $new_request->{_query_params} = $request->{_query_params};
    $new_request->{_route_params} = $request->{_route_params};
    $new_request->{_params_are_decoded} = 1;
    $new_request->{headers} = $request->headers;

    if( my $session = Dancer::Session->engine 
                      && Dancer::Session->get_current_session ) {
        my $name = $session->session_name;

        # make sure that COOKIE is populated
        $new_request->{env}{COOKIE} ||= $new_request->{env}{HTTP_COOKIE};

        no warnings;  # COOKIE can be undef
        unless ( $new_request->{env}{COOKIE} =~ /$name\s*=/ ) {
            $new_request->{env}{COOKIE} = join ';', 
                grep { $_ } 
                $new_request->{env}{COOKIE}, 
                join '=', $name, Dancer::Session->get_current_session->id;
        }
    }

    $new_request->{uploads} = $request->uploads;

    return $new_request;
}

sub _valid_method {
    my $method = shift;
    return $method =~ /^(?:head|post|get|put|delete)$/i;
}

sub _merge_params {
    my ($params, $to_add) = @_;

    die unless ref $to_add eq "HASH";
    for my $key (keys %$to_add) {
        $params->{$key} = $to_add->{$key};
    }
    return $params;
}

sub base {
    my $self = shift;
    my $uri  = $self->_common_uri;

    return $uri->canonical;
}

sub _common_uri {
    my $self = shift;

    my $path   = $self->env->{SCRIPT_NAME} || '';
    my $port   = $self->env->{SERVER_PORT};
    my $server = $self->env->{SERVER_NAME};
    my $host   = $self->host;
    my $scheme = $self->scheme;

    my $uri = URI->new;
    $uri->scheme($scheme);
    $uri->authority($host || "$server:$port");
    if (setting('behind_proxy')) {
        my $request_base = $self->env->{REQUEST_BASE} || $self->env->{HTTP_REQUEST_BASE} || '';
        $uri->path($request_base . $path || '/');
    }
    else {
        $uri->path($path || '/');
    }

    return $uri;
}

sub uri_base {
    my $self  = shift;
    my $uri   = $self->_common_uri;
    my $canon = $uri->canonical;

    if ( $uri->path eq '/' ) {
        $canon =~ s{/$}{};
    }

    return $canon;
}

sub uri_for {
    my ($self, $part, $params, $dont_escape) = @_;
    my $uri = $self->base;

    # Make sure there's exactly one slash between the base and the new part
    my $base = $uri->path;
    $base =~ s|/$||;
    $part =~ s|^/||;
    $uri->path("$base/$part");

    $uri->query_form($params) if $params;

    return $dont_escape ? uri_unescape($uri->canonical) : $uri->canonical;
}

sub params {
    my ($self, $source) = @_;

    my @caller = caller;

    if (not $self->{_params_are_decoded}) {
        $self->{params}        = _decode($self->{params});
        $self->{_body_params}  = _decode($self->{_body_params});
        $self->{_query_params} = _decode($self->{_query_params});
        $self->{_route_params} = _decode($self->{_route_params});
        $self->{_params_are_decoded} = 1;
    }

    return %{$self->{params}} if wantarray && @_ == 1;
    return $self->{params} if @_ == 1;

    if ($source eq 'query') {
        return %{$self->{_query_params}} if wantarray;
        return $self->{_query_params};
    }
    elsif ($source eq 'body') {
        return %{$self->{_body_params}} if wantarray;
        return $self->{_body_params};
    }
    if ($source eq 'route') {
        return %{$self->{_route_params}} if wantarray;
        return $self->{_route_params};
    }
    else {
        raise core_request => "Unknown source params \"$source\".";
    }
}

sub _decode {
    my ($h) = @_;
    return if not defined $h;

    if (!ref($h) && !utf8::is_utf8($h)) {
        return decode('UTF-8', $h);
    }

    if (ref($h) eq 'HASH') {
        while (my ($k, $v) = each(%$h)) {
            $h->{$k} = _decode($v);
        }
        return $h;
    }

    if (ref($h) eq 'ARRAY') {
        return [ map { _decode($_) } @$h ];
    }

    return $h;
}

sub is_ajax {
    my $self = shift;

    # when using Plack::Builder headers are not set
    # so we're checking if it's actually there with PSGI plain headers
    if ( defined $self->{x_requested_with} ) {
        if ( $self->{x_requested_with} eq "XMLHttpRequest" ) {
            return 1;
        }
    }

    return 0 unless defined $self->headers;
    return 0 unless defined $self->header('X-Requested-With');
    return 0 if $self->header('X-Requested-With') ne 'XMLHttpRequest';
    return 1;
}

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

Used internally to define some default values and parse parameters.

=head2 new_for_request($method, $path, $params, $body, $headers)

An alternate constructor convenient for test scripts which creates a request
object with the arguments given.

=head2 forward($request, $new_location)

Create a new request which is a clone of the current one, apart
from the path location, which points instead to the new location.
This is used internally to chain requests using the forward keyword.

Note that the new location should be a hash reference. Only one key is
required, the C<to_url>, that should point to the URL that forward
will use. Optional values are the key C<params> to a hash of
parameters to be added to the current request parameters, and the key
C<options> that points to a hash of options about the redirect (for
instance, C<method> pointing to a new request method).

=head2 is_forward

Flag that will be set to true if the request has been L<forwarded|Dancer::Request::forward>.

=head2 to_string()

Return a string representing the request object (eg: C<"GET /some/path">)

=head2 method()

Return the HTTP method used by the client to access the application.

While this method returns the method string as provided by the environment, it's
better to use one of the following boolean accessors if you want to inspect the
requested method.

=head2 address()

Return the IP address of the client.

=head2 remote_host()

Return the remote host of the client. This only works with web servers configured
to do a reverse DNS lookup on the client's IP address.

=head2 protocol()

Return the protocol (HTTP/1.0 or HTTP/1.1) used for the request.

=head2 port()

Return the port of the server.

=head2 uri()

An alias to request_uri()

=head2 request_uri()

Return the raw, undecoded request URI path.

=head2 user()

Return remote user if defined.

=head2 script_name()

Return script_name from the environment.

=head2 scheme()

Return the scheme of the request

=head2 secure()

Return true of false, indicating whether the connection is secure

=head2 is_get()

Return true if the method requested by the client is 'GET'

=head2 is_head()

Return true if the method requested by the client is 'HEAD'

=head2 is_patch()

Return true if the method requested by the client is 'PATCH'

=head2 is_post()

Return true if the method requested by the client is 'POST'

=head2 is_put()

Return true if the method requested by the client is 'PUT'

=head2 is_delete()

Return true if the method requested by the client is 'DELETE'

=head2 path()

Return the path requested by the client.

=head2 base()

Returns an absolute URI for the base of the application.  Returns a L<URI>
object (which stringifies to the URL, as you'd expect).

=head2 uri_base()

Same thing as C<base> above, except it removes the last trailing slash in the
path if it is the only path.

This means that if your base is I<http://myserver/>, C<uri_base> will return
I<http://myserver> (notice no trailing slash). This is considered very useful
when using templates to do the following thing:

    <link rel="stylesheet" href="<% request.uri_base %>/css/style.css" />