68 lines
1.3 KiB
Perl
68 lines
1.3 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
use warnings "all";
|
|
use strict;
|
|
use Cache::Memcached;
|
|
use Data::Dumper;
|
|
|
|
my $mc = '127.0.0.1:11212';
|
|
|
|
my $memd = new Cache::Memcached { 'servers' => [ $mc ] };
|
|
my $slabs_total;
|
|
my $itemref = $memd->stats(['slabs']);
|
|
|
|
foreach ( split(/\n/, $itemref->{'hosts'}->{$mc}->{'slabs'})) {
|
|
if($_ =~ /active_slabs (\d+)/) {
|
|
$slabs_total = $1;
|
|
last;
|
|
}
|
|
}
|
|
|
|
if ($slabs_total == 0) {
|
|
print "no slabs!\n";
|
|
exit 0;
|
|
}
|
|
|
|
$itemref = $memd->stats(['items']);
|
|
|
|
if (defined($itemref->{'hosts'}->{$mc}->{'items'})
|
|
and (length($itemref->{'hosts'}->{$mc}->{'items'}) > 2)) {
|
|
|
|
foreach my $stat (split("\n", $itemref->{'hosts'}->{$mc}->{'items'})) {
|
|
my $slab;
|
|
my $itemsamount;
|
|
|
|
if ($stat =~ /^STAT items\:(\d+)\:number (\d+)/) {
|
|
$slab = $1;
|
|
$itemsamount = $2;
|
|
} else {
|
|
undef $slab;
|
|
undef $itemsamount;
|
|
next;
|
|
}
|
|
|
|
my $cachedump = $memd->stats(["cachedump $slab $itemsamount"]);
|
|
my @keys = map {
|
|
(split(/ /))[1];
|
|
} split(/\n/, $cachedump->{'hosts'}->{$mc}->{"cachedump $slab $itemsamount"});
|
|
|
|
foreach my $key (@keys) {
|
|
my $url = $memd->get($key) // "not defined";
|
|
printf ("+ %s -> %s\n", $key, $url);
|
|
undef $url;
|
|
#$memd->delete($key);
|
|
}
|
|
|
|
undef $slab;
|
|
undef $itemsamount;
|
|
undef $cachedump;
|
|
@keys = -1;
|
|
undef @keys;
|
|
}
|
|
}
|
|
|
|
$memd->disconnect_all;
|
|
|
|
#print Dumper(\%INC);
|
|
|