File Coverage

blib/lib/Dancer/Session.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	12	16	75.0
condition	5	5	100.0
subroutine	11	11	100.0
pod	0	6	0.0
total	74	84	88.1

package Dancer::Session;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: session engine for the Dancer framework
$Dancer::Session::VERSION = '1.3514_04'; # TRIAL
$Dancer::Session::VERSION = '1.351404';
use strict;
use warnings;

use Carp;
use Dancer::Cookies;
use Dancer::Engine;

# Singleton representing the session engine class to use
my $ENGINE = undef;
sub engine {$ENGINE}

# This wrapper look for the session engine and try to load it.
sub init {
    my ($class, $name, $config) = @_;
    $ENGINE = Dancer::Engine->build(session => $name, $config);

    #$ENGINE->init(); already done
}

# retrieve or create a session for the client
sub get_current_session {
    shift;
    my %p       = @_;
    my $sid     = engine->read_session_id;
    my $session = undef;
    my $class   = ref(engine);

    my $sessions = Dancer::SharedData->sessions || {};
    my $name    = $class->session_name();
    if ($sid and $session = $sessions->{$name}{$sid}) {
        return $session;
    }

    $session = $class->retrieve($sid) if $sid;

    if (not defined $session) {
        $session = $class->create();
    }

    $sessions->{$name}{$session->id} = $session;
    Dancer::SharedData->sessions($sessions);

    # Generate a session cookie; we want to do this regardless of whether the
    # session is new or existing, so that the cookie expiry is updated.
    engine->write_session_id($session->id)
        unless $p{no_update};

    return $session;
}

sub get { get_current_session(@_) }

sub read {
    my ($class, $key) = @_;
    return unless $key;
    my $session = get_current_session();
    return $session->get_value($key);
}

sub write {
    my ($class, $key, $value) = @_;

    return unless $key;
    $key eq 'id' and croak 'Can\'t store to session key with name "id"';

    my $session = get_current_session();
    $session->set_value($key, $value);

    # TODO : should be moved as an "after" filter
    $session->flush unless $session->is_lazy;
    return $value;
}

1;

__END__