"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/scripts/damemtop" (16 Jul 2020, 15891 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 #  dormando's awesome memcached top utility!
    3 #
    4 #  Copyright 2009 Dormando (dormando@rydia.net).  All rights reserved.
    5 #
    6 #  Use and distribution licensed under the BSD license.  See
    7 #  the COPYING file for full text.
    8 
    9 use strict;
   10 use warnings FATAL => 'all';
   11 
   12 use AnyEvent;
   13 use AnyEvent::Socket;
   14 use AnyEvent::Handle;
   15 use Getopt::Long;
   16 use YAML qw/Dump Load LoadFile/;
   17 use Term::ReadKey qw/ReadMode ReadKey GetTerminalSize/;
   18 
   19 our $VERSION = '0.1';
   20 
   21 my $CLEAR     = `clear`;
   22 my @TERM_SIZE = ();
   23 $|++;
   24 
   25 my %opts = ();
   26 GetOptions(\%opts, 'help|h', 'config=s');
   27 
   28 if ($opts{help}) {
   29     show_help(); exit;
   30 }
   31 
   32 $SIG{INT} = sub {
   33     ReadMode('normal');
   34     print "\n";
   35     exit;
   36 };
   37 
   38 # TODO: make this load from central location, and merge in homedir changes.
   39 # then merge Getopt::Long stuff on top of that
   40 # TODO: Set a bunch of defaults and merge in.
   41 my $CONF = load_config();
   42 my %CONS    = ();
   43 my $LAST_RUN = time; # time after the last loop cycle.
   44 my $TIME_SINCE_LAST_RUN = time; # time since last loop cycle.
   45 my $loop_timer;
   46 my $main_cond;
   47 my $prev_stats_results;
   48 
   49 my %display_modes = (
   50     't' => \&display_top_mode,
   51     '?' => \&display_help_mode,
   52     'h' => \&display_help_mode,
   53 );
   54 
   55 my %column_compute = (
   56     'hostname' => { stats => [], code => \&compute_hostname},
   57     'hit_rate' => { stats => ['get_hits', 'get_misses'],
   58                     code  => \&compute_hit_rate },
   59     'fill_rate' => { stats => ['bytes', 'limit_maxbytes'],
   60                     code => \&compute_fill_rate },
   61 );
   62 
   63 my %column_format = (
   64     'hit_rate' => \&format_percent,
   65     'fill_rate' => \&format_percent,
   66 );
   67 
   68 # This can collapse into %column_compute
   69 my %column_format_totals = (
   70     'hit_rate' => 0,
   71     'fill_rate' => 0,
   72 );
   73 
   74 ReadMode('cbreak');
   75 my $LAST_KEY = '';
   76 my $read_keys = AnyEvent->io (
   77     fh => \*STDIN, poll => 'r',
   78     cb => sub {
   79         $LAST_KEY = ReadKey(-1);
   80         # If there is a running timer, cancel it.
   81         # Don't want to interrupt a main loop run.
   82         # fire_main_loop()'s iteration will pick up the keypress.
   83         if ($loop_timer) {
   84             $loop_timer = undef;
   85             $main_cond->send;
   86         }
   87     }
   88 );
   89 
   90 # start main loop
   91 fire_main_loop();
   92 
   93 ### AnyEvent related code.
   94 
   95 sub fire_main_loop {
   96     for (;;) {
   97         $loop_timer = undef;
   98         $main_cond = AnyEvent->condvar;
   99         my $time_taken = main_loop();
  100         my $delay = $CONF->{delay} - $time_taken;
  101         $delay = 0 if $delay < 0;
  102         $loop_timer = AnyEvent->timer(
  103             after => $delay,
  104             cb    => $main_cond,
  105         );
  106         $main_cond->recv;
  107     }
  108 }
  109 
  110 sub main_loop {
  111     my $start = AnyEvent->now; # use ->time to find the end.
  112     maintain_connections();
  113 
  114     my $cv = AnyEvent->condvar;
  115 
  116     # FIXME: Need to dump early if there're no connected conns
  117     # FIXME: Make this only fetch stats from cons we care to visualize?
  118     # maybe keep everything anyway to maintain averages?
  119     my %stats_results = ();
  120     while (my ($hostname, $con) = each %CONS) {
  121         $cv->begin;
  122         call_stats($con, ['', 'items', 'slabs'], sub {
  123             $stats_results{$hostname} = shift;
  124             $cv->end;
  125         });
  126     }
  127     $cv->recv;
  128 
  129     # Short circuit since we don't have anything to compare to.
  130     unless ($prev_stats_results) {
  131         $prev_stats_results = \%stats_results;
  132         return $CONF->{delay};
  133     }
  134 
  135     # Semi-exact global time diff for stats that want to average
  136     # themselves per-second.
  137     my $this_run = AnyEvent->time;
  138     $TIME_SINCE_LAST_RUN = $this_run - $LAST_RUN;
  139     $LAST_RUN = $this_run;
  140 
  141     # Done all our fetches. Drive the display.
  142     display_run($prev_stats_results, \%stats_results);
  143     $prev_stats_results = \%stats_results;
  144 
  145     my $end  = AnyEvent->time;
  146     my $diff = $LAST_RUN - $start;
  147     print "loop took: $diff";
  148     return $diff;
  149 }
  150 
  151 sub maintain_connections {
  152     my $cv    = AnyEvent->condvar;
  153 
  154     $cv->begin (sub { shift->send });
  155     for my $host (@{$CONF->{servers}}) {
  156         next if $CONS{$host};
  157         $cv->begin;
  158         $CONS{$host} = connect_memcached($host, sub {
  159             if ($_[0] eq 'err') {
  160                 print "Failed connecting to $host: ", $_[1], "\n";
  161                 delete $CONS{$host};
  162             }
  163             $cv->end;
  164         });
  165     }
  166     $cv->end;
  167 
  168     $cv->recv;
  169 }
  170 
  171 sub connect_memcached {
  172     my ($fullhost, $cb)   = @_;
  173     my ($host, $port) = split /:/, $fullhost;
  174 
  175     my $con; $con = AnyEvent::Handle->new (
  176         connect => [$host => $port],
  177         on_connect => sub {
  178             $cb->('con');
  179         },
  180         on_connect_error => sub {
  181             $cb->('err', $!);
  182             $con->destroy;
  183         },
  184         on_eof   => sub {
  185             $cb->('err', $!);
  186             $con->destroy;
  187         },
  188     );
  189     return $con;
  190 }
  191 
  192 # Function's getting a little weird since I started optimizing it.
  193 # As of my first set of production tests, this routine is where we spend
  194 # almost all of our processing time.
  195 sub call_stats {
  196     my ($con, $cmds, $cb) = @_;
  197 
  198     my $stats = {};
  199     my $num_types = @$cmds;
  200 
  201     my $reader; $reader = sub {
  202         my ($con, $results) = @_;
  203         {
  204             my %temp = ();
  205             for my $line (split(/\n/, $results)) {
  206                 my ($k, $v) = (split(/\s+/, $line))[1,2];
  207                 $temp{$k} = $v;
  208             }
  209             $stats->{$cmds->[0]} = \%temp;
  210         }
  211         shift @$cmds;
  212         unless (@$cmds) {
  213             # Out of commands to process, return goodies.
  214             $cb->($stats);
  215             return;
  216         }
  217     };
  218 
  219     for my $cmd (@$cmds) {
  220         $con->push_write('stats ' . $cmd . "\n");
  221         $stats->{$cmd} = {};
  222         $con->push_read(line => "END\r\n", $reader);
  223     }
  224 }
  225 
  226 ### Compute routines
  227 
  228 sub compute_hostname {
  229     return $_[0];
  230 }
  231 
  232 sub compute_hit_rate {
  233     my $s = $_[1];
  234     my $total = $s->{get_hits} + $s->{get_misses};
  235     return 'NA' unless $total;
  236     return $s->{get_hits} / $total;
  237 }
  238 
  239 sub compute_fill_rate {
  240     my $s = $_[1];
  241     return $s->{bytes} / $s->{limit_maxbytes};
  242 }
  243 
  244 sub format_column {
  245     my ($col, $val) = @_;
  246     my $res;
  247     $col =~ s/^all_//;
  248     if ($column_format{$col}) {
  249         if (ref($column_format{$col}) eq 'CODE') {
  250             return $column_format{$col}->($val);
  251         } else {
  252             return $val .= $column_format{$col};
  253         }
  254     } else {
  255         return format_commas($val);
  256     }
  257 }
  258 
  259 sub column_can_total {
  260     my $col = shift;
  261     $col =~ s/^all_//;
  262     return 1 unless exists $column_format_totals{$col};
  263     return $column_format_totals{$col};
  264 }
  265 
  266 ### Display routines
  267 
  268 # If there isn't a specific column type computer, see if we just want to
  269 # look at the specific stat and return it.
  270 # If column is a generic type and of 'all_cmd_get' format, return the more
  271 # complete stat instead of the diffed stat.
  272 sub compute_column {
  273     my ($col, $host, $prev_stats, $curr_stats) = @_;
  274     my $diff_stats = 1;
  275     $diff_stats    = 0 if ($col =~ s/^all_//);
  276 
  277     # Really should decide on whether or not to flatten the hash :/
  278     my $find_stat = sub {
  279         for my $type (keys %{$_[0]}) {
  280             return $_[0]->{$type}->{$_[1]} if exists $_[0]->{$type}->{$_[1]};
  281         }
  282     };
  283 
  284     my $diff_stat = sub {
  285         my $stat = shift;
  286         return 'NA' unless defined $find_stat->($curr_stats, $stat);
  287         if ($diff_stats) {
  288             my $diff = eval {
  289                 return ($find_stat->($curr_stats, $stat)
  290                        - $find_stat->($prev_stats, $stat))
  291                        / $TIME_SINCE_LAST_RUN;
  292             };
  293             return 'NA' if ($@);
  294             return $diff;
  295         } else {
  296             return $find_stat->($curr_stats, $stat);
  297         }
  298     };
  299 
  300     if (my $comp = $column_compute{$col}) {
  301         my %s = ();
  302         for my $stat (@{$comp->{stats}}) {
  303             $s{$stat} = $diff_stat->($stat);
  304         }
  305         return $comp->{code}->($host, \%s);
  306     } else {
  307         return $diff_stat->($col);
  308     }
  309     return 'NA';
  310 }
  311 
  312 # We have a bunch of stats from a bunch of connections.
  313 # At this point we run a particular display mode, capture the lines, then
  314 # truncate and display them.
  315 sub display_run {
  316     my $prev_stats = shift;
  317     my $curr_stats = shift;
  318     @TERM_SIZE = GetTerminalSize;
  319     die "cannot detect terminal size" unless $TERM_SIZE[0] && $TERM_SIZE[1];
  320 
  321     if ($LAST_KEY eq 'q') {
  322         print "\n";
  323         ReadMode('normal'); exit;
  324     }
  325 
  326     if ($LAST_KEY ne $CONF->{mode} && exists $display_modes{$LAST_KEY}) {
  327         $CONF->{prev_mode} = $CONF->{mode};
  328         $CONF->{mode} = $LAST_KEY;
  329     } elsif ($CONF->{mode} eq 'h' || $CONF->{mode} eq '?') {
  330         # Bust out of help mode on any key.
  331         $CONF->{mode} = $CONF->{prev_mode};
  332     }
  333     my $lines = $display_modes{$CONF->{mode}}->($prev_stats, $curr_stats);
  334     display_lines($lines) if $lines;
  335 }
  336 
  337 # Default "top" mode.
  338 # create a set of computed columns as requested by the config.
  339 # this has gotten a little out of hand... needs more cleanup/abstraction.
  340 sub display_top_mode {
  341     my $prev_stats = shift;
  342     my $curr_stats = shift;
  343 
  344     my @columns = @{$CONF->{top_mode}->{columns}};
  345     my @rows    = ();
  346     my @tot_row = ();
  347 
  348     # Round one.
  349     for my $host (sort keys %{$curr_stats}) {
  350         my @row = ();
  351         for my $colnum (0 .. @columns-1) {
  352             my $col = $columns[$colnum];
  353             my $res = compute_column($col, $host, $prev_stats->{$host},
  354                       $curr_stats->{$host});
  355             $tot_row[$colnum] += $res if is_numeric($res);
  356             push @row, $res;
  357         }
  358         push(@rows, \@row);
  359     }
  360 
  361     # Sort rows by sort column (ascending or descending)
  362     if (my $sort = $CONF->{top_mode}->{sort_column}) {
  363         my $order  = $CONF->{top_mode}->{sort_order} || 'asc';
  364         my $colnum = 0;
  365         for (0 .. @columns-1) { $colnum = $_ if $columns[$_] eq $sort; }
  366         my @newrows;
  367         if ($order eq 'asc') {
  368             if (is_numeric($rows[0]->[$colnum])) {
  369                 @newrows = sort { $a->[$colnum] <=> $b->[$colnum] } @rows;
  370             } else {
  371                 @newrows = sort { $a->[$colnum] cmp $b->[$colnum] } @rows;
  372             }
  373         } else {
  374             if (is_numeric($rows[0]->[$colnum])) {
  375                 @newrows = sort { $b->[$colnum] <=> $a->[$colnum] } @rows;
  376             } else {
  377                 @newrows = sort { $b->[$colnum] cmp $a->[$colnum] } @rows;
  378             }
  379         }
  380         @rows = @newrows;
  381     }
  382 
  383     # Format each column after the sort...
  384     {
  385         my @newrows = ();
  386         for my $row (@rows) {
  387             my @newrow = ();
  388             for my $colnum (0 .. @columns-1) {
  389                 push @newrow, is_numeric($row->[$colnum]) ?
  390                             format_column($columns[$colnum], $row->[$colnum]) :
  391                             $row->[$colnum];
  392             }
  393             push @newrows, \@newrow;
  394         }
  395         @rows = @newrows;
  396     }
  397 
  398     # Create average and total rows.
  399     my @avg_row = ();
  400     for my $col (0 .. @columns-1) {
  401         if (is_numeric($tot_row[$col])) {
  402             my $countable_rows = 0;
  403             for my $row (@rows) {
  404                 next unless $row->[$col];
  405                 $countable_rows++ unless $row->[$col] eq 'NA';
  406             }
  407             $countable_rows = 1 unless $countable_rows;
  408             push @avg_row, format_column($columns[$col],
  409                  sprintf('%.2f', $tot_row[$col] / $countable_rows));
  410         } else {
  411             push @avg_row, 'NA';
  412         }
  413         $tot_row[$col] = 'NA' unless defined $tot_row[$col];
  414         $tot_row[$col] = 'NA' unless (column_can_total($columns[$col]));
  415         $tot_row[$col] = format_column($columns[$col], $tot_row[$col])
  416                          unless $tot_row[$col] eq 'NA';
  417     }
  418     unshift @rows, \@avg_row;
  419     unshift @rows, ['AVERAGE:'];
  420     unshift @rows, \@tot_row;
  421     unshift @rows, ['TOTAL:'];
  422 
  423     # Round two. Pass @rows into a function which returns an array with the
  424     # desired format spacing for each column.
  425     unshift @rows, \@columns;
  426     my $spacing = find_optimal_spacing(\@rows);
  427 
  428     my @display_lines = ();
  429     for my $row (@rows) {
  430         my $line = '';
  431         for my $col (0 .. @$row-1) {
  432             my $space = $spacing->[$col];
  433             $line .= sprintf("%-${space}s ", $row->[$col]);
  434         }
  435         push @display_lines, $line;
  436     }
  437 
  438     return \@display_lines;
  439 }
  440 
  441 sub display_help_mode {
  442     my $help = <<"ENDHELP";
  443 
  444 dormando's awesome memcached top utility version v$VERSION
  445 
  446 This early version requires you to edit the ~/.damemtop/damemtop.yaml
  447 (or /etc/damemtop.yaml) file in order to change options.
  448 See --help for more info.
  449 
  450 Hit any key to exit help.
  451 ENDHELP
  452     my @lines = split /\n/, $help;
  453     display_lines(\@lines);
  454     $LAST_KEY = ReadKey(0);
  455     return;
  456 }
  457 
  458 # Takes a set of lines, clears screen, dumps header, trims lines, etc
  459 # MAYBE: mode to wrap lines instead of trim them?
  460 sub display_lines {
  461     my $lines = shift;
  462 
  463     my $width         = $TERM_SIZE[0];
  464     my $height_remain = $TERM_SIZE[1];
  465 
  466     unshift @$lines, display_header($width);
  467     clear_screen() unless $CONF->{no_clear};
  468 
  469     while (--$height_remain && @$lines) {
  470         # truncate too long lines.
  471         my $line = shift @$lines;
  472         $line = substr $line, 0, $width-1;
  473         print $line, "\n";
  474     }
  475 }
  476 
  477 sub display_header {
  478     my $topbar = 'damemtop: ' . scalar localtime;
  479     if ($CONF->{mode} eq 't' && $CONF->{top_mode}->{sort_column}) {
  480         $topbar .= ' [sort: ' . $CONF->{top_mode}->{sort_column} . ']';
  481     }
  482     $topbar .= ' [delay: ' . $CONF->{delay} . 's]';
  483     return $topbar;
  484 }
  485 
  486 ### Utilities
  487 
  488 # find the optimal format spacing for each column, which is:
  489 # longest length of item in col + 2 (whitespace).
  490 sub find_optimal_spacing {
  491     my $rows  = shift;
  492     my @maxes = ();
  493 
  494     my $num_cols = @{$rows->[0]};
  495     for my $row (@$rows) {
  496         for my $col (0 .. $num_cols-1) {
  497             $maxes[$col] = 0 unless $maxes[$col];
  498             next unless $row->[$col];
  499             $maxes[$col] = length($row->[$col])
  500                 if length($row->[$col]) > $maxes[$col];
  501         }
  502     }
  503     for my $col (0 .. $num_cols) {
  504         $maxes[$col] += 1;
  505     }
  506 
  507     return \@maxes;
  508 }
  509 
  510 # doesn't try too hard to identify numbers...
  511 sub is_numeric {
  512     return 0 unless $_[0];
  513     return 1 if $_[0] =~ m/^\d+(\.\d*)?(\w+)?$/;
  514     return 0;
  515 }
  516 
  517 sub format_percent {
  518     return sprintf("%.2f%%", $_[0] * 100);
  519 }
  520 
  521 sub format_commas {
  522     my $num = shift;
  523     $num = int($num);
  524     $num =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
  525     return $num;
  526 }
  527 
  528 # Can tick counters/etc here as well.
  529 sub clear_screen {
  530     print $CLEAR;
  531 }
  532 
  533 # tries minimally to find a localized config file.
  534 # TODO: Handle the YAML error and make it prettier.
  535 sub load_config {
  536     my $config = $opts{config} if $opts{config};
  537     my $homedir = "$ENV{HOME}/.damemtop/damemtop.yaml";
  538     if (-e $homedir) {
  539         $config = $homedir;
  540     } else {
  541         $config = '/etc/damemtop.yaml';
  542     }
  543     return LoadFile($config);
  544 }
  545 
  546 sub show_help {
  547     print <<"ENDHELP";
  548 dormando's awesome memcached top utility version v$VERSION
  549 
  550 This program is copyright (c) 2009 Dormando.
  551 Use and distribution licensed under the BSD license.  See
  552 the COPYING file for full text.
  553 
  554 contact: dormando\@rydia.net or memcached\@googlegroups.com.
  555 
  556 This early version requires you to edit the ~/.damemtop/damemtop.yaml
  557 (or /etc/damemtop.yaml) file in order to change options.
  558 
  559 You may display any column that is in the output of
  560 'stats', 'stats items', or 'stats slabs' from memcached's ASCII protocol.
  561 Start a column with 'all_' (ie; 'all_get_hits') to display the current stat,
  562 otherwise the stat is displayed as an average per second.
  563 
  564 Specify a "sort_column" under "top_mode" to sort the output by any column.
  565 
  566 Some special "computed" columns exist:
  567 hit_rate (get/miss hit ratio)
  568 fill_rate (% bytes used out of the maximum memory limit)
  569 ENDHELP
  570     exit;
  571 }