Several changes as per Baron & Daniel's mails.

Most importantly, it replaces --zero-rows with --show-inactive, and
changes the default logic used to decide when to print a device.
This commit is contained in:
Brian Fraser
2012-01-16 09:37:53 -03:00
parent 87d12c9802
commit d01d838b64
5 changed files with 310 additions and 148 deletions

View File

@@ -1568,16 +1568,16 @@ sub new {
} }
my ($o) = @args{@required_args}; my ($o) = @args{@required_args};
my $columns = $o->get('columns'); my $columns = $o->get('columns-regex');
my $devices = $o->get('devices'); my $devices = $o->get('devices-regex');
my $self = { my $self = {
filename => '/proc/diskstats', filename => '/proc/diskstats',
block_size => 512, block_size => 512,
zero_rows => $o->get('zero-rows'), show_inactive => $o->get('show-inactive'),
sample_time => $o->get('sample-time') || 0, sample_time => $o->get('sample-time') || 0,
column_regex => qr/$columns/, column_regex => qr/$columns/,
device_regex => qr/$devices/, device_regex => $devices ? qr/$devices/ : undef,
interactive => 0, interactive => 0,
%args, %args,
@@ -1600,8 +1600,11 @@ sub new {
], ],
_stats_for => {}, _stats_for => {},
_ordered_devs => [], _ordered_devs => [],
_active_devices => {},
_ts => {}, _ts => {},
_first => 1, _first => 1,
_first_time_magic => 1,
_nochange_skips => [],
_save_curr_as_prev => 1, _save_curr_as_prev => 1,
_print_header => 1, _print_header => 1,
@@ -1641,14 +1644,14 @@ sub set_first_ts {
$self->{_ts}->{first} = $val || 0; $self->{_ts}->{first} = $val || 0;
} }
sub zero_rows { sub show_inactive {
my ($self) = @_; my ($self) = @_;
return $self->{zero_rows}; return $self->{show_inactive};
} }
sub set_zero_rows { sub set_show_inactive {
my ($self, $new_val) = @_; my ($self, $new_val) = @_;
$self->{zero_rows} = $new_val; $self->{show_inactive} = $new_val;
} }
sub sample_time { sub sample_time {
@@ -1692,9 +1695,7 @@ sub device_regex {
sub set_device_regex { sub set_device_regex {
my ( $self, $new_re ) = @_; my ( $self, $new_re ) = @_;
if ($new_re) { return $self->{device_regex} = $new_re;
return $self->{device_regex} = $new_re;
}
} }
sub filename { sub filename {
@@ -1859,11 +1860,6 @@ sub col_ok {
return ($column =~ $regex) || (trim($column) =~ $regex); return ($column =~ $regex) || (trim($column) =~ $regex);
} }
sub dev_ok {
my ( $self, $device ) = @_;
return $device =~ $self->{device_regex};
}
our @columns_in_order = ( our @columns_in_order = (
[ " 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", ],
@@ -2159,6 +2155,33 @@ sub _calc_delta_for {
return \%deltas; return \%deltas;
} }
sub _print_device_if {
my ($self, $dev ) = @_;
my $dev_re = $self->device_regex();
if ( $dev_re ) {
return $dev if $dev =~ $dev_re;
}
else {
return $dev if $self->{_first_time_magic}; # First time around
if ( $self->show_inactive() || $self->active_device($dev) ) {
return $dev;
}
else {
my $curr = $self->stats_for($dev);
my $first = $self->first_stats_for($dev);
if ( first { $curr->[$_] != $first->[$_] } READS..MS_WEIGHTED ) {
$self->set_active_device($dev, 1);
return $dev;
}
}
}
push @{$self->{_nochange_skips}}, $dev;
return;
}
sub _calc_stats_for_deltas { sub _calc_stats_for_deltas {
my ( $self, $elapsed ) = @_; my ( $self, $elapsed ) = @_;
my @end_stats; my @end_stats;
@@ -2166,11 +2189,12 @@ sub _calc_stats_for_deltas {
my $devs_in_group = $self->compute_devs_in_group(); my $devs_in_group = $self->compute_devs_in_group();
foreach my $dev ( grep { $self->dev_ok($_) } @devices ) { foreach my $dev ( grep { $self->_print_device_if($_) } @devices ) {
my $curr = $self->stats_for($dev); my $curr = $self->stats_for($dev);
next unless $curr;
my $against = $self->delta_against($dev); my $against = $self->delta_against($dev);
next unless $curr && $against;
my $delta_for = $self->_calc_delta_for( $curr, $against ); my $delta_for = $self->_calc_delta_for( $curr, $against );
my $in_progress = $curr->[IOS_IN_PROGRESS]; my $in_progress = $curr->[IOS_IN_PROGRESS];
my $tot_in_progress = $against->[SUM_IOS_IN_PROGRESS] || 0; my $tot_in_progress = $against->[SUM_IOS_IN_PROGRESS] || 0;
@@ -2203,6 +2227,12 @@ sub _calc_stats_for_deltas {
push @end_stats, \%stats; push @end_stats, \%stats;
} }
$self->{_first_time_magic} = undef;
if ( @{$self->{_nochange_skips}} ) {
my $devs = join ", ", @{$self->{_nochange_skips}};
PTDEBUG && _d("Skipping [$devs], haven't changed from the first sample");
$self->{_nochange_skips} = [];
}
return @end_stats; return @end_stats;
} }
@@ -2222,13 +2252,24 @@ sub print_header {
} }
} }
sub active_device {
my ( $self, $dev ) = @_;
return $self->{_active_devices}->{$dev};
}
sub set_active_device {
my ($self, $dev, $val) = @_;
return $self->{_active_devices}->{$dev} = $val;
}
sub clear_active_devices {
my ( $self ) = @_;
return $self->{_active_devices} = {};
}
sub print_rows { sub print_rows {
my ($self, $format, $cols, $stat) = @_; my ($self, $format, $cols, $stat) = @_;
if ( ! $self->zero_rows() ) {
return unless grep {
sprintf("%7.1f", $_) != 0
} @{ $stat }{ @$cols };
}
printf $format . "\n", @{ $stat }{ qw( line_ts dev ), @$cols }; printf $format . "\n", @{ $stat }{ qw( line_ts dev ), @$cols };
} }
@@ -2573,7 +2614,7 @@ package DiskstatsGroupBySample;
use warnings; use warnings;
use strict; use strict;
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 base qw( Diskstats ); use base qw( Diskstats );
@@ -2667,7 +2708,7 @@ sub compute_devs_in_group {
my $stats = $self->stats_for(); my $stats = $self->stats_for();
my $re = $self->device_regex(); my $re = $self->device_regex();
return scalar grep { return scalar grep {
$stats->{$_} && $_ =~ $re $stats->{$_} && $self->_print_device_if($_)
} $self->ordered_devs; } $self->ordered_devs;
} }
@@ -2684,10 +2725,12 @@ sub _calc_stats_for_deltas {
my $delta_for; my $delta_for;
foreach my $dev ( grep { $self->dev_ok($_) } $self->ordered_devs ) { foreach my $dev ( grep { $self->_print_device_if($_) } $self->ordered_devs() ) {
my $curr = $self->stats_for($dev); my $curr = $self->stats_for($dev);
my $against = $self->delta_against($dev); my $against = $self->delta_against($dev);
next unless $curr && $against;
my $delta = $self->_calc_delta_for( $curr, $against ); my $delta = $self->_calc_delta_for( $curr, $against );
$delta->{ios_in_progress} = $curr->[Diskstats::IOS_IN_PROGRESS]; $delta->{ios_in_progress} = $curr->[Diskstats::IOS_IN_PROGRESS];
while ( my ( $k, $v ) = each %$delta ) { while ( my ( $k, $v ) = each %$delta ) {
@@ -2725,6 +2768,13 @@ sub _calc_stats_for_deltas {
$stats{dev} = $self->compute_dev( $devs_in_group ); $stats{dev} = $self->compute_dev( $devs_in_group );
$self->{_first_time_magic} = undef;
if ( @{$self->{_nochange_skips}} ) {
my $devs = join ", ", @{$self->{_nochange_skips}};
PTDEBUG && _d("Skipping [$devs], haven't changed from the first sample");
$self->{_nochange_skips} = [];
}
return \%stats; return \%stats;
} }
@@ -2799,6 +2849,7 @@ my %actions = (
pause(@_); pause(@_);
return; return;
}, },
' ' => \&print_header,
'?' => \&help, '?' => \&help,
); );
@@ -2825,7 +2876,8 @@ sub run_interactive {
my ($tmp_fh, $filename, $child_pid, $child_fh); my ($tmp_fh, $filename, $child_pid, $child_fh);
if ( $filename = $args{filename} ) { if ( $filename = $args{filename} ) {
open $tmp_fh, "<", $filename or die "Cannot open $filename: $OS_ERROR"; open $tmp_fh, "<", $filename
or die "Cannot open $filename: $OS_ERROR";
} }
else { else {
($tmp_fh, $filename) = file_to_use( $o->get('save-samples') ); ($tmp_fh, $filename) = file_to_use( $o->get('save-samples') );
@@ -2938,21 +2990,22 @@ sub gather_samples {
my $sel = IO::Select->new(\*STDIN); my $sel = IO::Select->new(\*STDIN);
my $filename = $args{filename}; my $filename = $args{filename};
open my $fh, ">>", $filename
or die "Cannot open $filename for appending: $OS_ERROR";
GATHER_DATA: GATHER_DATA:
while ( $args{gather_while}->() ) { while ( $args{gather_while}->() ) {
if ( read_command_timeout( $sel, $args{sampling_interval} ) ) { if ( read_command_timeout( $sel, $args{sampling_interval} ) ) {
last GATHER_DATA; last GATHER_DATA;
} }
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 "Cannot open /proc/diskstats: $OS_ERROR";
my @to_print = timestamp(); my @to_print = timestamp();
push @to_print, <$diskstats_fh>; push @to_print, <$diskstats_fh>;
$fh->printflush(@to_print); $fh->printflush(@to_print);
close $diskstats_fh or die $OS_ERROR; close $diskstats_fh or die $OS_ERROR;
close $fh or die $OS_ERROR;
$samples++; $samples++;
if ( defined($args{samples_to_gather}) if ( defined($args{samples_to_gather})
@@ -2960,9 +3013,24 @@ sub gather_samples {
last GATHER_DATA; last GATHER_DATA;
} }
} }
close $fh or die $OS_ERROR;
return; return;
} }
sub print_header {
my (%args) = @_;
my @required_args = qw( OptionParser );
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
}
my ($o) = @args{@required_args};
my $obj = $o->get("current_group_by_obj");
my ($header) = $obj->design_print_formats();
local $obj->{_print_header} = 1;
return $obj->print_header($header, "#ts", "device");
}
sub group_by { sub group_by {
my (%args) = @_; my (%args) = @_;
@@ -3010,11 +3078,11 @@ sub help {
my (%args) = @_; my (%args) = @_;
my $obj = $args{OptionParser}->get("current_group_by_obj"); my $obj = $args{OptionParser}->get("current_group_by_obj");
my $mode = substr ref($obj), 16, 1; my $mode = substr ref($obj), 16, 1;
my $column_re = $args{OptionParser}->get('columns'); my $column_re = $args{OptionParser}->get('columns-regex');
my $device_re = $args{OptionParser}->get('devices'); my $device_re = $args{OptionParser}->get('devices-regex');
my $interval = $obj->sample_time() || '(none)'; my $interval = $obj->sample_time() || '(none)';
my $disp_int = $args{OptionParser}->get('redisplay-interval'); my $disp_int = $args{OptionParser}->get('redisplay-interval');
my $inact_disk = $obj->zero_rows() ? 'no' : 'yes'; my $inact_disk = $obj->show_inactive() ? 'no' : 'yes';
for my $re ( $column_re, $device_re ) { for my $re ( $column_re, $device_re ) {
$re ||= '(none)'; $re ||= '(none)';
@@ -3090,10 +3158,10 @@ sub hide_inactive_disks {
"Filter inactive rows? (Leave blank for 'No') " "Filter inactive rows? (Leave blank for 'No') "
); );
$args{OptionParser}->set('zero-rows', !$new_val); $args{OptionParser}->set('show-inactive', !$new_val);
$args{OptionParser}->get("current_group_by_obj") $args{OptionParser}->get("current_group_by_obj")
->set_zero_rows(!$new_val); ->set_show_inactive(!$new_val);
return; return;
} }
@@ -3120,7 +3188,7 @@ sub get_new_value_for {
sub get_new_regex_for { sub get_new_regex_for {
my ($looking_for, $message) = @_; my ($looking_for, $message) = @_;
(my $looking_for_o = $looking_for) =~ s/_.*$/s/; (my $looking_for_o = $looking_for) =~ tr/_/-/;
$looking_for = "set_$looking_for"; $looking_for = "set_$looking_for";
return sub { return sub {
my (%args) = @_; my (%args) = @_;
@@ -3135,8 +3203,15 @@ sub get_new_regex_for {
$o->set($looking_for_o, $new_regex); $o->set($looking_for_o, $new_regex);
} }
elsif ( !$EVAL_ERROR && !$new_regex ) { elsif ( !$EVAL_ERROR && !$new_regex ) {
my $re;
if ( $looking_for =~ /device/ ) {
$re = undef;
}
else {
$re = qr/.+/;
}
$o->get("current_group_by_obj") $o->get("current_group_by_obj")
->$looking_for( qr/.+/ ); ->$looking_for( $re );
$o->set($looking_for_o, ''); $o->set($looking_for_o, '');
} }
else { else {
@@ -3156,16 +3231,18 @@ sub pause {
} }
my $got_highres = eval { require Time::HiRes }; my $got_highres = eval { require Time::HiRes };
PTDEBUG && _d('Timestamp', $got_highres
? "Using the pure Perl version"
: "Using the system's date command" );
sub timestamp { sub timestamp {
if ( $got_highres ) { if ( $got_highres ) {
PTDEBUG && _d('Timestamp', "Using the pure Perl version");
my ( $seconds, $microseconds ) = Time::HiRes::gettimeofday(); my ( $seconds, $microseconds ) = Time::HiRes::gettimeofday();
return sprintf( "TS %d.%d %s\n", $seconds, return sprintf( "TS %d.%d %s\n", $seconds,
$microseconds*1000, Transformers::ts($seconds) ); $microseconds*1000, Transformers::ts($seconds) );
} }
else { else {
PTDEBUG && _d('Timestamp', "Using the system's date command"); return `date +'TS %s.%N %F %T'`;
`date +'TS %s.%N %F %T'`;
} }
} }
@@ -3199,12 +3276,10 @@ use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0;
# Dump backtrace on exception if debugging is enabled. # Dump backtrace on exception if debugging is enabled.
if ( PTDEBUG ) { local $SIG{__DIE__} = sub {
local $SIG{__DIE__} = sub { require Carp;
require Carp; Carp::confess(@_) unless $EXCEPTIONS_BEING_CAUGHT;
Carp::confess(@_) unless $EXCEPTIONS_BEING_CAUGHT; } if PTDEBUG;
};
}
sub main { sub main {
@ARGV = @_; # set global ARGV for this package @ARGV = @_; # set global ARGV for this package
@@ -3217,17 +3292,13 @@ sub main {
$o->get_opts(); $o->get_opts();
# --sample-time only applies to --group-by sample. # --sample-time only applies to --group-by sample.
if ( $o->get('group-by') !~ m/sample/i ) { if ( PTDEBUG && $o->get('group-by') !~ m/sample/i ) {
$o->set('sample-time', undef); _d("Possibly useless use of --sample-time without --group-by sample");
} }
if ( !$o->get('help') ) { if ( !$o->get('help') ) {
if ( !$o->get('columns') ) { if ( !$o->get('columns-regex') ) {
$o->save_error("A regex pattern for --devices must be specified"); $o->save_error("A regex pattern for --column-regex must be specified");
}
if ( !$o->get('devices') ) {
$o->save_error("A regex pattern for --devices must be specified");
} }
} }
@@ -3237,10 +3308,18 @@ sub main {
my $diskstats = new DiskstatsMenu(); my $diskstats = new DiskstatsMenu();
return $diskstats->run_interactive( return $diskstats->run_interactive(
OptionParser => $o, OptionParser => $o,
filename => $ARGV[0] filename => $ARGV[0]
); );
} }
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";
}
# ############################################################################ # ############################################################################
# Run the program. # Run the program.
# ############################################################################ # ############################################################################
@@ -3422,15 +3501,15 @@ type: Array
Read this comma-separated list of config files; if specified, this must be the Read this comma-separated list of config files; if specified, this must be the
first option on the command line. first option on the command line.
=item --columns =item --columns-regex
type: string; default: cnc|rt|busy|prg|time|io_s type: string; default: cnc|rt|busy|prg|time|io_s
Perl regex of which columns to include. Perl regex of which columns to include.
=item --devices =item --devices-regex
type: string; default: .+ type: string
Perl regex of which devices to include. Perl regex of which devices to include.
@@ -3474,14 +3553,9 @@ type: int; default: 1
Sample /proc/diskstats every N seconds. Sample /proc/diskstats every N seconds.
=item --zero-rows =item --show-inactive
Show rows with all zero values. Show inactive devices.
=item --memory-for-speed
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

View File

@@ -70,17 +70,17 @@ sub new {
my ($o) = @args{@required_args}; my ($o) = @args{@required_args};
# Regex patterns. # Regex patterns.
my $columns = $o->get('columns'); my $columns = $o->get('columns-regex');
my $devices = $o->get('devices'); my $devices = $o->get('devices-regex');
my $self = { my $self = {
# Defaults # Defaults
filename => '/proc/diskstats', filename => '/proc/diskstats',
block_size => 512, block_size => 512,
zero_rows => $o->get('zero-rows'), show_inactive => $o->get('show-inactive'),
sample_time => $o->get('sample-time') || 0, sample_time => $o->get('sample-time') || 0,
column_regex => qr/$columns/, column_regex => qr/$columns/,
device_regex => qr/$devices/, device_regex => $devices ? qr/$devices/ : undef,
interactive => 0, interactive => 0,
%args, %args,
@@ -103,8 +103,11 @@ sub new {
], ],
_stats_for => {}, _stats_for => {},
_ordered_devs => [], _ordered_devs => [],
_active_devices => {},
_ts => {}, _ts => {},
_first => 1, _first => 1,
_first_time_magic => 1,
_nochange_skips => [],
# Internal for now, but might need APIfying. # Internal for now, but might need APIfying.
_save_curr_as_prev => 1, _save_curr_as_prev => 1,
@@ -146,14 +149,14 @@ sub set_first_ts {
$self->{_ts}->{first} = $val || 0; $self->{_ts}->{first} = $val || 0;
} }
sub zero_rows { sub show_inactive {
my ($self) = @_; my ($self) = @_;
return $self->{zero_rows}; return $self->{show_inactive};
} }
sub set_zero_rows { sub set_show_inactive {
my ($self, $new_val) = @_; my ($self, $new_val) = @_;
$self->{zero_rows} = $new_val; $self->{show_inactive} = $new_val;
} }
sub sample_time { sub sample_time {
@@ -197,9 +200,7 @@ sub device_regex {
sub set_device_regex { sub set_device_regex {
my ( $self, $new_re ) = @_; my ( $self, $new_re ) = @_;
if ($new_re) { return $self->{device_regex} = $new_re;
return $self->{device_regex} = $new_re;
}
} }
sub filename { sub filename {
@@ -369,11 +370,6 @@ sub col_ok {
return ($column =~ $regex) || (trim($column) =~ $regex); return ($column =~ $regex) || (trim($column) =~ $regex);
} }
sub dev_ok {
my ( $self, $device ) = @_;
return $device =~ $self->{device_regex};
}
our @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", ],
@@ -728,6 +724,49 @@ sub _calc_delta_for {
return \%deltas; return \%deltas;
} }
sub _print_device_if {
# This method decides whenever a device should be printed.
# As per Baron's mail, it tries this:
# * Print all devices specified by --devices-regex, regardless
# of whether they've changed
# Otherwise,
# * Print all devices when --show-inactive is given
# Otherwise,
# * Print all devices whose line in /proc/diskstats is different
# from the first-ever observed sample
my ($self, $dev ) = @_;
my $dev_re = $self->device_regex();
if ( $dev_re ) {
# device_regex was set explicitly, either through --devices-regex,
# or by using the d option in interactive mode, and not leaving
# it blank
return $dev if $dev =~ $dev_re;
}
else {
return $dev if $self->{_first_time_magic}; # First time around
if ( $self->show_inactive() || $self->active_device($dev) ) {
# If --show-interactive is enabled, or we've seen
# the device be active at least once.
return $dev;
}
else {
my $curr = $self->stats_for($dev);
my $first = $self->first_stats_for($dev);
if ( first { $curr->[$_] != $first->[$_] } READS..MS_WEIGHTED ) {
# It's different from the first one. Mark as active and return.
$self->set_active_device($dev, 1);
return $dev;
}
}
}
# Not active, add it to the list of skips for debugging.
push @{$self->{_nochange_skips}}, $dev;
return;
}
sub _calc_stats_for_deltas { sub _calc_stats_for_deltas {
my ( $self, $elapsed ) = @_; my ( $self, $elapsed ) = @_;
my @end_stats; my @end_stats;
@@ -736,11 +775,12 @@ 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 dev_ok regex, and we have stats for" # Read "For each device that passes the dev_ok regex, and we have stats for"
foreach my $dev ( grep { $self->dev_ok($_) } @devices ) { foreach my $dev ( grep { $self->_print_device_if($_) } @devices ) {
my $curr = $self->stats_for($dev); my $curr = $self->stats_for($dev);
next unless $curr;
my $against = $self->delta_against($dev); my $against = $self->delta_against($dev);
next unless $curr && $against;
my $delta_for = $self->_calc_delta_for( $curr, $against ); my $delta_for = $self->_calc_delta_for( $curr, $against );
my $in_progress = $curr->[IOS_IN_PROGRESS]; my $in_progress = $curr->[IOS_IN_PROGRESS];
my $tot_in_progress = $against->[SUM_IOS_IN_PROGRESS] || 0; my $tot_in_progress = $against->[SUM_IOS_IN_PROGRESS] || 0;
@@ -774,6 +814,12 @@ sub _calc_stats_for_deltas {
push @end_stats, \%stats; push @end_stats, \%stats;
} }
$self->{_first_time_magic} = undef;
if ( @{$self->{_nochange_skips}} ) {
my $devs = join ", ", @{$self->{_nochange_skips}};
PTDEBUG && _d("Skipping [$devs], haven't changed from the first sample");
$self->{_nochange_skips} = [];
}
return @end_stats; return @end_stats;
} }
@@ -793,20 +839,24 @@ sub print_header {
} }
} }
sub active_device {
my ( $self, $dev ) = @_;
return $self->{_active_devices}->{$dev};
}
sub set_active_device {
my ($self, $dev, $val) = @_;
return $self->{_active_devices}->{$dev} = $val;
}
sub clear_active_devices {
my ( $self ) = @_;
return $self->{_active_devices} = {};
}
sub print_rows { sub print_rows {
my ($self, $format, $cols, $stat) = @_; my ($self, $format, $cols, $stat) = @_;
if ( ! $self->zero_rows() ) {
# Conundrum: What is "zero"?
# Is 0.000001 zero? How about 0.1?
# Here the answer is "it looks like zero after formatting";
# unfortunately, we lack the formats at this point. We could
# fetch them again, but that's a pain, so instead we use
# %7.1f, which is what most of them are anyway, and should
# work for nearly all cases.
return unless grep {
sprintf("%7.1f", $_) != 0
} @{ $stat }{ @$cols };
}
printf $format . "\n", @{ $stat }{ qw( line_ts dev ), @$cols }; printf $format . "\n", @{ $stat }{ qw( line_ts dev ), @$cols };
} }

View File

@@ -26,7 +26,7 @@ package DiskstatsGroupBySample;
use warnings; use warnings;
use strict; use strict;
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 base qw( Diskstats ); use base qw( Diskstats );
@@ -132,7 +132,7 @@ sub compute_devs_in_group {
my $re = $self->device_regex(); my $re = $self->device_regex();
return scalar grep { return scalar grep {
# Got stats for that device, and it matches the devices re # Got stats for that device, and it matches the devices re
$stats->{$_} && $_ =~ $re $stats->{$_} && $self->_print_device_if($_)
} $self->ordered_devs; } $self->ordered_devs;
} }
@@ -150,10 +150,12 @@ sub _calc_stats_for_deltas {
my $delta_for; my $delta_for;
foreach my $dev ( grep { $self->dev_ok($_) } $self->ordered_devs ) { foreach my $dev ( grep { $self->_print_device_if($_) } $self->ordered_devs() ) {
my $curr = $self->stats_for($dev); my $curr = $self->stats_for($dev);
my $against = $self->delta_against($dev); my $against = $self->delta_against($dev);
next unless $curr && $against;
my $delta = $self->_calc_delta_for( $curr, $against ); my $delta = $self->_calc_delta_for( $curr, $against );
$delta->{ios_in_progress} = $curr->[Diskstats::IOS_IN_PROGRESS]; $delta->{ios_in_progress} = $curr->[Diskstats::IOS_IN_PROGRESS];
while ( my ( $k, $v ) = each %$delta ) { while ( my ( $k, $v ) = each %$delta ) {
@@ -191,6 +193,13 @@ sub _calc_stats_for_deltas {
$stats{dev} = $self->compute_dev( $devs_in_group ); $stats{dev} = $self->compute_dev( $devs_in_group );
$self->{_first_time_magic} = undef;
if ( @{$self->{_nochange_skips}} ) {
my $devs = join ", ", @{$self->{_nochange_skips}};
PTDEBUG && _d("Skipping [$devs], haven't changed from the first sample");
$self->{_nochange_skips} = [];
}
return \%stats; return \%stats;
} }

View File

@@ -60,6 +60,7 @@ my %actions = (
pause(@_); pause(@_);
return; return;
}, },
' ' => \&print_header,
'?' => \&help, '?' => \&help,
); );
@@ -89,7 +90,8 @@ sub run_interactive {
# Here's a big crux of the program. If we have a filename, we don't # 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. # need to fork and create a child, just read from it.
if ( $filename = $args{filename} ) { if ( $filename = $args{filename} ) {
open $tmp_fh, "<", $filename or die "Cannot open $filename: $OS_ERROR"; open $tmp_fh, "<", $filename
or die "Cannot open $filename: $OS_ERROR";
} }
else { else {
($tmp_fh, $filename) = file_to_use( $o->get('save-samples') ); ($tmp_fh, $filename) = file_to_use( $o->get('save-samples') );
@@ -220,14 +222,16 @@ sub gather_samples {
my $sel = IO::Select->new(\*STDIN); my $sel = IO::Select->new(\*STDIN);
my $filename = $args{filename}; my $filename = $args{filename};
open my $fh, ">>", $filename
or die "Cannot open $filename for appending: $OS_ERROR";
GATHER_DATA: GATHER_DATA:
while ( $args{gather_while}->() ) { while ( $args{gather_while}->() ) {
if ( read_command_timeout( $sel, $args{sampling_interval} ) ) { if ( read_command_timeout( $sel, $args{sampling_interval} ) ) {
last GATHER_DATA; last GATHER_DATA;
} }
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 "Cannot open /proc/diskstats: $OS_ERROR";
my @to_print = timestamp(); my @to_print = timestamp();
push @to_print, <$diskstats_fh>; push @to_print, <$diskstats_fh>;
@@ -236,7 +240,6 @@ sub gather_samples {
# prints, and then restores the original autoflush state. # prints, and then restores the original autoflush state.
$fh->printflush(@to_print); $fh->printflush(@to_print);
close $diskstats_fh or die $OS_ERROR; close $diskstats_fh or die $OS_ERROR;
close $fh or die $OS_ERROR;
$samples++; $samples++;
if ( defined($args{samples_to_gather}) if ( defined($args{samples_to_gather})
@@ -244,9 +247,24 @@ sub gather_samples {
last GATHER_DATA; last GATHER_DATA;
} }
} }
close $fh or die $OS_ERROR;
return; return;
} }
sub print_header {
my (%args) = @_;
my @required_args = qw( OptionParser );
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
}
my ($o) = @args{@required_args};
my $obj = $o->get("current_group_by_obj");
my ($header) = $obj->design_print_formats();
local $obj->{_print_header} = 1;
return $obj->print_header($header, "#ts", "device");
}
sub group_by { sub group_by {
my (%args) = @_; my (%args) = @_;
@@ -301,11 +319,11 @@ sub help {
my (%args) = @_; my (%args) = @_;
my $obj = $args{OptionParser}->get("current_group_by_obj"); my $obj = $args{OptionParser}->get("current_group_by_obj");
my $mode = substr ref($obj), 16, 1; my $mode = substr ref($obj), 16, 1;
my $column_re = $args{OptionParser}->get('columns'); my $column_re = $args{OptionParser}->get('columns-regex');
my $device_re = $args{OptionParser}->get('devices'); my $device_re = $args{OptionParser}->get('devices-regex');
my $interval = $obj->sample_time() || '(none)'; my $interval = $obj->sample_time() || '(none)';
my $disp_int = $args{OptionParser}->get('redisplay-interval'); my $disp_int = $args{OptionParser}->get('redisplay-interval');
my $inact_disk = $obj->zero_rows() ? 'no' : 'yes'; my $inact_disk = $obj->show_inactive() ? 'no' : 'yes';
for my $re ( $column_re, $device_re ) { for my $re ( $column_re, $device_re ) {
$re ||= '(none)'; $re ||= '(none)';
@@ -381,10 +399,10 @@ sub hide_inactive_disks {
"Filter inactive rows? (Leave blank for 'No') " "Filter inactive rows? (Leave blank for 'No') "
); );
$args{OptionParser}->set('zero-rows', !$new_val); $args{OptionParser}->set('show-inactive', !$new_val);
$args{OptionParser}->get("current_group_by_obj") $args{OptionParser}->get("current_group_by_obj")
->set_zero_rows(!$new_val); ->set_show_inactive(!$new_val);
return; return;
} }
@@ -411,7 +429,7 @@ sub get_new_value_for {
sub get_new_regex_for { sub get_new_regex_for {
my ($looking_for, $message) = @_; my ($looking_for, $message) = @_;
(my $looking_for_o = $looking_for) =~ s/_.*$/s/; (my $looking_for_o = $looking_for) =~ tr/_/-/;
$looking_for = "set_$looking_for"; $looking_for = "set_$looking_for";
return sub { return sub {
my (%args) = @_; my (%args) = @_;
@@ -426,12 +444,21 @@ sub get_new_regex_for {
$o->set($looking_for_o, $new_regex); $o->set($looking_for_o, $new_regex);
} }
elsif ( !$EVAL_ERROR && !$new_regex ) { elsif ( !$EVAL_ERROR && !$new_regex ) {
# This might seem weird, but an empty pattern is my $re;
# somewhat magical, and basically just asking for trouble. if ( $looking_for =~ /device/ ) {
# Instead we give them what awk would, a pattern that always # Special case code for device regexen. If they left the field
# matches. # blank, we return to the original, magical behavior:
$re = undef;
}
else {
# This might seem weird, but an empty pattern is
# somewhat magical, and basically just asking for trouble.
# Instead we give them what awk would, a pattern that always
# matches.
$re = qr/.+/;
}
$o->get("current_group_by_obj") $o->get("current_group_by_obj")
->$looking_for( qr/.+/ ); ->$looking_for( $re );
$o->set($looking_for_o, ''); $o->set($looking_for_o, '');
} }
else { else {
@@ -451,18 +478,20 @@ sub pause {
} }
my $got_highres = eval { require Time::HiRes }; my $got_highres = eval { require Time::HiRes };
PTDEBUG && _d('Timestamp', $got_highres
? "Using the pure Perl version"
: "Using the system's date command" );
sub timestamp { sub timestamp {
if ( $got_highres ) { if ( $got_highres ) {
# Can do everything in Perl # Can do everything in Perl
# TS timestamp.nanoseconds ISO8601-timestamp # TS timestamp.nanoseconds ISO8601-timestamp
PTDEBUG && _d('Timestamp', "Using the pure Perl version");
my ( $seconds, $microseconds ) = Time::HiRes::gettimeofday(); my ( $seconds, $microseconds ) = Time::HiRes::gettimeofday();
return sprintf( "TS %d.%d %s\n", $seconds, return sprintf( "TS %d.%d %s\n", $seconds,
$microseconds*1000, Transformers::ts($seconds) ); $microseconds*1000, Transformers::ts($seconds) );
} }
else { else {
PTDEBUG && _d('Timestamp', "Using the system's date command"); return `date +'TS %s.%N %F %T'`;
`date +'TS %s.%N %F %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 tests => 108; use Test::More tests => 107;
use PerconaTest; use PerconaTest;
@@ -46,12 +46,12 @@ can_ok( $obj, qw(
for my $attr ( for my $attr (
[ filename => (File::Temp::tempfile($0.'diskstats.XXXXXX', [ filename => (File::Temp::tempfile($0.'diskstats.XXXXXX',
OPEN=>0, UNLINK=>1))[1] ], OPEN=>0, UNLINK=>1))[1] ],
[ column_regex => qr/!!!/ ], [ column_regex => qr/!!!/ ],
[ device_regex => qr/!!!/ ], [ device_regex => qr/!!!/ ],
[ block_size => 215 ], [ block_size => 215 ],
[ zero_rows => 1 ], [ show_inactive => 1 ],
[ sample_time => 1 ], [ sample_time => 1 ],
[ interactive => 1 ], [ interactive => 1 ],
) { ) {
my $attribute = $attr->[0]; my $attribute = $attr->[0];
my $value = $attr->[1]; my $value = $attr->[1];
@@ -87,9 +87,7 @@ for my $test (
6869437, # ms_spent_doing_io 6869437, # ms_spent_doing_io
20744582, # ms_weighted 20744582, # ms_weighted
19129073152, # read_bytes
18680735.5, # read_kbs 18680735.5, # read_kbs
415436974080,#written_bytes
405700170, # written_kbs 405700170, # written_kbs
20139567, # ios_requested 20139567, # ios_requested
434566047232,# ios_in_bytes 434566047232,# ios_in_bytes
@@ -101,8 +99,7 @@ for my $test (
[ [
'8', '33', 'sdc1', 1572537676, '2369344', 3687151364, '8', '33', 'sdc1', 1572537676, '2369344', 3687151364,
'1575056414', 2541895139, '1708184481', 3991989096, '1575056414', 2541895139, '1708184481', 3991989096,
'121136333', '1', '982122453', '1798311795', '121136333', '1', '982122453', '1798311795', '1843575682',
'1887821498368', '1843575682', '2043898417152',
'1995994548', 4114432815, '3931719915520' '1995994548', 4114432815, '3931719915520'
], ],
"parse_diskstats_line works" "parse_diskstats_line works"
@@ -113,7 +110,7 @@ for my $test (
'8', '33', 'sdc1', 1572537676, '2369344', 3687151364, '8', '33', 'sdc1', 1572537676, '2369344', 3687151364,
'1575056414', 2541895139, '1708184481', 3991989096, '1575056414', 2541895139, '1708184481', 3991989096,
'121136333', '1', '982122453', '1798311795', '121136333', '1', '982122453', '1798311795',
'1887821498368', '1843575682', '2043898417152', '1843575682',
'1995994548', 4114432815, '3931719915520' '1995994548', 4114432815, '3931719915520'
], ],
"parse_diskstats_line ignores a trailing newline" "parse_diskstats_line ignores a trailing newline"
@@ -285,25 +282,28 @@ is_deeply(
); );
# ############################################################################ # ############################################################################
# zero_rows -- That is, whenever it prints inactive devices. # show_inactive -- Whenever it prints inactive devices.
# ############################################################################ # ############################################################################
$obj->set_zero_rows(0); ##
my $print_output = output( ## show_inactive now functions inside parse_from
sub { ##
$obj->print_rows( #$obj->set_show_inactive(0);
"SHOULDN'T PRINT THIS", #my $print_output = output(
[ qw( a b c ) ], # sub {
{ a => 0, b => 0, c => 0, d => 10 } # $obj->print_rows(
); # "SHOULDN'T PRINT THIS",
} # [ qw( a b c ) ],
); # { a => 0, b => 0, c => 0, d => 10 }
$obj->set_zero_rows(1); # );
# }
is( #);
$print_output, #$obj->set_show_inactive(1);
"", #
"->zero_rows works" #is(
); # $print_output,
# "",
# "->show_inactive works"
#);
# ############################################################################ # ############################################################################
# Sane defaults and fatal errors # Sane defaults and fatal errors
@@ -467,11 +467,11 @@ for my $test (
class => "DiskstatsGroupBySample", class => "DiskstatsGroupBySample",
results_file_prefix => "sample", results_file_prefix => "sample",
}) { }) {
my $obj = $test->{class}->new(OptionParser => $o, zero_rows => 1); my $obj = $test->{class}->new(OptionParser => $o, show_inactive => 1);
my $prefix = $test->{results_file_prefix}; my $prefix = $test->{results_file_prefix};
$obj->set_column_regex(qr/ \A (?!.*io_s$|\s*[qs]time$) /x); $obj->set_column_regex(qr/ \A (?!.*io_s$|\s*[qs]time$) /x);
$obj->set_zero_rows(1); $obj->set_show_inactive(1);
for my $filename ( map "diskstats-00$_.txt", 1..5 ) { for my $filename ( map "diskstats-00$_.txt", 1..5 ) {
my $file = File::Spec->catfile( "t", "pt-diskstats", "samples", $filename ); my $file = File::Spec->catfile( "t", "pt-diskstats", "samples", $filename );