percona/percona-toolkit
1
0
Fork 0
mirror of https://github.com/percona/percona-toolkit.git synced 2025-09-11 05:29:30 +00:00
Code Issues Packages Projects Releases Wiki Activity

Work in progress v3: Working interactive mode, initial documentation.

Browse Source 
With this most of the interactive mode should be working.

pt_diskstats.pm has the documentation and can be used for testing,
which should be in the next commit.

This commit also includes the revamped command line options.
This commit is contained in:
Brian Fraser
2011-12-15 20:26:55 -03:00
parent 0fd09e8f6e
commit 7b12dbec64
7 changed files with 850 additions and 207 deletions
Download Patch File Download Diff File Expand all files Collapse all files

121
lib/Diskstats.pm
View File

@@ -19,12 +19,13 @@
# ###########################################################################
{
# Package: Diskstats
#
# This package implements most of the logic in the old shell pt-diskstats;
# it parses data from /proc/diskstats, calculcates deltas, and prints those.
package Diskstats;
use warnings;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
@@ -41,9 +42,9 @@ BEGIN {
Storable->import(qw(dclone));
}
else {
# An extrenely poor man's dclone.
require Scalar::Util;
# An extrenely poor man's dclone.
# Nevermind the prototype. dclone has it, so it's here only it for
# the sake of completeness.
*dclone = sub ($) {
@@ -65,23 +66,31 @@ sub new {
my ( $class, %args ) = @_;
my $self = {
# Defaults
filename => '/proc/diskstats',
column_regex => qr/cnc|rt|mb|busy|prg/,
device_regex => qr/(?=)/,
block_size => 512,
out_fh => \*STDOUT,
filter_zeroed_rows => 0,
samples_to_gather => 0,
interval => 0,
sample_time => 0,
interactive => 0,
%args,
_stats_for => {},
_sorted_devs => [],
_ts => {},
_save_curr_as_prev => 1, # Internal for now
_first => 1,
# Internal for now, but might need APIfying.
_save_curr_as_prev => 1,
_print_header => 1,
};
# If they passed us an attribute explicitly, we use those.
for my $attribute ( grep { !/^_/ && defined $args{$_} } keys %$self ) {
$self->{$attribute} = $args{$attribute};
}
return bless $self, $class;
}
@@ -110,14 +119,25 @@ sub first_ts {
sub filter_zeroed_rows {
my ($self, $new_val) = @_;
if ( $new_val ) {
if ( defined($new_val) ) {
$self->{filter_zeroed_rows} = $new_val;
}
return $self->{filter_zeroed_rows};
}
sub sample_time {
my ($self, $new_val) = @_;
if (defined($new_val)) {
$self->{sample_time} = $new_val;
}
return $self->{sample_time};
}
sub interactive {
my ($self) = @_;
my ($self, $new_val) = @_;
if (defined($new_val)) {
$self->{interactive} = $new_val;
}
return $self->{interactive};
}
@@ -151,7 +171,7 @@ sub device_regex {
sub filename {
my ( $self, $new_filename ) = @_;
if ($new_filename) {
if ( defined $new_filename ) {
return $self->{filename} = $new_filename;
}
return $self->{filename} || '/proc/diskstats';
@@ -183,6 +203,7 @@ sub add_sorted_devs {
sub clear_state {
my ($self) = @_;
$self->{_first} = 1;
$self->{_print_header} = 1;
$self->clear_current_stats();
$self->clear_previous_stats();
$self->clear_first_stats();
@@ -259,6 +280,36 @@ sub has_stats {
&& scalar grep 1, @{ $self->stats_for }{ $self->sorted_devs };
}
sub _save_current_as_previous {
my ( $self, $curr_hashref ) = @_;
if ( $self->{_save_curr_as_prev} ) {
$self->{_previous_stats_for} = $curr_hashref;
for my $dev (keys %$curr_hashref) {
$self->{_previous_stats_for}->{$dev}->{sum_ios_in_progress} +=
$curr_hashref->{$dev}->{ios_in_progress};
}
$self->previous_ts($self->current_ts());
}
return;
}
sub _save_current_as_first {
my ($self, $curr_hashref) = @_;
if ( $self->{_first} ) {
$self->{_first_stats_for} = $curr_hashref;
$self->first_ts($self->current_ts());
$self->{_first} = undef;
}
}
sub _save_stats {
my ( $self, $hashref ) = @_;
$self->{_stats_for} = $hashref;
}
sub trim {
my ($c) = @_;
$c =~ s/^\s+//;
@@ -409,36 +460,6 @@ sub parse_diskstats_line {
}
}
sub _save_current_as_previous {
my ( $self, $curr_hashref ) = @_;
if ( $self->{_save_curr_as_prev} ) {
$self->{_previous_stats_for} = $curr_hashref;
for my $dev (keys %$curr_hashref) {
$self->{_previous_stats_for}->{$dev}->{sum_ios_in_progress} +=
$curr_hashref->{$dev}->{ios_in_progress};
}
$self->previous_ts($self->current_ts());
}
return;
}
sub _save_current_as_first {
my ($self, $curr_hashref) = @_;
if ( $self->{_first} ) {
$self->{_first_stats_for} = $curr_hashref;
$self->first_ts($self->current_ts());
$self->{_first} = undef;
}
}
sub _save_stats {
my ( $self, $hashref ) = @_;
$self->{_stats_for} = $hashref;
}
# Method: parse_from()
# Parses data from one of the sources.
#
@@ -475,6 +496,7 @@ sub parse_from_filename {
return $lines_read;
}
# Method: parse_from_filehandle()
# Parses data received from using readline() on the filehandle. This is
# particularly useful, as you could pass in a filehandle to a pipe, or
@@ -509,9 +531,7 @@ sub parse_from_data {
sub _load {
my ( $self, $fh, $sample_callback ) = @_;
my $lines_read = 0;
my $block_size = $self->block_size;
my $new_cur = {};
while ( my $line = <$fh> ) {
@@ -527,13 +547,9 @@ sub _load {
$self->_save_current_as_first( dclone($self->stats_for) );
$new_cur = {};
}
# XXX TODO Ugly hack for interactive mode
my $ret = 0;
if ($sample_callback) {
$ret = $self->$sample_callback($ts);
$self->$sample_callback($ts);
}
$lines_read = $NR;
last if $ret;
}
else {
chomp($line);
@@ -545,7 +561,8 @@ sub _load {
#$self->_save_stats($new_cur);
$self->_save_current_as_first( dclone($self->stats_for) );
}
return $lines_read;
# Seems like this could be useful.
return $INPUT_LINE_NUMBER;
}
sub _calc_read_stats {
@@ -698,15 +715,17 @@ sub _calc_deltas {
sub print_header {
my ($self, $header, @args) = @_;
if ( $self->{_print_header} ) {
printf { $self->out_fh } $header . "\n", @args;
}
}
sub print_rest {
my ($self, $format, $cols, $stat) = @_;
if ( $self->filter_zeroed_rows ) {
return unless grep $_, @{$stat}{ @$cols };
if ( $self->filter_zeroed_rows() ) {
return unless grep { sprintf("%7.1f", $_) != 0 } @{$stat}{ grep { $self->col_ok($_) } @$cols };
}
printf { $self->out_fh } $format . "\n",
printf { $self->out_fh() } $format . "\n",
@{$stat}{ qw( line_ts dev ), @$cols };
}

28
lib/DiskstatsGroupByAll.pm
View File

@@ -38,7 +38,9 @@ sub group_by {
sub group_by_all {
my ($self, %args) = @_;
if ( !$args{clear_state} ) {
$self->clear_state();
}
if (!$self->interactive) {
$self->parse_from(
@@ -49,25 +51,43 @@ sub group_by_all {
},
map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
);
$self->clear_state();
}
else {
my $orig = tell $args{filehandle};
$self->parse_from(
sample_callback => sub {
$self->print_deltas(
header_cb => sub { CORE::state $x = 0; my $self = shift; $self->print_header(@_) unless $x++; },
header_cb => sub {
my $self = shift;
if ( $self->{_print_header} ) {
my $meth = $args{header_cb} || "print_header";
$self->$meth(@_);
}
$self->{_print_header} = undef;
},
rest_cb => $args{rest_cb},
);
#map { ( $_ => $args{$_} ) } qw( header_cb rest_cb ),
},
map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
);
if (!$self->previous_ts) {
seek $args{filehandle}, $orig, 0;
}
return;
}
$self->clear_state();
}
sub clear_state {
my $self = shift;
if (!$self->interactive()) {
$self->SUPER::clear_state(@_);
}
else {
my $orig_print_header = $self->{_print_header};
$self->SUPER::clear_state(@_);
$self->{_print_header} = $orig_print_header;
}
}
sub delta_against {

4
lib/DiskstatsGroupByDisk.pm
View File

@@ -65,7 +65,7 @@ sub group_by_disk {
my $elapsed =
( $self->current_ts() || 0 ) -
( $self->first_ts() || 0 );
if ( $ts > 0 && $elapsed >= $self->{interval} ) {
if ( $ts > 0 && $elapsed >= $self->sample_time() ) {
$self->print_deltas(
header_cb => sub {
my ($self, @args) = @_;
@@ -109,8 +109,10 @@ sub group_by_disk {
sub clear_state {
my ($self, @args) = @_;
my $orig_print_h = $self->{_print_header};
$self->{_iterations} = 0;
$self->SUPER::clear_state(@args);
$self->{_print_header} = $orig_print_h;
}
sub compute_line_ts {

36
lib/DiskstatsGroupBySample.pm
View File

@@ -50,16 +50,19 @@ sub group_by_sample {
my ( $self, %args ) = @_;
my ( $header_cb, $rest_cb ) = $args{qw( header_cb rest_cb )};
if (!$self->interactive) {
$self->clear_state;
}
$self->parse_from(
sample_callback =>
sub { my ( $self, $ts ) = @_; $self->_sample_callback( $ts, %args ) },
sample_callback => $self->can("_sample_callback"),
map( { ( $_ => $args{$_} ) } qw(filehandle filename data) ),
);
if (!$self->interactive) {
$self->clear_state;
}
}
sub _sample_callback {
my ( $self, $ts, %args ) = @_;
@@ -73,31 +76,23 @@ sub _sample_callback {
( $self->current_ts() || 0 ) -
( $self->previous_ts() || 0 );
if ( $ts > 0 && $elapsed >= $self->{interval} ) {
if ( $ts > 0 && $elapsed >= $self->sample_time() ) {
$self->print_deltas(
max_device_length => 6,
header_cb => sub {
my ( $self, $header, @args ) = @_;
if ( $self->{_print_header} ) {
$self->{_print_header} = 0;
if ( my $cb = $args{header_cb} ) {
$self->$cb( $header, @args );
}
else {
printf { $self->out_fh } $header . "\n", @args;
}
my $method = $args{header_cb} || "print_header";
$self->$method( $header, @args );
$self->{_print_header} = undef;
}
},
rest_cb => sub {
my ( $self, $format, $cols, $stat ) = @_;
if ( my $callback = $args{rest_cb} ) {
$self->$callback( $format, $cols, $stat );
}
else {
printf { $self->out_fh } $format . "\n",
@{$stat}{ qw( line_ts dev ), @$cols };
}
my $method = $args{rest_cb} || "print_rest";
$self->$method( $format, $cols, $stat );
$printed_a_line = 1;
}
);
@@ -129,7 +124,10 @@ sub clear_state {
sub compute_devs_in_group {
my ($self) = @_;
return scalar grep 1, @{ $self->stats_for }{ $self->sorted_devs };
return scalar grep {
# Got stats for that device, and we want to print it
$self->stats_for($_) && $self->dev_ok($_)
} $self->sorted_devs;
}
sub compute_dev {
@@ -159,7 +157,7 @@ sub _calc_stats_for_deltas {
my $in_progress = $delta_for->{ios_in_progress}; #$curr->{"ios_in_progress"};
my $tot_in_progress = 0; #$against->{"sum_ios_in_progress"} || 0;
my $devs_in_group = $self->compute_devs_in_group;
my $devs_in_group = $self->compute_devs_in_group() || 1;
my %stats = (
$self->_calc_read_stats( $delta_for, $elapsed, $devs_in_group ),

302
lib/DiskstatsMenu.pm
View File

@@ -22,8 +22,8 @@ package DiskstatsMenu;
# DiskstatsMenu
use warnings;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
@@ -31,14 +31,13 @@ use re qw( regexp_pattern );
use IO::Handle;
use IO::Select;
use Scalar::Util qw( looks_like_number );
use File::Temp qw( tempfile tempdir );
use Scalar::Util qw( looks_like_number blessed );
use ReadKeyMini qw( ReadMode );
use DiskstatsGroupByAll;
use DiskstatsGroupByDisk;
use DiskstatsGroupBySample;
require DiskstatsGroupByAll;
require DiskstatsGroupByDisk;
require DiskstatsGroupBySample;
our $VERSION = '0.01';
@@ -46,40 +45,66 @@ my %actions = (
'A' => \&group_by,
'D' => \&group_by,
'S' => \&group_by,
's' => \&get_new_interval,
'c' => get_new_x_regex("column_re", "Enter a column pattern: "),
'd' => get_new_x_regex("disk_re", "Enter a disk/device pattern: "),
'i' => \&hide_inactive_disks,
'd' => get_new_value_for( "redisplay_interval", "Enter a new redisplay interval in seconds: " ),
'z' => get_new_value_for( "interval", "Enter a new interval between samples in seconds: " ),
'c' => get_new_x_regex( "column_regex", "Enter a column pattern: " ),
'/' => get_new_x_regex( "device_regex", "Enter a disk/device pattern: " ),
'q' => sub { return 'last' },
'p' => \&pause,
'?' => \&help,
);
sub run {
my %option_to_object = (
D => "DiskstatsGroupByDisk",
A => "DiskstatsGroupByAll",
S => "DiskstatsGroupBySample",
);
my %object_to_option = reverse %option_to_object;
sub run_interactive {
my ($self, %args) = @_;
die "I need an [o] argument" unless $args{o} && blessed($args{o})
&& (
$args{o}->isa("OptionParser")
|| $args{o}->can("get")
);
my $o = $args{o};
my %opts = (
keep_file => undef,
samples_to_gather => undef,
sample_interval => 3,
interval => 0.5,
device_regex => qr/sda/,
save_samples => $o->get('save-samples') || undef,
samples_to_gather => $o->get('iterations') || undef,
sampling_interval => $o->get('interval') || 1,
display_interval => 1,
sample_time => $o->get('sample-time') || 1,
column_regex => $o->get('columns') || undef,
device_regex => $o->get('devices') || undef,
interactive => 1,
filter_zeroed_rows => 0,
);
my $dir = tempdir( CLEANUP => 1 );
my ($tmp_fh, $filename) = tempfile(
"diskstats-samples.XXXXXXXX",
DIR => $dir,
UNLINK => 1,
OPEN => 1,
);
my $pid = open my $child_fh, "|-";
my ($tmp_fh, $filename, $child_pid, $child_fh);
if (not defined $pid) {
# Here's a big crux of the program. If we have a filename, we don't
# need to fork and create a child, just read from it.
if ( $args{filename} ) {
$filename = $args{filename};
open $tmp_fh, "<", $filename or die "Couldn't open [$filename]: $OS_ERROR";
}
else {
($tmp_fh, $filename) = file_to_use( $opts{save_samples} );
# fork(), but future-proofing it in case we ever need to speak to
# the child
$child_pid = open $child_fh, "|-";
if (not defined $child_pid) {
die "Couldn't fork: $OS_ERROR";
}
if ( !$pid ) {
if ( !$child_pid ) {
# Child
# Bit of helpful magic: Changes how the program's name is displayed,
@@ -90,40 +115,42 @@ sub run {
open my $fh, ">>", $filename or die $!;
while ( getppid() ) {
sleep($opts{sample_interval});
open my $diskstats_fh, "<", "/proc/diskstats"
or die $!;
gather_samples(
gather_while => sub { getppid() },
samples_to_gather => $opts{samples_to_gather},
sampling_interval => $opts{sampling_interval},
filehandle => $fh,
);
my @to_print = <$diskstats_fh>;
push @to_print, `date +'TS %s.%N %F %T'`;
# Lovely little method from IO::Handle: turns on autoflush,
# prints, and then restores the original autoflush state.
$fh->printflush(@to_print);
close $diskstats_fh or die $!;
}
close $fh or die $!;
unlink $filename unless $opts{keep_file};
unlink $filename unless $opts{save_samples};
exit(0);
}
}
local $SIG{CHLD} = 'IGNORE';
STDOUT->autoflush;
STDIN->blocking(0);
my $sel = IO::Select->new(\*STDIN);
my $class = $option_to_object{ substr uc($o->get('group-by') || 'Disk'), 0, 1 };
$opts{obj} = $class->new( %opts );
my $lines_read = 0;
$opts{obj} = DiskstatsGroupByDisk->new(%opts);
if ( $args{filename} ) {
group_by(
select_obj => $sel,
options => \%opts,
filehandle => $tmp_fh,
got => substr(uc($o->get('group-by') || 'Disk'), 0, 1),
);
}
ReadKeyMini::cbreak();
warn $filename;
MAIN_LOOP:
while (1) {
if ( $sel->can_read( $opts{interval} ) ) {
while (my $got = <STDIN>) { # Should probably be sysread
if ( $sel->can_read( $opts{display_interval} ) ) {
while ( my $got = <STDIN> ) {
if ($actions{$got}) {
my $ret = $actions{$got}->(
select_obj => $sel,
@@ -135,36 +162,153 @@ sub run {
}
}
}
$lines_read += $opts{obj}->group_by( filehandle => $tmp_fh ) || 0;
$tmp_fh->clearerr if eof $tmp_fh;
# As a possible source of confusion, note that this calls the group_by
# _method_ in DiskstatsGroupBySomething, not the group_by _function_
# defined below.
$opts{obj}->group_by( filehandle => $tmp_fh, clear_state => 0 ) || 0;
if ( eof $tmp_fh ) {
# If we are gathering samples (don't have a filename), and we have a sample
# limit (set by --iterations), the child process just calls it quits once
# it gathers enough samples. When that happens, we are also done.
if ( !$args{filename} && $opts{samples_to_gather} && kill 0, $child_pid ) {
last MAIN_LOOP;
}
# This one comes from IO::Handle. I clears the eof flag
# from a filehandle, so we can try reading from it again.
$tmp_fh->clearerr;
}
}
ReadKeyMini::cooked();
kill 9, $pid;
close($tmp_fh);
if ( !$args{filename} ) {
close( $child_fh ) or die "Child error: $?";
kill 9, $child_pid;
}
close($tmp_fh) or die "Couldn't close: $OS_ERROR";
return;
}
{
my %objects = (
D => "DiskstatsGroupByDisk",
A => "DiskstatsGroupByAll",
S => "DiskstatsGroupBySample",
);
sub gather_samples {
my (%opts) = @_;
my $samples = 0;
GATHER_DATA:
while ( $opts{gather_while}->() ) {
sleep($opts{sampling_interval});
open my $diskstats_fh, "<", "/proc/diskstats"
or die $!;
my @to_print = <$diskstats_fh>;
push @to_print, `date +'TS %s.%N %F %T'`;
# Lovely little method from IO::Handle: turns on autoflush,
# prints, and then restores the original autoflush state.
$opts{filehandle}->printflush(@to_print);
close $diskstats_fh or die $!;
$samples++;
if ( defined($opts{samples_to_gather}) && $samples >= $opts{samples_to_gather} ) {
last GATHER_DATA;
}
}
return;
}
sub group_by {
my (%args) = @_;
my $got = $args{got};
if ( ref( $args{options}->{obj} ) ne $objects{$got} ) {
if ( ref( $args{options}->{obj} ) ne $option_to_object{$got} ) {
# Particularly important! Otherwise we would depend on the
# object's ->new being smart about discarding unrecognized
# values.
delete $args{options}->{obj};
# This would fail on a stricter constructor, so it probably
# needs fixing.
$args{options}->{obj} = $objects{$got}->new( %{$args{options}} );
$args{options}->{obj} = $option_to_object{$got}->new( %{$args{options}});
}
seek $args{filehandle}, 0, 0;
# Just aliasing this for a bit.
for my $obj ( $args{options}->{obj} ) {
if ( $option_to_object{$got} eq "DiskstatsGroupBySample" ) {
$obj->interactive(1);
}
else {
$obj->interactive(0);
}
$obj->group_by(
filehandle => $args{filehandle},
# Only print the header once, as if in interactive.
header_cb => sub {
my $print_header;
return sub {
unless ($print_header++) {
shift->print_header(@_)
}
};
}->(),
);
$obj->interactive(1);
$obj->{_print_header} = 0;
}
}
sub help {
my (%args) = @_;
my $obj = $args{options}->{obj};
my $mode = $object_to_option{ref($obj)};
my ($column_re) = regexp_pattern( $obj->column_regex() );
my ($device_re) = regexp_pattern( $obj->device_regex() );
my $interval = $obj->interval() || '(none)';
my $disp_int = $args{options}->{display_interval} || '(none)';
my $inact_disk = $obj->filter_zeroed_rows() || '';
for my $re ( $column_re, $device_re ) {
$re =~ s/^\Q(?=)\E$//;
$re ||= '(none)';
}
print <<"HELP";
You can control this program by key presses:
------------------- Key ------------------- ---- Current Setting ----
A, D, S) Set the group-by mode $mode
c) Enter a Perl regex to match column names $column_re
/) Enter a Perl regex to match disk names $device_re
z) Set the sample size in seconds $interval
i) Hide/show inactive disks $inact_disk
d) Set the redisplay interval in seconds $disp_int
p) Pause the program
q) Quit the program
------------------- Press any key to continue -----------------------
HELP
pause(@_);
}
sub file_to_use {
my ( $filename ) = @_;
#$filename ||= `mktemp -d /tmp/pt-diskstats.$PID.XXXXXXXX`;
if ( $filename ) {
open my $fh, "<", $filename
or die "Couldn't open $filename: $OS_ERROR";
return $fh, $filename;
}
else {
local $EVAL_ERROR;
if ( !eval { require File::Temp } ) {
die "Can't call mktemp nor load File::Temp. Please install either of those or pass in an explicit filename.";
}
my $dir = File::Temp::tempdir( CLEANUP => 1 );
return File::Temp::tempfile(
"pt-diskstats.$PID.XXXXXXXX",
DIR => $dir,
UNLINK => 1,
OPEN => 1,
);
}
}
sub get_input {
@@ -181,18 +325,33 @@ sub get_input {
return $new_opt;
}
sub get_new_interval {
sub hide_inactive_disks {
my (%args) = @_;
my $new_interval = get_input("Enter a redisplay interval: ");
my $new_val = get_input("Filter inactive rows? (Leave blank for 'No') ");
$args{options}->{filter_zeroed_rows} = $new_val;
$args{options}->{obj}->filter_zeroed_rows($new_val);
return;
}
sub get_new_value_for {
my ($looking_for, $message) = @_;
return sub {
my (%args) = @_;
my $new_interval = get_input($message);
$new_interval ||= 0;
if ( looks_like_number($new_interval) ) {
return $args{options}->{interval} = $new_interval;
if ( $args{options}->{obj}->can($looking_for) ) {
$args{options}->{obj}->$looking_for($new_interval);
}
return $args{options}->{$looking_for} = $new_interval;
}
else {
die("invalid timeout specification");
}
};
}
sub get_new_x_regex {
@@ -201,6 +360,7 @@ sub get_new_x_regex {
my (%args) = @_;
my $new_regex = get_input($message);
local $EVAL_ERROR;
if ( $new_regex && (my $re = eval { qr/$new_regex/i }) ) {
$args{options}->{$looking_for} = $re;
}
@@ -214,26 +374,10 @@ sub get_new_x_regex {
else {
die("invalid regex specification: $EVAL_ERROR");
}
$args{options}->{obj}->$looking_for( $args{options}->{$looking_for} );
};
}
sub help {
# XXX: TODO
print <<'HELP';
You can control this program by key presses:
------------------- Key ------------------- ---- Current Setting ----
A, D, S) Set the group-by mode \$opt{OPT_g}
c) Enter an awk regex to match column names \$opt{OPT_c}
d) Enter an awk regex to match disk names \$opt{OPT_d}
i) Set the sample size in seconds \$opt{OPT_i}
s) Set the redisplay interval in seconds \$opt{OPT_s}
p) Pause the program
q) Quit the program
------------------- Press any key to continue -----------------------
HELP
pause(@_);
}
sub pause {
my (%args) = @_;
STDIN->blocking(1);
@@ -244,8 +388,8 @@ sub pause {
}
1;
__PACKAGE__->run(@ARGV) unless caller;
#XXX TODO
#__PACKAGE__->run_interactive(@ARGV, o => bless {}, "OptionParser") unless caller;
}
# ###########################################################################

343
lib/pt_diskstats.pm Normal file
View File

@@ -0,0 +1,343 @@
{
package pt_diskstats;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
use DiskstatsMenu;
use OptionParser;
local $SIG{__DIE__} = sub {
require Carp;
Carp::confess(@_) unless $^S; # This is $EXCEPTIONS_BEING_CAUGHT
} if MKDEBUG;
sub main {
shift;
local @ARGV = @_; # set global ARGV for this package
# ########################################################################
# Get configuration information.
# ########################################################################
my $o = OptionParser->new( file => __FILE__ );
$o->get_specs();
$o->get_opts();
# Interactive mode. Delegate to Diskstats::Menu
return DiskstatsMenu->run_interactive( o => $o, filename => $ARGV[0] );
}
# Somewhat important if STDOUT is tied to a terminal.
END { close STDOUT or die "Couldn't close stdout: $OS_ERROR" }
__PACKAGE__->main(@ARGV) unless caller;
1;
}
=pod
=head1 NAME
pt-diskstats - Aggregate and summarize F</proc/diskstats>.
=head1 SYNOPSIS
Usage: pt-diskstats [OPTION...] [FILES]
pt-diskstats reads F</proc/diskstats> periodically, or files with the
contents of F</proc/diskstats>, aggregates the data, and prints it nicely.
=head1 RISKS
The following section is included to inform users about the potential risks,
whether known or unknown, of using this tool. The two main categories of risks
are those created by the nature of the tool (e.g. read-only tools vs. read-write
tools) and those created by bugs.
pt-diskstats is a read-only tool. It should be very low-risk.
At the time of this release, we know of no bugs that could cause serious harm
to users.
The authoritative source for updated information is always the online issue
tracking system. Issues that affect this tool will be marked as such. You can
see a list of such issues at the following URL:
L<http://www.percona.com/bugs/pt-diskstats>.
See also L<"BUGS"> for more information on filing bugs and getting help.
=head1 DESCRIPTION
pt-diskstats tool is similar to iostat, but has some advantages. It separates
reads and writes, for example, and computes some things that iostat does in
either incorrect or confusing ways. It is also menu-driven and interactive
with several different ways to aggregate the data, and integrates well with
the L<pt-collect> tool. These properties make it very convenient for quickly
drilling down into I/O performance at the desired level of granularity.
This program works in two main modes. One way is to process a file with saved
disk statistics, which you specify on the command line. The other way is to
start a background process gathering samples at intervals and saving them into
a file, and process this file in the foreground. In both cases, the tool is
interactively controlled by keystrokes, so you can redisplay and slice the
data flexibly and easily. If the tool is not attached to a terminal, it
doesn't run interactively; it just processes and prints its output, then exits.
Otherwise it loops until you exit with the 'q' key.
If you press the '?' key, you will bring up the interactive help menu that
shows which keys control the program.
XXX TODO:
Files should have this format:
<contents of /proc/diskstats>
TS <timestamp>
<contents of /proc/diskstats>
... et cetera
TS <timestamp> <-- must end with a TS line.
See L<http://aspersa.googlecode.com/svn/html/diskstats.html> for a detailed
example of using the tool.
=head1 OUTPUT
The columns are as follows:
=over
=item #ts
The number of seconds of samples in the line. If there is only one, then
the timestamp itself is shown, without the {curly braces}.
=item device
The device name. If there is more than one device, then instead the number
of devices aggregated into the line is shown, in {curly braces}.
=item rd_mb_s
The number of megabytes read per second, average, during the sampled interval.
=item rd_cnc
The average concurrency of the read operations, as computed by Little's Law
(a.k.a. queueing theory).
=item rd_rt
The average response time of the read operations, in milliseconds.
=item wr_mb_s
Megabytes written per second, average.
=item wr_cnc
Write concurrency, similar to read concurrency.
=item wr_rt
Write response time, similar to read response time.
=item busy
The fraction of time that the device had at least one request in progress;
this is what iostat calls %util (which is a misleading name).
=item in_prg
The number of requests that were in progress. Unlike the read and write
concurrencies, which are averages that are generated from reliable numbers,
this number is an instantaneous sample, and you can see that it might
represent a spike of requests, rather than the true long-term average.
=back
In addition to the above columns, there are a few columns that are hidden by
default. If you press the 'c' key, and then press Enter, you will blank out
the regular expression pattern that selects columns to display, and you will
then see the extra columns:
=over
=item rd_s
The number of reads per second.
=item rd_avkb
The average size of the reads, in kilobytes.
=item rd_mrg
The percentage of read requests that were merged together in the disk
scheduler before reaching the device.
=item wr_s, wr_avgkb, and wr_mrg
These are analogous to their C<rd_*> cousins.
=back
=head1 OPTIONS
This tool accepts additional command-line arguments. Refer to the
L<"SYNOPSIS"> and usage information for details.
=over
=item --config
type: Array
Read this comma-separated list of config files; if specified, this must be the
first option on the command line.
=item --columns
type: string; default: cnc|rt|mb|busy|prg
Perl regex of which columns to include.
=item --devices
type: string
Perl regex of which devices to include.
=item --group-by
type: string; default: disk
Group-by mode (default disk); specify one of the following:
disk - Each line of output shows one disk device.
sample - Each line of output shows one sample of statistics.
all - Each line of output shows one sample and one disk device.
=item --sample-time
type: int; default: 1
In --group-by sample mode, include INTERVAL seconds of samples per group.
=item --save-samples
type: string
File to save diskstats samples in; these can be used for later analysis.
=item --iterations
type: int
When in interactive mode, stop after N samples.
=item --interval
type: int; default: 1
Sample /proc/diskstats every N seconds.
=item --help
Show help and exit.
=item --version
Show version and exit.
=back
=head1 ENVIRONMENT
This tool does not use any environment variables.
=head1 SYSTEM REQUIREMENTS
This tool requires Perl v5.8.0 or newer and the F</proc> filesystem, unless
reading from files.
=head1 BUGS
For a list of known bugs, see L<http://www.percona.com/bugs/pt-diskstats>.
Please report bugs at L<https://bugs.launchpad.net/percona-toolkit>.
Include the following information in your bug report:
=over
=item * Complete command-line used to run the tool
=item * Tool L<"--version">
=item * MySQL version of all servers involved
=item * Output from the tool including STDERR
=item * Input files (log/dump/config files, etc.)
=back
If possible, include debugging output by running the tool with C<PTDEBUG>;
see L<"ENVIRONMENT">.
=head1 DOWNLOADING
Visit L<http://www.percona.com/software/percona-toolkit/> to download the
latest release of Percona Toolkit. Or, get the latest release from the
command line:
wget percona.com/get/percona-toolkit.tar.gz
wget percona.com/get/percona-toolkit.rpm
wget percona.com/get/percona-toolkit.deb
You can also get individual tools from the latest release:
wget percona.com/get/TOOL
Replace C<TOOL> with the name of any tool.
=head1 AUTHORS
Baron Schwartz
=head1 ABOUT PERCONA TOOLKIT
This tool is part of Percona Toolkit, a collection of advanced command-line
tools developed by Percona for MySQL support and consulting. Percona Toolkit
was forked from two projects in June, 2011: Maatkit and Aspersa. Those
projects were created by Baron Schwartz and developed primarily by him and
Daniel Nichter, both of whom are employed by Percona. Visit
L<http://www.percona.com/software/> for more software developed by Percona.
=head1 COPYRIGHT, LICENSE, AND WARRANTY
This program is copyright 2010-2011 Baron Schwartz, 2011 Percona Inc.
Feedback and improvements are welcome.
THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
systems, you can issue `man perlgpl' or `man perlartistic' to read these
licenses.
You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place, Suite 330, Boston, MA 02111-1307 USA.
=head1 VERSION
pt-diskstats 1.0.1
=cut

137
t/lib/Diskstats.t
View File

@@ -22,6 +22,8 @@ BEGIN {
use_ok "DiskstatsGroupBySample";
}
{
my $obj = new_ok("Diskstats");
can_ok( $obj, qw(
@@ -32,6 +34,28 @@ can_ok( $obj, qw(
parse_from print_deltas
) );
# Test the constructor
for my $attr (
[ filename => '/corp/diskstats' ],
[ column_regex => qr/!!!/ ],
[ device_regex => qr/!!!/ ],
[ block_size => 215 ],
[ out_fh => \*STDERR ],
[ filter_zeroed_rows => 1 ],
[ sample_time => 1 ],
[ interactive => 1 ],
) {
my $attribute = $attr->[0];
my $value = $attr->[1];
my $test_obj = Diskstats->new( @$attr );
is(
$test_obj->$attribute(),
$value,
"Passing an explicit [$attribute] to the constructor works",
);
}
my $line = "104 0 cciss/c0d0 2139885 162788 37361471 8034486 17999682 83425310 811400340 12711047 0 6869437 20744582";
my %expected_results = (
@@ -90,22 +114,41 @@ is($header, join(" ", q{%5s %-6s}, map { $_->[0] } @columns_in_order),
($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10);
my $all_columns_format = join(" ", q{%5s %-10s}, map { $_->[0] } @columns_in_order);
is($header, $all_columns_format, "design_print_formats: max_device_length works");
is(
$header,
$all_columns_format,
"design_print_formats: max_device_length works"
);
$obj->column_regex(qr/(?!)/); # Will never match
($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10);
is($header, q{%5s %-10s }, "design_print_formats respects column_regex");
is(
$header,
q{%5s %-10s },
"design_print_formats respects column_regex"
);
$obj->column_regex(qr//);
($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10, columns => []);
is($header, q{%5s %-10s }, "...unless we pass an explicit column array");
($header, $rest, $cols) = $obj->design_print_formats(
max_device_length => 10,
columns => []
);
is(
$header,
q{%5s %-10s },
"...unless we pass an explicit column array"
);
$obj->column_regex(qr/./);
($header, $rest, $cols) = $obj->design_print_formats(
max_device_length => 10,
columns => [qw( busy )]
);
is($header, q{%5s %-10s busy}, "");
is(
$header,
q{%5s %-10s busy},
""
);
($header, $rest, $cols) = $obj->design_print_formats(
max_device_length => 10,
@@ -136,21 +179,95 @@ close($fh);
is($obj->out_fh(), \*STDOUT, "and if we close the set filehandle, it reverts to STDOUT");
is_deeply([$obj->sorted_devs()], [], "sorted_devs starts empty");
is_deeply(
[ $obj->sorted_devs() ],
[],
"sorted_devs starts empty"
);
$obj->add_sorted_devs("sda");
is_deeply([$obj->sorted_devs()], [qw(sda)], "We can add devices just fine,");
is_deeply(
[ $obj->sorted_devs() ],
[ qw( sda ) ],
"We can add devices just fine,"
);
$obj->add_sorted_devs("sda");
is_deeply([$obj->sorted_devs()], [qw(sda)], "...And duplicates get detected and discarded");
is_deeply(
[ $obj->sorted_devs() ],
[ qw( sda ) ],
"...And duplicates get detected and discarded"
);
$obj->clear_sorted_devs();
is_deeply([$obj->sorted_devs()], [], "clear_sorted_devs does as advertized,");
is_deeply(
[ $obj->sorted_devs() ],
[],
"clear_sorted_devs does as advertized,"
);
$obj->add_sorted_devs("sda");
is_deeply([$obj->sorted_devs()], [qw(sda)], "...And clears the internal duplicate-checking list");
is_deeply(
[ $obj->sorted_devs() ],
[ qw( sda ) ],
"...And clears the internal duplicate-checking list"
);
$obj->filter_zeroed_rows(1);
my $print_output = output(
sub {
$obj->print_rest(
"SHOULDN'T PRINT THIS",
[ qw( a b c ) ],
{ a => 0, b => 0, c => 0, d => 10 }
);
}
);
$obj->filter_zeroed_rows(0);
is(
$print_output,
"",
"->filter_zeroed_rows works"
);
for my $method ( qw( delta_against delta_against_ts group_by ) ) {
throws_ok(
sub { Diskstats->$method() },
qr/\QYou must override $method() in a subclass\E/,
"->$method has to be overriden"
);
}
is(
Diskstats->compute_line_ts( first_ts => 0 ),
sprintf( "%5.1f", 0 ),
"compute_line_ts has a sane default",
);
$obj->{_print_header} = 0;
is(
output( sub { $obj->print_header } ),
"",
"INTERNAL: _print_header works"
);
$obj->current_ts(0);
$obj->previous_ts(0);
throws_ok(
sub { $obj->_calc_deltas() },
qr/Time elapsed is/,
"->_calc_deltas fails if the time elapsed is 0"
);
throws_ok(
sub { $obj->parse_from_data( "ASMFHNASJNFASKLFLKHNSKD" ); },
qr/isn't in the diskstats format/,
"->parse_from and friends fail on malformed data"
);
}
# Common tests for all three subclasses
for my $test (
{