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

Several fixes. --save-samples and --help should work now.

Browse Source
This commit is contained in:
Brian Fraser
2012-01-10 10:47:50 -03:00
parent 93271379d8
commit b4289010b1
10 changed files with 226 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files

91
lib/Diskstats.pm
View File

@@ -27,7 +27,7 @@ package Diskstats;
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use IO::Handle; use IO::Handle;
use List::Util qw( max first ); use List::Util qw( max first );
@@ -63,8 +63,10 @@ sub new {
}; };
if ( $o->get('memory-for-speed') ) { if ( $o->get('memory-for-speed') ) {
PTDEBUG && _d('Diskstats', "Called with memory-for-speed");
eval { eval {
require Memoize; Memoize::memoize('_parse_diskstats_line') require Memoize;
Memoize::memoize('_parse_diskstats_line');
}; };
if ($EVAL_ERROR) { if ($EVAL_ERROR) {
warn "Can't trade memory for speed: $EVAL_ERROR. Continuing as usual."; warn "Can't trade memory for speed: $EVAL_ERROR. Continuing as usual.";
@@ -90,27 +92,28 @@ sub new {
# The next lot are accessors, plus some convenience functions. # The next lot are accessors, plus some convenience functions.
sub _ts_common {
my ($self, $key, $val) = @_;
if ($val) {
$self->{_ts}->{$key} = $val;
}
return $self->{_ts}->{$key};
}
sub curr_ts { sub curr_ts {
my ($self, $val) = @_; my ($self, $val) = @_;
return $self->_ts_common("curr", $val); if ($val) {
$self->{_ts}->{curr} = $val;
}
return $self->{_ts}->{curr} || 0;
} }
sub prev_ts { sub prev_ts {
my ($self, $val) = @_; my ($self, $val) = @_;
return $self->_ts_common("prev", $val); if ($val) {
$self->{_ts}->{prev} = $val;
}
return $self->{_ts}->{prev} || 0;
} }
sub first_ts { sub first_ts {
my ($self, $val) = @_; my ($self, $val) = @_;
return $self->_ts_common("first", $val); if ($val) {
$self->{_ts}->{first} = $val;
}
return $self->{_ts}->{first} || 0;
} }
sub filter_zeroed_rows { sub filter_zeroed_rows {
@@ -256,28 +259,31 @@ sub clear_first_stats {
$self->_clear_stats_common( "_first_stats_for", @args ); $self->_clear_stats_common( "_first_stats_for", @args );
} }
sub _stats_for_common {
my ( $self, $dev, $key ) = @_;
$self->{$key} ||= {};
if ($dev) {
return $self->{$key}->{$dev};
}
return $self->{$key};
}
sub stats_for { sub stats_for {
my ( $self, $dev ) = @_; my ( $self, $dev ) = @_;
$self->_stats_for_common( $dev, '_stats_for' ); $self->{_stats_for} ||= {};
if ($dev) {
return $self->{_stats_for}->{$dev};
}
return $self->{_stats_for};
} }
sub prev_stats_for { sub prev_stats_for {
my ( $self, $dev ) = @_; my ( $self, $dev ) = @_;
$self->_stats_for_common( $dev, '_prev_stats_for' ); $self->{_prev_stats_for} ||= {};
if ($dev) {
return $self->{_prev_stats_for}->{$dev};
}
return $self->{_prev_stats_for};
} }
sub first_stats_for { sub first_stats_for {
my ( $self, $dev ) = @_; my ( $self, $dev ) = @_;
$self->_stats_for_common( $dev, '_first_stats_for' ); $self->{_first_stats_for} ||= {};
if ($dev) {
return $self->{_first_stats_for}->{$dev};
}
return $self->{_first_stats_for};
} }
sub has_stats { sub has_stats {
@@ -344,7 +350,7 @@ sub dev_ok {
return $device =~ $regex; return $device =~ $regex;
} }
my @columns_in_order = ( our @columns_in_order = (
# Column # Format # Key name # Column # Format # Key name
[ " rd_s" => "%7.1f", "reads_sec", ], [ " rd_s" => "%7.1f", "reads_sec", ],
[ "rd_avkb" => "%7.1f", "avg_read_sz", ], [ "rd_avkb" => "%7.1f", "avg_read_sz", ],
@@ -500,6 +506,7 @@ sub _parse_diskstats_line {
\s*$/x) \s*$/x)
{ {
for my $key ( @diskstats_fields ) { for my $key ( @diskstats_fields ) {
# Unintiialized values should be 0
$dev_stats{$key} ||= 0; $dev_stats{$key} ||= 0;
} }
# Copypaste from above, should probably abstract, but it would make # Copypaste from above, should probably abstract, but it would make
@@ -791,12 +798,16 @@ sub _calc_stats_for_deltas {
my $devs_in_group = $self->compute_devs_in_group(); my $devs_in_group = $self->compute_devs_in_group();
# Read "For each device that passes the regex, and we have stats for" # Read "For each device that passes the dev_ok regex, and we have stats for"
foreach my $dev ( foreach my $dev_and_curr (
grep { $self->dev_ok($_) && $self->stats_for($_) } map {
my $curr = $self->dev_ok($_) && $self->stats_for($_);
$curr ? [ $_, $curr ] : ()
}
@devices ) @devices )
{ {
my $curr = $self->stats_for($dev); my $dev = $dev_and_curr->[0];
my $curr = $dev_and_curr->[1];
my $against = $self->delta_against($dev); my $against = $self->delta_against($dev);
my $delta_for = $self->_calc_delta_for( $curr, $against ); my $delta_for = $self->_calc_delta_for( $curr, $against );
@@ -851,7 +862,7 @@ sub print_header {
} }
} }
sub print_rest { sub print_rows {
my ($self, $format, $cols, $stat) = @_; my ($self, $format, $cols, $stat) = @_;
if ( $self->filter_zeroed_rows() ) { if ( $self->filter_zeroed_rows() ) {
# Conundrum: What is "zero"? # Conundrum: What is "zero"?
@@ -871,7 +882,9 @@ sub print_rest {
sub print_deltas { sub print_deltas {
my ( $self, %args ) = @_; my ( $self, %args ) = @_;
my ( $header, $format, $cols ) = $self->design_print_formats( my ( $header, $format, $cols ) = $self->design_print_formats(
# Not required args, because design_print_formats picks sane defaults.
max_device_length => $args{max_device_length}, max_device_length => $args{max_device_length},
columns => $args{columns}, columns => $args{columns},
); );
@@ -879,7 +892,7 @@ sub print_deltas {
return unless $self->delta_against_ts(); return unless $self->delta_against_ts();
@$cols = map { $self->_column_to_key($_) } @$cols; @$cols = map { $self->_column_to_key($_) } @$cols;
my ( $header_callback, $rest_callback ) = @args{qw( header_callback rest_callback )}; my ( $header_callback, $rows_callback ) = @args{qw( header_callback rows_callback )};
if ( $header_callback ) { if ( $header_callback ) {
$self->$header_callback( $header, "#ts", "device" ); $self->$header_callback( $header, "#ts", "device" );
@@ -889,11 +902,11 @@ sub print_deltas {
} }
for my $stat ( $self->_calc_deltas() ) { for my $stat ( $self->_calc_deltas() ) {
if ($rest_callback) { if ($rows_callback) {
$self->$rest_callback( $format, $cols, $stat ); $self->$rows_callback( $format, $cols, $stat );
} }
else { else {
$self->print_rest( $format, $cols, $stat ); $self->print_rows( $format, $cols, $stat );
} }
} }
} }
@@ -926,6 +939,14 @@ sub group_by {
die 'You must override group_by() in a subclass'; die 'You must override group_by() in a subclass';
} }
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
1; 1;
} }

4
lib/DiskstatsGroupByAll.pm
View File

@@ -40,7 +40,7 @@ sub group_by_all {
sample_callback => sub { sample_callback => sub {
$self->print_deltas( $self->print_deltas(
map { ( $_ => $args{$_} ) } map { ( $_ => $args{$_} ) }
qw( header_callback rest_callback ), qw( header_callback rows_callback ),
); );
}, },
map( { ($_ => $args{$_}) } qw(filehandle filename data) ), map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
@@ -59,7 +59,7 @@ sub group_by_all {
} }
$self->{_print_header} = undef; $self->{_print_header} = undef;
}, },
rest_callback => $args{rest_callback}, rows_callback => $args{rows_callback},
); );
}, },
map( { ($_ => $args{$_}) } qw(filehandle filename data) ), map( { ($_ => $args{$_}) } qw(filehandle filename data) ),

6
lib/DiskstatsGroupByDisk.pm
View File

@@ -47,7 +47,7 @@ sub group_by {
# last sample. # last sample.
sub group_by_disk { sub group_by_disk {
my ($self, %args) = @_; my ($self, %args) = @_;
my ($header_callback, $rest_callback) = $args{ qw( header_callback rest_callback ) }; my ($header_callback, $rows_callback) = $args{ qw( header_callback rows_callback ) };
$self->clear_state() unless $self->interactive(); $self->clear_state() unless $self->interactive();
@@ -74,7 +74,7 @@ sub group_by_disk {
} }
$self->{_print_header} = undef; $self->{_print_header} = undef;
}, },
rest_callback => $args{rest_callback}, rows_callback => $args{rows_callback},
); );
$self->{_iterations} = -1; $self->{_iterations} = -1;
@@ -103,7 +103,7 @@ sub group_by_disk {
$self->print_deltas( $self->print_deltas(
header_callback => $args{header_callback}, header_callback => $args{header_callback},
rest_callback => $args{rest_callback}, rows_callback => $args{rows_callback},
); );
$self->clear_state(); $self->clear_state();

6
lib/DiskstatsGroupBySample.pm
View File

@@ -48,7 +48,7 @@ sub group_by {
# last sample. # last sample.
sub group_by_sample { sub group_by_sample {
my ( $self, %args ) = @_; my ( $self, %args ) = @_;
my ( $header_callback, $rest_callback ) = $args{qw( header_callback rest_callback )}; my ( $header_callback, $rows_callback ) = $args{qw( header_callback rows_callback )};
$self->clear_state() unless $self->interactive(); $self->clear_state() unless $self->interactive();
@@ -96,9 +96,9 @@ sub _sample_callback {
$self->{_print_header} = undef; $self->{_print_header} = undef;
} }
}, },
rest_callback => sub { rows_callback => sub {
my ( $self, $format, $cols, $stat ) = @_; my ( $self, $format, $cols, $stat ) = @_;
my $method = $args{rest_callback} || "print_rest"; my $method = $args{rows_callback} || "print_rows";
$self->$method( $format, $cols, $stat ); $self->$method( $format, $cols, $stat );
$printed_a_line = 1; $printed_a_line = 1;
} }

93
lib/DiskstatsMenu.pm
View File

@@ -25,13 +25,14 @@ package DiskstatsMenu;
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use IO::Handle; use IO::Handle;
use IO::Select; use IO::Select;
use Scalar::Util qw( looks_like_number blessed ); use Scalar::Util qw( looks_like_number blessed );
use ReadKeyMini qw( ReadMode ); use ReadKeyMini qw( ReadMode );
use Transformers qw( ts );
require DiskstatsGroupByAll; require DiskstatsGroupByAll;
require DiskstatsGroupByDisk; require DiskstatsGroupByDisk;
@@ -60,7 +61,7 @@ my %actions = (
'?' => \&help, '?' => \&help,
); );
my %option_to_object = ( my %input_to_object = (
D => "DiskstatsGroupByDisk", D => "DiskstatsGroupByDisk",
A => "DiskstatsGroupByAll", A => "DiskstatsGroupByAll",
S => "DiskstatsGroupBySample", S => "DiskstatsGroupBySample",
@@ -72,7 +73,6 @@ sub new {
sub run_interactive { sub run_interactive {
my ($self, %args) = @_; my ($self, %args) = @_;
my @required_args = qw(OptionParser); my @required_args = qw(OptionParser);
foreach my $arg ( @required_args ) { foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg}; die "I need a $arg argument" unless $args{$arg};
@@ -121,6 +121,8 @@ sub run_interactive {
} }
} }
PTDEBUG && _d("Using filename", $filename);
# I don't think either of these are needed actually, since piped opens # I don't think either of these are needed actually, since piped opens
# are supposed to deal with children on their own, but it doesn't hurt. # are supposed to deal with children on their own, but it doesn't hurt.
local $SIG{CHLD} = 'IGNORE'; local $SIG{CHLD} = 'IGNORE';
@@ -135,7 +137,7 @@ sub run_interactive {
: $group_by =~ m/sample/i ? 'DiskstatsGroupBySample' : $group_by =~ m/sample/i ? 'DiskstatsGroupBySample'
: $group_by =~ m/all/i ? 'DiskstatsGroupByAll' : $group_by =~ m/all/i ? 'DiskstatsGroupByAll'
: die "Invalid --group-by: $group_by"; : die "Invalid --group-by: $group_by";
$opts{obj} = $class->new( %opts ); $opts{current_group_by_obj} = $class->new( %opts );
if ( $args{filename} ) { if ( $args{filename} ) {
group_by( group_by(
@@ -164,26 +166,26 @@ sub run_interactive {
# As a possible source of confusion, note that this calls the group_by # As a possible source of confusion, note that this calls the group_by
# _method_ in DiskstatsGroupBySomething, not the group_by _function_ # _method_ in DiskstatsGroupBySomething, not the group_by _function_
# defined below. # defined below.
$opts{obj}->group_by( filehandle => $tmp_fh ) || 0; $opts{current_group_by_obj}->group_by( filehandle => $tmp_fh ) || 0;
if ( eof $tmp_fh ) { if ( eof $tmp_fh ) {
# 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;
}
# If we are gathering samples (don't have a filename), and # If we are gathering samples (don't have a filename), and
# we have a sample limit (set by --iterations), the child # we have a sample limit (set by --iterations), the child
# process just calls it quits once it gathers enough samples. # process just calls it quits once it gathers enough samples.
# When that happens, we are also done. # When that happens, we are also done.
if ( !$args{filename} && $o->get('iterations') if ( !$args{filename} && $o->get('iterations')
&& kill 0, $child_pid ) { && !kill(0, $child_pid) ) {
waitpid $child_pid, 0;
last MAIN_LOOP; 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(); ReadKeyMini::cooked();
if ( !$args{filename} ) { if ( !$args{filename} && kill 0, $child_pid ) {
$child_fh->printflush("End\n"); $child_fh->printflush("End\n");
waitpid $child_pid, 0; waitpid $child_pid, 0;
} }
@@ -213,12 +215,11 @@ sub gather_samples {
if ( read_command_timeout( $sel, $opts{sampling_interval} ) ) { if ( read_command_timeout( $sel, $opts{sampling_interval} ) ) {
last GATHER_DATA; last GATHER_DATA;
} }
open my $fh, ">>", $filename or die $OS_ERROR; open my $fh, ">>", $filename or die $OS_ERROR;
open my $diskstats_fh, "<", "/proc/diskstats" open my $diskstats_fh, "<", "/proc/diskstats"
or die $OS_ERROR; or die $OS_ERROR;
my @to_print = `date +'TS %s.%N %F %T'`; my @to_print = timestamp();
push @to_print, <$diskstats_fh>; push @to_print, <$diskstats_fh>;
# Lovely little method from IO::Handle: turns on autoflush, # Lovely little method from IO::Handle: turns on autoflush,
@@ -238,23 +239,28 @@ sub gather_samples {
sub group_by { sub group_by {
my (%args) = @_; my (%args) = @_;
my $input = $args{input};
if ( ref( $args{options}->{obj} ) ne $option_to_object{$input} ) { my @required_args = qw( options input );
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
}
my ($options, $input) = @args{@required_args};
if ( ref( $args{options}->{current_group_by_obj} ) ne $input_to_object{$input} ) {
# Particularly important! Otherwise we would depend on the # Particularly important! Otherwise we would depend on the
# object's ->new being smart about discarding unrecognized # object's ->new being smart about discarding unrecognized
# values. # values.
delete $args{options}->{obj}; delete $args{options}->{current_group_by_obj};
# This would fail on a stricter constructor, so it probably # This would fail on a stricter constructor, so it probably
# needs fixing. # needs fixing.
$args{options}->{obj} = $option_to_object{$input}->new( $args{options}->{current_group_by_obj} = $input_to_object{$input}->new(
%{$args{options}} %{$args{options}}
); );
} }
seek $args{filehandle}, 0, 0; seek $args{filehandle}, 0, 0;
# Just aliasing this for a bit. # Just aliasing this for a bit.
for my $obj ( $args{options}->{obj} ) { for my $obj ( $args{options}->{current_group_by_obj} ) {
if ( $obj->isa("DiskstatsGroupBySample") ) { if ( $obj->isa("DiskstatsGroupBySample") ) {
$obj->interactive(1); $obj->interactive(1);
} }
@@ -280,7 +286,7 @@ sub group_by {
sub help { sub help {
my (%args) = @_; my (%args) = @_;
my $obj = $args{options}->{obj}; my $obj = $args{options}->{current_group_by_obj};
my $mode = substr ref($obj), 16, 1; my $mode = substr ref($obj), 16, 1;
my $column_re = $args{options}->{OptionParser}->get('columns'); my $column_re = $args{options}->{OptionParser}->get('columns');
my $device_re = $args{options}->{OptionParser}->get('devices'); my $device_re = $args{options}->{OptionParser}->get('devices');
@@ -313,20 +319,22 @@ sub file_to_use {
my ( $filename ) = @_; my ( $filename ) = @_;
if ( !$filename ) { if ( !$filename ) {
PTDEBUG && _d('No explicit filename passed in, trying to get one from mktemp');
chomp($filename = `mktemp -t pt-diskstats.$PID.XXXXXXXX`); chomp($filename = `mktemp -t pt-diskstats.$PID.XXXXXXXX`);
} }
if ( $filename ) { if ( $filename ) {
open my $fh, "<", $filename open my $fh, "+>", $filename
or die "Cannot open $filename: $OS_ERROR"; or die "Cannot open $filename: $OS_ERROR";
return $fh, $filename; return $fh, $filename;
} }
else { else {
PTDEBUG && _d("mktemp didn't return a filename, trying to use File::Temp");
local $EVAL_ERROR; local $EVAL_ERROR;
if ( !eval { require File::Temp } ) { if ( !eval { require File::Temp } ) {
die "Can't call mktemp nor load File::Temp. die "Can't call mktemp nor load File::Temp.",
Install either of those, or pass in an explicit " Install either of those, or pass in an explicit",
filename through --save-samples."; " filename through --save-samples.";
} }
my $dir = File::Temp::tempdir( CLEANUP => 1 ); my $dir = File::Temp::tempdir( CLEANUP => 1 );
return File::Temp::tempfile( return File::Temp::tempfile(
@@ -359,7 +367,7 @@ sub hide_inactive_disks {
# Eeep. In OptionParser, "true" means show; in Diskstats, "true" means hide. # Eeep. In OptionParser, "true" means show; in Diskstats, "true" means hide.
# Thus !$new_val for OptionParser # Thus !$new_val for OptionParser
$args{options}->{OptionParser}->set('zero-rows', !$new_val); $args{options}->{OptionParser}->set('zero-rows', !$new_val);
$args{options}->{obj}->filter_zeroed_rows($new_val); $args{options}->{current_group_by_obj}->filter_zeroed_rows($new_val);
return; return;
} }
@@ -371,10 +379,11 @@ sub get_new_value_for {
my (%args) = @_; my (%args) = @_;
my $new_interval = get_blocking_input($message) || 0; my $new_interval = get_blocking_input($message) || 0;
die "invalid timeout specification" unless looks_like_number($new_interval); die "Invalid timeout: $new_interval"
unless looks_like_number($new_interval);
if ( $args{options}->{obj}->can($looking_for) ) { if ( $args{options}->{current_group_by_obj}->can($looking_for) ) {
$args{options}->{obj}->$looking_for($new_interval); $args{options}->{current_group_by_obj}->$looking_for($new_interval);
} }
$args{options}->{OptionParser}->set($looking_for_o, $new_interval); $args{options}->{OptionParser}->set($looking_for_o, $new_interval);
return $new_interval; return $new_interval;
@@ -390,7 +399,7 @@ sub get_new_regex_for {
local $EVAL_ERROR; local $EVAL_ERROR;
if ( $new_regex && (my $re = eval { qr/$new_regex/i }) ) { if ( $new_regex && (my $re = eval { qr/$new_regex/i }) ) {
$args{options}->{obj}->$looking_for( $re ); $args{options}->{current_group_by_obj}->$looking_for( $re );
$args{options}->{OptionParser}->set($looking_for_o, $new_regex); $args{options}->{OptionParser}->set($looking_for_o, $new_regex);
} }
elsif ( !$EVAL_ERROR && !$new_regex ) { elsif ( !$EVAL_ERROR && !$new_regex ) {
@@ -398,7 +407,7 @@ sub get_new_regex_for {
# somewhat magical, and basically just asking for trouble. # somewhat magical, and basically just asking for trouble.
# Instead we give them what awk would, a pattern that always # Instead we give them what awk would, a pattern that always
# matches. # matches.
$args{options}->{obj}->$looking_for( qr/(?=)/ ); $args{options}->{current_group_by_obj}->$looking_for( qr/(?=)/ );
$args{options}->{OptionParser}->set($looking_for_o, ''); $args{options}->{OptionParser}->set($looking_for_o, '');
} }
else { else {
@@ -417,6 +426,30 @@ sub pause {
return; return;
} }
my $got_highres = eval { require Time::HiRes };
sub timestamp {
if ( $got_highres ) {
# Can do everything in Perl
# TS timestamp.nanoseconds ISO8601-timestamp
PTDEBUG && _d('Timestamp', "Using the pure Perl version");
my ( $seconds, $microseconds ) = Time::HiRes::gettimeofday();
return sprintf( "TS %d.%d %s\n", $seconds,
$microseconds*1000, Transformers::ts($seconds) );
}
else {
PTDEBUG && _d('Timestamp', "Using the system's date command");
`date +'TS %s.%N %F %T'`;
}
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
1; 1;
} }
# ########################################################################### # ###########################################################################

7
lib/ReadKeyMini.pm
View File

@@ -116,9 +116,10 @@ sub readkey {
cbreak(); cbreak();
sysread(STDIN, $key, 1); sysread(STDIN, $key, 1);
my $timeout = 0.1; my $timeout = 0.1;
if ( $key eq "\033" ) { # Ugly and broken hack, but good enough for the two minutes it took to write. if ( $key eq "\033" ) {
# Namely, Ctrl escapes, the F keys, and other stuff you can send from the keyboard # Ugly and broken hack, but good enough for the two minutes it took to write.
# take more than one "character" to represent, and wrong be wrong to break into pieces. # Namely, Ctrl escapes, the F-NUM keys, and other stuff you can send from the keyboard
# take more than one "character" to represent, and would be wrong to break into pieces.
{ {
my $x = ''; my $x = '';
STDIN->blocking(0); STDIN->blocking(0);

5
lib/pt_diskstats.pm
View File

@@ -34,6 +34,8 @@ sub main {
$o->get_specs(); $o->get_specs();
$o->get_opts(); $o->get_opts();
$o->usage_or_errors();
my $diskstats = new DiskstatsMenu; my $diskstats = new DiskstatsMenu;
# Interactive mode. Delegate to DiskstatsMenu::run_interactive # Interactive mode. Delegate to DiskstatsMenu::run_interactive
@@ -282,7 +284,8 @@ Show rows with all zero values.
=item --memory-for-speed =item --memory-for-speed
XXX TODO INTERNAL yadda EXPERIMENTAL! Trades memory for speed, by storing more things in memory.
What it stores, and how, may all be subject to change.
=item --help =item --help

85
t/lib/Diskstats.t
View File

@@ -9,7 +9,7 @@ BEGIN {
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use Test::More qw( no_plan ); use Test::More tests => 128;
use PerconaTest; use PerconaTest;
@@ -39,8 +39,9 @@ can_ok( $obj, qw(
) ); ) );
# Test the constructor # Test the constructor
use File::Temp ();
for my $attr ( for my $attr (
[ filename => '/corp/diskstats' ], [ filename => (File::Temp::tempfile($0.'diskstats.XXXXXX', OPEN=>0, UNLINK=>1))[1]],
[ column_regex => qr/!!!/ ], [ column_regex => qr/!!!/ ],
[ device_regex => qr/!!!/ ], [ device_regex => qr/!!!/ ],
[ block_size => 215 ], [ block_size => 215 ],
@@ -89,35 +90,31 @@ my %expected_results = (
); );
# Copypasted from Diskstats.pm. If the one in there changes so should this. # Copypasted from Diskstats.pm. If the one in there changes so should this.
my @columns_in_order = ( my @columns_in_order = @Diskstats::columns_in_order;
# Colum # Format # Key name
[ " rd_s" => "%7.1f", "reads_sec", ],
[ "rd_avkb" => "%7.1f", "avg_read_sz", ],
[ "rd_mb_s" => "%7.1f", "mbytes_read_sec", ],
[ "rd_mrg" => "%5.0f%%", "read_merge_pct", ],
[ "rd_cnc" => "%6.1f", "read_conc", ],
[ " rd_rt" => "%7.1f", "read_rtime", ],
[ " wr_s" => "%7.1f", "writes_sec", ],
[ "wr_avkb" => "%7.1f", "avg_write_sz", ],
[ "wr_mb_s" => "%7.1f", "mbytes_written_sec", ],
[ "wr_mrg" => "%5.0f%%", "write_merge_pct", ],
[ "wr_cnc" => "%6.1f", "write_conc", ],
[ " wr_rt" => "%7.1f", "write_rtime", ],
[ "busy" => "%3.0f%%", "busy", ],
[ "in_prg" => "%6d", "in_progress", ],
);
my ($dev, $res) = $obj->parse_diskstats_line($line, $obj->block_size); my ($dev, $res) = $obj->parse_diskstats_line($line, $obj->block_size);
is_deeply( $res, \%expected_results, "parse_diskstats_line works" ); is_deeply( $res, \%expected_results, "parse_diskstats_line works" );
$obj->column_regex(qr/./);
my ($header, $rows, $cols) = $obj->design_print_formats();
is_deeply(
$cols,
[ map { $_->[0] } @columns_in_order ],
"design_print_formats: returns the expected columns"
);
# qr/ \A (?!.*io_s$|\s*[qs]time$) /x # qr/ \A (?!.*io_s$|\s*[qs]time$) /x
$obj->column_regex(qr/cnc|rt|busy|prg|[mk]b|[dr]_s|mrg/); $obj->column_regex(qr/cnc|rt|busy|prg|[mk]b|[dr]_s|mrg/);
my ($header, $rest, $cols) = $obj->design_print_formats(); ($header, $rows, $cols) = $obj->design_print_formats();
is($header, join(" ", q{%5s %-6s}, map { $_->[0] } @columns_in_order), is(
"design_print_formats: sanity check for defaults"); $header,
join(" ", q{%5s %-6s}, grep { $_ =~ $obj->column_regex() } map { $_->[0] } @columns_in_order),
"design_print_formats: sanity check for defaults"
);
($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10); $obj->column_regex(qr/./);
($header, $rows, $cols) = $obj->design_print_formats(max_device_length => 10);
my $all_columns_format = join(" ", q{%5s %-10s}, map { $_->[0] } @columns_in_order); my $all_columns_format = join(" ", q{%5s %-10s}, map { $_->[0] } @columns_in_order);
is( is(
$header, $header,
@@ -126,7 +123,7 @@ is(
); );
$obj->column_regex(qr/(?!)/); # Will never match $obj->column_regex(qr/(?!)/); # Will never match
($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10); ($header, $rows, $cols) = $obj->design_print_formats(max_device_length => 10);
is( is(
$header, $header,
q{%5s %-10s }, q{%5s %-10s },
@@ -134,7 +131,7 @@ is(
); );
$obj->column_regex(qr/./); $obj->column_regex(qr/./);
($header, $rest, $cols) = $obj->design_print_formats( ($header, $rows, $cols) = $obj->design_print_formats(
max_device_length => 10, max_device_length => 10,
columns => [] columns => []
); );
@@ -145,7 +142,7 @@ is(
); );
$obj->column_regex(qr/./); $obj->column_regex(qr/./);
($header, $rest, $cols) = $obj->design_print_formats( ($header, $rows, $cols) = $obj->design_print_formats(
max_device_length => 10, max_device_length => 10,
columns => [qw( busy )] columns => [qw( busy )]
); );
@@ -155,11 +152,17 @@ is(
"" ""
); );
($header, $rest, $cols) = $obj->design_print_formats( ($header, $rows, $cols) = $obj->design_print_formats(
max_device_length => 10, max_device_length => 10,
columns => [map { $_->[0] } @columns_in_order], columns => [
map { $_->[0] } @columns_in_order
],
); );
is($header, $all_columns_format, ""); is(
$header,
$all_columns_format,
""
);
throws_ok( sub { $obj->design_print_formats( columns => {} ) }, throws_ok( sub { $obj->design_print_formats( columns => {} ) },
qr/The columns argument to design_print_formats should be an arrayref/, qr/The columns argument to design_print_formats should be an arrayref/,
@@ -220,7 +223,7 @@ is_deeply(
$obj->filter_zeroed_rows(1); $obj->filter_zeroed_rows(1);
my $print_output = output( my $print_output = output(
sub { sub {
$obj->print_rest( $obj->print_rows(
"SHOULDN'T PRINT THIS", "SHOULDN'T PRINT THIS",
[ qw( a b c ) ], [ qw( a b c ) ],
{ a => 0, b => 0, c => 0, d => 10 } { a => 0, b => 0, c => 0, d => 10 }
@@ -306,6 +309,12 @@ for my $test (
); );
}); });
if ( $filename =~ /003/ && $prefix eq "disk" ) {
open my $yadda, ">", "TEMP.txt";
print { $yadda } $got;
close($yadda);
}
is($got, $expected, "$method: $filename via filename"); is($got, $expected, "$method: $filename via filename");
$got = output( $got = output(
@@ -351,12 +360,16 @@ TS 1297205887.156653000
TS 1297205888.161613000 TS 1297205888.161613000
EOF EOF
my $got = output( {
sub{ local $TODO = "Group by all works a bit differently. Probably worth it to make all three consistent, eventually" if ($prefix eq "all");
$obj->$method(data => $data); local $EVAL_ERROR;
}); my $got = output( sub { $obj->$method(data => $data) }, stderr => 1 );
like(
ok(!$got, "$method: 1 line of data between two TS lines results in no output"); $got,
qr/Time elapsed is/,
"$method: 1 line of data between two TS lines results in an error"
);
}
$obj->curr_ts(0); $obj->curr_ts(0);
$obj->prev_ts(0); $obj->prev_ts(0);

6
t/pt-diskstats/expected/disk_diskstats-003.txt
View File

@@ -24,8 +24,8 @@
{279} sda6 0.0 0.0 0.0 47% 0.0 4.0 3.7 0.0 0.0 64% 0.0 0.2 0% 0 {279} sda6 0.0 0.0 0.0 47% 0.0 4.0 3.7 0.0 0.0 64% 0.0 0.2 0% 0
{279} sdb 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0 {279} sdb 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0
{279} sdb1 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0 {279} sdb1 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0
{279} sdc 749.2 16.0 11.7 1% 1.0 1.3 261.4 15.8 4.0 0% 0.2 0.6 98% 0 {279} sdc 746.8 16.0 11.7 1% 0.9 1.3 261.4 15.8 4.0 0% 0.2 0.6 97% 0
{279} sdc1 749.2 16.0 11.7 1% 1.0 1.3 261.4 15.8 4.0 0% 0.2 0.6 98% 0 {279} sdc1 746.8 16.0 11.7 1% 0.9 1.3 261.4 15.8 4.0 0% 0.2 0.6 97% 0
{279} dm-0 0.0 0.0 0.0 0% 0.0 0.0 2.4 4.0 0.0 0% 0.0 0.0 0% 0 {279} dm-0 0.0 0.0 0.0 0% 0.0 0.0 2.4 4.0 0.0 0% 0.0 0.0 0% 0
{279} dm-1 0.0 4.0 0.0 0% 0.0 4.0 2.1 4.0 0.0 0% 0.0 0.4 0% 0 {279} dm-1 0.0 4.0 0.0 0% 0.0 4.0 2.1 4.0 0.0 0% 0.0 0.4 0% 0
{279} dm-2 0.0 0.0 0.0 0% 0.0 0.0 0.1 4.0 0.0 0% 0.0 0.1 0% 0 {279} dm-2 0.0 0.0 0.0 0% 0.0 0.0 0.1 4.0 0.0 0% 0.0 0.1 0% 0
@@ -39,4 +39,4 @@
{279} md0 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0 {279} md0 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0
{279} emcpowera 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0 {279} emcpowera 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0
{279} emcpowera1 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0 {279} emcpowera1 0.0 0.0 0.0 0% 0.0 0.0 0.0 0.0 0.0 0% 0.0 0.0 0% 0
{279} dm-7 755.0 15.9 11.7 0% 1.0 1.3 261.7 15.8 4.0 0% 0.2 0.6 98% 0 {279} dm-7 752.7 15.9 11.7 0% 1.0 1.3 261.7 15.8 4.0 0% 0.2 0.6 97% 0

33
t/pt-diskstats/pt-diskstats.t
View File

@@ -9,12 +9,43 @@ BEGIN {
use strict; use strict;
use warnings FATAL => 'all'; use warnings FATAL => 'all';
use English qw(-no_match_vars); use English qw(-no_match_vars);
use Test::More qw( no_plan ); use Test::More tests => 16;
use File::Spec; use File::Spec;
use File::Temp ();
use PerconaTest; use PerconaTest;
use pt_diskstats; use pt_diskstats;
my ($fh, $tempfile) = File::Temp::tempfile(
"diskstats.test.XXXXXXXXX",
OPEN => 1, UNLINK => 1 );
my $iterations = 2;
my $out = output( sub {
pt_diskstats::main(
"--group-by" => "all",
"--columns" => "cnc|rt|mb|busy|prg",
"--save-samples" => $tempfile,
"--iterations" => $iterations,
"--zero-rows",
);
});
sub FakeParser::get {}
my $count = 0;
Diskstats->new(
OptionParser => bless {}, "FakeParser"
)->parse_from_filename( $tempfile, sub { $count++ } );
is(
$count-1,
$iterations,
"--save-samples and --iterations work"
);
close $fh;
{ {
# Tie magic. During the tests we tie STDIN to always return a lone "q". # Tie magic. During the tests we tie STDIN to always return a lone "q".
# See the note in the bottom of this file about *DATA. Please don't close it. # See the note in the bottom of this file about *DATA. Please don't close it.