2 # dormando's awesome memcached top utility!
4 # Copyright 2009 Dormando (dormando@rydia.net). All rights reserved.
6 # Use and distribution licensed under the BSD license. See
7 # the COPYING file for full text.
10 use warnings FATAL
=> 'all';
16 use YAML qw
/Dump Load LoadFile/;
17 use Term
::ReadKey qw
/ReadMode ReadKey GetTerminalSize/;
26 GetOptions
(\
%opts, 'help|h', 'config=s');
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
();
43 my $LAST_RUN = time; # time after the last loop cycle.
44 my $TIME_SINCE_LAST_RUN = time; # time since last loop cycle.
47 my $prev_stats_results;
50 't' => \
&display_top_mode
,
51 '?' => \
&display_help_mode
,
52 'h' => \
&display_help_mode
,
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
},
64 'hit_rate' => \
&format_percent
,
65 'fill_rate' => \
&format_percent
,
68 # This can collapse into %column_compute
69 my %column_format_totals = (
76 my $read_keys = AnyEvent
->io (
77 fh
=> \
*STDIN
, poll
=> 'r',
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.
93 ### AnyEvent related code.
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(
111 my $start = AnyEvent
->now; # use ->time to find the end.
112 maintain_connections
();
114 my $cv = AnyEvent
->condvar;
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) {
122 call_stats
($con, ['', 'items', 'slabs'], sub {
123 $stats_results{$hostname} = shift;
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
};
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;
141 # Done all our fetches. Drive the display.
142 display_run
($prev_stats_results, \
%stats_results);
143 $prev_stats_results = \
%stats_results;
145 my $end = AnyEvent
->time;
146 my $diff = $LAST_RUN - $start;
147 print "loop took: $diff";
151 sub maintain_connections
{
152 my $cv = AnyEvent
->condvar;
154 $cv->begin (sub { shift->send });
155 for my $host (@
{$CONF->{servers
}}) {
156 next if $CONS{$host};
158 $CONS{$host} = connect_memcached
($host, sub {
159 if ($_[0] eq 'err') {
160 print "Failed connecting to $host: ", $_[1], "\n";
171 sub connect_memcached
{
172 my ($fullhost, $cb) = @_;
173 my ($host, $port) = split /:/, $fullhost;
175 my $con; $con = AnyEvent
::Handle
->new (
176 connect => [$host => $port],
180 on_connect_error
=> sub {
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.
196 my ($con, $cmds, $cb) = @_;
199 my $num_types = @
$cmds;
201 my $reader; $reader = sub {
202 my ($con, $results) = @_;
205 for my $line (split(/\n/, $results)) {
206 my ($k, $v) = (split(/\s+/, $line))[1,2];
209 $stats->{$cmds->[0]} = \
%temp;
213 # Out of commands to process, return goodies.
219 for my $cmd (@
$cmds) {
220 $con->push_write('stats ' . $cmd . "\n");
222 $con->push_read(line
=> "END\r\n", $reader);
228 sub compute_hostname
{
232 sub compute_hit_rate
{
234 my $total = $s->{get_hits
} + $s->{get_misses
};
235 return 'NA' unless $total;
236 return $s->{get_hits
} / $total;
239 sub compute_fill_rate
{
241 return $s->{bytes
} / $s->{limit_maxbytes
};
245 my ($col, $val) = @_;
248 if ($column_format{$col}) {
249 if (ref($column_format{$col}) eq 'CODE') {
250 return $column_format{$col}->($val);
252 return $val .= $column_format{$col};
255 return format_commas
($val);
259 sub column_can_total
{
262 return 1 unless exists $column_format_totals{$col};
263 return $column_format_totals{$col};
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.
273 my ($col, $host, $prev_stats, $curr_stats) = @_;
275 $diff_stats = 0 if ($col =~ s/^all_//);
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]};
284 my $diff_stat = sub {
286 return 'NA' unless defined $find_stat->($curr_stats, $stat);
289 return ($find_stat->($curr_stats, $stat)
290 - $find_stat->($prev_stats, $stat))
291 / $TIME_SINCE_LAST_RUN;
296 return $find_stat->($curr_stats, $stat);
300 if (my $comp = $column_compute{$col}) {
302 for my $stat (@
{$comp->{stats
}}) {
303 $s{$stat} = $diff_stat->($stat);
305 return $comp->{code
}->($host, \
%s);
307 return $diff_stat->($col);
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.
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];
321 if ($LAST_KEY eq 'q') {
323 ReadMode
('normal'); exit;
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
};
333 my $lines = $display_modes{$CONF->{mode
}}->($prev_stats, $curr_stats);
334 display_lines
($lines) if $lines;
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;
344 my @columns = @
{$CONF->{top_mode
}->{columns
}};
349 for my $host (sort keys %{$curr_stats}) {
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);
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';
365 for (0 .. @columns-1) { $colnum = $_ if $columns[$_] eq $sort; }
367 if ($order eq 'asc') {
368 if (is_numeric
($rows[0]->[$colnum])) {
369 @newrows = sort { $a->[$colnum] <=> $b->[$colnum] } @rows;
371 @newrows = sort { $a->[$colnum] cmp $b->[$colnum] } @rows;
374 if (is_numeric
($rows[0]->[$colnum])) {
375 @newrows = sort { $b->[$colnum] <=> $a->[$colnum] } @rows;
377 @newrows = sort { $b->[$colnum] cmp $a->[$colnum] } @rows;
383 # Format each column after the sort...
386 for my $row (@rows) {
388 for my $colnum (0 .. @columns-1) {
389 push @newrow, is_numeric
($row->[$colnum]) ?
390 format_column
($columns[$colnum], $row->[$colnum]) :
393 push @newrows, \
@newrow;
398 # Create average and total rows.
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';
407 $countable_rows = 1 unless $countable_rows;
408 push @avg_row, format_column
($columns[$col],
409 sprintf('%.2f', $tot_row[$col] / $countable_rows));
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';
418 unshift @rows, \
@avg_row;
419 unshift @rows, ['AVERAGE:'];
420 unshift @rows, \
@tot_row;
421 unshift @rows, ['TOTAL:'];
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);
428 my @display_lines = ();
429 for my $row (@rows) {
431 for my $col (0 .. @
$row-1) {
432 my $space = $spacing->[$col];
433 $line .= sprintf("%-${space}s ", $row->[$col]);
435 push @display_lines, $line;
438 return \
@display_lines;
441 sub display_help_mode
{
442 my $help = <<"ENDHELP";
444 dormando's awesome memcached top utility version v$VERSION
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.
450 Hit any key to exit help.
452 my @lines = split /\n/, $help;
453 display_lines
(\
@lines);
454 $LAST_KEY = ReadKey
(0);
458 # Takes a set of lines, clears screen, dumps header, trims lines, etc
459 # MAYBE: mode to wrap lines instead of trim them?
463 my $width = $TERM_SIZE[0];
464 my $height_remain = $TERM_SIZE[1];
466 unshift @
$lines, display_header
($width);
467 clear_screen
() unless $CONF->{no_clear
};
469 while (--$height_remain && @
$lines) {
470 # truncate too long lines.
471 my $line = shift @
$lines;
472 $line = substr $line, 0, $width-1;
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
} . ']';
482 $topbar .= ' [delay: ' . $CONF->{delay
} . 's]';
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
{
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];
503 for my $col (0 .. $num_cols) {
510 # doesn't try too hard to identify numbers...
512 return 0 unless $_[0];
513 return 1 if $_[0] =~ m/^\d+(\.\d*)?(\w+)?$/;
518 return sprintf("%.2f%%", $_[0] * 100);
524 $num =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
528 # Can tick counters/etc here as well.
533 # tries minimally to find a localized config file.
534 # TODO: Handle the YAML error and make it prettier.
536 my $config = $opts{config
} if $opts{config
};
537 my $homedir = "$ENV{HOME}/.damemtop/damemtop.yaml";
541 $config = '/etc/damemtop.yaml';
543 return LoadFile
($config);
548 dormando's awesome memcached top utility version v$VERSION
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.
554 contact: dormando\@rydia.net or memcached\@googlegroups.com.
556 This early version requires you to edit the ~/.damemtop/damemtop.yaml
557 (or /etc/damemtop.yaml) file in order to change options.
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.
564 Specify a "sort_column" under "top_mode" to sort the output by any column.
566 Some special "computed" columns exist:
567 hit_rate (get/miss hit ratio)
568 fill_rate (% bytes used out of the maximum memory limit)