Return to memcached_dump.pl CVS log

Up to [LON-CAPA] / loncom / debugging_tools

Annotation of loncom/debugging_tools/memcached_dump.pl, revision 1.2

1.2     ! raeburn     1: #!/usr/bin/perl 
1.1       raeburn     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: #
1.2     ! raeburn     8: # $Id: memcached_dump.pl,v 1.1 2016/02/21 17:29:33 raeburn Exp $
1.1       raeburn     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;
1.2     ! raeburn    39: use Apache::lonnet;
        !            40: 
1.1       raeburn    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;
1.2     ! raeburn    99: my @possdoms = &Apache::lonnet::current_machine_domains();
        !           100: my %machinedoms = ();
        !           101: map { $machinedoms{$_} = 1; } @possdoms;
1.1       raeburn   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:           }
1.2     ! raeburn   122:           if ($name =~ /^ltitools/) {
        !           123:               my ($dom) = (&unescape($escname) =~/:([^:]+)$/);
        !           124:               if (($dom eq '') || (!$machinedoms{$dom})) {
        !           125:                   next;
        !           126:               }
        !           127:           }
1.1       raeburn   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: