view release on metacpan or  search on metacpan

scripts/memd.pl  view on Meta::CPAN

#!/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;
			}