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

Several corrections as per Daniel and Baron's feedback.

Browse Source 
Still TODO: Attributes still have a single method that doubles
as a getter and setter. The constructor for Diskstats is still
weird -- A tad more stricter than it should be, if anything.
->print_rest is still rest, even though that's hardly
memorable, mostly because of a lack of ideas on what to
rename it. The main loop in the Menu is still a while (1).

As a nice perk, it's nearly twice as fast now! It also adds a
_very_ experimental --memory-for-speed argument, which
turns on memoization for the current biggest bottleneck.
This commit is contained in:
Brian Fraser
2011-12-22 19:24:56 -03:00
parent 467254aca3
commit d3ef9edaaa
10 changed files with 619 additions and 1341 deletions
Download Patch File Download Diff File Expand all files Collapse all files

219
lib/DiskstatsMenu.pm
View File

@@ -37,19 +37,26 @@ require DiskstatsGroupByAll;
require DiskstatsGroupByDisk;
require DiskstatsGroupBySample;
our $VERSION = '0.01';
my %actions = (
'A' => \&group_by,
'D' => \&group_by,
'S' => \&group_by,
'i' => \&hide_inactive_disks,
'd' => get_new_value_for( "redisplay_interval", "Enter a new redisplay interval in seconds: " ),
'z' => get_new_value_for( "sample_time", "Enter a new interval between samples in seconds: " ),
'c' => get_new_regex_for( "column_regex", "Enter a column pattern: " ),
'/' => get_new_regex_for( "device_regex", "Enter a disk/device pattern: " ),
'd' => get_new_value_for( "redisplay_interval",
"Enter a new redisplay interval in seconds: " ),
'z' => get_new_value_for( "sample_time",
"Enter a new interval between samples in seconds: " ),
'c' => get_new_regex_for( "column_regex",
"Enter a column pattern: " ),
'/' => get_new_regex_for( "device_regex",
"Enter a disk/device pattern: " ),
# Magical return value.
'q' => sub { return 'last' },
'p' => \&pause,
'p' => sub {
print "Paused - press any key to continue\n";
pause(@_);
return;
},
'?' => \&help,
);
@@ -59,52 +66,39 @@ my %option_to_object = (
S => "DiskstatsGroupBySample",
);
my %object_to_option = reverse %option_to_object;
sub new {
bless {}, shift;
}
sub run_interactive {
my ($self, %args) = @_;
die "I need an [o] argument" unless $args{o} && blessed($args{o})
&& (
$args{o}->isa("OptionParser")
|| $args{o}->can("get")
);
my $o = $args{o};
my @required_args = qw(OptionParser);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
}
my ($o) = @args{@required_args};
my %opts = (
save_samples => $o->get('save-samples') || undef,
samples_to_gather => $o->get('iterations') || undef,
sampling_interval => $o->get('interval') || 1,
redisplay_interval => 1,
sample_time => $o->get('sample-time') || 1,
column_regex => $o->get('columns') || undef,
device_regex => $o->get('devices') || undef,
interactive => 1,
filter_zeroed_rows => !$o->get('zero-rows'),
OptionParser => $o,
);
for my $re_key ( grep { $opts{$_} } qw( column_regex device_regex ) ) {
$opts{$re_key} = qr/$opts{$re_key}/i;
}
my ($tmp_fh, $filename, $child_pid, $child_fh);
# Here's a big crux of the program. If we have a filename, we don't
# need to fork and create a child, just read from it.
if ( $args{filename} ) {
$filename = $args{filename};
open $tmp_fh, "<", $filename or die "Couldn't open [$filename]: $OS_ERROR";
if ( $filename = $args{filename} ) {
open $tmp_fh, "<", $filename or die "Cannot open $filename: $OS_ERROR";
}
else {
($tmp_fh, $filename) = file_to_use( $opts{save_samples} );
($tmp_fh, $filename) = file_to_use( $o->get('save-samples') );
# fork(), but future-proofing it in case we ever need to speak to
# the child
$child_pid = open $child_fh, "|-";
if (not defined $child_pid) {
die "Couldn't fork: $OS_ERROR";
}
die "Cannot fork: $OS_ERROR" unless defined $child_pid;
if ( !$child_pid ) {
# Child
@@ -113,52 +107,55 @@ sub run_interactive {
# so it's easier to track in things like ps.
local $PROGRAM_NAME = "$PROGRAM_NAME (data-gathering daemon)";
close($tmp_fh);
open my $fh, ">>", $filename or die $!;
close $tmp_fh;
gather_samples(
gather_while => sub { getppid() },
samples_to_gather => $opts{samples_to_gather},
sampling_interval => $opts{sampling_interval},
filehandle => $fh,
samples_to_gather => $o->get('iterations'),
sampling_interval => $o->get('interval'),
filename => $filename,
);
close $fh or die $!;
unlink $filename unless $opts{save_samples};
unlink $filename unless $o->get('save-samples');
exit(0);
}
}
# 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';
local $SIG{PIPE} = 'IGNORE';
STDOUT->autoflush;
STDIN->blocking(0);
my $sel = IO::Select->new(\*STDIN);
my $class = $option_to_object{ substr ucfirst($o->get('group-by') || 'Disk'), 0, 1 };
$opts{obj} = $class->new( %opts );
my $sel = IO::Select->new(\*STDIN);
my $group_by = $o->get('group-by') || 'disk';
my $class = $group_by =~ m/disk/i ? 'DiskstatsGroupByDisk'
: $group_by =~ m/sample/i ? 'DiskstatsGroupBySample'
: $group_by =~ m/all/i ? 'DiskstatsGroupByAll'
: die "Invalid --group-by: $group_by";
$opts{obj} = $class->new( %opts );
if ( $args{filename} ) {
group_by(
header_cb => sub { shift->print_header(@_) },
header_callback => sub { shift->print_header(@_) },
select_obj => $sel,
options => \%opts,
filehandle => $tmp_fh,
got => substr(ucfirst($o->get('group-by') || 'Disk'), 0, 1),
input => substr(ucfirst($group_by), 0, 1),
);
}
ReadKeyMini::cbreak();
MAIN_LOOP:
while (1) {
if ( my $got = read_command_timeout($sel, $opts{redisplay_interval} ) ) {
if ($actions{$got}) {
my $ret = $actions{$got}->(
if ( my $input = read_command_timeout($sel, $o->get('redisplay-interval') ) ) {
if ($actions{$input}) {
my $ret = $actions{$input}->(
select_obj => $sel,
options => \%opts,
got => $got,
input => $input,
filehandle => $tmp_fh,
) || '';
last MAIN_LOOP if $ret eq 'last';
@@ -167,13 +164,15 @@ 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, clear_state => 0 ) || 0;
$opts{obj}->group_by( filehandle => $tmp_fh ) || 0;
if ( eof $tmp_fh ) {
# If we are gathering samples (don't have a filename), and we have a sample
# limit (set by --iterations), the child process just calls it quits once
# it gathers enough samples. When that happens, we are also done.
if ( !$args{filename} && $opts{samples_to_gather} && kill 0, $child_pid ) {
# 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 ) {
last MAIN_LOOP;
}
@@ -189,8 +188,8 @@ sub run_interactive {
waitpid $child_pid, 0;
}
close($tmp_fh) or die "Couldn't close: $OS_ERROR";
return;
close $tmp_fh or die "Cannot close: $OS_ERROR";
return 0; # Exit status
}
sub read_command_timeout {
@@ -206,26 +205,31 @@ sub gather_samples {
my $samples = 0;
STDIN->blocking(0);
my $sel = IO::Select->new(\*STDIN);
my $sel = IO::Select->new(\*STDIN);
my $filename = $opts{filename};
GATHER_DATA:
while ( $opts{gather_while}->() ) {
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 $!;
or die $OS_ERROR;
my @to_print = `date +'TS %s.%N %F %T'`;
push @to_print, <$diskstats_fh>;
# Lovely little method from IO::Handle: turns on autoflush,
# prints, and then restores the original autoflush state.
$opts{filehandle}->printflush(@to_print);
close $diskstats_fh or die $!;
$fh->printflush(@to_print);
close $diskstats_fh or die $OS_ERROR;
close $fh or die $OS_ERROR;
$samples++;
if ( defined($opts{samples_to_gather}) && $samples >= $opts{samples_to_gather} ) {
if ( defined($opts{samples_to_gather})
&& $samples >= $opts{samples_to_gather} ) {
last GATHER_DATA;
}
}
@@ -234,17 +238,18 @@ sub gather_samples {
sub group_by {
my (%args) = @_;
my $input = $args{input};
my $got = $args{got};
if ( ref( $args{options}->{obj} ) ne $option_to_object{$got} ) {
if ( ref( $args{options}->{obj} ) ne $option_to_object{$input} ) {
# Particularly important! Otherwise we would depend on the
# object's ->new being smart about discarding unrecognized
# values.
delete $args{options}->{obj};
# This would fail on a stricter constructor, so it probably
# needs fixing.
$args{options}->{obj} = $option_to_object{$got}->new( %{$args{options}});
$args{options}->{obj} = $option_to_object{$input}->new(
%{$args{options}}
);
}
seek $args{filehandle}, 0, 0;
@@ -259,7 +264,7 @@ sub group_by {
$obj->group_by(
filehandle => $args{filehandle},
# Only print the header once, as if in interactive.
header_cb => $args{header_cb} || sub {
header_callback => $args{header_callback} || sub {
my $print_header;
return sub {
unless ($print_header++) {
@@ -273,38 +278,18 @@ sub group_by {
}
}
# regexp_pattern is used for pretty-printing regexen, since they can stringify to
# different things depending on the version of Perl. Unfortunately, 5.8
# lacks this, so in that version, we put in a facsimile.
BEGIN {
local $EVAL_ERROR;
eval { require re; re::regexp_pattern(qr//) };
if ( $EVAL_ERROR ) {
*regexp_pattern = sub {
my ($re) = @_;
(my $string_re = $re) =~ s/\A\(\?[^:]*?:(.*)\)\z/$1/sm;
return $string_re;
};
}
else {
re->import("regexp_pattern");
}
}
sub help {
my (%args) = @_;
my $obj = $args{options}->{obj};
my $mode = $object_to_option{ref($obj)};
my ($column_re) = regexp_pattern( $obj->column_regex() );
my ($device_re) = regexp_pattern( $obj->device_regex() );
my $mode = substr ref($obj), 16, 1;
my $column_re = $args{options}->{OptionParser}->get('columns');
my $device_re = $args{options}->{OptionParser}->get('devices');
my $interval = $obj->sample_time() || '(none)';
my $disp_int = $args{options}->{redisplay_interval} || '(none)';
my $disp_int = $args{options}->{OptionParser}->get('redisplay-interval');
my $inact_disk = $obj->filter_zeroed_rows() ? 'yes' : 'no';
for my $re ( $column_re, $device_re ) {
$re ||= '(none)';
$re =~ s/^\Q(?=)\E$/(none)/;
}
print <<"HELP";
@@ -321,6 +306,7 @@ sub help {
------------------- Press any key to continue -----------------------
HELP
pause(@_);
return;
}
sub file_to_use {
@@ -332,13 +318,15 @@ sub file_to_use {
if ( $filename ) {
open my $fh, "<", $filename
or die "Couldn't open $filename: $OS_ERROR";
or die "Cannot open $filename: $OS_ERROR";
return $fh, $filename;
}
else {
local $EVAL_ERROR;
if ( !eval { require File::Temp } ) {
die "Can't call mktemp nor load File::Temp. 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(
@@ -350,7 +338,7 @@ sub file_to_use {
}
}
sub get_input {
sub get_blocking_input {
my ($message) = @_;
STDIN->blocking(1);
@@ -365,55 +353,58 @@ sub get_input {
}
sub hide_inactive_disks {
my (%args) = @_;
my $new_val = !!get_input("Filter inactive rows? (Leave blank for 'No') ");
my (%args) = @_;
my $new_val = get_blocking_input("Filter inactive rows? (Leave blank for 'No') ");
$args{options}->{filter_zeroed_rows} = $new_val;
# 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);
return;
}
sub get_new_value_for {
my ($looking_for, $message) = @_;
(my $looking_for_o = $looking_for) =~ tr/_/-/;
return sub {
my (%args) = @_;
my $new_interval = get_input($message);
my $new_interval = get_blocking_input($message) || 0;
$new_interval ||= 0;
if ( looks_like_number($new_interval) ) {
if ( $args{options}->{obj}->can($looking_for) ) {
$args{options}->{obj}->$looking_for($new_interval);
}
return $args{options}->{$looking_for} = $new_interval;
}
else {
die("invalid timeout specification");
die "invalid timeout specification" unless looks_like_number($new_interval);
if ( $args{options}->{obj}->can($looking_for) ) {
$args{options}->{obj}->$looking_for($new_interval);
}
$args{options}->{OptionParser}->set($looking_for_o, $new_interval);
return $new_interval;
};
}
sub get_new_regex_for {
my ($looking_for, $message) = @_;
(my $looking_for_o = $looking_for) =~ s/_.*$/s/;
return sub {
my (%args) = @_;
my $new_regex = get_input($message);
my (%args) = @_;
my $new_regex = get_blocking_input($message);
local $EVAL_ERROR;
if ( $new_regex && (my $re = eval { qr/$new_regex/i }) ) {
$args{options}->{$looking_for} = $re;
$args{options}->{obj}->$looking_for( $re );
$args{options}->{OptionParser}->set($looking_for_o, $new_regex);
}
elsif ( !$EVAL_ERROR && !$new_regex ) {
# 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.
$args{options}->{$looking_for} = qr/(?=)/;
$args{options}->{obj}->$looking_for( qr/(?=)/ );
$args{options}->{OptionParser}->set($looking_for_o, '');
}
else {
die("invalid regex specification: $EVAL_ERROR");
die "invalid regex specification: $EVAL_ERROR";
}
$args{options}->{obj}->$looking_for( $args{options}->{$looking_for} );
return;
};
}