#!/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;
}