572 lines
16 KiB
Perl
572 lines
16 KiB
Perl
#!/usr/bin/perl
|
|
# dormando's awesome memcached top utility!
|
|
#
|
|
# Copyright 2009 Dormando (dormando@rydia.net). All rights reserved.
|
|
#
|
|
# Use and distribution licensed under the BSD license. See
|
|
# the COPYING file for full text.
|
|
|
|
use strict;
|
|
use warnings FATAL => 'all';
|
|
|
|
use AnyEvent;
|
|
use AnyEvent::Socket;
|
|
use AnyEvent::Handle;
|
|
use Getopt::Long;
|
|
use YAML qw/Dump Load LoadFile/;
|
|
use Term::ReadKey qw/ReadMode ReadKey GetTerminalSize/;
|
|
|
|
our $VERSION = '0.1';
|
|
|
|
my $CLEAR = `clear`;
|
|
my @TERM_SIZE = ();
|
|
$|++;
|
|
|
|
my %opts = ();
|
|
GetOptions(\%opts, 'help|h', 'config=s');
|
|
|
|
if ($opts{help}) {
|
|
show_help(); exit;
|
|
}
|
|
|
|
$SIG{INT} = sub {
|
|
ReadMode('normal');
|
|
print "\n";
|
|
exit;
|
|
};
|
|
|
|
# TODO: make this load from central location, and merge in homedir changes.
|
|
# then merge Getopt::Long stuff on top of that
|
|
# TODO: Set a bunch of defaults and merge in.
|
|
my $CONF = load_config();
|
|
my %CONS = ();
|
|
my $LAST_RUN = time; # time after the last loop cycle.
|
|
my $TIME_SINCE_LAST_RUN = time; # time since last loop cycle.
|
|
my $loop_timer;
|
|
my $main_cond;
|
|
my $prev_stats_results;
|
|
|
|
my %display_modes = (
|
|
't' => \&display_top_mode,
|
|
'?' => \&display_help_mode,
|
|
'h' => \&display_help_mode,
|
|
);
|
|
|
|
my %column_compute = (
|
|
'hostname' => { stats => [], code => \&compute_hostname},
|
|
'hit_rate' => { stats => ['get_hits', 'get_misses'],
|
|
code => \&compute_hit_rate },
|
|
'fill_rate' => { stats => ['bytes', 'limit_maxbytes'],
|
|
code => \&compute_fill_rate },
|
|
);
|
|
|
|
my %column_format = (
|
|
'hit_rate' => \&format_percent,
|
|
'fill_rate' => \&format_percent,
|
|
);
|
|
|
|
# This can collapse into %column_compute
|
|
my %column_format_totals = (
|
|
'hit_rate' => 0,
|
|
'fill_rate' => 0,
|
|
);
|
|
|
|
ReadMode('cbreak');
|
|
my $LAST_KEY = '';
|
|
my $read_keys = AnyEvent->io (
|
|
fh => \*STDIN, poll => 'r',
|
|
cb => sub {
|
|
$LAST_KEY = ReadKey(-1);
|
|
# If there is a running timer, cancel it.
|
|
# Don't want to interrupt a main loop run.
|
|
# fire_main_loop()'s iteration will pick up the keypress.
|
|
if ($loop_timer) {
|
|
$loop_timer = undef;
|
|
$main_cond->send;
|
|
}
|
|
}
|
|
);
|
|
|
|
# start main loop
|
|
fire_main_loop();
|
|
|
|
### AnyEvent related code.
|
|
|
|
sub fire_main_loop {
|
|
for (;;) {
|
|
$loop_timer = undef;
|
|
$main_cond = AnyEvent->condvar;
|
|
my $time_taken = main_loop();
|
|
my $delay = $CONF->{delay} - $time_taken;
|
|
$delay = 0 if $delay < 0;
|
|
$loop_timer = AnyEvent->timer(
|
|
after => $delay,
|
|
cb => $main_cond,
|
|
);
|
|
$main_cond->recv;
|
|
}
|
|
}
|
|
|
|
sub main_loop {
|
|
my $start = AnyEvent->now; # use ->time to find the end.
|
|
maintain_connections();
|
|
|
|
my $cv = AnyEvent->condvar;
|
|
|
|
# FIXME: Need to dump early if there're no connected conns
|
|
# FIXME: Make this only fetch stats from cons we care to visualize?
|
|
# maybe keep everything anyway to maintain averages?
|
|
my %stats_results = ();
|
|
while (my ($hostname, $con) = each %CONS) {
|
|
$cv->begin;
|
|
call_stats($con, ['', 'items', 'slabs'], sub {
|
|
$stats_results{$hostname} = shift;
|
|
$cv->end;
|
|
});
|
|
}
|
|
$cv->recv;
|
|
|
|
# Short circuit since we don't have anything to compare to.
|
|
unless ($prev_stats_results) {
|
|
$prev_stats_results = \%stats_results;
|
|
return $CONF->{delay};
|
|
}
|
|
|
|
# Semi-exact global time diff for stats that want to average
|
|
# themselves per-second.
|
|
my $this_run = AnyEvent->time;
|
|
$TIME_SINCE_LAST_RUN = $this_run - $LAST_RUN;
|
|
$LAST_RUN = $this_run;
|
|
|
|
# Done all our fetches. Drive the display.
|
|
display_run($prev_stats_results, \%stats_results);
|
|
$prev_stats_results = \%stats_results;
|
|
|
|
my $end = AnyEvent->time;
|
|
my $diff = $LAST_RUN - $start;
|
|
print "loop took: $diff";
|
|
return $diff;
|
|
}
|
|
|
|
sub maintain_connections {
|
|
my $cv = AnyEvent->condvar;
|
|
|
|
$cv->begin (sub { shift->send });
|
|
for my $host (@{$CONF->{servers}}) {
|
|
next if $CONS{$host};
|
|
$cv->begin;
|
|
$CONS{$host} = connect_memcached($host, sub {
|
|
if ($_[0] eq 'err') {
|
|
print "Failed connecting to $host: ", $_[1], "\n";
|
|
delete $CONS{$host};
|
|
}
|
|
$cv->end;
|
|
});
|
|
}
|
|
$cv->end;
|
|
|
|
$cv->recv;
|
|
}
|
|
|
|
sub connect_memcached {
|
|
my ($fullhost, $cb) = @_;
|
|
my ($host, $port) = split /:/, $fullhost;
|
|
|
|
my $con; $con = AnyEvent::Handle->new (
|
|
connect => [$host => $port],
|
|
on_connect => sub {
|
|
$cb->('con');
|
|
},
|
|
on_connect_error => sub {
|
|
$cb->('err', $!);
|
|
$con->destroy;
|
|
},
|
|
on_eof => sub {
|
|
$cb->('err', $!);
|
|
$con->destroy;
|
|
},
|
|
);
|
|
return $con;
|
|
}
|
|
|
|
# Function's getting a little weird since I started optimizing it.
|
|
# As of my first set of production tests, this routine is where we spend
|
|
# almost all of our processing time.
|
|
sub call_stats {
|
|
my ($con, $cmds, $cb) = @_;
|
|
|
|
my $stats = {};
|
|
my $num_types = @$cmds;
|
|
|
|
my $reader; $reader = sub {
|
|
my ($con, $results) = @_;
|
|
{
|
|
my %temp = ();
|
|
for my $line (split(/\n/, $results)) {
|
|
my ($k, $v) = (split(/\s+/, $line))[1,2];
|
|
$temp{$k} = $v;
|
|
}
|
|
$stats->{$cmds->[0]} = \%temp;
|
|
}
|
|
shift @$cmds;
|
|
unless (@$cmds) {
|
|
# Out of commands to process, return goodies.
|
|
$cb->($stats);
|
|
return;
|
|
}
|
|
};
|
|
|
|
for my $cmd (@$cmds) {
|
|
$con->push_write('stats ' . $cmd . "\n");
|
|
$stats->{$cmd} = {};
|
|
$con->push_read(line => "END\r\n", $reader);
|
|
}
|
|
}
|
|
|
|
### Compute routines
|
|
|
|
sub compute_hostname {
|
|
return $_[0];
|
|
}
|
|
|
|
sub compute_hit_rate {
|
|
my $s = $_[1];
|
|
my $total = $s->{get_hits} + $s->{get_misses};
|
|
return 'NA' unless $total;
|
|
return $s->{get_hits} / $total;
|
|
}
|
|
|
|
sub compute_fill_rate {
|
|
my $s = $_[1];
|
|
return $s->{bytes} / $s->{limit_maxbytes};
|
|
}
|
|
|
|
sub format_column {
|
|
my ($col, $val) = @_;
|
|
my $res;
|
|
$col =~ s/^all_//;
|
|
if ($column_format{$col}) {
|
|
if (ref($column_format{$col}) eq 'CODE') {
|
|
return $column_format{$col}->($val);
|
|
} else {
|
|
return $val .= $column_format{$col};
|
|
}
|
|
} else {
|
|
return format_commas($val);
|
|
}
|
|
}
|
|
|
|
sub column_can_total {
|
|
my $col = shift;
|
|
$col =~ s/^all_//;
|
|
return 1 unless exists $column_format_totals{$col};
|
|
return $column_format_totals{$col};
|
|
}
|
|
|
|
### Display routines
|
|
|
|
# If there isn't a specific column type computer, see if we just want to
|
|
# look at the specific stat and return it.
|
|
# If column is a generic type and of 'all_cmd_get' format, return the more
|
|
# complete stat instead of the diffed stat.
|
|
sub compute_column {
|
|
my ($col, $host, $prev_stats, $curr_stats) = @_;
|
|
my $diff_stats = 1;
|
|
$diff_stats = 0 if ($col =~ s/^all_//);
|
|
|
|
# Really should decide on whether or not to flatten the hash :/
|
|
my $find_stat = sub {
|
|
for my $type (keys %{$_[0]}) {
|
|
return $_[0]->{$type}->{$_[1]} if exists $_[0]->{$type}->{$_[1]};
|
|
}
|
|
};
|
|
|
|
my $diff_stat = sub {
|
|
my $stat = shift;
|
|
return 'NA' unless defined $find_stat->($curr_stats, $stat);
|
|
if ($diff_stats) {
|
|
my $diff = eval {
|
|
return ($find_stat->($curr_stats, $stat)
|
|
- $find_stat->($prev_stats, $stat))
|
|
/ $TIME_SINCE_LAST_RUN;
|
|
};
|
|
return 'NA' if ($@);
|
|
return $diff;
|
|
} else {
|
|
return $find_stat->($curr_stats, $stat);
|
|
}
|
|
};
|
|
|
|
if (my $comp = $column_compute{$col}) {
|
|
my %s = ();
|
|
for my $stat (@{$comp->{stats}}) {
|
|
$s{$stat} = $diff_stat->($stat);
|
|
}
|
|
return $comp->{code}->($host, \%s);
|
|
} else {
|
|
return $diff_stat->($col);
|
|
}
|
|
return 'NA';
|
|
}
|
|
|
|
# We have a bunch of stats from a bunch of connections.
|
|
# At this point we run a particular display mode, capture the lines, then
|
|
# truncate and display them.
|
|
sub display_run {
|
|
my $prev_stats = shift;
|
|
my $curr_stats = shift;
|
|
@TERM_SIZE = GetTerminalSize;
|
|
die "cannot detect terminal size" unless $TERM_SIZE[0] && $TERM_SIZE[1];
|
|
|
|
if ($LAST_KEY eq 'q') {
|
|
print "\n";
|
|
ReadMode('normal'); exit;
|
|
}
|
|
|
|
if ($LAST_KEY ne $CONF->{mode} && exists $display_modes{$LAST_KEY}) {
|
|
$CONF->{prev_mode} = $CONF->{mode};
|
|
$CONF->{mode} = $LAST_KEY;
|
|
} elsif ($CONF->{mode} eq 'h' || $CONF->{mode} eq '?') {
|
|
# Bust out of help mode on any key.
|
|
$CONF->{mode} = $CONF->{prev_mode};
|
|
}
|
|
my $lines = $display_modes{$CONF->{mode}}->($prev_stats, $curr_stats);
|
|
display_lines($lines) if $lines;
|
|
}
|
|
|
|
# Default "top" mode.
|
|
# create a set of computed columns as requested by the config.
|
|
# this has gotten a little out of hand... needs more cleanup/abstraction.
|
|
sub display_top_mode {
|
|
my $prev_stats = shift;
|
|
my $curr_stats = shift;
|
|
|
|
my @columns = @{$CONF->{top_mode}->{columns}};
|
|
my @rows = ();
|
|
my @tot_row = ();
|
|
|
|
# Round one.
|
|
for my $host (sort keys %{$curr_stats}) {
|
|
my @row = ();
|
|
for my $colnum (0 .. @columns-1) {
|
|
my $col = $columns[$colnum];
|
|
my $res = compute_column($col, $host, $prev_stats->{$host},
|
|
$curr_stats->{$host});
|
|
$tot_row[$colnum] += $res if is_numeric($res);
|
|
push @row, $res;
|
|
}
|
|
push(@rows, \@row);
|
|
}
|
|
|
|
# Sort rows by sort column (ascending or descending)
|
|
if (my $sort = $CONF->{top_mode}->{sort_column}) {
|
|
my $order = $CONF->{top_mode}->{sort_order} || 'asc';
|
|
my $colnum = 0;
|
|
for (0 .. @columns-1) { $colnum = $_ if $columns[$_] eq $sort; }
|
|
my @newrows;
|
|
if ($order eq 'asc') {
|
|
if (is_numeric($rows[0]->[$colnum])) {
|
|
@newrows = sort { $a->[$colnum] <=> $b->[$colnum] } @rows;
|
|
} else {
|
|
@newrows = sort { $a->[$colnum] cmp $b->[$colnum] } @rows;
|
|
}
|
|
} else {
|
|
if (is_numeric($rows[0]->[$colnum])) {
|
|
@newrows = sort { $b->[$colnum] <=> $a->[$colnum] } @rows;
|
|
} else {
|
|
@newrows = sort { $b->[$colnum] cmp $a->[$colnum] } @rows;
|
|
}
|
|
}
|
|
@rows = @newrows;
|
|
}
|
|
|
|
# Format each column after the sort...
|
|
{
|
|
my @newrows = ();
|
|
for my $row (@rows) {
|
|
my @newrow = ();
|
|
for my $colnum (0 .. @columns-1) {
|
|
push @newrow, is_numeric($row->[$colnum]) ?
|
|
format_column($columns[$colnum], $row->[$colnum]) :
|
|
$row->[$colnum];
|
|
}
|
|
push @newrows, \@newrow;
|
|
}
|
|
@rows = @newrows;
|
|
}
|
|
|
|
# Create average and total rows.
|
|
my @avg_row = ();
|
|
for my $col (0 .. @columns-1) {
|
|
if (is_numeric($tot_row[$col])) {
|
|
my $countable_rows = 0;
|
|
for my $row (@rows) {
|
|
next unless $row->[$col];
|
|
$countable_rows++ unless $row->[$col] eq 'NA';
|
|
}
|
|
$countable_rows = 1 unless $countable_rows;
|
|
push @avg_row, format_column($columns[$col],
|
|
sprintf('%.2f', $tot_row[$col] / $countable_rows));
|
|
} else {
|
|
push @avg_row, 'NA';
|
|
}
|
|
$tot_row[$col] = 'NA' unless defined $tot_row[$col];
|
|
$tot_row[$col] = 'NA' unless (column_can_total($columns[$col]));
|
|
$tot_row[$col] = format_column($columns[$col], $tot_row[$col])
|
|
unless $tot_row[$col] eq 'NA';
|
|
}
|
|
unshift @rows, \@avg_row;
|
|
unshift @rows, ['AVERAGE:'];
|
|
unshift @rows, \@tot_row;
|
|
unshift @rows, ['TOTAL:'];
|
|
|
|
# Round two. Pass @rows into a function which returns an array with the
|
|
# desired format spacing for each column.
|
|
unshift @rows, \@columns;
|
|
my $spacing = find_optimal_spacing(\@rows);
|
|
|
|
my @display_lines = ();
|
|
for my $row (@rows) {
|
|
my $line = '';
|
|
for my $col (0 .. @$row-1) {
|
|
my $space = $spacing->[$col];
|
|
$line .= sprintf("%-${space}s ", $row->[$col]);
|
|
}
|
|
push @display_lines, $line;
|
|
}
|
|
|
|
return \@display_lines;
|
|
}
|
|
|
|
sub display_help_mode {
|
|
my $help = <<"ENDHELP";
|
|
|
|
dormando's awesome memcached top utility version v$VERSION
|
|
|
|
This early version requires you to edit the ~/.damemtop/damemtop.yaml
|
|
(or /etc/damemtop.yaml) file in order to change options.
|
|
See --help for more info.
|
|
|
|
Hit any key to exit help.
|
|
ENDHELP
|
|
my @lines = split /\n/, $help;
|
|
display_lines(\@lines);
|
|
$LAST_KEY = ReadKey(0);
|
|
return;
|
|
}
|
|
|
|
# Takes a set of lines, clears screen, dumps header, trims lines, etc
|
|
# MAYBE: mode to wrap lines instead of trim them?
|
|
sub display_lines {
|
|
my $lines = shift;
|
|
|
|
my $width = $TERM_SIZE[0];
|
|
my $height_remain = $TERM_SIZE[1];
|
|
|
|
unshift @$lines, display_header($width);
|
|
clear_screen() unless $CONF->{no_clear};
|
|
|
|
while (--$height_remain && @$lines) {
|
|
# truncate too long lines.
|
|
my $line = shift @$lines;
|
|
$line = substr $line, 0, $width-1;
|
|
print $line, "\n";
|
|
}
|
|
}
|
|
|
|
sub display_header {
|
|
my $topbar = 'damemtop: ' . scalar localtime;
|
|
if ($CONF->{mode} eq 't' && $CONF->{top_mode}->{sort_column}) {
|
|
$topbar .= ' [sort: ' . $CONF->{top_mode}->{sort_column} . ']';
|
|
}
|
|
$topbar .= ' [delay: ' . $CONF->{delay} . 's]';
|
|
return $topbar;
|
|
}
|
|
|
|
### Utilities
|
|
|
|
# find the optimal format spacing for each column, which is:
|
|
# longest length of item in col + 2 (whitespace).
|
|
sub find_optimal_spacing {
|
|
my $rows = shift;
|
|
my @maxes = ();
|
|
|
|
my $num_cols = @{$rows->[0]};
|
|
for my $row (@$rows) {
|
|
for my $col (0 .. $num_cols-1) {
|
|
$maxes[$col] = 0 unless $maxes[$col];
|
|
next unless $row->[$col];
|
|
$maxes[$col] = length($row->[$col])
|
|
if length($row->[$col]) > $maxes[$col];
|
|
}
|
|
}
|
|
for my $col (0 .. $num_cols) {
|
|
$maxes[$col] += 1;
|
|
}
|
|
|
|
return \@maxes;
|
|
}
|
|
|
|
# doesn't try too hard to identify numbers...
|
|
sub is_numeric {
|
|
return 0 unless $_[0];
|
|
return 1 if $_[0] =~ m/^\d+(\.\d*)?(\w+)?$/;
|
|
return 0;
|
|
}
|
|
|
|
sub format_percent {
|
|
return sprintf("%.2f%%", $_[0] * 100);
|
|
}
|
|
|
|
sub format_commas {
|
|
my $num = shift;
|
|
$num = int($num);
|
|
$num =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
|
|
return $num;
|
|
}
|
|
|
|
# Can tick counters/etc here as well.
|
|
sub clear_screen {
|
|
print $CLEAR;
|
|
}
|
|
|
|
# tries minimally to find a localized config file.
|
|
# TODO: Handle the YAML error and make it prettier.
|
|
sub load_config {
|
|
my $config = $opts{config} if $opts{config};
|
|
my $homedir = "$ENV{HOME}/.damemtop/damemtop.yaml";
|
|
if (-e $homedir) {
|
|
$config = $homedir;
|
|
} else {
|
|
$config = '/etc/damemtop.yaml';
|
|
}
|
|
return LoadFile($config);
|
|
}
|
|
|
|
sub show_help {
|
|
print <<"ENDHELP";
|
|
dormando's awesome memcached top utility version v$VERSION
|
|
|
|
This program is copyright (c) 2009 Dormando.
|
|
Use and distribution licensed under the BSD license. See
|
|
the COPYING file for full text.
|
|
|
|
contact: dormando\@rydia.net or memcached\@googlegroups.com.
|
|
|
|
This early version requires you to edit the ~/.damemtop/damemtop.yaml
|
|
(or /etc/damemtop.yaml) file in order to change options.
|
|
|
|
You may display any column that is in the output of
|
|
'stats', 'stats items', or 'stats slabs' from memcached's ASCII protocol.
|
|
Start a column with 'all_' (ie; 'all_get_hits') to display the current stat,
|
|
otherwise the stat is displayed as an average per second.
|
|
|
|
Specify a "sort_column" under "top_mode" to sort the output by any column.
|
|
|
|
Some special "computed" columns exist:
|
|
hit_rate (get/miss hit ratio)
|
|
fill_rate (% bytes used out of the maximum memory limit)
|
|
ENDHELP
|
|
exit;
|
|
}
|