Return to memcached_dump.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- Dump memcached's currently stored keys and values.
  See: http://mail.lon-capa.org/pipermail/lon-capa-admin/2015-February/003005.html

    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: