package MojoX::Session;

use strict;
use warnings;

our $VERSION = '0.01';

use base 'Mojo::Base';

use Digest::SHA1 'sha1_hex';

__PACKAGE__->attr('store', chained => 1);
__PACKAGE__->attr('transport', chained => 1);

__PACKAGE__->attr('ip_match', default => 0, chained => 1);
__PACKAGE__->attr('expires_delta', default => 3600, chained => 1);

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

__PACKAGE__->attr('sid', chained => 1);
__PACKAGE__->attr('_expires', chained => 1, default => 0);
__PACKAGE__->attr('_data', default => sub {{}});

sub create {
    my $self = shift;

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

    $self->_is_new(1);

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

    $self->_generate_sid;

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

    $self->_is_flushed(0);

    return $self->sid;
}

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

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

    unless ($sid) {
        $sid = $self->transport->get if $self->transport;
        return unless $sid;
    }

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

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

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

        return unless $self->data('__ip_match');

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

    $self->_is_stored(1);

    return $self->sid;
}

sub flush {
    my $self = shift;

    return unless $self->sid && !$self->_is_flushed;

    if ($self->is_expired && $self->_is_stored) {
        $self->store->delete($self->sid) if $self->store;
        $self->_is_stored(0);
        $self->_is_flushed(1);
        return;
    }

    if ($self->_is_new) {
        $self->store->create($self->sid, $self->expires, $self->data)
          if $self->store;
        $self->_is_new(0);
    } else {
        $self->store->update($self->sid, $self->expires, $self->data)
          if $self->store;
    }

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

sub data {
    my $self = shift;

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

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

    my %params = @_;

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

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

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

sub expire {
    my $self = shift;
    $self->expires(time - 30 * 24 * 3600);

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

    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);

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

    $self->_is_flushed(0);
}

sub is_expired {
    my ($self) = shift;

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

sub _remote_addr { $ENV{REMOTE_ADDR} }

sub _generate_sid {
    my $self = shift;

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

sub DESTROY {
    my $self = shift;

    $self->flush();
}

1;
__END__

=head1 NAME

MojoX::Session - Session management for Mojo

=head1 SYNOPSIS

    my $session = MojoX::Session->new(
        store     => MojoX::Session::Store::DBI->new(dbh  => $dbh),
        transport => MojoX::Session::Transport::Cookie->new(tx => $tx),
        ip_match  => 1
    );

    $session->create(); # creates new session
    $session->load();   # tries to find session

    $session->sid; # session id

    $session->data('foo' => 'bar'); # set foo to bar
    $session->data('foo'); # get foo value

    $session->data('foo' => undef); # works
    $session->clear('foo'); # delete foo from data

    $session->flush(); # writes session to the store
    undef $session;    # same as above

=head1 DESCRIPTION

L<MojoX::Session> is a session management for L<Mojo>. Based on L<CGI::Session>
and L<HTTP::Session> but without any dependencies except the core ones.

=head1 ATTRIBUTES

L<MojoX::Session> implements the following attributes.

=head2 C<store>
    
    Store object

    my $store = $session->store;
    $session  = $session->store(MojoX::Session::Store::DBI->new(dbh => $dbh));

=head2 C<transport>

    Transport to find and store session id

    my $transport = $session->transport;
    $session
        = $session->transport(MojoX::Session::Transport::Cookie->new(tx => $tx));

=head2 C<ip_match>

    Check if ip matches, default is 0

    my $ip_match = $session->ip_match;
    $ip_match    = $session->ip_match(0);

=head2 C<expires_delta>

    Seconds until session is considered expired

    my $expires_delta = $session->expires_delta;
    $expires_delta    = $session->expires_delta(3600);

=head1 METHODS

L<MojoX::Session> inherits all methods from L<Mojo::Base> and implements the
following new ones.

=head2 C<new>
    
    my $session = MojoX::Session->new(...);

    Returns new L<MojoX::Session> object.

=head2 C<create>

    my $sid = $session->create;
    $session->flush;

Creates new session. Puts sid into the transport. Call flush if you want to
store it.

=head2 C<load>

    $session->load;
    $session->load($sid);

Tries to load session from the store, gets sid from transport unless it is
provided. If sesssion is expired it will loaded also.

=head2 C<flush>

    $session->flush;

Flush actually writes to the store in these situations:
- new session was created (inserts it);
- any value was changed (updates it)
- session is expired (deletes it)

Flush is also called on object destruction.

=head2 C<sid>

    my $sid = $session->sid;

Returns session id.

=head2 C<data>
    
    my $foo = $session->data('foo');
    $session->data('foo' => 'bar');
    $session->data('foo' => 'bar', 'bar' => 'foo');
    $session->data('foo' => undef);
    # or
    my $foo = $session->data->{foo};
    $session->data->{foo} = 'bar';

Get and set values to the session.

=head2 C<clear>

    $session->clear('bar');
    $session->clear;
    $session->flush;

Clear session values. Delete only one value if argument is provided.  Call flush
if you want to clear it in the store.

=head2 C<expires>

    $session->expires;
    $session->expires(123456789);

Get/set session expire time.

=head2 C<expire>

    $session->expire;
    $session->flush;

Force session to expire. Call flush if you want to remove it from the store.
Flush will be called also on object destruction and will automatically delete
expired session from the store.

=head2 C<is_expired>

Check if session is expired.

=head2 C<extend_expires>

Entend session expires time. Set it to current_time + expires_delta.

=head1 SEE ALSO

L<CGI::Session>, L<HTTP::Session>

=head1 AUTHOR

vti, C<vti@cpan.org>.

=head1 COPYRIGHT

Copyright (C) 2008, Viacheslav Tikhanovskii.

This program is free software, you can redistribute it and/or modify it under
the same terms as Perl 5.10.

=cut
