use strict;
use warnings;
package Rubric::WebApp::Session;
# ABSTRACT: the Rubric session plugin
$Rubric::WebApp::Session::VERSION = '0.156';
use CGI::Cookie;
use Crypt::CBC;
use JSON 2 ();
use MIME::Base64;
use Sub::Exporter -setup => {
  -as => '_import',
  exports => [
    qw(session session_cipherer get_cookie_payload set_cookie_payload)
  ],
  groups  => [ default => [ -all ] ],
};

sub import {
  my ($self) = @_;
  my $caller = caller;

  Carp::croak "no session_cipher_key key set"
    unless Rubric::Config->session_cipher_key;

  $caller->add_callback(init    => 'get_cookie_payload');
  $caller->add_callback(postrun => 'set_cookie_payload');
  $self->_import({ into => $caller });
}

#pod =head1 METHODS
#pod
#pod These methods are imported into the using class and should be called on an
#pod object of that type -- here, a Rubric::WebApp.
#pod
#pod =head2 session
#pod
#pod This returns the session, a hashref.
#pod
#pod =cut

sub session {
  my ($self) = @_;
  return $self->{__PACKAGE__}{session} ||= $self->get_cookie_payload;
}

my $COOKIE_NAME   = 'RubricSession';

sub __empty { Rubric::WebApp::Session::Object->new({}) }

#pod =head2 session_cipherer
#pod
#pod This returns a Crypt::CBC object for handling ciphering.
#pod
#pod =cut

sub session_cipherer {
  my ($self) = @_;

  $self->{__PACKAGE__}{cipherer} ||= Crypt::CBC->new(
    -key    => Rubric::Config->session_cipher_key,
    -cipher => 'Rijndael',
    -padding => 'standard',
  );
}

#pod =head2 get_cookie_payload
#pod
#pod This gets the cookie and returns the payload as a R::WA::Session::Object.
#pod
#pod =cut

sub get_cookie_payload {
  my ($self) = @_;

  return __empty unless my $cookie_value = $self->query->cookie($COOKIE_NAME);

  my $cipherer = $self->session_cipherer;

  my $data = eval {
    JSON->new->utf8->decode(
      $cipherer->decrypt(decode_base64($cookie_value))
    );
  };

  my $session = $data ? Rubric::WebApp::Session::Object->new($data) : __empty;
}

#pod =head2 set_cookie_payload
#pod
#pod This method writes the session data back out to a cookie entry.
#pod
#pod =cut

sub set_cookie_payload {
  my ($self) = @_;

  my $cookie_value = eval {
    my $json = JSON->new->utf8->encode($self->session->as_hash);

    encode_base64($self->session_cipherer->encrypt($json));
  };

  my $cookie = CGI::Cookie->new(
    -name     => $COOKIE_NAME,
    -expires  => '+30d',
    -value    => $cookie_value,
    -secure   => Rubric::Config->cookie_secure,
    -httponly => Rubric::Config->cookie_httponly,
  );

  $self->header_add(-cookie => [ $cookie ]);
}

#pod =head1 SESSION OBJECT METHODS
#pod
#pod =cut

package Rubric::WebApp::Session::Object;
$Rubric::WebApp::Session::Object::VERSION = '0.156';
#pod =head2 new
#pod
#pod This makes a new session object.  You don't need this.
#pod
#pod =cut

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

#pod =head2 param
#pod
#pod   $obj->param('foo');        # get
#pod   $obj->param('foo', 'val'); # set
#pod
#pod =cut

sub param {
  my $self = shift;

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

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

  die "invalid number of args to session->param";
}

#pod =head2 clear
#pod
#pod   $obj->clear('name');
#pod
#pod Clear the entry (delete it entirely) from the session.
#pod
#pod =cut

sub clear {
  my ($self, $param) = @_;
  delete $self->{$param};
}

#pod =head2 delete
#pod
#pod   $session->delete;
#pod
#pod Removes all data from the session.
#pod
#pod =cut

sub delete {
  my ($self) = @_;
  %$self = ();
}

#pod =head2 as_hash
#pod
#pod This returns a hashref containing the session data.
#pod
#pod =cut

sub as_hash {
  return { %{ $_[0] } };
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Rubric::WebApp::Session - the Rubric session plugin

=head1 VERSION

version 0.156

=head1 METHODS

These methods are imported into the using class and should be called on an
object of that type -- here, a Rubric::WebApp.

=head2 session

This returns the session, a hashref.

=head2 session_cipherer

This returns a Crypt::CBC object for handling ciphering.

=head2 get_cookie_payload

This gets the cookie and returns the payload as a R::WA::Session::Object.

=head2 set_cookie_payload

This method writes the session data back out to a cookie entry.

=head1 SESSION OBJECT METHODS

=head2 new

This makes a new session object.  You don't need this.

=head2 param

  $obj->param('foo');        # get
  $obj->param('foo', 'val'); # set

=head2 clear

  $obj->clear('name');

Clear the entry (delete it entirely) from the session.

=head2 delete

  $session->delete;

Removes all data from the session.

=head2 as_hash

This returns a hashref containing the session data.

=head1 AUTHOR

Ricardo SIGNES <rjbs@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2004 by Ricardo SIGNES.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut