More changes as per Baron's review.

Tries to implement a facsimile to http://www.xaprb.com/blog/2011/03/18/how-to-gather-statistics-at-regular-intervals/
For both sampling and rendering.
This commit is contained in:
Brian Fraser
2012-01-18 05:19:48 -03:00
parent 3a66cf5187
commit 5b43ed0d5e
11 changed files with 1263 additions and 69 deletions
+37 -32
View File
@@ -2813,10 +2813,11 @@ use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
use POSIX qw( :sys_wait_h );
use POSIX qw( fmod :sys_wait_h );
use IO::Handle;
use IO::Select;
use Time::HiRes qw( gettimeofday );
use Scalar::Util qw( looks_like_number blessed );
use ReadKeyMini qw( ReadMode );
@@ -2831,8 +2832,8 @@ my %actions = (
'D' => \&group_by,
'S' => \&group_by,
'i' => \&hide_inactive_disks,
'd' => get_new_value_for( "redisplay_interval",
"Enter a new redisplay interval in seconds: " ),
'd' => get_new_value_for( "refresh_interval",
"Enter a new refresh interval in seconds: " ),
'z' => get_new_value_for( "sample_time",
"Enter a new interval between samples in seconds: " ),
'c' => get_new_regex_for( "columns_regex",
@@ -2892,7 +2893,6 @@ sub run_interactive {
gather_samples(
gather_while => sub { getppid() },
samples_to_gather => $o->get('iterations'),
sampling_interval => $o->get('interval'),
filename => $filename,
);
@@ -2939,8 +2939,11 @@ sub run_interactive {
my $run = 1;
MAIN_LOOP:
while ($run) {
my $redisplay_interval = $o->get('redisplay-interval');
if ( my $input = read_command_timeout($sel, $redisplay_interval ) ) {
my $refresh_interval = $o->get('refresh-interval');
my $time = scalar Time::HiRes::gettimeofday();
my $sleep = $refresh_interval - fmod( $time, ($refresh_interval + 0.5) );
if ( my $input = read_command_timeout($sel, $sleep ) ) {
if ($actions{$input}) {
my $ret = $actions{$input}->(
select_obj => $sel,
@@ -2949,6 +2952,20 @@ sub run_interactive {
filehandle => $tmp_fh,
) || '';
last MAIN_LOOP if $ret eq 'last';
if ( $args{filename}
&& !grep { $input eq $_ } qw( A S D ), ' ', "\n" )
{
my $obj = $o->get("current_group_by_obj");
local $obj->{_print_header} = 1;
$obj->clear_state();
group_by(
select_obj => $sel,
OptionParser => $o,
input => substr(ref($obj), 16, 1),
filehandle => $tmp_fh,
);
}
}
}
$o->get("current_group_by_obj")
@@ -2995,7 +3012,9 @@ sub gather_samples {
GATHER_DATA:
while ( $args{gather_while}->() ) {
if ( read_command_timeout( $sel, $args{sampling_interval} ) ) {
my $time = scalar Time::HiRes::gettimeofday();
my $sleep = 1 - fmod( $time, 1 );
if ( read_command_timeout( $sel, $sleep ) ) {
last GATHER_DATA;
}
open my $diskstats_fh, "<", "/proc/diskstats"
@@ -3081,7 +3100,7 @@ sub help {
my $column_re = $args{OptionParser}->get('columns-regex');
my $device_re = $args{OptionParser}->get('devices-regex');
my $interval = $obj->sample_time() || '(none)';
my $disp_int = $args{OptionParser}->get('redisplay-interval');
my $disp_int = $args{OptionParser}->get('refresh-interval');
my $inact_disk = $obj->show_inactive() ? 'no' : 'yes';
for my $re ( $column_re, $device_re ) {
@@ -3096,7 +3115,7 @@ sub help {
/) Enter a Perl regex to match disk names $device_re
z) Set the sample size in seconds $interval
i) Hide inactive disks $inact_disk
d) Set the redisplay interval in seconds $disp_int
d) Set the refresh interval in seconds $disp_int
p) Pause the program
q) Quit the program
------------------- Press any key to continue -----------------------
@@ -3115,6 +3134,7 @@ sub file_to_use {
}
if ( $filename ) {
unlink $filename;
open my $fh, "+>", $filename
or die "Cannot open $filename: $OS_ERROR";
return $fh, $filename;
@@ -3157,8 +3177,8 @@ sub hide_inactive_disks {
my $obj = $args{OptionParser}->get("current_group_by_obj");
my $new_val = !$obj->show_inactive();
$args{OptionParser}->set('show-inactive', !$new_val);
$obj->set_show_inactive(!$new_val);
$args{OptionParser}->set('show-inactive', $new_val);
$obj->set_show_inactive($new_val);
return;
}
@@ -3172,7 +3192,8 @@ sub get_new_value_for {
my $new_interval = get_blocking_input($message) || 0;
die "Invalid timeout: $new_interval"
unless looks_like_number($new_interval);
unless looks_like_number($new_interval)
&& ($new_interval = int($new_interval));
my $obj = $o->get("current_group_by_obj");
if ( my $setter = $obj->can("set_$looking_for") ) {
@@ -3227,20 +3248,10 @@ sub pause {
return;
}
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 {
if ( $got_highres ) {
my ( $seconds, $microseconds ) = Time::HiRes::gettimeofday();
return sprintf( "TS %d.%d %s\n", $seconds,
$microseconds*1000, Transformers::ts($seconds) );
}
else {
return `date +'TS %s.%N %F %T'`;
}
my ( $seconds, $microseconds ) = Time::HiRes::gettimeofday();
return sprintf( "TS %d.%d %s\n", $seconds,
$microseconds*1000, Transformers::ts($seconds) );
}
sub _d {
@@ -3532,18 +3543,12 @@ type: int
When in interactive mode, stop after N samples.
=item --redisplay-interval
=item --refresh-interval
type: int; default: 1
When in interactive mode, wait N seconds before printing to the screen.
=item --interval
type: int; default: 1
Sample /proc/diskstats every N seconds.
=item --show-inactive
Show inactive devices.