File Coverage

blib/lib/CGI/Easy/Session.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	6	8	75.0
condition	8	9	88.8
subroutine	11	11	100.0
pod	2	2	100.0
total	77	81	95.0

package CGI::Easy::Session;
use 5.010001;
use warnings;
use strict;
use utf8;
use Carp;

our $VERSION = 'v2.0.1';

use Data::UUID;
use CGI::Easy::Util qw( quote_list unquote_hash );

use constant SESSION_EXPIRE => 365*24*60*60; # 1 year

my $UG;


sub new {
    my ($class, $r, $h) = @_;
    my $self = {
        id      => undef,
        perm    => undef,
        temp    => undef,
        _r      => $r,
        _h      => $h,
    };
    bless $self, $class;
    $self->_init;
    return $self;
}

sub _init {
    my ($self) = @_;
    my $r = $self->{_r};
    my $c = $r->{cookie};
    if ($c->{sid}) {
        $self->{id} = $c->{sid};
    }
    else {
        my $referer = $r->{ENV}{HTTP_REFERER} || q{};
        if ($referer !~ m{\A\w+://\Q$r->{host}\E[:/]}xms) {
            $UG ||= Data::UUID->new();
            $self->{id} = $UG->create_b64();
        }
    }
    if ($self->{id}) {
        $self->{_h}->add_cookie({
            name    => 'sid',
            value   => $self->{id},
            expires => time + SESSION_EXPIRE,
        });
    }
    $self->{perm} = unquote_hash($c->{perm}) || {};
    $self->{temp} = unquote_hash($c->{temp}) || {};
    return;
}

sub save {
    my ($self) = @_;
    my $h = $self->{_h};
    my @other_cookies = grep {$_->{name} ne 'perm' && $_->{name} ne 'temp'}
        @{ $h->{'Set-Cookie'} };
    $h->{'Set-Cookie'} = [
        @other_cookies,
        {
            name    => 'perm',
            value   => quote_list(%{ $self->{perm} }),
            expires => time + SESSION_EXPIRE,
        },
        {
            name    => 'temp',
            value   => quote_list(%{ $self->{temp} }),
        },
    ];
    return;
}


1; # Magic true value required at end of module
__END__