r2wee 发表于 2014-8-6 09:10:33

memcahced perl管理工具 memcached-tool

#!/usr/bin/perl
#
# memcached-tool:
#   stats/management tool for memcached.
#
# Author:
#   Brad Fitzpatrick <brad@danga.com>
#
# Contributor:
#   Andrey Niakhaichyk <andrey@niakhaichyk.org>
#
# License:
#   public domain.I give up all rights to this
#   tool.modify and copy at will.
#
use strict;
use IO::Socket::INET;
my $addr = shift;
my $mode = shift || "display";
my ($from, $to);
if ($mode eq "display") {
    undef $mode if @ARGV;
} elsif ($mode eq "move") {
    $from = shift;
    $to = shift;
    undef $mode if $from < 6 || $from > 17;
    undef $mode if $to   < 6 || $to   > 17;
    print STDERR "ERROR: parameters out of range\n\n" unless $mode;
} elsif ($mode eq 'dump') {
    ;
} elsif ($mode eq 'stats') {
    ;
} elsif ($mode eq 'settings') {
    ;
} elsif ($mode eq 'sizes') {
    ;
} else {
    undef $mode;
}
undef $mode if @ARGV;
die
    "Usage: memcached-tool <host[:port] | /path/to/socket> \n
       memcached-tool 10.0.0.5:11211 display    # shows slabs
       memcached-tool 10.0.0.5:11211            # same.(default is display)
       memcached-tool 10.0.0.5:11211 stats      # shows general stats
       memcached-tool 10.0.0.5:11211 settings   # shows settings stats
       memcached-tool 10.0.0.5:11211 sizes      # shows sizes stats
       memcached-tool 10.0.0.5:11211 dump       # dumps keys and values
WARNING! sizes is a development command.
As of 1.4 it is still the only command which will lock your memcached instance for some time.
If you have many millions of stored items, it can become unresponsive for several minutes.
Run this at your own risk. It is roadmapped to either make this feature optional
or at least speed it up.
" unless $addr && $mode;
my $sock;
if ($addr =~ m:/:) {
    $sock = IO::Socket::UNIX->new(
      Peer => $addr,
    );
}
else {
    $addr .= ':11211' unless $addr =~ /:\d+$/;
    $sock = IO::Socket::INET->new(
      PeerAddr => $addr,
      Proto    => 'tcp',
    );
}
die "Couldn't connect to $addr\n" unless $sock;
if ($mode eq 'dump') {
    my %items;
    my $totalitems;
    print $sock "stats items\r\n";
    while (<$sock>) {
      last if /^END/;
      if (/^STAT items:(\d*):number (\d*)/) {
            $items{$1} = $2;
            $totalitems += $2;
      }
    }
    print STDERR "Dumping memcache contents\n";
    print STDERR "Number of buckets: " . scalar(keys(%items)) . "\n";
    print STDERR "Number of items: $totalitems\n";
    foreach my $bucket (sort(keys(%items))) {
      print STDERR "Dumping bucket $bucket - " . $items{$bucket} . " total items\n";
      print $sock "stats cachedump $bucket $items{$bucket}\r\n";
      my %keyexp;
      while (<$sock>) {
            last if /^END/;
            # return format looks like this
            # ITEM foo
            if (/^ITEM (\S+) \[.* (\d+) s\]/) {
                $keyexp{$1} = $2;
            }
      }
      foreach my $k (keys(%keyexp)) {
            print $sock "get $k\r\n";
            my $response = <$sock>;
            if ($response =~ /VALUE (\S+) (\d+) (\d+)/) {
                my $flags = $2;
                my $len = $3;
                my $val;
                read $sock, $val, $len;
                print "add $k $flags $keyexp{$k} $len\r\n$val\r\n";
                # get the END
                $_ = <$sock>;
                $_ = <$sock>;
            }
      }
    }
    exit;
}
if ($mode eq 'stats') {
    my %items;
    print $sock "stats\r\n";
    while (<$sock>) {
      last if /^END/;
      chomp;
      if (/^STAT\s+(\S*)\s+(.*)/) {
            $items{$1} = $2;
      }
    }
    printf ("#%-17s %5s %11s\n", $addr, "Field", "Value");
    foreach my $name (sort(keys(%items))) {
      printf ("%24s %12s\n", $name, $items{$name});
    }
    exit;
}
if ($mode eq 'settings') {
    my %items;
    print $sock "stats settings\r\n";
    while (<$sock>) {
      last if /^END/;
      chomp;
      if (/^STAT\s+(\S*)\s+(.*)/) {
            $items{$1} = $2;
      }
    }
    printf ("#%-17s %5s %11s\n", $addr, "Field", "Value");
    foreach my $name (sort(keys(%items))) {
      printf ("%24s %12s\n", $name, $items{$name});
    }
    exit;
}
if ($mode eq 'sizes') {
    my %items;
    print $sock "stats sizes\r\n";
    while (<$sock>) {
      last if /^END/;
      chomp;
      if (/^STAT\s+(\S*)\s+(.*)/) {
            $items{$1} = $2;
      }
    }
    printf ("#%-17s %5s %11s\n", $addr, "Size", "Count");
    foreach my $name (sort(keys(%items))) {
      printf ("%24s %12s\n", $name, $items{$name});
    }
    exit;
}
# display mode:
my %items;# class -> { number, age, chunk_size, chunks_per_page,
#            total_pages, total_chunks, used_chunks,
#            free_chunks, free_chunks_end }
print $sock "stats items\r\n";
my $max = 0;
while (<$sock>) {
    last if /^END/;
    if (/^STAT items:(\d+):(\w+) (\d+)/) {
      $items{$1}{$2} = $3;
    }
}
print $sock "stats slabs\r\n";
while (<$sock>) {
    last if /^END/;
    if (/^STAT (\d+):(\w+) (\d+)/) {
      $items{$1}{$2} = $3;
      $max = $1;
    }
}
print "#Item_SizeMax_age   Pages   Count   Full?Evicted Evict_Time OOM\n";
foreach my $n (1..$max) {
    my $it = $items{$n};
    next if (0 == $it->{total_pages});
    my $size = $it->{chunk_size} < 1024 ?
      "$it->{chunk_size}B" :
      sprintf("%.1fK", $it->{chunk_size} / 1024.0);
    my $full = $it->{free_chunks_end} == 0 ? "yes" : " no";
    printf("%3d %8s %9ds %7d %7d %7s %8d %8d %4d\n",
         $n, $size, $it->{age}, $it->{total_pages},
         $it->{number}, $full, $it->{evicted},
         $it->{evicted_time}, $it->{outofmemory});
}


使用方法:
将上述代码保存为memcached-tool文件.
查看memcached状态

1
2
3
4
# perl Mem.pl127.0.0.1:11211
#Item_SizeMax_age   Pages   Count   Full?Evicted Evict_Time OOM
1      96B   22304s       1       3   yes      0      0    0
2   120B         0s       1       0   yes      0      0    0





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
# perl Mem.pl127.0.0.1:11211 stats
#127.0.0.1:11211   Field       Value
         accepting_conns         1
               auth_cmds         0
             auth_errors         0
                   bytes         238
            bytes_read      7154
         bytes_written      139374
            cas_badval         0
                cas_hits         0
            cas_misses         0
               cmd_flush         1
               cmd_get          50
               cmd_set          67
               cmd_touch         0
             conn_yields         0
   connection_structures          15
       crawler_reclaimed         0
      curr_connections          12
            curr_items         3
               decr_hits          30
             decr_misses         0
             delete_hits         2
         delete_misses         0
       evicted_unfetched         0
               evictions         0
       expired_unfetched         0
                get_hits          36
            get_misses          14
            hash_bytes      524288
       hash_is_expanding         0
      hash_power_level          16
               incr_hits          30
             incr_misses         0
                libevent 2.0.21-stable
          limit_maxbytes    33554432
   listen_disabled_num         0
            malloc_fails         0
                     pid       48154
            pointer_size          64
               reclaimed         1
            reserved_fds          20
         rusage_system    0.594909
             rusage_user    1.153824
               threads         4
                  time1406887940
       total_connections         175
             total_items          59
            touch_hits         0
            touch_misses         0
                  uptime       26566
               version      1.4.20



页: [1]
查看完整版本: memcahced perl管理工具 memcached-tool