File Coverage

blib/lib/Cot/Plugin/Session.pm

Criterion	Covered	Total	%
statement	34	57	59.6
branch	0	8	0.0
condition	1	8	12.5
subroutine	11	19	57.8
pod	0	2	0.0
total	46	94	48.9

package Cot::Plugin::Session;
use strict;
use warnings;
use 5.008005;
our $VERSION = "0.07";
use parent qw(Cot::Plugin);
use File::Spec;
use Digest::SHA1 ();
use YAML         ();
use Carp;
our $SESSIONID = 'sessid';
use constant STOREDIR => '_cotsession';

sub init {
    my ( $self, $cot ) = @_;
    $self->{_app} = $cot;
    $self->{_dir} = File::Spec->catdir( $ENV{TMPDIR} || '/tmp', STOREDIR );
    $cot->session($self);
}

sub load {
    my ( $self, $sessid ) = @_;
    $sessid ||= $self->{_app}->req->cookies->{$SESSIONID};
    $sessid = Digest::SHA1::sha1_hex( rand() . $$ . {} . time )
      unless ( $sessid && -f $self->_path($sessid) );
    my $path    = $self->_path($sessid);
    my $sessobj = {};
    $sessobj = YAML::LoadFile($path) if ( -f $path );
    new Cot::Plugin::Session::Object(
        {
            _app => $self->{_app},
            dir  => $self->_dir($sessid),
            path => $path,
            obj  => $sessobj,
            id   => $sessid,
        }
    );
}

sub _dir {
    my ( $self, $sessid ) = @_;
    File::Spec->catdir(
        $self->{_dir},
        substr( $sessid, 0, 2 ),
        substr( $sessid, 2, 2 )
    );
}

sub _path {
    my ( $self, $sessid ) = @_;
    File::Spec->catfile(
        $self->{_dir},
        substr( $sessid, 0, 2 ),
        substr( $sessid, 2, 2 ), $sessid
    );
}

package Cot::Plugin::Session::Object;
use File::Path qw/mkpath/;

sub new {
    my ( $class, $obj ) = @_;
    bless $obj, $class;
}

sub get {
    my ( $self, $k ) = @_;
    $self->{obj}->{$k};
}

sub set {
    my ( $self, $k, $v ) = @_;
    $self->{obj}->{$k} = $v;
    mkpath( $self->{dir} ) unless -e $self->{dir};
    YAML::DumpFile( $self->{path}, $self->{obj} );
}

sub delete {
    my $self = shift;
    unlink $self->{path} if ( -f $self->{path} );
}

sub bakecookie {
    my ( $self, %param ) = @_;
    $self->{_app}->res->cookies->{$Cot::Plugin::Session::SESSIONID} = {
        value => $self->{id},
        %param,
    };
}

1;
__END__