Return to memcached_dump.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

- cached data for ltitools:domain key only displayed for machine's domains.

    1: #!/usr/bin/perl 
    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.2 2017/05/07 12:58:12 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: use Apache::lonnet;
   40: 
   41: 
   42: $SIG{'__WARN__'} = sub { warn $_[0] unless (caller eq "Cache::Memcached"); };
   43: 
   44: #
   45: # Options
   46: my ($unesc,$showsize,$help) = (0,0,0);
   47: GetOptions("unescape" => \$unesc,
   48:            "u"        => \$unesc,
   49:            "size"     => \$showsize,
   50:            "s"        => \$showsize,
   51:            "help"     => \$help);
   52: #
   53: # Help them out if they ask for it
   54: if ($help) {
   55:     print <<END;
   56: memcached_dump.pl - dump contents of memcache to stdout.
   57: Specify --unescape to have all the keys unescaped.
   58: Specify --size to show the size of the value stored for each key.
   59: Specify names (or parts of names of keys) to look for on the command line.
   60: Options:
   61:    --help     Display this help.
   62:    --unescape Unescape the keys before printing them out.
   63:    -u         Same as --unescape
   64:    --size     Display the size  of the value stored for each key.
   65:    -s         Same as --size
   66: Examples:
   67:     memcached_dump.pl -u -s
   68:     memcached_dump.pl -u dns
   69:     memcached_dump.pl -u dns iphost
   70: END
   71:     exit;
   72: }
   73: 
   74: my @keys;
   75: 
   76: #
   77: # Loop through ARGV getting files.
   78: while (my $keyname = shift) {
   79:     unless(grep(/^\Q$keyname\E$/,@keys)) {
   80:         push(@keys,$keyname);
   81:     }
   82: }
   83: 
   84: my $instance = "127.0.0.1:11211";
   85: my $memd = new Cache::Memcached {
   86:      'servers' => [ $instance],
   87:      'debug' => 0,
   88: };
   89: 
   90: my %containers;
   91: my $stats = $memd->stats('items');
   92: my $items = $stats->{hosts}->{$instance}->{items};
   93: foreach my $line (split(/\r\n/,$items)) {
   94:      my ($key) = (split(/:/,$line,3))[1];
   95:      $containers{$key} = 1;
   96: }
   97: 
   98: my $count = 0;
   99: my @possdoms = &Apache::lonnet::current_machine_domains();
  100: my %machinedoms = ();
  101: map { $machinedoms{$_} = 1; } @possdoms;
  102: foreach my $container (sort(keys(%containers))) {
  103:       my $result = $memd->stats("cachedump $container 0");
  104:       my $contents = $result->{hosts}->{$instance}->{"cachedump $container 0"};
  105: 
  106:       foreach my $item (split(/\r\n/,$contents)) {
  107:           my ($escname,$size) = ($item =~ /^ITEM\s+(\S+)\s+\[([^;]+)/);
  108:           my $name = $escname;
  109:           if ($unesc) {
  110:               $name = &unescape($escname);
  111:           }
  112:           if (@keys) {
  113:               my $match = 0;
  114:               foreach my $key (@keys) {
  115:                    if ($name =~ /\Q$key\E/) {
  116:                        $match = 1;
  117:                        last;
  118:                    }
  119:               } 
  120:               next unless($match); 
  121:           }
  122:           if ($name =~ /^ltitools/) {
  123:               my ($dom) = (&unescape($escname) =~/:([^:]+)$/);
  124:               if (($dom eq '') || (!$machinedoms{$dom})) {
  125:                   next;
  126:               }
  127:           }
  128:           my $val = $memd->get($escname);
  129:           $count ++;
  130:           if ($showsize) {
  131:               print "$name $size ".Dumper($val)."\n";
  132:           } else {
  133:               print "$name ".Dumper($val)."\n";
  134:           }
  135:       }
  136: }
  137: $memd->disconnect_all;
  138: 
  139: if ((@keys) && ($count ==0)) {
  140:     if (@keys == 1) {
  141:         print "No matches found for $keys[0]\n";
  142:     } else {
  143:         print "No matches found for any of: ".join(' ',@keys)."\n";
  144:     }
  145: }
  146: