mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-10-19 17:04:00 +00:00
Slew of changes from Daniel's review.
This commit is contained in:
345
lib/Diskstats.pm
345
lib/Diskstats.pm
@@ -32,6 +32,35 @@ use constant PTDEBUG => $ENV{PTDEBUG} || 0;
|
|||||||
use IO::Handle;
|
use IO::Handle;
|
||||||
use List::Util qw( max first );
|
use List::Util qw( max first );
|
||||||
|
|
||||||
|
my $constants;
|
||||||
|
BEGIN {
|
||||||
|
$constants = {
|
||||||
|
major => 0,
|
||||||
|
minor => 1,
|
||||||
|
device => 2,
|
||||||
|
reads => 3,
|
||||||
|
reads_merged => 4,
|
||||||
|
read_sectors => 5,
|
||||||
|
ms_spent_reading => 6,
|
||||||
|
writes => 7,
|
||||||
|
writes_merged => 8,
|
||||||
|
written_sectors => 9,
|
||||||
|
ms_spent_writing => 10,
|
||||||
|
ios_in_progress => 11,
|
||||||
|
ms_spent_doing_io => 12,
|
||||||
|
ms_weighted => 13,
|
||||||
|
read_bytes => 14,
|
||||||
|
read_kbs => 15,
|
||||||
|
written_bytes => 16,
|
||||||
|
written_kbs => 17,
|
||||||
|
ios_requested => 18,
|
||||||
|
ios_in_bytes => 19,
|
||||||
|
sum_ios_in_progress => 20,
|
||||||
|
};
|
||||||
|
|
||||||
|
require constant;
|
||||||
|
constant->import($constants);
|
||||||
|
}
|
||||||
sub new {
|
sub new {
|
||||||
my ( $class, %args ) = @_;
|
my ( $class, %args ) = @_;
|
||||||
|
|
||||||
@@ -39,19 +68,26 @@ sub new {
|
|||||||
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};
|
||||||
}
|
}
|
||||||
my ($o) = @args{@required_args};
|
my $o = delete $args{OptionParser};
|
||||||
|
# We take OptionParser out of %args, since the latter
|
||||||
|
# will be saved inside the new object, and OptionParser
|
||||||
|
# is abused by DiskstatsMenu to store the current
|
||||||
|
# GroupBy object.
|
||||||
|
|
||||||
|
local $EVAL_ERROR;
|
||||||
my $self = {
|
my $self = {
|
||||||
# Defaults
|
# Defaults
|
||||||
filename => '/proc/diskstats',
|
filename => '/proc/diskstats',
|
||||||
column_regex => qr/cnc|rt|busy|prg|time|io_s/,
|
column_regex => qr/cnc|rt|busy|prg|time|io_s/,
|
||||||
device_regex => qr/.+/,
|
device_regex => qr/.+/,
|
||||||
block_size => 512,
|
block_size => 512,
|
||||||
out_fh => \*STDOUT,
|
output_fh => \*STDOUT,
|
||||||
zero_rows => $o->get('zero-rows') ? 1 : undef,
|
zero_rows => $o->get('zero-rows') ? 1 : undef,
|
||||||
sample_time => $o->get('sample-time') || 0,
|
sample_time => $o->get('sample-time') || 0,
|
||||||
interactive => 0,
|
interactive => 0,
|
||||||
|
|
||||||
|
%args,
|
||||||
|
|
||||||
_stats_for => {},
|
_stats_for => {},
|
||||||
_ordered_devs => [],
|
_ordered_devs => [],
|
||||||
_ts => {},
|
_ts => {},
|
||||||
@@ -62,31 +98,20 @@ sub new {
|
|||||||
_print_header => 1,
|
_print_header => 1,
|
||||||
};
|
};
|
||||||
|
|
||||||
if ( $o->get('memory-for-speed') ) {
|
# This next part turns the strings passed in from the command line
|
||||||
PTDEBUG && _d('Diskstats', "Called with memory-for-speed");
|
# into actual regexen, but also avoids the case where they entered
|
||||||
eval {
|
# --devices '' or --columns ''. When qr//'d, those become the empty
|
||||||
require Memoize;
|
# pattern, which is magical; Instead, we give them what awk would:
|
||||||
Memoize::memoize('_parse_diskstats_line');
|
# A pattern that always matches.
|
||||||
};
|
|
||||||
if ($EVAL_ERROR) {
|
|
||||||
warn "Can't trade memory for speed: $EVAL_ERROR. Continuing as usual.";
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
my %pod_to_attribute = (
|
my %pod_to_attribute = (
|
||||||
columns => 'column_regex',
|
columns => 'column_regex',
|
||||||
devices => 'device_regex'
|
devices => 'device_regex'
|
||||||
);
|
);
|
||||||
for my $key ( grep { defined $o->get($_) } keys %pod_to_attribute ) {
|
for my $key ( grep { defined $o->get($_) } keys %pod_to_attribute ) {
|
||||||
my $re = $o->get($key) || '(?=)';
|
my $re = $o->get($key) || '.+';
|
||||||
$self->{ $pod_to_attribute{$key} } = qr/$re/i;
|
$self->{ $pod_to_attribute{$key} } = qr/$re/i;
|
||||||
}
|
}
|
||||||
|
|
||||||
# If they passed us an attribute explicitly, we use those.
|
|
||||||
for my $attribute ( grep { !/^_/ && defined $args{$_} } keys %$self ) {
|
|
||||||
$self->{$attribute} = $args{$attribute};
|
|
||||||
}
|
|
||||||
|
|
||||||
return bless $self, $class;
|
return bless $self, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -157,21 +182,21 @@ sub set_interactive {
|
|||||||
}
|
}
|
||||||
|
|
||||||
# Checks whenever said filehandle is open. If it's not, defaults to STDOUT.
|
# Checks whenever said filehandle is open. If it's not, defaults to STDOUT.
|
||||||
sub out_fh {
|
sub output_fh {
|
||||||
my ( $self ) = @_;
|
my ( $self ) = @_;
|
||||||
if ( !$self->{out_fh} || !$self->{out_fh}->opened ) {
|
if ( !$self->{output_fh} || !$self->{output_fh}->opened ) {
|
||||||
$self->{out_fh} = \*STDOUT;
|
$self->{output_fh} = \*STDOUT;
|
||||||
}
|
}
|
||||||
return $self->{out_fh};
|
return $self->{output_fh};
|
||||||
}
|
}
|
||||||
|
|
||||||
# It sets or returns the currently set filehandle, kind of like a poor man's
|
# It sets or returns the currently set filehandle, kind of like a poor man's
|
||||||
# select().
|
# select().
|
||||||
sub set_out_fh {
|
sub set_output_fh {
|
||||||
my ( $self, $new_fh ) = @_;
|
my ( $self, $new_fh ) = @_;
|
||||||
# ->opened comes from IO::Handle.
|
# ->opened comes from IO::Handle.
|
||||||
if ( $new_fh && ref($new_fh) && $new_fh->opened ) {
|
if ( $new_fh && ref($new_fh) && $new_fh->opened ) {
|
||||||
$self->{out_fh} = $new_fh;
|
$self->{output_fh} = $new_fh;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -210,7 +235,7 @@ sub set_filename {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub block_size {
|
sub block_size {
|
||||||
my $self = shift;
|
my ( $self ) = @_;
|
||||||
return $self->{block_size};
|
return $self->{block_size};
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -254,7 +279,7 @@ sub clear_ts {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub clear_ordered_devs {
|
sub clear_ordered_devs {
|
||||||
my $self = shift;
|
my ($self) = @_;
|
||||||
$self->{_seen_devs} = {};
|
$self->{_seen_devs} = {};
|
||||||
$self->ordered_devs( [] );
|
$self->ordered_devs( [] );
|
||||||
}
|
}
|
||||||
@@ -318,7 +343,7 @@ sub has_stats {
|
|||||||
my $stats = $self->stats_for;
|
my $stats = $self->stats_for;
|
||||||
|
|
||||||
for my $key ( keys %$stats ) {
|
for my $key ( keys %$stats ) {
|
||||||
return 1 if $stats->{$key} && %{ $stats->{$key} }
|
return 1 if $stats->{$key} && @{ $stats->{$key} }
|
||||||
}
|
}
|
||||||
|
|
||||||
return;
|
return;
|
||||||
@@ -330,8 +355,8 @@ sub _save_curr_as_prev {
|
|||||||
if ( $self->{_save_curr_as_prev} ) {
|
if ( $self->{_save_curr_as_prev} ) {
|
||||||
$self->{_prev_stats_for} = $curr;
|
$self->{_prev_stats_for} = $curr;
|
||||||
for my $dev (keys %$curr) {
|
for my $dev (keys %$curr) {
|
||||||
$self->{_prev_stats_for}->{$dev}->{sum_ios_in_progress} +=
|
$self->{_prev_stats_for}->{$dev}->[sum_ios_in_progress] +=
|
||||||
$curr->{$dev}->{ios_in_progress};
|
$curr->{$dev}->[ios_in_progress];
|
||||||
}
|
}
|
||||||
$self->set_prev_ts($self->curr_ts());
|
$self->set_prev_ts($self->curr_ts());
|
||||||
}
|
}
|
||||||
@@ -344,20 +369,13 @@ sub _save_curr_as_first {
|
|||||||
|
|
||||||
if ( $self->{_first} ) {
|
if ( $self->{_first} ) {
|
||||||
$self->{_first_stats_for} = {
|
$self->{_first_stats_for} = {
|
||||||
# 1-level deep copy of the original structure. Should
|
map { $_ => [@{$curr->{$_}}] } keys %$curr
|
||||||
# be enough.
|
|
||||||
map { $_ => {%{$curr->{$_}}} } keys %$curr
|
|
||||||
};
|
};
|
||||||
$self->set_first_ts($self->curr_ts());
|
$self->set_first_ts($self->curr_ts());
|
||||||
$self->{_first} = undef;
|
$self->{_first} = undef;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub _save_stats {
|
|
||||||
my ( $self, $stats ) = @_;
|
|
||||||
return $self->{_stats_for} = $stats;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub trim {
|
sub trim {
|
||||||
my ($c) = @_;
|
my ($c) = @_;
|
||||||
$c =~ s/^\s+//;
|
$c =~ s/^\s+//;
|
||||||
@@ -439,7 +457,7 @@ our @columns_in_order = (
|
|||||||
sub design_print_formats {
|
sub design_print_formats {
|
||||||
my ( $self, %args ) = @_;
|
my ( $self, %args ) = @_;
|
||||||
my ( $dev_length, $columns ) = @args{qw( max_device_length columns )};
|
my ( $dev_length, $columns ) = @args{qw( max_device_length columns )};
|
||||||
$dev_length ||= max 6, map length, $self->ordered_devs;
|
$dev_length ||= max 6, map length, $self->ordered_devs();
|
||||||
my ( $header, $format );
|
my ( $header, $format );
|
||||||
|
|
||||||
# For each device, print out the following: The timestamp offset and
|
# For each device, print out the following: The timestamp offset and
|
||||||
@@ -462,21 +480,11 @@ sub design_print_formats {
|
|||||||
{
|
{
|
||||||
# This is hot code. In any given run it could end up being called
|
# This is hot code. In any given run it could end up being called
|
||||||
# thousands of times, so beware: Here could be dragons.
|
# thousands of times, so beware: Here could be dragons.
|
||||||
my @diskstats_fields = qw(
|
|
||||||
reads reads_merged read_sectors ms_spent_reading
|
|
||||||
writes writes_merged written_sectors ms_spent_writing
|
|
||||||
ios_in_progress ms_spent_doing_io ms_weighted
|
|
||||||
);
|
|
||||||
# This allows parse_diskstats_line() to be overriden, but also to be
|
|
||||||
# memoized without a normalization function.
|
|
||||||
|
|
||||||
# Magic goto, removes this function from the return stack. Haven't
|
sub parse_diskstats_line {
|
||||||
# benchmarked it, but ostensibly faster.
|
my ( $self, $line, $block_size ) = @_;
|
||||||
sub parse_diskstats_line { shift; goto &_parse_diskstats_line }
|
my @dev_stats;
|
||||||
sub _parse_diskstats_line {
|
$#dev_stats = 30; # Pre-expand the amount of keys for this array.
|
||||||
my ( $line, $block_size ) = @_;
|
|
||||||
my $dev;
|
|
||||||
keys my %dev_stats = 30; # Pre-expand the amount of buckets for this hash.
|
|
||||||
|
|
||||||
# The following split replaces this:
|
# The following split replaces this:
|
||||||
# $line =~ /^
|
# $line =~ /^
|
||||||
@@ -502,22 +510,20 @@ sub _parse_diskstats_line {
|
|||||||
# Assigns the first two elements of the list created by split() into
|
# Assigns the first two elements of the list created by split() into
|
||||||
# %dev_stats as the major and minor, the third element into $dev,
|
# %dev_stats as the major and minor, the third element into $dev,
|
||||||
# and the remaining elements back into %dev_stats.
|
# and the remaining elements back into %dev_stats.
|
||||||
if ( 14 == (( @dev_stats{qw( major minor )}, $dev, @dev_stats{@diskstats_fields} ) =
|
if ( 14 == ( @dev_stats = split " ", $line ) ) {
|
||||||
split " ", $line, 14 ) )
|
$dev_stats[read_kbs] =
|
||||||
{
|
( $dev_stats[read_bytes] = $dev_stats[read_sectors]
|
||||||
$dev_stats{read_kbs} =
|
|
||||||
( $dev_stats{read_bytes} = $dev_stats{read_sectors}
|
|
||||||
* $block_size ) / 1024;
|
* $block_size ) / 1024;
|
||||||
$dev_stats{written_kbs} =
|
$dev_stats[written_kbs] =
|
||||||
( $dev_stats{written_bytes} = $dev_stats{written_sectors}
|
( $dev_stats[written_bytes] = $dev_stats[written_sectors]
|
||||||
* $block_size ) / 1024;
|
* $block_size ) / 1024;
|
||||||
$dev_stats{ios_requested} = $dev_stats{reads}
|
$dev_stats[ios_requested] = $dev_stats[reads]
|
||||||
+ $dev_stats{writes};
|
+ $dev_stats[writes];
|
||||||
|
|
||||||
$dev_stats{ios_in_bytes} = $dev_stats{read_bytes}
|
$dev_stats[ios_in_bytes] = $dev_stats[read_bytes]
|
||||||
+ $dev_stats{written_bytes};
|
+ $dev_stats[written_bytes];
|
||||||
|
|
||||||
return ( $dev, \%dev_stats );
|
return ( $dev_stats[device], \@dev_stats );
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
return;
|
return;
|
||||||
@@ -532,9 +538,9 @@ sub _parse_diskstats_line {
|
|||||||
# %args - Arguments
|
# %args - Arguments
|
||||||
#
|
#
|
||||||
# Optional Arguments:
|
# Optional Arguments:
|
||||||
# filehandle - Reads data from a filehandle by calling readline()
|
# filehandle - Reads data from a filehandle.
|
||||||
# on it.
|
# data - A normal scalar, opened as a scalar filehandle,
|
||||||
# data - Reads data one line at a time.
|
# after which it behaves like the above argument.
|
||||||
# filename - Opens a filehandle to the file and reads it one
|
# filename - Opens a filehandle to the file and reads it one
|
||||||
# line at a time.
|
# line at a time.
|
||||||
# sample_callback - Called each time a sample is processed, passed
|
# sample_callback - Called each time a sample is processed, passed
|
||||||
@@ -542,31 +548,37 @@ sub _parse_diskstats_line {
|
|||||||
#
|
#
|
||||||
|
|
||||||
sub parse_from {
|
sub parse_from {
|
||||||
my ( $self, %args ) = @_;
|
my ( $self, %args ) = @_;
|
||||||
|
|
||||||
my $lines_read = $args{filehandle}
|
my $lines_read;
|
||||||
? $self->parse_from_filehandle( @args{qw( filehandle sample_callback )} )
|
if ($args{filehandle}) {
|
||||||
: $args{data}
|
$lines_read = $self->_parse_from_filehandle(
|
||||||
? $self->parse_from_data( @args{qw( data sample_callback )} )
|
@args{qw( filehandle sample_callback )}
|
||||||
: $self->parse_from_filename( @args{qw( filename sample_callback )} );
|
);
|
||||||
return $lines_read;
|
}
|
||||||
}
|
elsif ( $args{data} ) {
|
||||||
|
open( my $fh, "<", ref($args{data}) ? $args{data} : \$args{data} )
|
||||||
|
or die "Couldn't parse data: $OS_ERROR";
|
||||||
sub parse_from_filename {
|
my $lines_read = $self->_parse_from_filehandle(
|
||||||
my ( $self, $filename, $sample_callback ) = @_;
|
$fh, $args{sample_callback}
|
||||||
|
);
|
||||||
$filename ||= $self->filename();
|
close $fh or warn "Cannot close: $OS_ERROR";
|
||||||
|
}
|
||||||
open my $fh, "<", $filename
|
else {
|
||||||
or die "Cannot parse $filename: $OS_ERROR";
|
my $filename = $args{filename} || $self->filename();
|
||||||
my $lines_read = $self->parse_from_filehandle( $fh, $sample_callback );
|
|
||||||
close $fh or die "Cannot close: $OS_ERROR";
|
open my $fh, "<", $filename
|
||||||
|
or die "Cannot parse $filename: $OS_ERROR";
|
||||||
|
$lines_read = $self->_parse_from_filehandle(
|
||||||
|
$fh, $args{sample_callback}
|
||||||
|
);
|
||||||
|
close $fh or warn "Cannot close: $OS_ERROR";
|
||||||
|
}
|
||||||
|
|
||||||
return $lines_read;
|
return $lines_read;
|
||||||
}
|
}
|
||||||
|
|
||||||
# Method: parse_from_filehandle()
|
# Method: _parse_from_filehandle()
|
||||||
# Parses data received from using readline() on the filehandle. This is
|
# Parses data received from using readline() on the filehandle. This is
|
||||||
# particularly useful, as you could pass in a filehandle to a pipe, or
|
# particularly useful, as you could pass in a filehandle to a pipe, or
|
||||||
# a tied filehandle, or a PerlIO::Scalar handle. Or your normal
|
# a tied filehandle, or a PerlIO::Scalar handle. Or your normal
|
||||||
@@ -578,59 +590,42 @@ sub parse_from_filename {
|
|||||||
# the latest timestamp.
|
# the latest timestamp.
|
||||||
#
|
#
|
||||||
|
|
||||||
sub parse_from_filehandle {
|
sub _parse_from_filehandle {
|
||||||
my ( $self, $filehandle, $sample_callback ) = @_;
|
my ( $self, $filehandle, $sample_callback ) = @_;
|
||||||
return $self->_load( $filehandle, $sample_callback );
|
return $self->_parse_and_load_diskstats( $filehandle, $sample_callback );
|
||||||
}
|
}
|
||||||
|
|
||||||
# Method: parse_from_data()
|
# Method: _parse_and_load_diskstats()
|
||||||
# Similar to parse_from_filehandle, but uses a reference to a scalar
|
|
||||||
# as a filehandle
|
|
||||||
#
|
|
||||||
# Parameters:
|
|
||||||
# data - A normal Perl scalar, or a ref to a scalar.
|
|
||||||
# sample_callback - Same as parse_from_filehandle.
|
|
||||||
#
|
|
||||||
sub parse_from_data {
|
|
||||||
my ( $self, $data, $sample_callback ) = @_;
|
|
||||||
|
|
||||||
open( my $fh, "<", ref($data) ? $data : \$data )
|
|
||||||
or die "Couldn't parse data: $OS_ERROR";
|
|
||||||
my $lines_read = $self->parse_from_filehandle( $fh, $sample_callback );
|
|
||||||
close $fh or die "";
|
|
||||||
|
|
||||||
return $lines_read;
|
|
||||||
}
|
|
||||||
|
|
||||||
# Method: _load()
|
|
||||||
# !!!!INTERNAL!!!!!
|
# !!!!INTERNAL!!!!!
|
||||||
# Reads from the filehandle, either saving the data as needed if dealing
|
# Reads from the filehandle, either saving the data as needed if dealing
|
||||||
# with a diskstats-formatted line, or if it finds a TS line and has a
|
# with a diskstats-formatted line, or if it finds a TS line and has a
|
||||||
# callback, defering to that.
|
# callback, defering to that.
|
||||||
|
|
||||||
sub _load {
|
sub _parse_and_load_diskstats {
|
||||||
my ( $self, $fh, $sample_callback ) = @_;
|
my ( $self, $fh, $sample_callback ) = @_;
|
||||||
my $block_size = $self->block_size();
|
my $block_size = $self->block_size();
|
||||||
my $current_ts = 0;
|
my $current_ts = 0;
|
||||||
my $new_cur = {};
|
my $new_cur = {};
|
||||||
|
|
||||||
while ( my $line = <$fh> ) {
|
while ( my $line = <$fh> ) {
|
||||||
if ( my ( $dev, $dev_stats ) = $self->parse_diskstats_line($line, $block_size) )
|
# The order of parsing here is intentionally backwards -- While the
|
||||||
|
# timestamp line will always happen first, it's actually the rarest
|
||||||
|
# thing to find -- Once ever couple dozen lines or so.
|
||||||
|
# This matters, because on a normal run, checking for the TS line
|
||||||
|
# first ends up in some ~10000 ultimately useless calls to the
|
||||||
|
# regular expression engine, and thus a noticeable slowdown;
|
||||||
|
# Something in the order of 2 seconds or so, per file.
|
||||||
|
if ( my ( $dev, $dev_stats )
|
||||||
|
= $self->parse_diskstats_line($line, $block_size) )
|
||||||
{
|
{
|
||||||
$new_cur->{$dev} = $dev_stats;
|
$new_cur->{$dev} = $dev_stats;
|
||||||
$self->add_ordered_dev($dev);
|
$self->add_ordered_dev($dev);
|
||||||
}
|
}
|
||||||
elsif ( my ($new_ts) = $line =~ /TS\s+([0-9]+(?:\.[0-9]+)?)/ ) {
|
elsif ( my ($new_ts) = $line =~ /TS\s+([0-9]+(?:\.[0-9]+)?)/ ) {
|
||||||
if ( $current_ts && %$new_cur ) {
|
if ( $current_ts && %$new_cur ) {
|
||||||
$self->_save_curr_as_prev( $self->stats_for() );
|
$self->_handle_ts_line($current_ts, $new_cur, $sample_callback);
|
||||||
$self->_save_stats($new_cur);
|
|
||||||
$self->set_curr_ts($current_ts);
|
|
||||||
$self->_save_curr_as_first( $new_cur );
|
|
||||||
$new_cur = {};
|
$new_cur = {};
|
||||||
}
|
}
|
||||||
if ($sample_callback) {
|
|
||||||
$self->$sample_callback($current_ts);
|
|
||||||
}
|
|
||||||
$current_ts = $new_ts;
|
$current_ts = $new_ts;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
@@ -639,22 +634,28 @@ sub _load {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if ( $current_ts ) {
|
if ( $current_ts && %{$new_cur} ) {
|
||||||
if ( %{$new_cur} ) {
|
$self->_handle_ts_line($current_ts, $new_cur, $sample_callback);
|
||||||
$self->_save_curr_as_prev( $self->stats_for() );
|
$new_cur = {};
|
||||||
$self->_save_stats($new_cur);
|
|
||||||
$self->set_curr_ts($current_ts);
|
|
||||||
$self->_save_curr_as_first( $new_cur );
|
|
||||||
$new_cur = {};
|
|
||||||
}
|
|
||||||
if ($sample_callback) {
|
|
||||||
$self->$sample_callback($current_ts);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
# Seems like this could be useful.
|
# Seems like this could be useful.
|
||||||
return $INPUT_LINE_NUMBER;
|
return $INPUT_LINE_NUMBER;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub _handle_ts_line {
|
||||||
|
my ($self, $current_ts, $new_cur, $sample_callback) = @_;
|
||||||
|
|
||||||
|
$self->_save_curr_as_prev( $self->stats_for() );
|
||||||
|
$self->{_stats_for} = $new_cur;
|
||||||
|
$self->set_curr_ts($current_ts);
|
||||||
|
$self->_save_curr_as_first( $new_cur );
|
||||||
|
|
||||||
|
if ($sample_callback) {
|
||||||
|
$self->$sample_callback($current_ts);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
sub _calc_read_stats {
|
sub _calc_read_stats {
|
||||||
my ( $self, %args ) = @_;
|
my ( $self, %args ) = @_;
|
||||||
|
|
||||||
@@ -746,10 +747,10 @@ sub _calc_misc_stats {
|
|||||||
|
|
||||||
# Busy is what iostat calls %util. This is the percent of
|
# Busy is what iostat calls %util. This is the percent of
|
||||||
# wall-clock time during which the device has I/O happening.
|
# wall-clock time during which the device has I/O happening.
|
||||||
$extra_stats{busy} =
|
$extra_stats{busy}
|
||||||
100 *
|
= 100
|
||||||
$delta_for->{ms_spent_doing_io} /
|
* $delta_for->{ms_spent_doing_io}
|
||||||
( 1000 * $elapsed * $devs_in_group );
|
/ ( 1000 * $elapsed * $devs_in_group ); # Highlighting failure: /
|
||||||
|
|
||||||
my $number_of_ios = $stats->{ios_requested};
|
my $number_of_ios = $stats->{ios_requested};
|
||||||
my $total_ms_spent_on_io = $delta_for->{ms_spent_reading}
|
my $total_ms_spent_on_io = $delta_for->{ms_spent_reading}
|
||||||
@@ -774,17 +775,27 @@ sub _calc_misc_stats {
|
|||||||
return %extra_stats;
|
return %extra_stats;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub _calc_delta_for {
|
# An array of arrayefs; the first element of each arrayref is
|
||||||
my ( $self, $curr, $against ) = @_;
|
# the value we are calculating the delta for, while the second
|
||||||
my %deltas = (
|
# element is the index in which the value resides.
|
||||||
map { ( $_ => ($curr->{$_} || 0) - ($against->{$_} || 0) ) }
|
# Basically, each arrayref is
|
||||||
qw(
|
# [ reads => reads() ]
|
||||||
reads reads_merged read_sectors ms_spent_reading
|
my @delta_keys = map { [ $_ => $constants->{$_} ] }
|
||||||
|
qw( reads reads_merged read_sectors ms_spent_reading
|
||||||
writes writes_merged written_sectors ms_spent_writing
|
writes writes_merged written_sectors ms_spent_writing
|
||||||
read_kbs written_kbs
|
read_kbs written_kbs
|
||||||
ms_spent_doing_io ms_weighted
|
ms_spent_doing_io ms_weighted );
|
||||||
)
|
|
||||||
);
|
sub _calc_delta_for {
|
||||||
|
my ( $self, $curr, $against ) = @_;
|
||||||
|
my %deltas;
|
||||||
|
|
||||||
|
for my $delta_key (@delta_keys) {
|
||||||
|
my ($key, $index) = @$delta_key;
|
||||||
|
$deltas{$key} = ($curr->[ $index ] || 0 )
|
||||||
|
- ($against->[ $index ] || 0 );
|
||||||
|
}
|
||||||
|
|
||||||
return \%deltas;
|
return \%deltas;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -796,20 +807,14 @@ 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_and_curr (
|
foreach my $dev ( grep { $self->dev_ok($_) } @devices ) {
|
||||||
map {
|
my $curr = $self->stats_for($dev);
|
||||||
my $curr = $self->dev_ok($_) && $self->stats_for($_);
|
next unless $curr;
|
||||||
$curr ? [ $_, $curr ] : ()
|
|
||||||
}
|
|
||||||
@devices )
|
|
||||||
{
|
|
||||||
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 );
|
||||||
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;
|
||||||
|
|
||||||
# Compute the per-second stats for reads, writes, and overall.
|
# Compute the per-second stats for reads, writes, and overall.
|
||||||
my %stats = (
|
my %stats = (
|
||||||
@@ -847,7 +852,7 @@ sub _calc_deltas {
|
|||||||
my ( $self ) = @_;
|
my ( $self ) = @_;
|
||||||
|
|
||||||
my $elapsed = $self->curr_ts() - $self->delta_against_ts();
|
my $elapsed = $self->curr_ts() - $self->delta_against_ts();
|
||||||
die "Time elapsed is [$elapsed]" unless $elapsed;
|
die "Time between samples should be > 0, is [$elapsed]" if $elapsed <= 0;
|
||||||
|
|
||||||
return $self->_calc_stats_for_deltas($elapsed);
|
return $self->_calc_stats_for_deltas($elapsed);
|
||||||
}
|
}
|
||||||
@@ -855,7 +860,7 @@ sub _calc_deltas {
|
|||||||
sub print_header {
|
sub print_header {
|
||||||
my ($self, $header, @args) = @_;
|
my ($self, $header, @args) = @_;
|
||||||
if ( $self->{_print_header} ) {
|
if ( $self->{_print_header} ) {
|
||||||
printf { $self->out_fh() } $header . "\n", @args;
|
printf { $self->output_fh() } $header . "\n", @args;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -871,10 +876,10 @@ sub print_rows {
|
|||||||
# work for nearly all cases.
|
# work for nearly all cases.
|
||||||
return unless grep {
|
return unless grep {
|
||||||
sprintf("%7.1f", $_) != 0
|
sprintf("%7.1f", $_) != 0
|
||||||
} @{$stat}{ @$cols };
|
} @{ $stat }{ @$cols };
|
||||||
}
|
}
|
||||||
printf { $self->out_fh() } $format . "\n",
|
printf { $self->output_fh() } $format . "\n",
|
||||||
@{$stat}{ qw( line_ts dev ), @$cols };
|
@{ $stat }{ qw( line_ts dev ), @$cols };
|
||||||
}
|
}
|
||||||
|
|
||||||
sub print_deltas {
|
sub print_deltas {
|
||||||
@@ -889,22 +894,14 @@ 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, $rows_callback ) = @args{qw( header_callback rows_callback )};
|
|
||||||
|
|
||||||
if ( $header_callback ) {
|
my $header_method = $args{header_callback} || "print_header";
|
||||||
$self->$header_callback( $header, "#ts", "device" );
|
my $rows_method = $args{rows_callback} || "print_rows";
|
||||||
}
|
|
||||||
else {
|
|
||||||
$self->print_header( $header, "#ts", "device" );
|
|
||||||
}
|
|
||||||
|
|
||||||
for my $stat ( $self->_calc_deltas() ) {
|
$self->$header_method( $header, "#ts", "device" );
|
||||||
if ($rows_callback) {
|
|
||||||
$self->$rows_callback( $format, $cols, $stat );
|
foreach my $stat ( $self->_calc_deltas() ) {
|
||||||
}
|
$self->$rows_method( $format, $cols, $stat );
|
||||||
else {
|
|
||||||
$self->print_rows( $format, $cols, $stat );
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@@ -30,67 +30,50 @@ use constant MKDEBUG => $ENV{MKDEBUG} || 0;
|
|||||||
|
|
||||||
use base qw( Diskstats );
|
use base qw( Diskstats );
|
||||||
|
|
||||||
sub group_by_all {
|
sub group_by {
|
||||||
my ($self, %args) = @_;
|
my ($self, %args) = @_;
|
||||||
|
|
||||||
$self->clear_state();
|
$self->clear_state();
|
||||||
|
|
||||||
if (!$self->interactive()) {
|
if (!$self->interactive()) {
|
||||||
$self->parse_from(
|
$self->parse_from(
|
||||||
|
filehandle => $args{filehandle},
|
||||||
|
filename => $args{filename},
|
||||||
|
data => $args{data},
|
||||||
sample_callback => sub {
|
sample_callback => sub {
|
||||||
$self->print_deltas(
|
$self->print_deltas(
|
||||||
map { ( $_ => $args{$_} ) }
|
header_callback => $args{header_callback},
|
||||||
qw( header_callback rows_callback ),
|
rows_callback => $args{rows_callback},
|
||||||
);
|
);
|
||||||
},
|
},
|
||||||
map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
|
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
my $orig = tell $args{filehandle};
|
my $orig = tell $args{filehandle} if $args{filehandle};
|
||||||
|
my $header_callback = $args{header_callback} || sub {
|
||||||
|
my ($self, @args) = @_;
|
||||||
|
$self->print_header(@args) if $self->{_print_header};
|
||||||
|
$self->{_print_header} = 0;
|
||||||
|
};
|
||||||
$self->parse_from(
|
$self->parse_from(
|
||||||
|
filehandle => $args{filehandle},
|
||||||
|
filename => $args{filename},
|
||||||
|
data => $args{data},
|
||||||
sample_callback => sub {
|
sample_callback => sub {
|
||||||
$self->print_deltas(
|
$self->print_deltas(
|
||||||
header_callback => sub {
|
header_callback => $header_callback,
|
||||||
my $self = shift;
|
rows_callback => $args{rows_callback},
|
||||||
if ( $self->{_print_header} ) {
|
|
||||||
my $meth = $args{header_callback} || "print_header";
|
|
||||||
$self->$meth(@_);
|
|
||||||
}
|
|
||||||
$self->{_print_header} = undef;
|
|
||||||
},
|
|
||||||
rows_callback => $args{rows_callback},
|
|
||||||
);
|
);
|
||||||
},
|
},
|
||||||
map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
|
|
||||||
);
|
);
|
||||||
if (!$self->prev_ts()) {
|
seek $args{filehandle}, $orig, 0 unless $self->prev_ts();
|
||||||
seek $args{filehandle}, $orig, 0;
|
|
||||||
}
|
|
||||||
return;
|
|
||||||
}
|
}
|
||||||
$self->clear_state();
|
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
# The next methods are all overrides!
|
# The next methods are all overrides!
|
||||||
|
|
||||||
sub group_by {
|
|
||||||
my $self = shift;
|
|
||||||
$self->group_by_all(@_);
|
|
||||||
}
|
|
||||||
|
|
||||||
sub clear_state {
|
|
||||||
my $self = shift;
|
|
||||||
if (!$self->interactive()) {
|
|
||||||
$self->SUPER::clear_state(@_);
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
my $orig_print_header = $self->{_print_header};
|
|
||||||
$self->SUPER::clear_state(@_);
|
|
||||||
$self->{_print_header} = $orig_print_header;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
sub delta_against {
|
sub delta_against {
|
||||||
my ($self, $dev) = @_;
|
my ($self, $dev) = @_;
|
||||||
return $self->prev_stats_for($dev);
|
return $self->prev_stats_for($dev);
|
||||||
|
@@ -38,20 +38,18 @@ sub new {
|
|||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub group_by {
|
|
||||||
my ($self, @args) = @_;
|
|
||||||
$self->group_by_disk(@args);
|
|
||||||
}
|
|
||||||
|
|
||||||
# Prints out one line for each disk, summing over the interval from first to
|
# Prints out one line for each disk, summing over the interval from first to
|
||||||
# last sample.
|
# last sample.
|
||||||
sub group_by_disk {
|
sub group_by {
|
||||||
my ($self, %args) = @_;
|
my ($self, %args) = @_;
|
||||||
my ($header_callback, $rows_callback) = $args{ qw( header_callback rows_callback ) };
|
my @optional_args = qw( header_callback rows_callback );
|
||||||
|
my ($header_callback, $rows_callback) = $args{ @optional_args };
|
||||||
|
|
||||||
$self->clear_state() unless $self->interactive();
|
$self->clear_state() unless $self->interactive();
|
||||||
|
|
||||||
my $original_offset = $args{filehandle} ? tell($args{filehandle}) : undef;
|
my $original_offset = ($args{filehandle} || ref($args{data}))
|
||||||
|
? tell($args{filehandle} || $args{data})
|
||||||
|
: undef;
|
||||||
|
|
||||||
my $lines_read = $self->parse_from(
|
my $lines_read = $self->parse_from(
|
||||||
sample_callback => sub {
|
sample_callback => sub {
|
||||||
@@ -89,19 +87,24 @@ sub group_by_disk {
|
|||||||
);
|
);
|
||||||
|
|
||||||
if ($self->interactive()) {
|
if ($self->interactive()) {
|
||||||
if ($self->{_iterations} == -1 && defined($original_offset)
|
# This is a guard against the weird but nasty situation where
|
||||||
&& eof($args{filehandle})) {
|
# we read several samples from the filehandle, but reach
|
||||||
|
# the end of file before $elapsed >= $self->sample_time().
|
||||||
|
# If that happens, we need to rewind the filehandle to
|
||||||
|
# where we started, so subsequent attempts (i.e. when
|
||||||
|
# the file has more data) have greater chances of succeeding,
|
||||||
|
# and no data goes unreported.
|
||||||
|
if ($self->{_iterations} != -1 && defined($original_offset)
|
||||||
|
&& eof($args{filehandle} || $args{data}) ) {
|
||||||
$self->clear_state;
|
$self->clear_state;
|
||||||
seek $args{filehandle}, $original_offset, 0;
|
seek( ($args{filehandle} || $args{data}), $original_offset, 0);
|
||||||
}
|
}
|
||||||
return $lines_read;
|
return $lines_read;
|
||||||
}
|
}
|
||||||
|
|
||||||
if ( $self->{_iterations} < 2 ) {
|
return if $self->{_iterations} < 2;
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
$self->print_deltas(
|
$self->print_deltas(
|
||||||
header_callback => $args{header_callback},
|
header_callback => $args{header_callback},
|
||||||
rows_callback => $args{rows_callback},
|
rows_callback => $args{rows_callback},
|
||||||
);
|
);
|
||||||
|
@@ -39,16 +39,12 @@ sub new {
|
|||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub group_by {
|
|
||||||
my $self = shift;
|
|
||||||
$self->group_by_sample(@_);
|
|
||||||
}
|
|
||||||
|
|
||||||
# Prints out one line for each disk, summing over the interval from first to
|
# Prints out one line for each disk, summing over the interval from first to
|
||||||
# last sample.
|
# last sample.
|
||||||
sub group_by_sample {
|
sub group_by {
|
||||||
my ( $self, %args ) = @_;
|
my ( $self, %args ) = @_;
|
||||||
my ( $header_callback, $rows_callback ) = $args{qw( header_callback rows_callback )};
|
my @optional_args = qw( header_callback rows_callback );
|
||||||
|
my ( $header_callback, $rows_callback ) = $args{ @optional_args };
|
||||||
|
|
||||||
$self->clear_state() unless $self->interactive();
|
$self->clear_state() unless $self->interactive();
|
||||||
|
|
||||||
@@ -145,7 +141,7 @@ sub compute_dev {
|
|||||||
$devs ||= $self->compute_devs_in_group();
|
$devs ||= $self->compute_devs_in_group();
|
||||||
return $devs > 1
|
return $devs > 1
|
||||||
? "{" . $devs . "}"
|
? "{" . $devs . "}"
|
||||||
: ( $self->ordered_devs )[0];
|
: $self->{ordered_devs}->[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
# Terrible breach of encapsulation, but it'll have to do for the moment.
|
# Terrible breach of encapsulation, but it'll have to do for the moment.
|
||||||
@@ -159,7 +155,7 @@ sub _calc_stats_for_deltas {
|
|||||||
my $against = $self->delta_against($dev);
|
my $against = $self->delta_against($dev);
|
||||||
|
|
||||||
my $delta = $self->_calc_delta_for( $curr, $against );
|
my $delta = $self->_calc_delta_for( $curr, $against );
|
||||||
$delta->{ios_in_progress} = $curr->{ios_in_progress};
|
$delta->{ios_in_progress} = $curr->[Diskstats::ios_in_progress];
|
||||||
while ( my ( $k, $v ) = each %$delta ) {
|
while ( my ( $k, $v ) = each %$delta ) {
|
||||||
$delta_for->{$k} += $v;
|
$delta_for->{$k} += $v;
|
||||||
}
|
}
|
||||||
|
@@ -70,7 +70,7 @@ my %input_to_object = (
|
|||||||
);
|
);
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
bless {}, shift;
|
return bless {}, shift;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub run_interactive {
|
sub run_interactive {
|
||||||
@@ -81,10 +81,8 @@ sub run_interactive {
|
|||||||
}
|
}
|
||||||
my ($o) = @args{@required_args};
|
my ($o) = @args{@required_args};
|
||||||
|
|
||||||
my %opts = (
|
# TODO Find out if there's a better way to do this.
|
||||||
interactive => 1,
|
$o->{opts}->{current_group_by_obj}->{value} = undef;
|
||||||
OptionParser => $o,
|
|
||||||
);
|
|
||||||
|
|
||||||
my ($tmp_fh, $filename, $child_pid, $child_fh);
|
my ($tmp_fh, $filename, $child_pid, $child_fh);
|
||||||
|
|
||||||
@@ -139,15 +137,20 @@ 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{current_group_by_obj} = $class->new( %opts );
|
$o->set("current_group_by_obj",
|
||||||
|
$class->new( OptionParser => $o, interactive => 1 )
|
||||||
|
);
|
||||||
|
|
||||||
|
my $header_callback = $o->get("current_group_by_obj")
|
||||||
|
->can("print_header");
|
||||||
|
|
||||||
if ( $args{filename} ) {
|
if ( $args{filename} ) {
|
||||||
group_by(
|
group_by(
|
||||||
header_callback => sub { shift->print_header(@_) },
|
header_callback => $header_callback,
|
||||||
select_obj => $sel,
|
select_obj => $sel,
|
||||||
options => \%opts,
|
OptionParser => $o,
|
||||||
filehandle => $tmp_fh,
|
filehandle => $tmp_fh,
|
||||||
input => substr(ucfirst($group_by), 0, 1),
|
input => substr(ucfirst($group_by), 0, 1),
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -155,13 +158,14 @@ sub run_interactive {
|
|||||||
my $run = 1;
|
my $run = 1;
|
||||||
MAIN_LOOP:
|
MAIN_LOOP:
|
||||||
while ($run) {
|
while ($run) {
|
||||||
if ( my $input = read_command_timeout($sel, $o->get('redisplay-interval') ) ) {
|
my $redisplay_interval = $o->get('redisplay-interval');
|
||||||
|
if ( my $input = read_command_timeout($sel, $redisplay_interval ) ) {
|
||||||
if ($actions{$input}) {
|
if ($actions{$input}) {
|
||||||
my $ret = $actions{$input}->(
|
my $ret = $actions{$input}->(
|
||||||
select_obj => $sel,
|
select_obj => $sel,
|
||||||
options => \%opts,
|
OptionParser => $o,
|
||||||
input => $input,
|
input => $input,
|
||||||
filehandle => $tmp_fh,
|
filehandle => $tmp_fh,
|
||||||
) || '';
|
) || '';
|
||||||
last MAIN_LOOP if $ret eq 'last';
|
last MAIN_LOOP if $ret eq 'last';
|
||||||
}
|
}
|
||||||
@@ -169,7 +173,8 @@ 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{current_group_by_obj}->group_by( filehandle => $tmp_fh ) || 0;
|
$o->get("current_group_by_obj")
|
||||||
|
->group_by( filehandle => $tmp_fh );
|
||||||
|
|
||||||
if ( eof $tmp_fh ) {
|
if ( eof $tmp_fh ) {
|
||||||
# This one comes from IO::Handle. I clears the eof flag
|
# This one comes from IO::Handle. I clears the eof flag
|
||||||
@@ -189,7 +194,8 @@ sub run_interactive {
|
|||||||
|
|
||||||
# If we don't have a filename, the daemon might still be running.
|
# If we don't have a filename, the daemon might still be running.
|
||||||
# If it is, ask it nicely to end, then wait.
|
# If it is, ask it nicely to end, then wait.
|
||||||
if ( !$args{filename} && !defined $o->get('iterations') && kill 0, $child_pid ) {
|
if ( !$args{filename} && !defined $o->get('iterations')
|
||||||
|
&& kill 0, $child_pid ) {
|
||||||
$child_fh->printflush("End\n");
|
$child_fh->printflush("End\n");
|
||||||
waitpid $child_pid, 0;
|
waitpid $child_pid, 0;
|
||||||
}
|
}
|
||||||
@@ -207,16 +213,16 @@ sub read_command_timeout {
|
|||||||
}
|
}
|
||||||
|
|
||||||
sub gather_samples {
|
sub gather_samples {
|
||||||
my (%opts) = @_;
|
my (%args) = @_;
|
||||||
my $samples = 0;
|
my $samples = 0;
|
||||||
|
|
||||||
STDIN->blocking(0);
|
STDIN->blocking(0);
|
||||||
my $sel = IO::Select->new(\*STDIN);
|
my $sel = IO::Select->new(\*STDIN);
|
||||||
my $filename = $opts{filename};
|
my $filename = $args{filename};
|
||||||
|
|
||||||
GATHER_DATA:
|
GATHER_DATA:
|
||||||
while ( $opts{gather_while}->() ) {
|
while ( $args{gather_while}->() ) {
|
||||||
if ( read_command_timeout( $sel, $opts{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 $fh, ">>", $filename or die $OS_ERROR;
|
||||||
@@ -233,8 +239,8 @@ sub gather_samples {
|
|||||||
close $fh or die $OS_ERROR;
|
close $fh or die $OS_ERROR;
|
||||||
|
|
||||||
$samples++;
|
$samples++;
|
||||||
if ( defined($opts{samples_to_gather})
|
if ( defined($args{samples_to_gather})
|
||||||
&& $samples >= $opts{samples_to_gather} ) {
|
&& $samples >= $args{samples_to_gather} ) {
|
||||||
last GATHER_DATA;
|
last GATHER_DATA;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -244,45 +250,48 @@ sub gather_samples {
|
|||||||
sub group_by {
|
sub group_by {
|
||||||
my (%args) = @_;
|
my (%args) = @_;
|
||||||
|
|
||||||
my @required_args = qw( options input );
|
my @required_args = qw( OptionParser input );
|
||||||
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};
|
||||||
}
|
}
|
||||||
my ($options, $input) = @args{@required_args};
|
my ($o, $input) = @args{@required_args};
|
||||||
|
|
||||||
if ( ref( $args{options}->{current_group_by_obj} ) ne $input_to_object{$input} ) {
|
if ( ref( $o->get("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}->{current_group_by_obj};
|
$o->set("current_group_by_obj", undef);
|
||||||
# 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}->{current_group_by_obj} = $input_to_object{$input}->new(
|
$o->set("current_group_by_obj",
|
||||||
%{$args{options}}
|
$input_to_object{$input}->new(
|
||||||
);
|
OptionParser => $o,
|
||||||
|
interactive => 1,
|
||||||
|
)
|
||||||
|
);
|
||||||
}
|
}
|
||||||
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}->{current_group_by_obj} ) {
|
for my $obj ( $o->get("current_group_by_obj") ) {
|
||||||
if ( $obj->isa("DiskstatsGroupBySample") ) {
|
if ( $obj->isa("DiskstatsGroupBySample") ) {
|
||||||
$obj->set_interactive(1);
|
$obj->set_interactive(1);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$obj->set_interactive(0);
|
$obj->set_interactive(0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
my $print_header;
|
||||||
|
my $header_callback = $args{header_callback} || sub {
|
||||||
|
my ($self, @args) = @_;
|
||||||
|
$self->print_header(@args) unless $print_header++
|
||||||
|
};
|
||||||
|
|
||||||
$obj->group_by(
|
$obj->group_by(
|
||||||
filehandle => $args{filehandle},
|
filehandle => $args{filehandle},
|
||||||
# Only print the header once, as if in interactive.
|
# Only print the header once, as if in interactive.
|
||||||
header_callback => $args{header_callback} || sub {
|
header_callback => $header_callback,
|
||||||
my $print_header;
|
);
|
||||||
return sub {
|
|
||||||
unless ($print_header++) {
|
|
||||||
shift->print_header(@_)
|
|
||||||
}
|
|
||||||
};
|
|
||||||
}->(),
|
|
||||||
);
|
|
||||||
$obj->set_interactive(1);
|
$obj->set_interactive(1);
|
||||||
$obj->{_print_header} = 0;
|
$obj->{_print_header} = 0;
|
||||||
}
|
}
|
||||||
@@ -290,12 +299,12 @@ sub group_by {
|
|||||||
|
|
||||||
sub help {
|
sub help {
|
||||||
my (%args) = @_;
|
my (%args) = @_;
|
||||||
my $obj = $args{options}->{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{options}->{OptionParser}->get('columns');
|
my $column_re = $args{OptionParser}->get('columns');
|
||||||
my $device_re = $args{options}->{OptionParser}->get('devices');
|
my $device_re = $args{OptionParser}->get('devices');
|
||||||
my $interval = $obj->sample_time() || '(none)';
|
my $interval = $obj->sample_time() || '(none)';
|
||||||
my $disp_int = $args{options}->{OptionParser}->get('redisplay-interval');
|
my $disp_int = $args{OptionParser}->get('redisplay-interval');
|
||||||
my $inact_disk = $obj->zero_rows() ? 'no' : 'yes';
|
my $inact_disk = $obj->zero_rows() ? 'no' : 'yes';
|
||||||
|
|
||||||
for my $re ( $column_re, $device_re ) {
|
for my $re ( $column_re, $device_re ) {
|
||||||
@@ -323,7 +332,8 @@ 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');
|
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`);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -333,7 +343,8 @@ sub file_to_use {
|
|||||||
return $fh, $filename;
|
return $fh, $filename;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
PTDEBUG && _d("mktemp didn't return a filename, trying to use File::Temp");
|
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.",
|
||||||
@@ -366,10 +377,14 @@ sub get_blocking_input {
|
|||||||
|
|
||||||
sub hide_inactive_disks {
|
sub hide_inactive_disks {
|
||||||
my (%args) = @_;
|
my (%args) = @_;
|
||||||
my $new_val = get_blocking_input("Filter inactive rows? (Leave blank for 'No') ");
|
my $new_val = get_blocking_input(
|
||||||
|
"Filter inactive rows? (Leave blank for 'No') "
|
||||||
|
);
|
||||||
|
|
||||||
$args{options}->{OptionParser}->set('zero-rows', !$new_val);
|
$args{OptionParser}->set('zero-rows', !$new_val);
|
||||||
$args{options}->{current_group_by_obj}->set_zero_rows(!$new_val);
|
|
||||||
|
$args{OptionParser}->get("current_group_by_obj")
|
||||||
|
->set_zero_rows(!$new_val);
|
||||||
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
@@ -379,16 +394,17 @@ sub get_new_value_for {
|
|||||||
(my $looking_for_o = $looking_for) =~ tr/_/-/;
|
(my $looking_for_o = $looking_for) =~ tr/_/-/;
|
||||||
return sub {
|
return sub {
|
||||||
my (%args) = @_;
|
my (%args) = @_;
|
||||||
|
my $o = $args{OptionParser};
|
||||||
my $new_interval = get_blocking_input($message) || 0;
|
my $new_interval = get_blocking_input($message) || 0;
|
||||||
|
|
||||||
die "Invalid timeout: $new_interval"
|
die "Invalid timeout: $new_interval"
|
||||||
unless looks_like_number($new_interval);
|
unless looks_like_number($new_interval);
|
||||||
|
|
||||||
if ( my $setter = $args{options}->{current_group_by_obj}->can("set_$looking_for") )
|
my $obj = $o->get("current_group_by_obj");
|
||||||
{
|
if ( my $setter = $obj->can("set_$looking_for") ) {
|
||||||
$args{options}->{current_group_by_obj}->$setter($new_interval);
|
$obj->$setter($new_interval);
|
||||||
}
|
}
|
||||||
$args{options}->{OptionParser}->set($looking_for_o, $new_interval);
|
$o->set($looking_for_o, $new_interval);
|
||||||
return $new_interval;
|
return $new_interval;
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
@@ -399,20 +415,24 @@ sub get_new_regex_for {
|
|||||||
$looking_for = "set_$looking_for";
|
$looking_for = "set_$looking_for";
|
||||||
return sub {
|
return sub {
|
||||||
my (%args) = @_;
|
my (%args) = @_;
|
||||||
|
my $o = $args{OptionParser};
|
||||||
my $new_regex = get_blocking_input($message);
|
my $new_regex = get_blocking_input($message);
|
||||||
|
|
||||||
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}->{current_group_by_obj}->$looking_for( $re );
|
$o->get("current_group_by_obj")
|
||||||
$args{options}->{OptionParser}->set($looking_for_o, $new_regex);
|
->$looking_for( $re );
|
||||||
|
|
||||||
|
$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
|
# This might seem weird, but an empty pattern is
|
||||||
# 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}->{current_group_by_obj}->$looking_for( qr/.+/ );
|
$o->get("current_group_by_obj")
|
||||||
$args{options}->{OptionParser}->set($looking_for_o, '');
|
->$looking_for( qr/.+/ );
|
||||||
|
$o->set($looking_for_o, '');
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
die "invalid regex specification: $EVAL_ERROR";
|
die "invalid regex specification: $EVAL_ERROR";
|
||||||
|
@@ -30,27 +30,27 @@ sub main {
|
|||||||
# ########################################################################
|
# ########################################################################
|
||||||
# Get configuration information.
|
# Get configuration information.
|
||||||
# ########################################################################
|
# ########################################################################
|
||||||
my $o = new OptionParser file => __FILE__;
|
my $o = new OptionParser(file => __FILE__);
|
||||||
$o->get_specs();
|
$o->get_specs();
|
||||||
$o->get_opts();
|
$o->get_opts();
|
||||||
|
|
||||||
$o->usage_or_errors();
|
$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
|
||||||
return $diskstats->run_interactive( OptionParser => $o, filename => $ARGV[0] );
|
return $diskstats->run_interactive(
|
||||||
|
OptionParser => $o,
|
||||||
|
filename => $ARGV[0]
|
||||||
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
# Somewhat important if STDOUT is tied to a terminal.
|
|
||||||
END { close STDOUT or die "Couldn't close stdout: $OS_ERROR" }
|
|
||||||
|
|
||||||
# ############################################################################
|
# ############################################################################
|
||||||
# Run the program.
|
# Run the program.
|
||||||
# ############################################################################
|
# ############################################################################
|
||||||
if ( !caller ) { exit main(@ARGV); }
|
if ( !caller ) { exit main(@ARGV); }
|
||||||
|
|
||||||
1;
|
1; # Because this is a module as well as a script.
|
||||||
}
|
}
|
||||||
|
|
||||||
# #############################################################################
|
# #############################################################################
|
||||||
@@ -282,11 +282,6 @@ Sample /proc/diskstats every N seconds.
|
|||||||
|
|
||||||
Show rows with all zero values.
|
Show rows with all zero values.
|
||||||
|
|
||||||
=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
|
||||||
|
|
||||||
Show help and exit.
|
Show help and exit.
|
||||||
|
@@ -9,11 +9,14 @@ 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 => 128;
|
use Test::More tests => 112;
|
||||||
|
|
||||||
use PerconaTest;
|
use PerconaTest;
|
||||||
|
|
||||||
|
use OptionParser;
|
||||||
|
|
||||||
use File::Spec;
|
use File::Spec;
|
||||||
|
use File::Temp ();
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
use_ok "Diskstats";
|
use_ok "Diskstats";
|
||||||
@@ -22,30 +25,30 @@ BEGIN {
|
|||||||
use_ok "DiskstatsGroupBySample";
|
use_ok "DiskstatsGroupBySample";
|
||||||
}
|
}
|
||||||
|
|
||||||
sub FakeParser::get {};
|
my $o = new OptionParser(description => 'Diskstats');
|
||||||
|
$o->get_specs( File::Spec->catfile($trunk, "bin", "pt-diskstats") );
|
||||||
|
|
||||||
{
|
{
|
||||||
|
my $obj = new Diskstats(OptionParser => $o);
|
||||||
my $o = bless {}, "FakeParser";
|
|
||||||
|
|
||||||
my $obj = new_ok(Diskstats => [OptionParser => $o]);
|
|
||||||
|
|
||||||
can_ok( $obj, qw(
|
can_ok( $obj, qw(
|
||||||
out_fh column_regex device_regex filename
|
output_fh column_regex device_regex filename
|
||||||
block_size ordered_devs clear_state clear_ordered_devs
|
block_size ordered_devs clear_state clear_ordered_devs
|
||||||
stats_for prev_stats_for first_stats_for
|
stats_for prev_stats_for first_stats_for
|
||||||
has_stats design_print_formats parse_diskstats_line
|
has_stats design_print_formats parse_diskstats_line
|
||||||
parse_from print_deltas
|
parse_from print_deltas
|
||||||
) );
|
) );
|
||||||
|
|
||||||
# Test the constructor
|
# ############################################################################
|
||||||
use File::Temp ();
|
# Testing the constructor.
|
||||||
|
# ############################################################################
|
||||||
for my $attr (
|
for my $attr (
|
||||||
[ filename => (File::Temp::tempfile($0.'diskstats.XXXXXX', OPEN=>0, UNLINK=>1))[1]],
|
[ 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 ],
|
||||||
[ out_fh => \*STDERR ],
|
[ output_fh => \*STDERR ],
|
||||||
[ zero_rows => 1 ],
|
[ zero_rows => 1 ],
|
||||||
[ sample_time => 1 ],
|
[ sample_time => 1 ],
|
||||||
[ interactive => 1 ],
|
[ interactive => 1 ],
|
||||||
@@ -61,41 +64,104 @@ for my $attr (
|
|||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
my $line = "104 0 cciss/c0d0 2139885 162788 37361471 8034486 17999682 83425310 811400340 12711047 0 6869437 20744582";
|
# ############################################################################
|
||||||
|
# parse_diskstats_line
|
||||||
|
# ############################################################################
|
||||||
|
for my $test (
|
||||||
|
[
|
||||||
|
"104 0 cciss/c0d0 2139885 162788 37361471 8034486 17999682 83425310 811400340 12711047 0 6869437 20744582",
|
||||||
|
[
|
||||||
|
104, 0, "cciss/c0d0", # major, minor, device
|
||||||
|
|
||||||
|
2139885, # reads
|
||||||
|
162788, # reads_merged
|
||||||
|
37361471, # read_sectors
|
||||||
|
8034486, # ms_spent_reading
|
||||||
|
|
||||||
|
17999682, # writes
|
||||||
|
83425310, # writes_merged
|
||||||
|
811400340, # written_sectors
|
||||||
|
12711047, # ms_spent_writing
|
||||||
|
|
||||||
|
0, # ios_in_progress
|
||||||
|
6869437, # ms_spent_doing_io
|
||||||
|
20744582, # ms_weighted
|
||||||
|
|
||||||
|
19129073152, # read_bytes
|
||||||
|
18680735.5, # read_kbs
|
||||||
|
415436974080,#written_bytes
|
||||||
|
405700170, # written_kbs
|
||||||
|
20139567, # ios_requested
|
||||||
|
434566047232,# ios_in_bytes
|
||||||
|
],
|
||||||
|
"parse_diskstats_line works"
|
||||||
|
],
|
||||||
|
[
|
||||||
|
" 8 33 sdc1 1572537676 2369344 3687151364 1575056414 2541895139 1708184481 3991989096 121136333 1 982122453 1798311795",
|
||||||
|
[
|
||||||
|
'8', '33', 'sdc1', 1572537676, '2369344', 3687151364,
|
||||||
|
'1575056414', 2541895139, '1708184481', 3991989096,
|
||||||
|
'121136333', '1', '982122453', '1798311795',
|
||||||
|
'1887821498368', '1843575682', '2043898417152',
|
||||||
|
'1995994548', 4114432815, '3931719915520'
|
||||||
|
],
|
||||||
|
"parse_diskstats_line works"
|
||||||
|
],
|
||||||
|
[
|
||||||
|
" 8 33 sdc1 1572537676 2369344 3687151364 1575056414 2541895139 1708184481 3991989096 121136333 1 982122453 1798311795\n",
|
||||||
|
[
|
||||||
|
'8', '33', 'sdc1', 1572537676, '2369344', 3687151364,
|
||||||
|
'1575056414', 2541895139, '1708184481', 3991989096,
|
||||||
|
'121136333', '1', '982122453', '1798311795',
|
||||||
|
'1887821498368', '1843575682', '2043898417152',
|
||||||
|
'1995994548', 4114432815, '3931719915520'
|
||||||
|
],
|
||||||
|
"parse_diskstats_line ignores a trailing newline"
|
||||||
|
],
|
||||||
|
[
|
||||||
|
" 8 33 sdc1 1572537676 2369344 3687151364 1575056414 2541895139 1708184481 3991989096 121136333 1 982122453 \n",
|
||||||
|
undef,
|
||||||
|
"parse_diskstats_line fails on a line without enough fields"
|
||||||
|
],
|
||||||
|
[
|
||||||
|
" 8 33 sdc1 1572537676 2369344 3687151364 1575056414 2541895139 1708184481 3991989096 121136333 1 982122453 12224123 12312312",
|
||||||
|
undef,
|
||||||
|
"parse_diskstats_line fails on a line with too many fields"
|
||||||
|
],
|
||||||
|
[
|
||||||
|
"",
|
||||||
|
undef,
|
||||||
|
"parse_diskstats_line returns undef on an empty string",
|
||||||
|
],
|
||||||
|
[
|
||||||
|
"Malformed line",
|
||||||
|
undef,
|
||||||
|
"parse_diskstats_line returns undef on a malformed line",
|
||||||
|
],
|
||||||
|
) {
|
||||||
|
my ($line, $expected_results, $desc) = @$test;
|
||||||
|
my ($dev, $res) = $obj->parse_diskstats_line($line, $obj->block_size);
|
||||||
|
is_deeply( $res, $expected_results, $desc );
|
||||||
|
}
|
||||||
|
|
||||||
my %expected_results = (
|
# For speed, ->parse_diskstats_line doesn't check for undef.
|
||||||
'major' => 104,
|
# In any case, this should never happen, since it's internally
|
||||||
'minor' => 0,
|
# used within a readline() loop.
|
||||||
|
local $EVAL_ERROR;
|
||||||
'reads' => 2139885,
|
eval { $obj->parse_diskstats_line(undef, $obj->block_size); };
|
||||||
'reads_merged' => 162788,
|
like(
|
||||||
'read_sectors' => 37361471,
|
$EVAL_ERROR,
|
||||||
'ms_spent_reading' => 8034486,
|
qr/Use of uninitialized value/,
|
||||||
'read_bytes' => 19129073152,
|
"parse_diskstats_line should fail on undef",
|
||||||
'read_kbs' => 18680735.5,
|
|
||||||
|
|
||||||
'writes' => 17999682,
|
|
||||||
'writes_merged' => 83425310,
|
|
||||||
'written_sectors' => 811400340,
|
|
||||||
'ms_spent_writing' => 12711047,
|
|
||||||
'written_bytes' => 415436974080,
|
|
||||||
'written_kbs' => 405700170,
|
|
||||||
|
|
||||||
'ios_in_progress' => 0,
|
|
||||||
'ms_spent_doing_io' => 6869437,
|
|
||||||
'ms_weighted' => 20744582,
|
|
||||||
|
|
||||||
'ios_requested' => 20139567,
|
|
||||||
'ios_in_bytes' => 434566047232,
|
|
||||||
);
|
);
|
||||||
|
|
||||||
# Copypasted from Diskstats.pm. If the one in there changes so should this.
|
|
||||||
|
# ############################################################################
|
||||||
|
# design_print_formats
|
||||||
|
# ############################################################################
|
||||||
|
|
||||||
my @columns_in_order = @Diskstats::columns_in_order;
|
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->set_column_regex(qr/./);
|
$obj->set_column_regex(qr/./);
|
||||||
my ($header, $rows, $cols) = $obj->design_print_formats();
|
my ($header, $rows, $cols) = $obj->design_print_formats();
|
||||||
is_deeply(
|
is_deeply(
|
||||||
@@ -154,9 +220,8 @@ is(
|
|||||||
|
|
||||||
($header, $rows, $cols) = $obj->design_print_formats(
|
($header, $rows, $cols) = $obj->design_print_formats(
|
||||||
max_device_length => 10,
|
max_device_length => 10,
|
||||||
columns => [
|
columns =>
|
||||||
map { $_->[0] } @columns_in_order
|
[ map { $_->[0] } @columns_in_order ],
|
||||||
],
|
|
||||||
);
|
);
|
||||||
is(
|
is(
|
||||||
$header,
|
$header,
|
||||||
@@ -168,6 +233,9 @@ 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/,
|
||||||
"design_print_formats dies when passed an invalid columns argument");
|
"design_print_formats dies when passed an invalid columns argument");
|
||||||
|
|
||||||
|
# ############################################################################
|
||||||
|
# timestamp methods
|
||||||
|
# ############################################################################
|
||||||
for my $method ( qw( curr_ts prev_ts first_ts ) ) {
|
for my $method ( qw( curr_ts prev_ts first_ts ) ) {
|
||||||
my $setter = "set_$method";
|
my $setter = "set_$method";
|
||||||
ok(!$obj->$method(), "Diskstats->$method is initially false");
|
ok(!$obj->$method(), "Diskstats->$method is initially false");
|
||||||
@@ -180,14 +248,26 @@ for my $method ( qw( curr_ts prev_ts first_ts ) ) {
|
|||||||
ok(!$obj->$method(), "Diskstats->clear_ts does as advertized");
|
ok(!$obj->$method(), "Diskstats->clear_ts does as advertized");
|
||||||
}
|
}
|
||||||
|
|
||||||
is($obj->out_fh(), \*STDOUT, "by default, outputs to STDOUT");
|
# ############################################################################
|
||||||
|
# output_fh
|
||||||
|
# ############################################################################
|
||||||
|
|
||||||
|
is($obj->output_fh(), \*STDOUT, "by default, outputs to STDOUT");
|
||||||
|
|
||||||
open my $fh, "<", \my $tmp;
|
open my $fh, "<", \my $tmp;
|
||||||
$obj->set_out_fh($fh);
|
$obj->set_output_fh($fh);
|
||||||
is($obj->out_fh(), $fh, "Changing it works");
|
is($obj->output_fh(), $fh, "Changing it works");
|
||||||
|
|
||||||
close($fh);
|
close($fh);
|
||||||
is($obj->out_fh(), \*STDOUT, "and if we close the set filehandle, it reverts to STDOUT");
|
is(
|
||||||
|
$obj->output_fh(),
|
||||||
|
\*STDOUT,
|
||||||
|
"and if we close the set filehandle, it reverts to STDOUT"
|
||||||
|
);
|
||||||
|
|
||||||
|
# ############################################################################
|
||||||
|
# Adding, removing and listing devices.
|
||||||
|
# ############################################################################
|
||||||
is_deeply(
|
is_deeply(
|
||||||
[ $obj->ordered_devs() ],
|
[ $obj->ordered_devs() ],
|
||||||
[],
|
[],
|
||||||
@@ -221,6 +301,9 @@ is_deeply(
|
|||||||
"...And clears the internal duplicate-checking list"
|
"...And clears the internal duplicate-checking list"
|
||||||
);
|
);
|
||||||
|
|
||||||
|
# ############################################################################
|
||||||
|
# zero_rows -- That is, whenever it prints inactive devices.
|
||||||
|
# ############################################################################
|
||||||
$obj->set_zero_rows(0);
|
$obj->set_zero_rows(0);
|
||||||
my $print_output = output(
|
my $print_output = output(
|
||||||
sub {
|
sub {
|
||||||
@@ -239,6 +322,9 @@ is(
|
|||||||
"->zero_rows works"
|
"->zero_rows works"
|
||||||
);
|
);
|
||||||
|
|
||||||
|
# ############################################################################
|
||||||
|
# Sane defaults and fatal errors
|
||||||
|
# ############################################################################
|
||||||
for my $method ( qw( delta_against delta_against_ts group_by ) ) {
|
for my $method ( qw( delta_against delta_against_ts group_by ) ) {
|
||||||
throws_ok(
|
throws_ok(
|
||||||
sub { Diskstats->$method() },
|
sub { Diskstats->$method() },
|
||||||
@@ -262,7 +348,7 @@ is(
|
|||||||
);
|
);
|
||||||
|
|
||||||
my $output = output(
|
my $output = output(
|
||||||
sub { $obj->parse_from_data( "ASMFHNASJNFASKLFLKHNSKD" ); },
|
sub { $obj->parse_from( data => "ASMFHNASJNFASKLFLKHNSKD" ); },
|
||||||
stderr => 1,
|
stderr => 1,
|
||||||
);
|
);
|
||||||
|
|
||||||
@@ -272,30 +358,137 @@ like(
|
|||||||
"->parse_from and friends fail on malformed data"
|
"->parse_from and friends fail on malformed data"
|
||||||
);
|
);
|
||||||
|
|
||||||
|
# ############################################################################
|
||||||
|
# _calc* methods
|
||||||
|
# ############################################################################
|
||||||
|
|
||||||
|
$obj->clear_state();
|
||||||
|
|
||||||
|
my $prev = {
|
||||||
|
TS => 1281367519,
|
||||||
|
data => ($obj->parse_diskstats_line(
|
||||||
|
"104 0 cciss/c0d0 2139885 162788 37361471 8034486 17999682 83425310 811400340 12711047 0 6869437 20744582", $obj->block_size))[1]
|
||||||
|
};
|
||||||
|
my $curr = {
|
||||||
|
TS => 1281367521,
|
||||||
|
data => ($obj->parse_diskstats_line(
|
||||||
|
"104 0 cciss/c0d0 2139886 162790 37361478 8034489 17999738 83425580 811402798 12711097 3 6869449 20744632", $obj->block_size))[1]
|
||||||
|
};
|
||||||
|
|
||||||
|
$obj->first_ts( $prev->{TS} );
|
||||||
|
$obj->prev_ts( $prev->{TS} );
|
||||||
|
$obj->curr_ts( $curr->{TS} );
|
||||||
|
|
||||||
|
my $deltas = $obj->_calc_delta_for($curr->{data}, $prev->{data});
|
||||||
|
|
||||||
|
is_deeply(
|
||||||
|
$deltas,
|
||||||
|
{
|
||||||
|
ms_spent_doing_io => 12,
|
||||||
|
ms_spent_reading => 3,
|
||||||
|
ms_spent_writing => 50,
|
||||||
|
ms_weighted => 50,
|
||||||
|
read_kbs => 3.5,
|
||||||
|
read_sectors => 7,
|
||||||
|
reads => 1,
|
||||||
|
reads_merged => 2,
|
||||||
|
writes => 56,
|
||||||
|
writes_merged => 270,
|
||||||
|
written_kbs => 1229,
|
||||||
|
written_sectors => 2458,
|
||||||
|
},
|
||||||
|
"_calc_delta_for works"
|
||||||
|
);
|
||||||
|
|
||||||
|
local $EVAL_ERROR;
|
||||||
|
eval { $obj->_calc_delta_for($curr->{data}, []) };
|
||||||
|
ok(!$EVAL_ERROR, "_calc_delta_for guards against undefined values");
|
||||||
|
|
||||||
|
my %read_stats = $obj->_calc_read_stats(
|
||||||
|
delta_for => $deltas,
|
||||||
|
elapsed => $curr->{TS} - $prev->{TS},
|
||||||
|
devs_in_group => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
is_deeply(
|
||||||
|
\%read_stats,
|
||||||
|
{
|
||||||
|
avg_read_sz => '3.5',
|
||||||
|
ios_read_sec => '0.003',
|
||||||
|
mbytes_read_sec => '0.001708984375',
|
||||||
|
read_conc => '0.0015',
|
||||||
|
read_merge_pct => '66.6666666666667',
|
||||||
|
read_requests => 3,
|
||||||
|
read_rtime => '3',
|
||||||
|
reads_sec => '0.5'
|
||||||
|
},
|
||||||
|
"_calc_read_stats works"
|
||||||
|
);
|
||||||
|
|
||||||
|
my %write_stats = $obj->_calc_write_stats(
|
||||||
|
delta_for => $deltas,
|
||||||
|
elapsed => $curr->{TS} - $prev->{TS},
|
||||||
|
devs_in_group => 1,
|
||||||
|
);
|
||||||
|
|
||||||
|
is_deeply(
|
||||||
|
\%write_stats,
|
||||||
|
{
|
||||||
|
avg_write_sz => '21.9464285714286',
|
||||||
|
ios_written_sec => '0.05',
|
||||||
|
mbytes_written_sec => '0.60009765625',
|
||||||
|
write_conc => '0.025',
|
||||||
|
write_merge_pct => '82.8220858895706',
|
||||||
|
write_requests => 326,
|
||||||
|
write_rtime => '0.892857142857143',
|
||||||
|
writes_sec => '28',
|
||||||
|
},
|
||||||
|
"_calc_write_stats works"
|
||||||
|
);
|
||||||
|
|
||||||
|
my %misc_stats = $obj->_calc_misc_stats(
|
||||||
|
delta_for => $deltas,
|
||||||
|
elapsed => $curr->{TS} - $prev->{TS},
|
||||||
|
devs_in_group => 1,
|
||||||
|
stats => { %write_stats, %read_stats },
|
||||||
|
);
|
||||||
|
|
||||||
|
is_deeply(
|
||||||
|
\%misc_stats,
|
||||||
|
{
|
||||||
|
busy => '0.6',
|
||||||
|
line_ts => ' 0.0',
|
||||||
|
qtime => 0,
|
||||||
|
s_spent_doing_io => '0.053',
|
||||||
|
stime => 0,
|
||||||
|
},
|
||||||
|
"_calc_misc_stats works"
|
||||||
|
);
|
||||||
|
|
||||||
|
$obj->clear_state();
|
||||||
|
|
||||||
}
|
}
|
||||||
# Common tests for all three subclasses
|
# ############################################################################
|
||||||
my $o = bless {}, "FakeParser";
|
# The three subclasses
|
||||||
|
# ############################################################################
|
||||||
for my $test (
|
for my $test (
|
||||||
{
|
{
|
||||||
class => "DiskstatsGroupByAll",
|
class => "DiskstatsGroupByAll",
|
||||||
method => "group_by_all",
|
|
||||||
results_file_prefix => "all",
|
results_file_prefix => "all",
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
class => "DiskstatsGroupByDisk",
|
class => "DiskstatsGroupByDisk",
|
||||||
method => "group_by_disk",
|
|
||||||
results_file_prefix => "disk",
|
results_file_prefix => "disk",
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
class => "DiskstatsGroupBySample",
|
class => "DiskstatsGroupBySample",
|
||||||
method => "group_by_sample",
|
|
||||||
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, zero_rows => 1);
|
||||||
my $method = $test->{method};
|
|
||||||
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);
|
||||||
|
|
||||||
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 );
|
||||||
@@ -305,54 +498,31 @@ for my $test (
|
|||||||
|
|
||||||
my $got = output(
|
my $got = output(
|
||||||
sub {
|
sub {
|
||||||
$obj->$method(
|
$obj->group_by(
|
||||||
filename => $file_with_trunk,
|
filename => $file_with_trunk,
|
||||||
);
|
);
|
||||||
});
|
});
|
||||||
|
|
||||||
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, "group_by $prefix: $filename via filename");
|
||||||
|
|
||||||
$got = output(
|
$got = output(
|
||||||
sub {
|
sub {
|
||||||
open my $fh, "<", $file_with_trunk or die $!;
|
open my $fh, "<", $file_with_trunk or die $!;
|
||||||
$obj->$method(
|
$obj->group_by(
|
||||||
filehandle => $fh,
|
filehandle => $fh,
|
||||||
);
|
);
|
||||||
});
|
});
|
||||||
|
|
||||||
is($got, $expected, "$method: $filename via filehandle");
|
is($got, $expected, "group_by $prefix: $filename via filehandle");
|
||||||
|
|
||||||
$got = output(
|
$got = output(
|
||||||
sub {
|
sub {
|
||||||
$obj->$method(
|
$obj->group_by(
|
||||||
data => load_file( $file ),
|
|
||||||
);
|
|
||||||
});
|
|
||||||
|
|
||||||
is($got, $expected, "$method: $filename via data");
|
|
||||||
|
|
||||||
$got = output(
|
|
||||||
sub {
|
|
||||||
$obj->$method(
|
|
||||||
data => "TS 1298130002.073935000\n" . load_file( $file ),
|
data => "TS 1298130002.073935000\n" . load_file( $file ),
|
||||||
);
|
);
|
||||||
});
|
});
|
||||||
|
|
||||||
is($got, $expected, "$method: $filename with an extra TS at the top");
|
is($got, $expected, "group_by $prefix: $filename with an extra TS at the top");
|
||||||
|
|
||||||
$obj->set_filename( $file_with_trunk );
|
|
||||||
$got = output(
|
|
||||||
sub {
|
|
||||||
$obj->$method();
|
|
||||||
});
|
|
||||||
|
|
||||||
is($got, $expected, "$method: $filename via obj->filename()");
|
|
||||||
}
|
}
|
||||||
|
|
||||||
my $data = <<'EOF';
|
my $data = <<'EOF';
|
||||||
@@ -361,16 +531,12 @@ TS 1297205887.156653000
|
|||||||
TS 1297205888.161613000
|
TS 1297205888.161613000
|
||||||
EOF
|
EOF
|
||||||
|
|
||||||
{
|
my $got = output( sub { $obj->group_by(data => $data) }, stderr => 1 );
|
||||||
local $TODO = "Group by all works a bit differently. Probably worth it to make all three consistent, eventually" if ($prefix eq "all");
|
is(
|
||||||
local $EVAL_ERROR;
|
$got,
|
||||||
my $got = output( sub { $obj->$method(data => $data) }, stderr => 1 );
|
'',
|
||||||
like(
|
"group_by $prefix: 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->set_curr_ts(0);
|
$obj->set_curr_ts(0);
|
||||||
$obj->set_prev_ts(0);
|
$obj->set_prev_ts(0);
|
||||||
@@ -378,7 +544,18 @@ EOF
|
|||||||
|
|
||||||
throws_ok(
|
throws_ok(
|
||||||
sub { $obj->_calc_deltas() },
|
sub { $obj->_calc_deltas() },
|
||||||
qr/Time elapsed is/,
|
qr/Time between samples should be > 0, is /,
|
||||||
"$test->{class}, ->_calc_deltas fails if the time elapsed is 0"
|
"$test->{class}, ->_calc_deltas fails if the time elapsed is 0"
|
||||||
);
|
);
|
||||||
|
|
||||||
|
$obj->set_curr_ts(0);
|
||||||
|
$obj->set_prev_ts(4);
|
||||||
|
$obj->set_first_ts(4);
|
||||||
|
|
||||||
|
throws_ok(
|
||||||
|
sub { $obj->_calc_deltas() },
|
||||||
|
qr/Time between samples should be > 0, is /,
|
||||||
|
"$test->{class}, ->_calc_deltas fails if the time elapsed is negative"
|
||||||
|
);
|
||||||
|
|
||||||
}
|
}
|
||||||
|
@@ -31,15 +31,16 @@ my $out = output( sub {
|
|||||||
);
|
);
|
||||||
});
|
});
|
||||||
|
|
||||||
sub FakeParser::get {}
|
my $o = new OptionParser(description => 'Diskstats');
|
||||||
|
$o->get_specs("$trunk/bin/pt-diskstats");
|
||||||
|
|
||||||
my $count = 0;
|
my $count = 0;
|
||||||
Diskstats->new(
|
Diskstats->new(
|
||||||
OptionParser => bless {}, "FakeParser"
|
OptionParser => $o,
|
||||||
)->parse_from_filename( $tempfile, sub { $count++ } );
|
)->parse_from( filename => $tempfile, sample_callback => sub { $count++ } );
|
||||||
|
|
||||||
is(
|
is(
|
||||||
$count-1,
|
$count,
|
||||||
$iterations,
|
$iterations,
|
||||||
"--save-samples and --iterations work"
|
"--save-samples and --iterations work"
|
||||||
);
|
);
|
||||||
|
Reference in New Issue
Block a user