Apache-Session-Memorycached
view release on metacpan or search on metacpan
lib/Apache/Session/Store/Memorycached.pm view on Meta::CPAN
package Apache::Session::Store::Memorycached;
use strict;
use Symbol;
use Data::Dumper;
use Cache::Memcached;
use Digest::MD5 qw(md5_hex);
use vars qw($VERSION);
$VERSION = '2.2';
sub new {
#This constructor allocate memory space for for the package!!
my $class = shift;
my $self;
$self->{opened} = 0;
return bless $self, $class;
}
sub insert {
#This function is called, when a tie instruction is launch with an undef id
#Otherwise at the first identification ( cf Login.pm )
my $self = shift;
my $session = shift;
if (! exists $session->{args}->{updateOnly}
|| $session->{args}->{updateOnly} != 1 ) {
my $retour;
my $ryserver = $session->{args}->{servers};
my $ryserverlocal = $session->{args}->{local};
my $rytimeout = $session->{args}->{timeout}||'0';
my $memd= new Cache::Memcached { 'servers' => $ryserver };
my $ident = $session->{data}->{_session_id};
my $rhash = $session->{data};
$retour = $memd->set($ident,$rhash,$rytimeout);
if($retour!=1){
$memd->set($ident,$rhash,$rytimeout);
}
if ($ryserverlocal)
{
my $memdlocal= new Cache::Memcached { 'servers' => $ryserverlocal};
my $identlocal = $session->{data}->{_session_id};
my $rhashlocal = $session->{data};
$retour = $memdlocal->set($identlocal,$rhashlocal,$rytimeout);
if($retour!=1){
$memdlocal->set($identlocal,$rhashlocal,$rytimeout);
}
}
}
$self->{opened} = 1;
}
sub update {
my $self = shift;
my $session = shift;
my $retour;
my $ryserver = $session->{args}->{servers};
my $ryserverlocal = $session->{args}->{local};
my $rytimeout = $session->{args}->{timeout}||'0';
my $principalkey;
my $keyvalue;
my $memd= new Cache::Memcached { 'servers' => $ryserver };
my $ident = $session->{data}->{_session_id} ;
my $rhash = $session->{data};
if ( $session->{args}->{principal} ) {
$principalkey = $session->{args}->{principal} ;
$keyvalue= $session->{data}->{$principalkey} ;
$keyvalue = md5_hex($keyvalue) ;
$memd->set($keyvalue,$ident,$rytimeout) if $keyvalue;
my $identp = $principalkey.'_MD5';
$session->{data}->{$identp} = $keyvalue ;
}
$retour = $memd->set($ident,$rhash,$rytimeout);
if($retour!=1){
}
if ($ryserverlocal)
{
my $memdlocal= new Cache::Memcached { 'servers' => $ryserverlocal};
my $identlocal = $session->{data}->{_session_id};
my $rhashlocal = $session->{data};
#### in order to prepare identify federation ####
if ( $session->{args}->{principal} ) {
$memdlocal->set($keyvalue,$identlocal,$rytimeout) if $keyvalue;
}
$retour = $memdlocal->set($identlocal,$rhashlocal,$rytimeout);
if($retour!=1){
}
}
##################################################
$self->{opened} = 1;
}
sub materialize {
my $self = shift;
my $session = shift;
my $ryserver = $session->{args}->{servers};
my $rhash;
( run in 2.127 seconds using v1.01-cache-2.11-cpan-df04353d9ac )