package Dancer2::Core::Context;
$Dancer2::Core::Context::VERSION = '0.140001';
# ABSTRACT: handles everything proper to a request's context.
use Moo;
use URI::Escape;
use Carp 'croak';
use Dancer2::Core::Types;
use Dancer2::Core::Request;
use Dancer2::Core::Response;
use Dancer2::Core::Cookie;
has app => (
is => 'rw',
isa => InstanceOf ['Dancer2::Core::App'],
weak_ref => 1,
predicate => 1,
);
# the PSGI-env to use for building the request to process
# this is the only mandatory argument to a context
has env => (
is => 'ro',
required => 1,
isa => HashRef,
);
# the incoming request
has request => (
is => 'rw',
lazy => 1,
builder => '_build_request',
isa => InstanceOf ['Dancer2::Core::Request'],
);
sub _build_request {
my ($self) = @_;
# If we have an app, get the serialization engine
my $engine = $self->app->engine('serializer')
if $self->has_app;
my $req = Dancer2::Core::Request->new( env => $self->env,
$engine ? ( serializer => $engine ) : (),
);
# Log deserialization errors
$self->app->log( core => "Failed to deserialize the request : "
. $engine->error ) if ( $engine && $engine->has_error );
return $req;
}
# a buffer for per-request variables
has buffer => (
is => 'rw',
isa => HashRef,
default => sub { {} },
);
sub vars { shift->buffer }
sub var {
my $self = shift;
@_ == 2
? $self->buffer->{ $_[0] } = $_[1]
: $self->buffer->{ $_[0] };
}
# a set of changes to apply to the response
# that HashRef will should be passed as attributes to a response object
has response => (
is => 'rw',
isa => InstanceOf ['Dancer2::Core::Response'],
lazy => 1,
default => sub {
my $self = shift;
my $engine = $self->has_app
? $self->app->engine('serializer')
: undef;
return Dancer2::Core::Response->new(
$engine ? (serializer => $engine) : ()
);
},
);
sub cookies { shift->request->cookies(@_) }
sub cookie {
my $self = shift;
return $self->request->cookies->{ $_[0] } if @_ == 1;
# writer
my ( $name, $value, %options ) = @_;
my $c =
Dancer2::Core::Cookie->new( name => $name, value => $value, %options );
$self->response->push_header( 'Set-Cookie' => $c->to_header );
}
sub redirect {
my ( $self, $destination, $status ) = @_;
# RFC 2616 requires an absolute URI with a scheme,
# turn the URI into that if it needs it
# Scheme grammar as defined in RFC 2396
# scheme = alpha *( alpha | digit | "+" | "-" | "." )
my $scheme_re = qr{ [a-z][a-z0-9\+\-\.]* }ix;
if ( $destination !~ m{^ $scheme_re : }x ) {
$destination = $self->request->uri_for( $destination, {}, 1 );
}
$self->response->redirect( $destination, $status );
# Short circuit any remaining before hook / route code
# ('pass' and after hooks are still processed)
$self->with_return->($self->response) if $self->has_with_return;
}
sub halt {
my ($self) = @_;
$self->response->halt;
# Short citcuit any remaining hook/route code
$self->with_return->($self->response) if $self->has_with_return;
}
has session => (
is => 'rw',
isa => Session,
lazy => 1,
builder => '_build_session',
predicate => '_has_session',
clearer => 1,
);
sub _build_session {
my ($self) = @_;
my $session;
# Find the session engine
my $engine = $self->app->engine('session');
# find the session cookie if any
if ( !$self->destroyed_session ) {
my $session_id;
my $session_cookie = $self->cookie( $engine->cookie_name );
if ( defined $session_cookie ) {
$session_id = $session_cookie->value;
}
# if we have a session cookie, try to retrieve the session
if ( defined $session_id ) {
eval { $session = $engine->retrieve( id => $session_id ) };
croak "Fail to retrieve session: $@"
if $@ && $@ !~ /Unable to retrieve session/;
}
}
# create the session if none retrieved
return $session ||= $engine->create();
}
sub has_session {
my ($self) = @_;
my $engine = $self->app->engine('session');
return $self->_has_session
|| ( $self->cookie( $engine->cookie_name )
&& !$self->has_destroyed_session );
}
has destroyed_session => (
is => 'rw',
isa => InstanceOf ['Dancer2::Core::Session'],
predicate => 1,
);
sub destroy_session {
my ($self) = @_;
# Find the session engine
my $engine = $self->app->engine('session');
# Expire session, set the expired cookie and destroy the session
# Setting the cookie ensures client gets an expired cookie unless
# a new session is created and supercedes it
my $session = $self->session;
$session->expires(-86400); # yesterday
$engine->destroy( id => $session->id );
# Clear session in context and invalidate session cookie in request
$self->destroyed_session($session);
$self->clear_session;
return;
}
has with_return => (
is => 'rw',
predicate => 1,
clearer => 'clear_with_response',
);
1;
__END__
=pod
=head1 NAME
Dancer2::Core::Context - handles everything proper to a request's context.
=head1 VERSION
version 0.140001
=head1 ATTRIBUTES
=head2 app
Reference to the L<Dancer2::Core::App> object for the current application.
=head2 env
Read-only accessor to a PSGI environment hash.
=head2 request
A L<Dancer2::Core::Request> object, built from the PSGI environment variable for this request.
=head2 response
A L<Dancer2::Core::Response> object, used to set content, headers and HTTP status codes.
=head2 session
Handle for the current session object, if any
=head2 destroyed_session
We cache a destroyed session here; once this is set we must not attempt to
retrieve the session from the cookie in the request. If no new session is
created, this is set (with expiration) as a cookie to force the browser to
expire the cookie.
=head2 with_return
Used to cache the coderef from L<Return::MultiLevel> within the dispatcher.
=head1 METHODS
=head2 vars
Returns a hashref of all per-request variables stored in this object.
=head2 var
By-name interface to variables stored in this context object.
my $stored = $context->var('some_variable');
returns the value of 'some_variable', while
$context->var('some_variable' => 'value');
will set it.
=head2 cookies
Shortcut that dispatches to L<Dancer2::Core::Request>'s cookies method.
=head2 cookie
Get a cookie from the L<request> object, or set one in the L<response> object.
=head2 redirect($destination, $status)
Sets a redirect in the response object. If $destination is not an absolute URI, then it will
be made into an absolute URI, relative to the URI in the request.
=head2 halt
Flag the response object as 'halted'.
If called during request dispatch, immediatly returns the response
to the dispatcher and after hooks will not be run.
=head2 has_session
Returns true if session engine has been defined and if either a session object
has been instantiated in the context or if a session cookie was found and not
subsequently invalidated.
=head2 destroy_session
Destroys the current session and ensures any subsequent session is created
from scratch and not from the request session cookie
=head1 AUTHOR
Dancer Core Developers
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014 by Alexis Sukrieh.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut