mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-10 21:19:59 +00:00
Several fixes. --save-samples and --help should work now.
This commit is contained in:
@@ -27,7 +27,7 @@ package Diskstats;
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
|
||||
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
||||
|
||||
use IO::Handle;
|
||||
use List::Util qw( max first );
|
||||
@@ -63,8 +63,10 @@ sub new {
|
||||
};
|
||||
|
||||
if ( $o->get('memory-for-speed') ) {
|
||||
PTDEBUG && _d('Diskstats', "Called with memory-for-speed");
|
||||
eval {
|
||||
require Memoize; Memoize::memoize('_parse_diskstats_line')
|
||||
require Memoize;
|
||||
Memoize::memoize('_parse_diskstats_line');
|
||||
};
|
||||
if ($EVAL_ERROR) {
|
||||
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.
|
||||
|
||||
sub _ts_common {
|
||||
my ($self, $key, $val) = @_;
|
||||
if ($val) {
|
||||
$self->{_ts}->{$key} = $val;
|
||||
}
|
||||
return $self->{_ts}->{$key};
|
||||
}
|
||||
|
||||
sub curr_ts {
|
||||
my ($self, $val) = @_;
|
||||
return $self->_ts_common("curr", $val);
|
||||
if ($val) {
|
||||
$self->{_ts}->{curr} = $val;
|
||||
}
|
||||
return $self->{_ts}->{curr} || 0;
|
||||
}
|
||||
|
||||
sub prev_ts {
|
||||
my ($self, $val) = @_;
|
||||
return $self->_ts_common("prev", $val);
|
||||
if ($val) {
|
||||
$self->{_ts}->{prev} = $val;
|
||||
}
|
||||
return $self->{_ts}->{prev} || 0;
|
||||
}
|
||||
|
||||
sub first_ts {
|
||||
my ($self, $val) = @_;
|
||||
return $self->_ts_common("first", $val);
|
||||
if ($val) {
|
||||
$self->{_ts}->{first} = $val;
|
||||
}
|
||||
return $self->{_ts}->{first} || 0;
|
||||
}
|
||||
|
||||
sub filter_zeroed_rows {
|
||||
@@ -256,28 +259,31 @@ sub clear_first_stats {
|
||||
$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 {
|
||||
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 {
|
||||
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 {
|
||||
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 {
|
||||
@@ -344,7 +350,7 @@ sub dev_ok {
|
||||
return $device =~ $regex;
|
||||
}
|
||||
|
||||
my @columns_in_order = (
|
||||
our @columns_in_order = (
|
||||
# Column # Format # Key name
|
||||
[ " rd_s" => "%7.1f", "reads_sec", ],
|
||||
[ "rd_avkb" => "%7.1f", "avg_read_sz", ],
|
||||
@@ -500,6 +506,7 @@ sub _parse_diskstats_line {
|
||||
\s*$/x)
|
||||
{
|
||||
for my $key ( @diskstats_fields ) {
|
||||
# Unintiialized values should be 0
|
||||
$dev_stats{$key} ||= 0;
|
||||
}
|
||||
# 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();
|
||||
|
||||
# Read "For each device that passes the regex, and we have stats for"
|
||||
foreach my $dev (
|
||||
grep { $self->dev_ok($_) && $self->stats_for($_) }
|
||||
# Read "For each device that passes the dev_ok regex, and we have stats for"
|
||||
foreach my $dev_and_curr (
|
||||
map {
|
||||
my $curr = $self->dev_ok($_) && $self->stats_for($_);
|
||||
$curr ? [ $_, $curr ] : ()
|
||||
}
|
||||
@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 $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) = @_;
|
||||
if ( $self->filter_zeroed_rows() ) {
|
||||
# Conundrum: What is "zero"?
|
||||
@@ -871,7 +882,9 @@ sub print_rest {
|
||||
|
||||
sub print_deltas {
|
||||
my ( $self, %args ) = @_;
|
||||
|
||||
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},
|
||||
columns => $args{columns},
|
||||
);
|
||||
@@ -879,7 +892,7 @@ sub print_deltas {
|
||||
return unless $self->delta_against_ts();
|
||||
|
||||
@$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 ) {
|
||||
$self->$header_callback( $header, "#ts", "device" );
|
||||
@@ -889,11 +902,11 @@ sub print_deltas {
|
||||
}
|
||||
|
||||
for my $stat ( $self->_calc_deltas() ) {
|
||||
if ($rest_callback) {
|
||||
$self->$rest_callback( $format, $cols, $stat );
|
||||
if ($rows_callback) {
|
||||
$self->$rows_callback( $format, $cols, $stat );
|
||||
}
|
||||
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';
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
}
|
||||
|
@@ -40,7 +40,7 @@ sub group_by_all {
|
||||
sample_callback => sub {
|
||||
$self->print_deltas(
|
||||
map { ( $_ => $args{$_} ) }
|
||||
qw( header_callback rest_callback ),
|
||||
qw( header_callback rows_callback ),
|
||||
);
|
||||
},
|
||||
map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
|
||||
@@ -59,7 +59,7 @@ sub group_by_all {
|
||||
}
|
||||
$self->{_print_header} = undef;
|
||||
},
|
||||
rest_callback => $args{rest_callback},
|
||||
rows_callback => $args{rows_callback},
|
||||
);
|
||||
},
|
||||
map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
|
||||
|
@@ -47,7 +47,7 @@ sub group_by {
|
||||
# last sample.
|
||||
sub group_by_disk {
|
||||
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();
|
||||
|
||||
@@ -74,7 +74,7 @@ sub group_by_disk {
|
||||
}
|
||||
$self->{_print_header} = undef;
|
||||
},
|
||||
rest_callback => $args{rest_callback},
|
||||
rows_callback => $args{rows_callback},
|
||||
);
|
||||
|
||||
$self->{_iterations} = -1;
|
||||
@@ -103,7 +103,7 @@ sub group_by_disk {
|
||||
|
||||
$self->print_deltas(
|
||||
header_callback => $args{header_callback},
|
||||
rest_callback => $args{rest_callback},
|
||||
rows_callback => $args{rows_callback},
|
||||
);
|
||||
|
||||
$self->clear_state();
|
||||
|
@@ -48,7 +48,7 @@ sub group_by {
|
||||
# last sample.
|
||||
sub group_by_sample {
|
||||
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();
|
||||
|
||||
@@ -96,9 +96,9 @@ sub _sample_callback {
|
||||
$self->{_print_header} = undef;
|
||||
}
|
||||
},
|
||||
rest_callback => sub {
|
||||
rows_callback => sub {
|
||||
my ( $self, $format, $cols, $stat ) = @_;
|
||||
my $method = $args{rest_callback} || "print_rest";
|
||||
my $method = $args{rows_callback} || "print_rows";
|
||||
$self->$method( $format, $cols, $stat );
|
||||
$printed_a_line = 1;
|
||||
}
|
||||
|
@@ -25,13 +25,14 @@ package DiskstatsMenu;
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
|
||||
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
||||
|
||||
use IO::Handle;
|
||||
use IO::Select;
|
||||
use Scalar::Util qw( looks_like_number blessed );
|
||||
|
||||
use ReadKeyMini qw( ReadMode );
|
||||
use Transformers qw( ts );
|
||||
|
||||
require DiskstatsGroupByAll;
|
||||
require DiskstatsGroupByDisk;
|
||||
@@ -60,7 +61,7 @@ my %actions = (
|
||||
'?' => \&help,
|
||||
);
|
||||
|
||||
my %option_to_object = (
|
||||
my %input_to_object = (
|
||||
D => "DiskstatsGroupByDisk",
|
||||
A => "DiskstatsGroupByAll",
|
||||
S => "DiskstatsGroupBySample",
|
||||
@@ -72,7 +73,6 @@ sub new {
|
||||
|
||||
sub run_interactive {
|
||||
my ($self, %args) = @_;
|
||||
|
||||
my @required_args = qw(OptionParser);
|
||||
foreach my $arg ( @required_args ) {
|
||||
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
|
||||
# are supposed to deal with children on their own, but it doesn't hurt.
|
||||
local $SIG{CHLD} = 'IGNORE';
|
||||
@@ -135,7 +137,7 @@ sub run_interactive {
|
||||
: $group_by =~ m/sample/i ? 'DiskstatsGroupBySample'
|
||||
: $group_by =~ m/all/i ? 'DiskstatsGroupByAll'
|
||||
: die "Invalid --group-by: $group_by";
|
||||
$opts{obj} = $class->new( %opts );
|
||||
$opts{current_group_by_obj} = $class->new( %opts );
|
||||
|
||||
if ( $args{filename} ) {
|
||||
group_by(
|
||||
@@ -164,26 +166,26 @@ sub run_interactive {
|
||||
# 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 ) || 0;
|
||||
$opts{current_group_by_obj}->group_by( filehandle => $tmp_fh ) || 0;
|
||||
|
||||
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
|
||||
# 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} && $o->get('iterations')
|
||||
&& kill 0, $child_pid ) {
|
||||
&& !kill(0, $child_pid) ) {
|
||||
waitpid $child_pid, 0;
|
||||
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();
|
||||
|
||||
if ( !$args{filename} ) {
|
||||
if ( !$args{filename} && kill 0, $child_pid ) {
|
||||
$child_fh->printflush("End\n");
|
||||
waitpid $child_pid, 0;
|
||||
}
|
||||
@@ -213,12 +215,11 @@ sub gather_samples {
|
||||
if ( read_command_timeout( $sel, $opts{sampling_interval} ) ) {
|
||||
last GATHER_DATA;
|
||||
}
|
||||
|
||||
open my $fh, ">>", $filename or die $OS_ERROR;
|
||||
open my $diskstats_fh, "<", "/proc/diskstats"
|
||||
or die $OS_ERROR;
|
||||
|
||||
my @to_print = `date +'TS %s.%N %F %T'`;
|
||||
my @to_print = timestamp();
|
||||
push @to_print, <$diskstats_fh>;
|
||||
|
||||
# Lovely little method from IO::Handle: turns on autoflush,
|
||||
@@ -238,23 +239,28 @@ sub gather_samples {
|
||||
|
||||
sub group_by {
|
||||
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
|
||||
# object's ->new being smart about discarding unrecognized
|
||||
# values.
|
||||
delete $args{options}->{obj};
|
||||
delete $args{options}->{current_group_by_obj};
|
||||
# This would fail on a stricter constructor, so it probably
|
||||
# needs fixing.
|
||||
$args{options}->{obj} = $option_to_object{$input}->new(
|
||||
$args{options}->{current_group_by_obj} = $input_to_object{$input}->new(
|
||||
%{$args{options}}
|
||||
);
|
||||
}
|
||||
seek $args{filehandle}, 0, 0;
|
||||
|
||||
# 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") ) {
|
||||
$obj->interactive(1);
|
||||
}
|
||||
@@ -280,7 +286,7 @@ sub group_by {
|
||||
|
||||
sub help {
|
||||
my (%args) = @_;
|
||||
my $obj = $args{options}->{obj};
|
||||
my $obj = $args{options}->{current_group_by_obj};
|
||||
my $mode = substr ref($obj), 16, 1;
|
||||
my $column_re = $args{options}->{OptionParser}->get('columns');
|
||||
my $device_re = $args{options}->{OptionParser}->get('devices');
|
||||
@@ -313,20 +319,22 @@ sub file_to_use {
|
||||
my ( $filename ) = @_;
|
||||
|
||||
if ( !$filename ) {
|
||||
PTDEBUG && _d('No explicit filename passed in, trying to get one from mktemp');
|
||||
chomp($filename = `mktemp -t pt-diskstats.$PID.XXXXXXXX`);
|
||||
}
|
||||
|
||||
if ( $filename ) {
|
||||
open my $fh, "<", $filename
|
||||
open my $fh, "+>", $filename
|
||||
or die "Cannot open $filename: $OS_ERROR";
|
||||
return $fh, $filename;
|
||||
}
|
||||
else {
|
||||
PTDEBUG && _d("mktemp didn't return a filename, trying to use File::Temp");
|
||||
local $EVAL_ERROR;
|
||||
if ( !eval { require File::Temp } ) {
|
||||
die "Can't call mktemp nor load File::Temp.
|
||||
Install either of those, or pass in an explicit
|
||||
filename through --save-samples.";
|
||||
die "Can't call mktemp nor load File::Temp.",
|
||||
" Install either of those, or pass in an explicit",
|
||||
" filename through --save-samples.";
|
||||
}
|
||||
my $dir = File::Temp::tempdir( CLEANUP => 1 );
|
||||
return File::Temp::tempfile(
|
||||
@@ -359,7 +367,7 @@ sub hide_inactive_disks {
|
||||
# Eeep. In OptionParser, "true" means show; in Diskstats, "true" means hide.
|
||||
# Thus !$new_val for OptionParser
|
||||
$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;
|
||||
}
|
||||
@@ -371,10 +379,11 @@ sub get_new_value_for {
|
||||
my (%args) = @_;
|
||||
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) ) {
|
||||
$args{options}->{obj}->$looking_for($new_interval);
|
||||
if ( $args{options}->{current_group_by_obj}->can($looking_for) ) {
|
||||
$args{options}->{current_group_by_obj}->$looking_for($new_interval);
|
||||
}
|
||||
$args{options}->{OptionParser}->set($looking_for_o, $new_interval);
|
||||
return $new_interval;
|
||||
@@ -390,7 +399,7 @@ sub get_new_regex_for {
|
||||
|
||||
local $EVAL_ERROR;
|
||||
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);
|
||||
}
|
||||
elsif ( !$EVAL_ERROR && !$new_regex ) {
|
||||
@@ -398,7 +407,7 @@ sub get_new_regex_for {
|
||||
# somewhat magical, and basically just asking for trouble.
|
||||
# Instead we give them what awk would, a pattern that always
|
||||
# matches.
|
||||
$args{options}->{obj}->$looking_for( qr/(?=)/ );
|
||||
$args{options}->{current_group_by_obj}->$looking_for( qr/(?=)/ );
|
||||
$args{options}->{OptionParser}->set($looking_for_o, '');
|
||||
}
|
||||
else {
|
||||
@@ -417,6 +426,30 @@ sub pause {
|
||||
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;
|
||||
}
|
||||
# ###########################################################################
|
||||
|
@@ -116,9 +116,10 @@ sub readkey {
|
||||
cbreak();
|
||||
sysread(STDIN, $key, 1);
|
||||
my $timeout = 0.1;
|
||||
if ( $key eq "\033" ) { # Ugly and broken hack, but good enough for the two minutes it took to write.
|
||||
# Namely, Ctrl escapes, the F keys, and other stuff you can send from the keyboard
|
||||
# take more than one "character" to represent, and wrong be wrong to break into pieces.
|
||||
if ( $key eq "\033" ) {
|
||||
# Ugly and broken hack, but good enough for the two minutes it took to write.
|
||||
# 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 = '';
|
||||
STDIN->blocking(0);
|
||||
|
@@ -34,6 +34,8 @@ sub main {
|
||||
$o->get_specs();
|
||||
$o->get_opts();
|
||||
|
||||
$o->usage_or_errors();
|
||||
|
||||
my $diskstats = new DiskstatsMenu;
|
||||
|
||||
# Interactive mode. Delegate to DiskstatsMenu::run_interactive
|
||||
@@ -282,7 +284,8 @@ Show rows with all zero values.
|
||||
|
||||
=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
|
||||
|
||||
|
@@ -9,7 +9,7 @@ BEGIN {
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
use Test::More qw( no_plan );
|
||||
use Test::More tests => 128;
|
||||
|
||||
use PerconaTest;
|
||||
|
||||
@@ -39,8 +39,9 @@ can_ok( $obj, qw(
|
||||
) );
|
||||
|
||||
# Test the constructor
|
||||
use File::Temp ();
|
||||
for my $attr (
|
||||
[ filename => '/corp/diskstats' ],
|
||||
[ filename => (File::Temp::tempfile($0.'diskstats.XXXXXX', OPEN=>0, UNLINK=>1))[1]],
|
||||
[ column_regex => qr/!!!/ ],
|
||||
[ device_regex => qr/!!!/ ],
|
||||
[ block_size => 215 ],
|
||||
@@ -89,35 +90,31 @@ my %expected_results = (
|
||||
);
|
||||
|
||||
# Copypasted from Diskstats.pm. If the one in there changes so should this.
|
||||
my @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 @columns_in_order = @Diskstats::columns_in_order;
|
||||
|
||||
my ($dev, $res) = $obj->parse_diskstats_line($line, $obj->block_size);
|
||||
|
||||
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
|
||||
$obj->column_regex(qr/cnc|rt|busy|prg|[mk]b|[dr]_s|mrg/);
|
||||
my ($header, $rest, $cols) = $obj->design_print_formats();
|
||||
is($header, join(" ", q{%5s %-6s}, map { $_->[0] } @columns_in_order),
|
||||
"design_print_formats: sanity check for defaults");
|
||||
($header, $rows, $cols) = $obj->design_print_formats();
|
||||
is(
|
||||
$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);
|
||||
is(
|
||||
$header,
|
||||
@@ -126,7 +123,7 @@ is(
|
||||
);
|
||||
|
||||
$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(
|
||||
$header,
|
||||
q{%5s %-10s },
|
||||
@@ -134,7 +131,7 @@ is(
|
||||
);
|
||||
|
||||
$obj->column_regex(qr/./);
|
||||
($header, $rest, $cols) = $obj->design_print_formats(
|
||||
($header, $rows, $cols) = $obj->design_print_formats(
|
||||
max_device_length => 10,
|
||||
columns => []
|
||||
);
|
||||
@@ -145,7 +142,7 @@ is(
|
||||
);
|
||||
|
||||
$obj->column_regex(qr/./);
|
||||
($header, $rest, $cols) = $obj->design_print_formats(
|
||||
($header, $rows, $cols) = $obj->design_print_formats(
|
||||
max_device_length => 10,
|
||||
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,
|
||||
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 => {} ) },
|
||||
qr/The columns argument to design_print_formats should be an arrayref/,
|
||||
@@ -220,7 +223,7 @@ is_deeply(
|
||||
$obj->filter_zeroed_rows(1);
|
||||
my $print_output = output(
|
||||
sub {
|
||||
$obj->print_rest(
|
||||
$obj->print_rows(
|
||||
"SHOULDN'T PRINT THIS",
|
||||
[ qw( a b c ) ],
|
||||
{ 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");
|
||||
|
||||
$got = output(
|
||||
@@ -351,12 +360,16 @@ TS 1297205887.156653000
|
||||
TS 1297205888.161613000
|
||||
EOF
|
||||
|
||||
my $got = output(
|
||||
sub{
|
||||
$obj->$method(data => $data);
|
||||
});
|
||||
|
||||
ok(!$got, "$method: 1 line of data between two TS lines results in no output");
|
||||
{
|
||||
local $TODO = "Group by all works a bit differently. Probably worth it to make all three consistent, eventually" if ($prefix eq "all");
|
||||
local $EVAL_ERROR;
|
||||
my $got = output( sub { $obj->$method(data => $data) }, stderr => 1 );
|
||||
like(
|
||||
$got,
|
||||
qr/Time elapsed is/,
|
||||
"$method: 1 line of data between two TS lines results in an error"
|
||||
);
|
||||
}
|
||||
|
||||
$obj->curr_ts(0);
|
||||
$obj->prev_ts(0);
|
||||
|
@@ -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} 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} 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} 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} 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 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-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
|
||||
@@ -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} 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} 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
|
||||
|
@@ -9,12 +9,43 @@ BEGIN {
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
use Test::More qw( no_plan );
|
||||
use Test::More tests => 16;
|
||||
use File::Spec;
|
||||
use File::Temp ();
|
||||
|
||||
use PerconaTest;
|
||||
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".
|
||||
# See the note in the bottom of this file about *DATA. Please don't close it.
|
||||
|
Reference in New Issue
Block a user