File Coverage

blib/lib/Dancer2/Session/CGISession.pm

Criterion	Covered	Total	%
statement	26	45	57.7
branch	2	10	20.0
condition	0	3	0.0
subroutine	9	12	75.0
pod	0	2	0.0
total	37	72	51.3

package Dancer2::Session::CGISession;

use strict;
use 5.008_005;
our $VERSION = '0.03';

use Moo;
use Carp;
use Dancer2::Core::Types;
use CGI::Session;

with 'Dancer2::Core::Role::SessionFactory';

#------------------------------------#
# Attributes
#------------------------------------#

has driver_params => (
    is => 'ro',
    default => sub { {}; }
);

has driver => (
    is => 'ro',
    default => sub { 'driver:File'; }
);

has name => (
    is => 'ro',
    default => sub { 'CGISESSID'; }
);

#------------------------------------#
# Role composition
#------------------------------------#

#might be possible to do something with CGI::Session find method here
sub _sessions {
    my ($self) = @_;
    return [];
}

sub generate_id {
    my ( $class ) = @_;

    #creation of the cgi session when generating the id, as it using dancer2 id to create CGI session seems not to be working
    my $cgi_session = CGI::Session->new(
        $class->driver,
        undef,
        $class->driver_params
    ) or die CGI::Session->errstr();;
    $cgi_session->expire( $class->session_duration );
    $cgi_session->name( $class->cookie_name );

    #Return the newly created CGI::Session id
    return $cgi_session->id();
}

sub _retrieve {
    my ( $class, $id ) = @_;

    my $cgi_session = $class->get_cgi_session( $id );
    if( $cgi_session->is_empty or $cgi_session->is_expired ) {
        # CGI Session has been removed from the server, die here, Dancer2::Core::Role::Session
        # knows how to deal with that, warn Caller by dying
        die "CGI Session has disappeared";
    }

    return $cgi_session->dataref();
}

sub _destroy {
    my ( $class, $id ) = @_;

    my $cgi_session = $class->get_cgi_session( $id );
    if( defined $cgi_session->id ) {
        $cgi_session->delete;
        $cgi_session->flush;
    }
}

sub _flush {
    my ( $class, $id, $data ) = @_;

    my $cgi_session = $class->get_cgi_session( $id );
    foreach my $key (keys %{$data} ){
        delete $$data{$key} if ($key =~ m/^_SESSION_/);
    }
    $cgi_session->param( %{$data} );
    $cgi_session->flush;
}

sub get_cgi_session {
    my ( $class, $id ) = @_;

    my $cgi_session = CGI::Session->load( $class->driver, $id, $class->driver_params )
        or die CGI::Session->errstr();

    return $cgi_session;
}

1;
__END__