view release on metacpan or  search on metacpan

lib/ASP4/SessionStateManager.pm  view on Meta::CPAN

package ASP4::SessionStateManager;

use strict;
use warnings 'all';
use base 'Ima::DBI::Contextual';
use HTTP::Date qw( time2iso time2str str2time );
use Time::HiRes 'gettimeofday';
use Digest::MD5 'md5_hex';
use Storable qw( freeze thaw );
use Scalar::Util 'weaken';
use ASP4::ConfigLoader;


sub new
{
  my ($class, $r) = @_;
  my $s = bless { }, $class;
  my $conn = context()->config->data_connections->session;
  
  local $^W = 0;
  $class->set_db('Session',
    $conn->dsn,
    $conn->username,
    $conn->password
  );
  
  my $id = $s->parse_session_id();
  unless( $id && $s->verify_session_id( $id, $conn->session_timeout ) )
  {
    $s->{SessionID} = $s->new_session_id();
    $s->write_session_cookie($r);
    return $s->create( $s->{SessionID} );
  }# end unless()
  
  return $s->retrieve( $id );
}# end new()

sub context { ASP4::HTTPContext->current }

sub is_read_only
{
  my ($s, $val) = @_;
  
  if( defined($val) )
  {
    $s->{____is_read_only} = $val;
  }
  else
  {
    return $s->{____is_read_only};
  }# end if()
}# end is_readonly()


sub parse_session_id
{
  my $session_config = context()->config->data_connections->session;
  my $cookie_name = $session_config->cookie_name;
  my ($id) = ($ENV{HTTP_COOKIE}||'') =~ m/\b\Q$cookie_name\E\=([a-f0-9]{32,32})/s;

  return $id;
}# end parse_session_id()


sub new_session_id { md5_hex( join ':', ( context()->config->web->www_root, $$, gettimeofday() ) ) }


sub write_session_cookie
{
  my ($s, $r) = @_;
  
  my $config = context()->config->data_connections->session;
  my $domain = "";
  unless( $config->cookie_domain eq '*' )
  {
    $domain = "domain=" . ( $config->cookie_domain || $ENV{HTTP_HOST} ) . ";";
  }# end unless()

lib/ASP4/SessionStateManager.pm  view on Meta::CPAN

{
  my $s = shift;
  
  no warnings 'uninitialized';
  md5_hex(
    join ":", 
      map { "$_:$s->{$_}" }
        grep { $_ ne '__signature' && $_ ne '____is_read_only' } sort keys(%$s)
  );
}# end _hash()


sub is_changed
{
  my $s = shift;
  
  no warnings 'uninitialized';
  $s->_hash ne $s->{__signature};
}# end is_changed()


sub reset
{
  my $s = shift;
  
  delete($s->{$_}) for grep { $_ ne 'SessionID' } keys %$s;
  $s->save;
  return;
}# end reset()


sub DESTROY
{
  my $s = shift;
  
  return undef(%$s) unless $s->{SessionID};
  
  unless( $s->is_read_only )
  {
    $s->save;# if $s->is_changed;
  }# end unless()
  undef(%$s);
}# end DESTROY()

1;# return true:

=pod

=head1 NAME

ASP4::SessionStateManager - Per-user state persistence

=head1 SYNOPSIS

  You've seen this page <%= $Session->{counter}++ %> times before.

=head1 DESCRIPTION

Web applications require session state management - and the simpler, the better.

C<ASP4::SessionStateManager> is a simple blessed hash.  When it goes out of scope,
it is saved to the database (or whatever).

If no changes were made to the session, it is not saved.

=head1 PUBLIC PROPERTIES

=head2 is_read_only( 1:0 )

Starting with version 1.044, setting this property to a true value will prevent
any changes made to the contents of the session during the current request from
being saved at the end of the request.

B<NOTE:> A side-effect is that calling C<< $Session->save() >> after calling C<< $Session->is_read_only(1) >>
will B<*NOT*> prevent changes from being saved B<ON PURPOSE>.  Explicitly calling C<< $Session->save() >>
will still cause the session data to be stored.  Setting C<< $Session->is_read_only(1) >> will only
prevent the default behavior of saving session state at the end of each successful request.

=head1 PUBLIC METHODS

=head2 save( )

Causes the session data to be saved. (Unless C<< $Session->is_read_only(1) >> is set.)

=head2 reset( )

Causes the session data to be emptied.

=head1 BUGS

It's possible that some bugs have found their way into this release.

Use RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ASP4> to submit bug reports.

=head1 HOMEPAGE

Please visit the ASP4 homepage at L<http://0x31337.org/code/> to see examples
of ASP4 in action.

=cut