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 )