1: #!/usr/bin/perl -w
2: #
3: # The LearningOnline Network
4: #
5: # memcached_dump.pl - dump key => values from Memcached to standard output,
6: # unescaping keys if asked to do so.
7: #
8: # $Id: memcached_dump.pl,v 1.1 2016/02/21 17:29:33 raeburn Exp $
9: #
10: # Copyright Michigan State University Board of Trustees
11: #
12: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
13: #
14: # LON-CAPA is free software; you can redistribute it and/or modify
15: # it under the terms of the GNU General Public License as published by
16: # the Free Software Foundation; either version 2 of the License, or
17: # (at your option) any later version.
18: #
19: # LON-CAPA is distributed in the hope that it will be useful,
20: # but WITHOUT ANY WARRANTY; without even the implied warranty of
21: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22: # GNU General Public License for more details.
23: #
24: # You should have received a copy of the GNU General Public License
25: # along with LON-CAPA; if not, write to the Free Software
26: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27: #
28: # /home/httpd/html/adm/gpl.txt
29: #
30: # http://www.lon-capa.org/
31: #
32: #################################################
33: use strict;
34: use Cache::Memcached;
35: use Data::Dumper;
36: use Getopt::Long;
37: use lib '/home/httpd/lib/perl/';
38: use LONCAPA;
39:
40: $SIG{'__WARN__'} = sub { warn $_[0] unless (caller eq "Cache::Memcached"); };
41:
42: #
43: # Options
44: my ($unesc,$showsize,$help) = (0,0,0);
45: GetOptions("unescape" => \$unesc,
46: "u" => \$unesc,
47: "size" => \$showsize,
48: "s" => \$showsize,
49: "help" => \$help);
50: #
51: # Help them out if they ask for it
52: if ($help) {
53: print <<END;
54: memcached_dump.pl - dump contents of memcache to stdout.
55: Specify --unescape to have all the keys unescaped.
56: Specify --size to show the size of the value stored for each key.
57: Specify names (or parts of names of keys) to look for on the command line.
58: Options:
59: --help Display this help.
60: --unescape Unescape the keys before printing them out.
61: -u Same as --unescape
62: --size Display the size of the value stored for each key.
63: -s Same as --size
64: Examples:
65: memcached_dump.pl -u -s
66: memcached_dump.pl -u dns
67: memcached_dump.pl -u dns iphost
68: END
69: exit;
70: }
71:
72: my @keys;
73:
74: #
75: # Loop through ARGV getting files.
76: while (my $keyname = shift) {
77: unless(grep(/^\Q$keyname\E$/,@keys)) {
78: push(@keys,$keyname);
79: }
80: }
81:
82: my $instance = "127.0.0.1:11211";
83: my $memd = new Cache::Memcached {
84: 'servers' => [ $instance],
85: 'debug' => 0,
86: };
87:
88: my %containers;
89: my $stats = $memd->stats('items');
90: my $items = $stats->{hosts}->{$instance}->{items};
91: foreach my $line (split(/\r\n/,$items)) {
92: my ($key) = (split(/:/,$line,3))[1];
93: $containers{$key} = 1;
94: }
95:
96: my $count = 0;
97: foreach my $container (sort(keys(%containers))) {
98: my $result = $memd->stats("cachedump $container 0");
99: my $contents = $result->{hosts}->{$instance}->{"cachedump $container 0"};
100:
101: foreach my $item (split(/\r\n/,$contents)) {
102: my ($escname,$size) = ($item =~ /^ITEM\s+(\S+)\s+\[([^;]+)/);
103: my $name = $escname;
104: if ($unesc) {
105: $name = &unescape($escname);
106: }
107: if (@keys) {
108: my $match = 0;
109: foreach my $key (@keys) {
110: if ($name =~ /\Q$key\E/) {
111: $match = 1;
112: last;
113: }
114: }
115: next unless($match);
116: }
117: my $val = $memd->get($escname);
118: $count ++;
119: if ($showsize) {
120: print "$name $size ".Dumper($val)."\n";
121: } else {
122: print "$name ".Dumper($val)."\n";
123: }
124: }
125: }
126: $memd->disconnect_all;
127:
128: if ((@keys) && ($count ==0)) {
129: if (@keys == 1) {
130: print "No matches found for $keys[0]\n";
131: } else {
132: print "No matches found for any of: ".join(' ',@keys)."\n";
133: }
134: }
135:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>