view release on metacpan or  search on metacpan

lib/Apache2/ASP/SessionStateManager/Memcached.pm  view on Meta::CPAN

package Apache2::ASP::SessionStateManager::Memcached;

use strict;
use warnings 'all';
use base 'Apache2::ASP::SessionStateManager';
use Cache::Memcached;
use Digest::MD5 'md5_hex';


#==============================================================================
sub new
{
  my ($class, %args) = @_;
  
  my $s = bless { }, $class;
  
  # Prepare our Session:
  if( my $id = $s->parse_session_id() )
  {
    if( $s->verify_session_id( $id ) )
    {
      $s->{SessionID} = $id;
      return $s->retrieve( $id );
    }
    else
    {
      $s->{SessionID} = $s->new_session_id();
      $s->write_session_cookie();
      return $s->create( $s->{SessionID} );
    }# end if()
  }
  else
  {
    $s->{SessionID} = $s->new_session_id();
    $s->write_session_cookie();
    return $s->create( $s->{SessionID} );
  }# end if()
}# end new()


#==============================================================================
sub memd
{
  my $s = shift;

  $s->{memd} ||= new Cache::Memcached {
    'servers' => [
      split(/,\s*/, $s->context->config->data_connections->session->dsn )
    ]
  };
  $s->{memd};
}# end memd()


#==============================================================================
sub verify_session_id
{
  my ($s, $SessionID) = @_;
  
  defined( $s->memd->get( $SessionID ) );
}# end verify_session_id()


#==============================================================================
sub retrieve
{
  my ($s, $SessionID) = @_;
  
  my $got = $s->memd->get( $SessionID );
  $got->{memd} = $s->memd;
  $got = bless $got, ref($s) || $s
    unless UNIVERSAL::isa( $got, __PACKAGE__ );
  return $got;
}# end retrieve()


#==============================================================================
sub create
{
  my ($s, $SessionID) = @_;
  
  eval {
    no warnings 'uninitialized';
    $s->{__signature} = md5_hex(
      join ":", 
        map { "$_:$s->{$_}" }
          grep { $_ && $_ !~ m/^(memd|__signature)/ } sort keys(%$s)
    );
  };
  
  $s->memd->set(
    $SessionID => $s,
    $s->context->config->data_connections->session->session_timeout * 60
  );
  $s;
}# end create()


#==============================================================================
sub save
{
  my ($s) = @_;
  
  no warnings 'uninitialized';
  return if eval { $s->{__signature} eq md5_hex(
    join ":", map { "$_:$s->{$_}" }
                grep { $_ && $_ !~ m/^(memd|__signature)/ } sort keys(%$s)
  )};
  eval {
    $s->{__signature} = md5_hex(
      join ":",
        map { "$_:$s->{$_}" } 
          grep { $_ && $_ !~ m/^(memd|__signature)/ } sort keys(%$s)
    );
  };
  
  $s->memd->set(
    $s->{SessionID} => $s,
    $s->context->config->data_connections->session->session_timeout * 60
  );
  1;