File Coverage

blib/lib/Plack/Middleware/Session/Simple.pm

Criterion	Covered	Total	%
statement	48	116	41.3
branch	7	52	13.4
condition	3	61	4.9
subroutine	14	25	56.0
pod	2	4	50.0
total	74	258	28.6

package Plack::Middleware::Session::Simple;

use 5.008005;
use strict;
use warnings;
use parent qw/Plack::Middleware/;
use Crypt::SysRandom qw/random_bytes/;
use Cookie::Baker;
use Plack::Util;
use Scalar::Util qw/blessed/;
use Plack::Util::Accessor qw/
    store
    cookie_name
    sid_generator
    sid_validator
    keep_empty
    path
    domain
    expires
    secure
    httponly
    serializer
/;

our $VERSION = "0.05";

sub prepare_app {
    my $self = shift;

    my $store = $self->store;
    die('store require get, set and remove method.')
        unless blessed $store
            && $store->can('get')
            && $store->can('set')
            && $store->can('remove');

    $self->cookie_name('simple_session') unless $self->cookie_name;
    $self->path('/') unless defined $self->path;
    $self->keep_empty(1) unless defined $self->keep_empty;

    if ( !$self->sid_generator ) {
        $self->sid_generator(sub{
            unpack('H*', Crypt::SysRandom::random_bytes(20));
        });
    }
    if ( !$self->sid_validator ) {
        $self->sid_validator(
            qr/\A[0-9a-f]{40}\Z/
        );
    }

}

sub call {
    my ($self,$env) = @_;

    my($id, $session) = $self->get_session($env);

    my $tied;
    if ($id && $session) {
        $tied = tie my %session,
            'Plack::Middleware::Session::Simple::Session', %$session;
        $env->{'psgix.session'} = \%session;
        $env->{'psgix.session.options'} = {
            id => $id,
        };
    } else {
        my $id = $self->{sid_generator}->();
        $tied = tie my %session,
            'Plack::Middleware::Session::Simple::Session';
        $env->{'psgix.session'} = \%session;
        $env->{'psgix.session.options'} = {
            id => $id,
            new_session => 1,
        };
    }

    my $res = $self->app->($env);

    $self->response_cb(
        $res, sub {
            $self->finalize($env, $_[0], $tied)
        }
    );
}

sub get_session {
    my ($self, $env) = @_;
    my $cookie = crush_cookie($env->{HTTP_COOKIE} || '')->{$self->{cookie_name}};
    return unless defined $cookie;
    return unless $cookie =~ $self->{sid_validator};

    my $session = $self->{store}->get($cookie) or return;
    $session = $self->{serializer}->[1]->($session) if $self->{serializer};
    return ($cookie, $session);
}

sub finalize {
    my ($self, $env, $res, $session) = @_;
    my $options = $env->{'psgix.session.options'};
    my $new_session = delete $options->{new_session};

    my $need_store;
    if ( ($new_session && $self->{keep_empty} && ! $session->has_key )
             || $session->[1] || $options->{expire} || $options->{change_id}) {
        $need_store = 1;
    }
    $need_store = 0 if $options->{no_store};

    my $set_cookie;
    if ( ($new_session && $self->{keep_empty} && ! $session->has_key )
             || ($new_session && $session->[1] )
             || $options->{expire} || $options->{change_id}) {
        $set_cookie = 1;
    }

    if ( $need_store ) {
        if ($options->{expire}) {
            $self->{store}->remove($options->{id});
        } elsif ($options->{change_id}) {
            $self->{store}->remove($options->{id});
            $options->{id} = $self->{sid_generator}->();
            my $val = $session->[0];
            $val = $self->{serializer}->[0]->($val) if $self->{serializer};
            $self->{store}->set($options->{id}, $val);
        } else {
            my $val = $session->[0];
            $val = $self->{serializer}->[0]->($val) if $self->{serializer};
            $self->{store}->set($options->{id}, $val);
        }
    }

    if ( $set_cookie ) {
        if ($options->{expire}) {
            $self->_set_cookie(
                $options->{id}, $res, %$options, expires => 'now');
        } else {
            $self->_set_cookie(
                $options->{id}, $res, %$options);
        }
    }
}

sub _set_cookie {
    my($self, $id, $res, %options) = @_;

    delete $options{id};

    $options{path}     = $self->{path} || '/' if !exists $options{path};
    $options{domain}   = $self->{domain}      if !exists $options{domain} && defined $self->{domain};
    $options{secure}   = $self->{secure}      if !exists $options{secure} && defined $self->{secure};
    $options{httponly} = $self->{httponly}    if !exists $options{httponly} && defined $self->{httponly};

    if (!exists $options{expires} && defined $self->{expires}) {
        $options{expires} = $self->{expires};
    }

    my $cookie = bake_cookie(
        $self->{cookie_name}, {
            value => $id,
            %options,
        }
    );
    Plack::Util::header_push($res->[1], 'Set-Cookie', $cookie);
}

1;

package Plack::Middleware::Session::Simple::Session;

use strict;
use warnings;
use Tie::Hash;
use base qw/Tie::ExtraHash/;

sub TIEHASH {
    my $class = shift;
    bless [{@_},0, scalar @_], $class;
}

sub STORE {
    $_[0]->[1]++;
    $_[0]->[0]{$_[1]} = $_[2]
}

sub DELETE {
    $_[0]->[1]++;
    delete $_[0]->[0]->{$_[1]}
}

sub CLEAR {
    $_[0]->[1]++;
    %{$_[0]->[0]} = ()
}

sub has_key {
    scalar keys %{$_[0]->[0]}
}

1;

__END__