File Coverage

blib/lib/MojoX/Session.pm

Criterion	Covered	Total	%
statement	157	190	82.6
branch	58	102	56.8
condition	6	11	54.5
subroutine	26	29	89.6
pod	13	13	100.0
total	260	345	75.3

package MojoX::Session;

use strict;
use warnings;

our $VERSION = '0.33';

use base 'Mojo::Base';

use Mojo::Loader;
use Mojo::ByteStream;
use Mojo::Transaction::HTTP;
use MojoX::Session::Transport::Cookie;
use Digest::SHA;

my $PRIVATE_IP_FIELD = 'mojox.session.ip_address';

__PACKAGE__->attr(loader => sub { my $l; eval { $l = Mojo::Loader->new }; $l });
__PACKAGE__->attr(tx     => sub { Mojo::Transaction::HTTP->new });
__PACKAGE__->attr([qw/sid _store/]);
__PACKAGE__->attr(_transport => sub { MojoX::Session::Transport::Cookie->new }
);

__PACKAGE__->attr(ip_match      => 0);
__PACKAGE__->attr(expires_delta => 3600);

__PACKAGE__->attr(_is_new     => 0);
__PACKAGE__->attr(_is_stored  => 0);
__PACKAGE__->attr(_is_flushed => 1);

__PACKAGE__->attr(_expires => 0);
__PACKAGE__->attr(_data => sub { {} });

__PACKAGE__->attr('error');

sub new {
    my $class = shift;
    my %args  = @_;

    my $store     = delete $args{store};
    my $transport = delete $args{transport};

    my $self = $class->SUPER::new(%args);

    $self->_store($self->_instance(Store => $store));
    $self->_transport($self->_instance(Transport => $transport));

    return $self;
}

sub store {
    my $self = shift;

    return $self->_store if @_ == 0;

    $self->_store($self->_instance(Store => shift));
}

sub transport {
    my $self = shift;

    return $self->_transport if @_ == 0;

    $self->_transport($self->_instance(Transport => shift));
}

sub _load_and_build {
    my $self = shift;
    my ($namespace, $name, $args) = @_;

    my $class = join('::',
        __PACKAGE__, $namespace, Mojo::ByteStream->new($name)->camelize);

    my $rv = $self->loader ? $self->loader->load($class) : Mojo::Loader::load_class($class);

    if (defined $rv) {
        die qq/Store "$class" can not be loaded : $rv/ if ref $rv;

        die qq/Store "$class" not found/;
    }

    return $class->new(%{$args || {}});
}

sub _instance {
    my $self = shift;
    my ($namespace, $instance) = @_;

    return unless $instance;

    if (ref $instance eq 'HASH') {
        die 'HASH';

        #$store
    }
    elsif (ref $instance eq 'ARRAY') {
        $instance =
          $self->_load_and_build($namespace, $instance->[0], $instance->[1]);
    }
    elsif (!ref $instance) {
        $instance = $self->_load_and_build($namespace, $instance);
    }

    return $instance;
}

sub create {
    my $self = shift;
    my ($cb) = @_;

    $self->_expires(time + $self->expires_delta);

    $self->_is_new(1);

    if ($self->ip_match) {
        $self->data($PRIVATE_IP_FIELD, $self->_remote_addr);
    }

    $self->_generate_sid;

    if ($self->transport) {
        $self->transport->tx($self->tx);
        $self->transport->set($self->sid, $self->expires);
    }

    $self->_is_flushed(0);

    return $cb->($self, $self->sid) if $cb;

    return $self->sid;
}

sub load {
    my $self = shift;
    my ($sid, $cb) = @_;

    ($cb, $sid) = ($sid, undef) if ref $sid eq 'CODE';

    $self->sid(undef);
    $self->_expires(0);
    $self->_data({});

    if ($self->transport) {
        $self->transport->tx($self->tx);
    }

    unless ($sid) {
        $sid = $self->transport->get;
        return $cb ? $cb->($self) : undef unless $sid;
    }

    if ($self->store->is_async) {
        $self->store->load(
            $sid => sub {
                my ($store, $expires, $data) = @_;

                if ($store->error) {
                    $self->error($store->error);
                    return $cb ? $cb->($self) : undef;
                }

                my $sid = $self->_on_load($sid, $expires, $data);

                return $cb->($self, $sid) if $cb;

                return $sid;
            }
        );
    }
    else {
        my ($expires, $data) = $self->store->load($sid);

        return $self->error($self->store->error) && undef
          if $self->store->error;

        my $sid = $self->_on_load($sid, $expires, $data);

        return unless $sid;

        return $sid;
    }
}

sub _on_load {
    my $self = shift;
    my ($sid, $expires, $data) = @_;

    unless (defined $expires && defined $data) {
        $self->transport->set($sid, time - 30 * 24 * 3600)
          if $self->transport;
        return;
    }

    $self->_expires($expires);
    $self->_data($data);

    if ($self->ip_match) {
        return unless $self->_remote_addr;

        return unless $self->data($PRIVATE_IP_FIELD);

        return unless $self->_remote_addr eq $self->data($PRIVATE_IP_FIELD);
    }

    $self->sid($sid);

    $self->_is_stored(1);

    return $self->sid;
}

sub flush {
    my $self = shift;
    my ($cb) = @_;

    return $cb ? $cb->($self) : 1 unless $self->sid && !$self->_is_flushed;

    if ($self->is_expired && $self->_is_stored) {
        if ($self->store->is_async) {

            $self->store->delete(
                $self->sid => sub {
                    my ($store) = @_;

                    if (my $error = $store->error) {
                        $self->error($error);
                        return $cb ? $cb->($self) : undef;
                    }

                    $self->_is_stored(0);
                    $self->_is_flushed(1);

                    return $cb->($self) if $cb;

                    return 1;
                }
            );
        }
        else {
            my $ok = $self->store->delete($self->sid);
            $self->_is_stored(0);
            $self->_is_flushed(1);
            return $ok;
        }
    }
    else {
        my $ok = 1;

        my $action = $self->_is_new ? 'create' : 'update';

        $self->_is_new(0);

        if ($self->store->is_async) {
            $self->store->$action(
                $self->sid,
                $self->expires,
                $self->data => sub {
                    my ($store) = @_;

                    if ($store->error) {
                        $self->error($store->error);
                        return $cb ? $cb->($self) : undef;
                    }

                    $self->_is_stored(1);
                    $self->_is_flushed(1);

                    return $cb ? $cb->($self) : 1;
                }
            );
        }
        else {
            $ok =
              $self->store->$action($self->sid, $self->expires, $self->data);

            unless ($ok) {
                $self->error($self->store->error);
                return;
            }

            $self->_is_stored(1);
            $self->_is_flushed(1);

            return $ok;
        }
    }
}

sub data {
    my $self = shift;

    if (@_ == 0) {
        return $self->_data;
    }

    if (@_ == 1) {
        return $self->_data->{$_[0]};
    }

    my %params = @_;

    $self->_data({%{$self->_data}, %params});
    $self->_is_flushed(0);
}

sub flash {
    my $self = shift;
    my ($key) = @_;

    return unless $key;

    $self->_is_flushed(0);

    return delete $self->data->{$key};
}

sub clear {
    my $self = shift;
    my ($key) = @_;

    if ($key) {
        delete $self->_data->{$key};
    }
    else {
        $self->_data({});
    }

    $self->_is_flushed(0);
}

sub expire {
    my $self = shift;

    $self->expires(0);

    if ($self->transport) {
        $self->transport->tx($self->tx);
        $self->transport->set($self->sid, $self->expires);
    }

    return $self;
}

sub expires {
    my $self = shift;
    my ($val) = @_;

    if (defined $val) {
        $self->_expires($val);
        $self->_is_flushed(0);
    }

    return $self->_expires;
}

sub extend_expires {
    my $self = shift;

    $self->_expires(time + $self->expires_delta);

    if ($self->transport) {
        $self->transport->tx($self->tx);
        $self->transport->set($self->sid, $self->expires);
    }

    $self->_is_flushed(0);
}

sub is_expired {
    my ($self) = shift;

    return time > $self->expires ? 1 : 0;
}

sub _remote_addr {
    my $self = shift;

    return $self->tx->remote_address;
}

sub _generate_sid {
    my $self = shift;

    # based on CGI::Session::ID
    my $sha1 = Digest::SHA->new(1);
    $sha1->add($$, time, rand(time));
    $self->sid($sha1->hexdigest);
}

1;
__END__