lemonldap-ng/modules/apache-session-memorycached/scripts/memd.pl

#!/usr/bin/perl
use strict;
use Apache::Session::Memorycached;
use Data::Dumper;
use Cache::Memcached;
my $serveur = shift;
my $option; 
my $session_id;
my @command = ("-s","-m","-d","-i","-TAG","-show","-modify","-delete","-info") ;
 
if (index($serveur,"-") != -1){

$option = $serveur;
$serveur = "localhost:11211";
}else{
$option = shift;
}
my $contenu;

if ($option eq "-s" or $option eq "-show"){
	$session_id = shift;	
	my $memd= new Cache::Memcached  { 'servers' => [$serveur]};
	my $hashref = $memd->get_multi();
	$contenu = Dumper($hashref);
	print ("$contenu\n");	
	my %session;
	
	tie %session, 'Apache::Session::Memorycached', $session_id, { 'servers' => [$serveur]} ;
	
	$contenu = Dumper(%session);
	if (keys(%session)==0){
		print "Aucune valeures pour l'entree [ $session_id ]\n";	
	}else{
		print "Contenu du memcached pour l'entree [ $session_id ]\n";
		print ("$contenu\n");
	}
	untie %session;
	exit;
}

if ($option eq "-m" or $option eq "-modify"){
	$session_id = shift;
	my $key = shift;
	my $value = shift;
	my %session;

	tie %session, 'Apache::Session::Memorycached', $session_id, { 'servers' => [$serveur]} ; 

	if (keys(%session)==0){
		print "Aucune valeures pour l'entree [ $session_id ]\n";
		exit;
	}
	print "Contenu du memcached pour l'entree[ $session_id ] avant modification : \n";
	$contenu = Dumper(%session);
	print ("$contenu\n");
	print "\n";
	my %Session;
	tie %Session, 'Apache::Session::Memorycached', undef, { 'servers' => [$serveur]};
                foreach (keys %session){
			if ($_ ne $key){
                        	$Session{$_} = $session{$_} if $session{$_} ;
        		}else{
				$Session{$_} = $value;
			}
		}

	my $cont = Dumper(%Session);
        print "Contenu du memcached pour l'entrée[ $session_id ] apres modification : \n";
	print ("$cont\n");
	print "\n";
	untie %Session;
	exit;
}
  

if($option eq "-d" or $option eq "-delete"){
	$session_id = shift;
	my $cle = shift;
	my %session;

	tie %session, 'Apache::Session::Memorycached', $session_id, { 'servers' => [$serveur]} ;
	
	$contenu = Dumper(%session);
	if (keys(%session)==0){
                print "Aucune valeures pour l'entree [ $session_id ]\n";
                exit;
        }

	print ("$contenu\n");
	print "\n";
	if (!defined($cle)){
		my $memd= new Cache::Memcached  { 'servers' => [$serveur]};

		my $result = $memd->delete($session_id);
		if ($result){
			print "L'entree [ $session_id ] a ete supprime du serveur \n";
		}else{
			print "L'entree [ $session_id ] n\'a pu etre supprime du serveur \n";
		}
	}else{
		my %Session;
        	tie %Session, 'Apache::Session::Memorycached', undef, { 'servers' => [$serveur]};
                foreach (keys %session){
                        if ($_ ne $cle){
                                $Session{$_} = $session{$_} if $session{$_} ;
                        }
                }

        my $cont = Dumper(%Session);
        print "Contenu du memcached pour l'entrée[ $session_id ] apres modification : \n";
        print ("$cont\n");
        print "\n";
        untie %Session;
	}
        exit;

	exit;

}

if($option eq "-i" or $option eq "-info"){
        
	my $memd= new Cache::Memcached  { 'servers' => [$serveur] };
	my $tag = shift;
	if (!defined($tag)){
		my $result = $memd->stats();
		my $pid = $result->{hosts}->{$serveur}->{misc}->{pid};
		my $taille = $result->{hosts}->{$serveur}->{malloc}->{arena_size};
		print "Pid    =>   $pid
";
my $clef;
my $valeur;

while (($clef, $valeur) = each(%{$result->{total}})) {
print "
$clef  =>  $valeur\n";
}
	}else{			
		my $result = $memd->stats($tag);
       		$contenu = Dumper($result);
	 	print ("$contenu\n");
        	print "\n";
}
exit;
}

if($option eq "-TAG"){
print "
List of Tags : 

misc      =>   The stats returned by a 'stats' command: pid, uptime, version, bytes, get_hits, etc.

malloc    =>   The stats returned by a 'stats malloc': total_alloc, arena_size, etc.

sizes     =>   The stats returned by a 'stats sizes'.

self      =>   The stats for the \$memd object itself (a copy of \$memd->{'stats'}).

maps      =>   The stats returned by a 'stats maps'.

cachedump =>   The stats returned by a 'stats cachedump'.

slabs     =>   The stats returned by a 'stats slabs'.

items     =>   The stats returned by a 'stats items'.\n";
exit;
}
print "Usage :  ./memd.pl [serveur::port] -s (-show)  [id]
                                   -d (-delete) [id]
                                   -m (-modify) [id] [Champs] [valeur]
                                   -a (-add) [id] [Champs] [valeur]
                                   -i (-info) [TAG]
Launch \"./memd.pl -TAG\" to get the list of TAG
\n";