Work in progress v3: Working interactive mode, initial documentation.

With this most of the interactive mode should be working.

pt_diskstats.pm has the documentation and can be used for testing,
which should be in the next commit.

This commit also includes the revamped command line options.

lib/Diskstats.pm

@@ -19,12 +19,13 @@
 # ###########################################################################
 {
 # Package: Diskstats
-#
+# This package implements most of the logic in the old shell pt-diskstats;
+# it parses data from /proc/diskstats, calculcates deltas, and prints those.
 
 package Diskstats;
 
-use warnings;
 use strict;
+use warnings FATAL => 'all';
 use English qw(-no_match_vars);
 use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
@@ -41,9 +42,9 @@ BEGIN {
       Storable->import(qw(dclone));
    }
    else {
-      # An extrenely poor man's dclone.
       require Scalar::Util;
 
+      # An extrenely poor man's dclone.
       # Nevermind the prototype. dclone has it, so it's here only it for
       # the sake of completeness.
       *dclone = sub ($) {
@@ -65,23 +66,31 @@ sub new {
    my ( $class, %args ) = @_;
 
    my $self = {
+      # Defaults
       filename           => '/proc/diskstats',
       column_regex       => qr/cnc|rt|mb|busy|prg/,
       device_regex       => qr/(?=)/,
       block_size         => 512,
       out_fh             => \*STDOUT,
       filter_zeroed_rows => 0,
-      samples_to_gather  => 0,
+      sample_time        => 0,
-      interval           => 0,
       interactive        => 0,
-      %args,
+
       _stats_for         => {},
       _sorted_devs       => [],
       _ts                => {},
-      _save_curr_as_prev => 1,    # Internal for now
       _first             => 1,
+
+      # Internal for now, but might need APIfying.
+      _save_curr_as_prev => 1,
+      _print_header      => 1,
    };
 
+   # 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;
 }
 
@@ -110,14 +119,25 @@ sub first_ts {
 
 sub filter_zeroed_rows {
    my ($self, $new_val) = @_;
-   if ( $new_val ) {
+   if ( defined($new_val) ) {
       $self->{filter_zeroed_rows} = $new_val;
    }
    return $self->{filter_zeroed_rows};
 }
 
+sub sample_time {
+   my ($self, $new_val) = @_;
+   if (defined($new_val)) {
+      $self->{sample_time} = $new_val;
+   }
+   return $self->{sample_time};
+}
+
 sub interactive {
-   my ($self) = @_;
+   my ($self, $new_val) = @_;
+   if (defined($new_val)) {
+      $self->{interactive} = $new_val;
+   }
    return $self->{interactive};
 }
 
@@ -151,7 +171,7 @@ sub device_regex {
 
 sub filename {
    my ( $self, $new_filename ) = @_;
-   if ($new_filename) {
+   if ( defined $new_filename ) {
       return $self->{filename} = $new_filename;
    }
    return $self->{filename} || '/proc/diskstats';
@@ -183,6 +203,7 @@ sub add_sorted_devs {
 sub clear_state {
    my ($self) = @_;
    $self->{_first} = 1;
+   $self->{_print_header} = 1;
    $self->clear_current_stats();
    $self->clear_previous_stats();
    $self->clear_first_stats();
@@ -259,6 +280,36 @@ sub has_stats {
      && scalar grep 1, @{ $self->stats_for }{ $self->sorted_devs };
 }
 
+sub _save_current_as_previous {
+   my ( $self, $curr_hashref ) = @_;
+
+   if ( $self->{_save_curr_as_prev} ) {
+      $self->{_previous_stats_for} = $curr_hashref;
+      for my $dev (keys %$curr_hashref) {
+         $self->{_previous_stats_for}->{$dev}->{sum_ios_in_progress} +=
+            $curr_hashref->{$dev}->{ios_in_progress};
+      }
+      $self->previous_ts($self->current_ts());
+   }
+
+   return;
+}
+
+sub _save_current_as_first {
+   my ($self, $curr_hashref) = @_;
+
+   if ( $self->{_first} ) {
+      $self->{_first_stats_for} = $curr_hashref;
+      $self->first_ts($self->current_ts());
+      $self->{_first} = undef;
+   }
+}
+
+sub _save_stats {
+   my ( $self, $hashref ) = @_;
+   $self->{_stats_for} = $hashref;
+}
+
 sub trim {
    my ($c) = @_;
    $c =~ s/^\s+//;
@@ -409,36 +460,6 @@ sub parse_diskstats_line {
    }
 }
 
-sub _save_current_as_previous {
-   my ( $self, $curr_hashref ) = @_;
-
-   if ( $self->{_save_curr_as_prev} ) {
-      $self->{_previous_stats_for} = $curr_hashref;
-      for my $dev (keys %$curr_hashref) {
-         $self->{_previous_stats_for}->{$dev}->{sum_ios_in_progress} +=
-            $curr_hashref->{$dev}->{ios_in_progress};
-      }
-      $self->previous_ts($self->current_ts());
-   }
-
-   return;
-}
-
-sub _save_current_as_first {
-   my ($self, $curr_hashref) = @_;
-
-   if ( $self->{_first} ) {
-      $self->{_first_stats_for} = $curr_hashref;
-      $self->first_ts($self->current_ts());
-      $self->{_first} = undef;
-   }
-}
-
-sub _save_stats {
-   my ( $self, $hashref ) = @_;
-   $self->{_stats_for} = $hashref;
-}
-
 # Method: parse_from()
 #   Parses data from one of the sources.
 #
@@ -475,6 +496,7 @@ sub parse_from_filename {
 
    return $lines_read;
 }
+
 # Method: parse_from_filehandle()
 #   Parses data received from using readline() on the filehandle. This is
 #   particularly useful, as you could pass in a filehandle to a pipe, or
@@ -509,9 +531,7 @@ sub parse_from_data {
 
 sub _load {
    my ( $self, $fh, $sample_callback ) = @_;
-   my $lines_read = 0;
    my $block_size = $self->block_size;
-
    my $new_cur    = {};
 
    while ( my $line = <$fh> ) {
@@ -527,13 +547,9 @@ sub _load {
             $self->_save_current_as_first( dclone($self->stats_for) );
             $new_cur = {};
          }
-         # XXX TODO Ugly hack for interactive mode
-         my $ret = 0;
          if ($sample_callback) {
-            $ret = $self->$sample_callback($ts);
+            $self->$sample_callback($ts);
          }
-         $lines_read = $NR;
-         last if $ret;
       }
       else {
          chomp($line);
@@ -545,7 +561,8 @@ sub _load {
       #$self->_save_stats($new_cur);
       $self->_save_current_as_first( dclone($self->stats_for) );
    }
-   return $lines_read;
+   # Seems like this could be useful.
+   return $INPUT_LINE_NUMBER;
 }
 
 sub _calc_read_stats {
@@ -698,15 +715,17 @@ sub _calc_deltas {
 
 sub print_header {
    my ($self, $header, @args) = @_;
+   if ( $self->{_print_header} ) {
       printf { $self->out_fh } $header . "\n", @args;
    }
+}
 
 sub print_rest {
    my ($self, $format, $cols, $stat) = @_;
-   if ( $self->filter_zeroed_rows ) {
+   if ( $self->filter_zeroed_rows() ) {
-      return unless grep $_, @{$stat}{ @$cols };
+      return unless grep { sprintf("%7.1f", $_) != 0 } @{$stat}{ grep { $self->col_ok($_) } @$cols };
    }
-   printf { $self->out_fh } $format . "\n",
+   printf { $self->out_fh() } $format . "\n",
            @{$stat}{ qw( line_ts dev ), @$cols };
 }
 

lib/DiskstatsGroupByAll.pm

@@ -38,7 +38,9 @@ sub group_by {
 sub group_by_all {
    my ($self, %args) = @_;
 
+   if ( !$args{clear_state} ) {
       $self->clear_state();
+   }
 
    if (!$self->interactive) {
       $self->parse_from(
@@ -49,25 +51,43 @@ sub group_by_all {
             },
          map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
       );
-
-      $self->clear_state();
    }
    else {
       my $orig = tell $args{filehandle};
       $self->parse_from(
          sample_callback => sub {
                $self->print_deltas(
-                  header_cb => sub { CORE::state $x = 0; my $self = shift; $self->print_header(@_) unless $x++;  },
+                  header_cb => sub {
+                     my $self = shift;
+                     if ( $self->{_print_header} ) {
+                        my $meth = $args{header_cb} || "print_header";
+                        $self->$meth(@_);
+                     }
+                     $self->{_print_header} = undef;
+                  },
+                  rest_cb => $args{rest_cb},
                );
-                  #map { ( $_ => $args{$_} ) } qw( header_cb rest_cb ),
             },
          map( { ($_ => $args{$_}) } qw(filehandle filename data) ),
       );
       if (!$self->previous_ts) {
          seek $args{filehandle}, $orig, 0;
       }
+      return;
+   }
    $self->clear_state();
 }
+
+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 {

lib/DiskstatsGroupByDisk.pm

@@ -65,7 +65,7 @@ sub group_by_disk {
                my $elapsed =
                      ( $self->current_ts() || 0 ) -
                      ( $self->first_ts() || 0 );
-               if ( $ts > 0 && $elapsed >= $self->{interval} ) {
+               if ( $ts > 0 && $elapsed >= $self->sample_time() ) {
                   $self->print_deltas(
                      header_cb => sub {
                         my ($self, @args) = @_;
@@ -109,8 +109,10 @@ sub group_by_disk {
 
 sub clear_state {
    my ($self, @args)   = @_;
+   my $orig_print_h = $self->{_print_header};
    $self->{_iterations} = 0;
    $self->SUPER::clear_state(@args);
+   $self->{_print_header} = $orig_print_h;
 }
 
 sub compute_line_ts {

lib/DiskstatsGroupBySample.pm

@@ -50,16 +50,19 @@ sub group_by_sample {
    my ( $self,      %args )    = @_;
    my ( $header_cb, $rest_cb ) = $args{qw( header_cb rest_cb )};
 
+   if (!$self->interactive) {
       $self->clear_state;
+   }
 
    $self->parse_from(
-      sample_callback =>
+      sample_callback => $self->can("_sample_callback"),
-        sub { my ( $self, $ts ) = @_; $self->_sample_callback( $ts, %args ) },
       map( { ( $_ => $args{$_} ) } qw(filehandle filename data) ),
    );
 
+   if (!$self->interactive) {
       $self->clear_state;
    }
+}
 
 sub _sample_callback {
    my ( $self, $ts, %args ) = @_;
@@ -73,31 +76,23 @@ sub _sample_callback {
      ( $self->current_ts() || 0 ) -
      ( $self->previous_ts() || 0 );
 
-   if ( $ts > 0 && $elapsed >= $self->{interval} ) {
+   if ( $ts > 0 && $elapsed >= $self->sample_time() ) {
 
       $self->print_deltas(
          max_device_length => 6,
          header_cb         => sub {
             my ( $self, $header, @args ) = @_;
+
             if ( $self->{_print_header} ) {
-               $self->{_print_header} = 0;
+               my $method = $args{header_cb} || "print_header";
-               if ( my $cb = $args{header_cb} ) {
+               $self->$method( $header, @args );
-                  $self->$cb( $header, @args );
+               $self->{_print_header} = undef;
-               }
-               else {
-                  printf { $self->out_fh } $header . "\n", @args;
-               }
             }
          },
          rest_cb => sub {
             my ( $self, $format, $cols, $stat ) = @_;
-            if ( my $callback = $args{rest_cb} ) {
+            my $method = $args{rest_cb} || "print_rest";
-               $self->$callback( $format, $cols, $stat );
+            $self->$method( $format, $cols, $stat );
-            }
-            else {
-               printf { $self->out_fh } $format . "\n",
-                 @{$stat}{ qw( line_ts dev ), @$cols };
-            }
             $printed_a_line = 1;
          }
       );
@@ -129,7 +124,10 @@ sub clear_state {
 
 sub compute_devs_in_group {
    my ($self) = @_;
-   return scalar grep 1, @{ $self->stats_for }{ $self->sorted_devs };
+   return scalar grep {
+            # Got stats for that device, and we want to print it
+            $self->stats_for($_) && $self->dev_ok($_)
+         } $self->sorted_devs;
 }
 
 sub compute_dev {
@@ -159,7 +157,7 @@ sub _calc_stats_for_deltas {
    my $in_progress = $delta_for->{ios_in_progress}; #$curr->{"ios_in_progress"};
    my $tot_in_progress = 0;    #$against->{"sum_ios_in_progress"} || 0;
 
-   my $devs_in_group = $self->compute_devs_in_group;
+   my $devs_in_group = $self->compute_devs_in_group() || 1;
 
    my %stats = (
       $self->_calc_read_stats( $delta_for, $elapsed, $devs_in_group ),

lib/DiskstatsMenu.pm

@@ -22,8 +22,8 @@ package DiskstatsMenu;
 
 # DiskstatsMenu
 
-use warnings;
 use strict;
+use warnings FATAL => 'all';
 use English qw(-no_match_vars);
 use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
@@ -31,14 +31,13 @@ use re qw( regexp_pattern );
 
 use IO::Handle;
 use IO::Select;
-use Scalar::Util qw( looks_like_number );
+use Scalar::Util qw( looks_like_number blessed );
-use File::Temp   qw( tempfile tempdir  );
 
 use ReadKeyMini  qw( ReadMode );
 
-use DiskstatsGroupByAll;
+require DiskstatsGroupByAll;
-use DiskstatsGroupByDisk;
+require DiskstatsGroupByDisk;
-use DiskstatsGroupBySample;
+require DiskstatsGroupBySample;
 
 our $VERSION = '0.01';
 
@@ -46,40 +45,66 @@ my %actions = (
    'A' => \&group_by,
    'D' => \&group_by,
    'S' => \&group_by,
-   's' => \&get_new_interval,
+   'i' => \&hide_inactive_disks,
-   'c' => get_new_x_regex("column_re", "Enter a column pattern: "),
+   'd' => get_new_value_for( "redisplay_interval", "Enter a new redisplay interval in seconds: " ),
-   'd' => get_new_x_regex("disk_re", "Enter a disk/device pattern: "),
+   'z' => get_new_value_for( "interval", "Enter a new interval between samples in seconds: " ),
+   'c' => get_new_x_regex( "column_regex", "Enter a column pattern: " ),
+   '/' => get_new_x_regex( "device_regex", "Enter a disk/device pattern: " ),
    'q' => sub { return 'last' },
    'p' => \&pause,
    '?' => \&help,
 );
 
-sub run {
+my %option_to_object = (
+      D  => "DiskstatsGroupByDisk",
+      A  => "DiskstatsGroupByAll",
+      S  => "DiskstatsGroupBySample",
+   );
+
+my %object_to_option = reverse %option_to_object;
+
+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 %opts = (
-      keep_file         => undef,
+      save_samples       => $o->get('save-samples') || undef,
-      samples_to_gather => undef,
+      samples_to_gather  => $o->get('iterations')   || undef,
-      sample_interval   => 3,
+      sampling_interval  => $o->get('interval')     || 1,
-      interval          => 0.5,
+      display_interval   => 1,
-      device_regex      => qr/sda/,
+      sample_time        => $o->get('sample-time')  || 1,
+      column_regex       => $o->get('columns')      || undef,
+      device_regex       => $o->get('devices')      || undef,
       interactive        => 1,
+      filter_zeroed_rows => 0,
    );
 
-   my $dir = tempdir( CLEANUP => 1 );
+   my ($tmp_fh, $filename, $child_pid, $child_fh);
-   my ($tmp_fh, $filename) = tempfile(
-                           "diskstats-samples.XXXXXXXX",
-                           DIR      => $dir,
-                           UNLINK   => 1,
-                           OPEN     => 1,
-                        );
-   my $pid = open my $child_fh, "|-";
 
-   if (not defined $pid) {
+   # 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";
+   }
+   else {
+      ($tmp_fh, $filename) = file_to_use( $opts{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";
       }
       
-   if ( !$pid ) {
+      if ( !$child_pid ) {
          # Child
    
          # Bit of helpful magic: Changes how the program's name is displayed,
@@ -90,40 +115,42 @@ sub run {
    
          open my $fh, ">>", $filename or die $!;
    
-      while ( getppid() ) {
+         gather_samples(
-         sleep($opts{sample_interval});
+               gather_while      => sub { getppid() },
-         open my $diskstats_fh, "<", "/proc/diskstats"
+               samples_to_gather => $opts{samples_to_gather},
-               or die $!;
+               sampling_interval => $opts{sampling_interval},
+               filehandle        => $fh,
+         );
    
-         my @to_print = <$diskstats_fh>;
-         push @to_print, `date +'TS %s.%N %F %T'`;
-
-         # Lovely little method from IO::Handle: turns on autoflush,
-         # prints, and then restores the original autoflush state.
-         $fh->printflush(@to_print);
-
-         close $diskstats_fh or die $!;
-      }
          close $fh or die $!;
-      unlink $filename unless $opts{keep_file};
+         unlink $filename unless $opts{save_samples};
          exit(0);
       }
+   }
+
+   local $SIG{CHLD} = 'IGNORE';
 
    STDOUT->autoflush;
    STDIN->blocking(0);
 
    my $sel    = IO::Select->new(\*STDIN);
+   my $class  = $option_to_object{ substr uc($o->get('group-by') || 'Disk'), 0, 1 };
+   $opts{obj} = $class->new( %opts );
 
-   my $lines_read = 0;
+   if ( $args{filename} ) {
-
+      group_by(
-   $opts{obj} = DiskstatsGroupByDisk->new(%opts);
+         select_obj => $sel,
+         options    => \%opts,
+         filehandle => $tmp_fh,
+         got        => substr(uc($o->get('group-by') || 'Disk'), 0, 1),
+      );
+   }
 
    ReadKeyMini::cbreak();
-   warn $filename;
    MAIN_LOOP:
    while (1) {
-      if ( $sel->can_read( $opts{interval} ) ) {
+      if ( $sel->can_read( $opts{display_interval} ) ) {
-         while (my $got = <STDIN>) { # Should probably be sysread
+         while ( my $got = <STDIN> ) {
             if ($actions{$got}) {
                my $ret = $actions{$got}->(
                                  select_obj => $sel,
@@ -135,36 +162,153 @@ sub run {
             }
          }
       }
-      $lines_read += $opts{obj}->group_by( filehandle => $tmp_fh ) || 0;
+      # As a possible source of confusion, note that this calls the group_by
-      $tmp_fh->clearerr if eof $tmp_fh;
+      # _method_ in DiskstatsGroupBySomething, not the group_by _function_
+      # defined below.
+      $opts{obj}->group_by( filehandle => $tmp_fh, clear_state => 0 ) || 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 ) {
+            last MAIN_LOOP;
+         }
+
+         # This one comes from IO::Handle. I clears the eof flag
+         # from a filehandle, so we can try reading from it again.
+         $tmp_fh->clearerr;
+      }
    }
    ReadKeyMini::cooked();
-   kill 9, $pid;
+
-   close($tmp_fh);
+   if ( !$args{filename} ) {
+      close( $child_fh ) or die "Child error: $?";
+      kill 9, $child_pid;
+   }
+   close($tmp_fh) or die "Couldn't close: $OS_ERROR";
    return;
 }
 
-{
+sub gather_samples {
-   my %objects = (
+   my (%opts) = @_;
-         D  => "DiskstatsGroupByDisk",
+   my $samples = 0;
-         A  => "DiskstatsGroupByAll",
+
-         S  => "DiskstatsGroupBySample",
+   GATHER_DATA:
-      );
+   while ( $opts{gather_while}->() ) {
+      sleep($opts{sampling_interval});
+      open my $diskstats_fh, "<", "/proc/diskstats"
+            or die $!;
+
+      my @to_print = <$diskstats_fh>;
+      push @to_print, `date +'TS %s.%N %F %T'`;
+
+      # 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 $!;
+
+      $samples++;
+      if ( defined($opts{samples_to_gather}) && $samples >= $opts{samples_to_gather} ) {
+         last GATHER_DATA;
+      }
+   }
+   return;
+}
 
 sub group_by {
    my (%args) = @_;
 
    my $got = $args{got};
 
-      if ( ref( $args{options}->{obj} ) ne $objects{$got} ) {
+   if ( ref( $args{options}->{obj} ) ne $option_to_object{$got} ) {
+      # 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} = $objects{$got}->new( %{$args{options}} );
+      $args{options}->{obj} = $option_to_object{$got}->new( %{$args{options}});
    }
    seek $args{filehandle}, 0, 0;
+
+   # Just aliasing this for a bit.
+   for my $obj ( $args{options}->{obj} ) {
+      if ( $option_to_object{$got} eq "DiskstatsGroupBySample" ) {
+         $obj->interactive(1);
+      }
+      else {
+         $obj->interactive(0);
+      }
+      $obj->group_by(
+               filehandle => $args{filehandle},
+               # Only print the header once, as if in interactive.
+               header_cb => sub {
+                     my $print_header;
+                     return sub {
+                        unless ($print_header++) {
+                           shift->print_header(@_)
+                        }
+                     };
+                  }->(),
+               );
+      $obj->interactive(1);
+      $obj->{_print_header} = 0;
+   }
 }
 
+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 $interval    = $obj->interval() || '(none)';
+   my $disp_int    = $args{options}->{display_interval} || '(none)';
+   my $inact_disk  = $obj->filter_zeroed_rows() || '';
+
+   for my $re ( $column_re, $device_re ) {
+      $re =~ s/^\Q(?=)\E$//;
+      $re ||= '(none)';
+   }
+
+   print <<"HELP";
+   You can control this program by key presses:
+   ------------------- Key ------------------- ---- Current Setting ----
+   A, D, S) Set the group-by mode              $mode
+   c) Enter a Perl regex to match column names $column_re
+   /) Enter a Perl regex to match disk names   $device_re
+   z) Set the sample size in seconds           $interval
+   i) Hide/show inactive disks                 $inact_disk
+   d) Set the redisplay interval in seconds    $disp_int
+   p) Pause the program
+   q) Quit the program
+   ------------------- Press any key to continue -----------------------
+HELP
+   pause(@_);
+}
+
+sub file_to_use {
+   my ( $filename ) = @_;
+   #$filename ||= `mktemp -d /tmp/pt-diskstats.$PID.XXXXXXXX`;
+   if ( $filename ) {
+      open my $fh, "<", $filename
+         or die "Couldn't 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. Please install either of those or pass in an explicit filename.";
+      }
+      my $dir = File::Temp::tempdir( CLEANUP => 1 );
+      return File::Temp::tempfile(
+                     "pt-diskstats.$PID.XXXXXXXX",
+                     DIR      => $dir,
+                     UNLINK   => 1,
+                     OPEN     => 1,
+                  );
+   }
 }
 
 sub get_input {
@@ -181,18 +325,33 @@ sub get_input {
    return $new_opt;
 }
 
-sub get_new_interval {
+sub hide_inactive_disks {
    my (%args)       = @_;
-   my $new_interval = get_input("Enter a redisplay interval: ");
+   my $new_val = get_input("Filter inactive rows? (Leave blank for 'No') ");
+
+   $args{options}->{filter_zeroed_rows} = $new_val;
+   $args{options}->{obj}->filter_zeroed_rows($new_val);
+   return;
+}
+
+sub get_new_value_for {
+   my ($looking_for, $message) = @_;
+   return sub {
+      my (%args)       = @_;
+      my $new_interval = get_input($message);
    
       $new_interval ||= 0;
    
       if ( looks_like_number($new_interval) ) {
-      return $args{options}->{interval} = $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");
       }
+   };
 }
 
 sub get_new_x_regex {
@@ -201,6 +360,7 @@ sub get_new_x_regex {
       my (%args)   = @_;
       my $new_regex = get_input($message);
    
+      local $EVAL_ERROR;
       if ( $new_regex && (my $re = eval { qr/$new_regex/i }) ) {
          $args{options}->{$looking_for} = $re;
       }
@@ -214,26 +374,10 @@ sub get_new_x_regex {
       else {
          die("invalid regex specification: $EVAL_ERROR");
       }
+      $args{options}->{obj}->$looking_for( $args{options}->{$looking_for} );
    };
 }
 
-sub help {
-   # XXX: TODO
-   print <<'HELP';
-   You can control this program by key presses:
-   ------------------- Key ------------------- ---- Current Setting ----
-   A, D, S) Set the group-by mode              \$opt{OPT_g}
-   c) Enter an awk regex to match column names \$opt{OPT_c}
-   d) Enter an awk regex to match disk names   \$opt{OPT_d}
-   i) Set the sample size in seconds           \$opt{OPT_i}
-   s) Set the redisplay interval in seconds    \$opt{OPT_s}
-   p) Pause the program
-   q) Quit the program
-   ------------------- Press any key to continue -----------------------
-HELP
-   pause(@_);
-}
-
 sub pause {
    my (%args) = @_;
    STDIN->blocking(1);
@@ -244,8 +388,8 @@ sub pause {
 }
 
 1;
-
+#XXX TODO
-__PACKAGE__->run(@ARGV) unless caller;
+#__PACKAGE__->run_interactive(@ARGV, o => bless {}, "OptionParser") unless caller;
 
 }
 # ###########################################################################

lib/pt_diskstats.pm

@@ -0,0 +1,343 @@
+{
+package pt_diskstats;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant MKDEBUG => $ENV{MKDEBUG} || 0;
+
+use DiskstatsMenu;
+use OptionParser;
+
+local $SIG{__DIE__} = sub {
+   require Carp;
+   Carp::confess(@_) unless $^S; # This is $EXCEPTIONS_BEING_CAUGHT
+} if MKDEBUG;
+
+sub main {
+   shift;
+   local @ARGV = @_;  # set global ARGV for this package
+
+   # ########################################################################
+   # Get configuration information.
+   # ########################################################################
+   my $o = OptionParser->new( file => __FILE__ );
+   $o->get_specs();
+   $o->get_opts();
+
+   # Interactive mode. Delegate to Diskstats::Menu
+   return DiskstatsMenu->run_interactive( o => $o, filename => $ARGV[0] );
+}
+
+# Somewhat important if STDOUT is tied to a terminal.
+END { close STDOUT or die "Couldn't close stdout: $OS_ERROR" }
+
+__PACKAGE__->main(@ARGV) unless caller;
+
+1;
+}
+=pod
+
+=head1 NAME
+
+pt-diskstats - Aggregate and summarize F</proc/diskstats>.
+
+=head1 SYNOPSIS
+
+Usage: pt-diskstats [OPTION...] [FILES]
+
+pt-diskstats reads F</proc/diskstats> periodically, or files with the
+contents of F</proc/diskstats>, aggregates the data, and prints it nicely.
+
+=head1 RISKS
+
+The following section is included to inform users about the potential risks,
+whether known or unknown, of using this tool.  The two main categories of risks
+are those created by the nature of the tool (e.g. read-only tools vs. read-write
+tools) and those created by bugs.
+
+pt-diskstats is a read-only tool.  It should be very low-risk.
+
+At the time of this release, we know of no bugs that could cause serious harm
+to users.
+
+The authoritative source for updated information is always the online issue
+tracking system.  Issues that affect this tool will be marked as such.  You can
+see a list of such issues at the following URL:
+L<http://www.percona.com/bugs/pt-diskstats>.
+
+See also L<"BUGS"> for more information on filing bugs and getting help.
+
+=head1 DESCRIPTION
+
+pt-diskstats tool is similar to iostat, but has some advantages. It separates
+reads and writes, for example, and computes some things that iostat does in
+either incorrect or confusing ways.  It is also menu-driven and interactive
+with several different ways to aggregate the data, and integrates well with
+the L<pt-collect> tool. These properties make it very convenient for quickly
+drilling down into I/O performance at the desired level of granularity.
+
+This program works in two main modes. One way is to process a file with saved
+disk statistics, which you specify on the command line.  The other way is to
+start a background process gathering samples at intervals and saving them into
+a file, and process this file in the foreground.  In both cases, the tool is
+interactively controlled by keystrokes, so you can redisplay and slice the
+data flexibly and easily.  If the tool is not attached to a terminal, it
+doesn't run interactively; it just processes and prints its output, then exits.
+Otherwise it loops until you exit with the 'q' key.
+
+If you press the '?' key, you will bring up the interactive help menu that
+shows which keys control the program.
+
+XXX TODO:
+
+Files should have this format:
+
+   <contents of /proc/diskstats>
+   TS <timestamp>
+   <contents of /proc/diskstats>
+   ... et cetera
+   TS <timestamp>  <-- must end with a TS line.
+
+See L<http://aspersa.googlecode.com/svn/html/diskstats.html> for a detailed
+example of using the tool.
+
+=head1 OUTPUT
+
+The columns are as follows:
+
+=over
+
+=item #ts
+
+The number of seconds of samples in the line.  If there is only one, then
+the timestamp itself is shown, without the {curly braces}.
+
+=item device
+
+The device name.  If there is more than one device, then instead the number
+of devices aggregated into the line is shown, in {curly braces}.
+
+=item rd_mb_s
+
+The number of megabytes read per second, average, during the sampled interval.
+
+=item rd_cnc
+
+The average concurrency of the read operations, as computed by Little's Law
+(a.k.a. queueing theory).
+
+=item rd_rt
+
+The average response time of the read operations, in milliseconds.
+
+=item wr_mb_s
+
+Megabytes written per second, average.
+
+=item wr_cnc
+
+Write concurrency, similar to read concurrency.
+
+=item wr_rt
+
+Write response time, similar to read response time.
+
+=item busy
+
+The fraction of time that the device had at least one request in progress;
+this is what iostat calls %util (which is a misleading name).
+
+=item in_prg
+
+The number of requests that were in progress.  Unlike the read and write
+concurrencies, which are averages that are generated from reliable numbers,
+this number is an instantaneous sample, and you can see that it might
+represent a spike of requests, rather than the true long-term average.
+
+=back
+
+In addition to the above columns, there are a few columns that are hidden by
+default. If you press the 'c' key, and then press Enter, you will blank out
+the regular expression pattern that selects columns to display, and you will
+then see the extra columns:
+
+=over
+
+=item rd_s
+
+The number of reads per second.
+
+=item rd_avkb
+
+The average size of the reads, in kilobytes.
+
+=item rd_mrg
+
+The percentage of read requests that were merged together in the disk
+scheduler before reaching the device.
+
+=item wr_s, wr_avgkb, and wr_mrg
+
+These are analogous to their C<rd_*> cousins.
+
+=back
+
+=head1 OPTIONS
+
+This tool accepts additional command-line arguments.  Refer to the
+L<"SYNOPSIS"> and usage information for details.
+
+=over
+
+=item --config
+
+type: Array
+
+Read this comma-separated list of config files; if specified, this must be the
+first option on the command line.
+
+=item --columns
+
+type: string; default: cnc|rt|mb|busy|prg
+
+Perl regex of which columns to include.
+
+=item --devices
+
+type: string
+
+Perl regex of which devices to include.
+
+=item --group-by
+
+type: string; default: disk
+
+Group-by mode (default disk); specify one of the following:
+
+   disk   - Each line of output shows one disk device.
+   sample - Each line of output shows one sample of statistics.
+   all    - Each line of output shows one sample and one disk device.
+
+=item --sample-time
+
+type: int; default: 1
+
+In --group-by sample mode, include INTERVAL seconds of samples per group.
+
+=item --save-samples
+
+type: string
+
+File to save diskstats samples in; these can be used for later analysis.
+
+=item --iterations
+
+type: int
+
+When in interactive mode, stop after N samples.
+
+=item --interval
+
+type: int; default: 1
+
+Sample /proc/diskstats every N seconds.
+
+=item --help
+
+Show help and exit.
+
+=item --version
+
+Show version and exit.
+
+=back
+
+=head1 ENVIRONMENT
+
+This tool does not use any environment variables.
+
+=head1 SYSTEM REQUIREMENTS
+
+This tool requires Perl v5.8.0 or newer and the F</proc> filesystem, unless
+reading from files.
+
+=head1 BUGS
+
+For a list of known bugs, see L<http://www.percona.com/bugs/pt-diskstats>.
+
+Please report bugs at L<https://bugs.launchpad.net/percona-toolkit>.
+Include the following information in your bug report:
+
+=over
+
+=item * Complete command-line used to run the tool
+
+=item * Tool L<"--version">
+
+=item * MySQL version of all servers involved
+
+=item * Output from the tool including STDERR
+
+=item * Input files (log/dump/config files, etc.)
+
+=back
+
+If possible, include debugging output by running the tool with C<PTDEBUG>;
+see L<"ENVIRONMENT">.
+
+=head1 DOWNLOADING
+
+Visit L<http://www.percona.com/software/percona-toolkit/> to download the
+latest release of Percona Toolkit.  Or, get the latest release from the
+command line:
+
+   wget percona.com/get/percona-toolkit.tar.gz
+
+   wget percona.com/get/percona-toolkit.rpm
+
+   wget percona.com/get/percona-toolkit.deb
+
+You can also get individual tools from the latest release:
+
+   wget percona.com/get/TOOL
+
+Replace C<TOOL> with the name of any tool.
+
+=head1 AUTHORS
+
+Baron Schwartz
+
+=head1 ABOUT PERCONA TOOLKIT
+
+This tool is part of Percona Toolkit, a collection of advanced command-line
+tools developed by Percona for MySQL support and consulting.  Percona Toolkit
+was forked from two projects in June, 2011: Maatkit and Aspersa.  Those
+projects were created by Baron Schwartz and developed primarily by him and
+Daniel Nichter, both of whom are employed by Percona.  Visit
+L<http://www.percona.com/software/> for more software developed by Percona.
+
+=head1 COPYRIGHT, LICENSE, AND WARRANTY
+
+This program is copyright 2010-2011 Baron Schwartz, 2011 Percona Inc.
+Feedback and improvements are welcome.
+
+THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+This program is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free Software
+Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
+systems, you can issue `man perlgpl' or `man perlartistic' to read these
+licenses.
+
+You should have received a copy of the GNU General Public License along with
+this program; if not, write to the Free Software Foundation, Inc., 59 Temple
+Place, Suite 330, Boston, MA  02111-1307  USA.
+
+=head1 VERSION
+
+pt-diskstats 1.0.1
+
+=cut

t/lib/Diskstats.t

@@ -22,6 +22,8 @@ BEGIN {
    use_ok "DiskstatsGroupBySample";
 }
 
+{
+
 my $obj = new_ok("Diskstats");
 
 can_ok( $obj, qw(
@@ -32,6 +34,28 @@ can_ok( $obj, qw(
                   parse_from print_deltas
                ) );
 
+# Test the constructor
+for my $attr (
+      [ filename           => '/corp/diskstats'      ],
+      [ column_regex       => qr/!!!/                ],
+      [ device_regex       => qr/!!!/                ],
+      [ block_size         => 215                    ],
+      [ out_fh             => \*STDERR               ],
+      [ filter_zeroed_rows => 1                      ],
+      [ sample_time        => 1                      ],
+      [ interactive        => 1                      ],
+   ) {
+   my $attribute   = $attr->[0];
+   my $value       = $attr->[1];
+   my $test_obj    = Diskstats->new( @$attr );
+
+   is(
+      $test_obj->$attribute(),
+      $value,
+      "Passing an explicit [$attribute] to the constructor works",
+   );
+}
+
 my $line = "104    0 cciss/c0d0 2139885 162788 37361471 8034486 17999682 83425310 811400340 12711047 0 6869437 20744582";
 
 my %expected_results = (
@@ -90,22 +114,41 @@ is($header, join(" ", q{%5s %-6s}, map { $_->[0] } @columns_in_order),
 
 ($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10);
 my $all_columns_format = join(" ", q{%5s %-10s}, map { $_->[0] } @columns_in_order);
-is($header, $all_columns_format, "design_print_formats: max_device_length works");
+is(
+   $header,
+   $all_columns_format,
+   "design_print_formats: max_device_length works"
+);
 
 $obj->column_regex(qr/(?!)/); # Will never match
 ($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10);
-is($header, q{%5s %-10s }, "design_print_formats respects column_regex");
+is(
+   $header,
+   q{%5s %-10s },
+   "design_print_formats respects column_regex"
+);
 
 $obj->column_regex(qr//);
-($header, $rest, $cols) = $obj->design_print_formats(max_device_length => 10, columns => []);
+($header, $rest, $cols) = $obj->design_print_formats(
-is($header, q{%5s %-10s }, "...unless we pass an explicit column array");
+                                    max_device_length => 10,
+                                    columns           => []
+                                 );
+is(
+   $header,
+   q{%5s %-10s },
+   "...unless we pass an explicit column array"
+);
 
 $obj->column_regex(qr/./);
 ($header, $rest, $cols) = $obj->design_print_formats(
                                  max_device_length => 10,
                                  columns           => [qw( busy )]
                            );
-is($header, q{%5s %-10s busy}, "");
+is(
+   $header,
+   q{%5s %-10s busy},
+   ""
+);
 
 ($header, $rest, $cols) = $obj->design_print_formats(
                                  max_device_length => 10,
@@ -136,21 +179,95 @@ close($fh);
 is($obj->out_fh(), \*STDOUT, "and if we close the set filehandle, it reverts to STDOUT");
 
 
-is_deeply([$obj->sorted_devs()], [], "sorted_devs starts empty");
+is_deeply(
+   [ $obj->sorted_devs() ],
+   [],
+   "sorted_devs starts empty"
+);
 
 $obj->add_sorted_devs("sda");
-is_deeply([$obj->sorted_devs()], [qw(sda)], "We can add devices just fine,");
+is_deeply(
+   [ $obj->sorted_devs() ],
+   [ qw( sda ) ],
+   "We can add devices just fine,"
+);
 
 $obj->add_sorted_devs("sda");
-is_deeply([$obj->sorted_devs()], [qw(sda)], "...And duplicates get detected and discarded");
+is_deeply(
+   [ $obj->sorted_devs() ],
+   [ qw( sda ) ],
+   "...And duplicates get detected and discarded"
+);
 
 $obj->clear_sorted_devs();
-is_deeply([$obj->sorted_devs()], [], "clear_sorted_devs does as advertized,");
+is_deeply(
+   [ $obj->sorted_devs() ],
+   [],
+   "clear_sorted_devs does as advertized,"
+);
 $obj->add_sorted_devs("sda");
-is_deeply([$obj->sorted_devs()], [qw(sda)], "...And clears the internal duplicate-checking list");
+is_deeply(
+   [ $obj->sorted_devs() ],
+   [ qw( sda ) ],
+   "...And clears the internal duplicate-checking list"
+);
 
+$obj->filter_zeroed_rows(1);
+my $print_output = output(
+   sub {
+      $obj->print_rest(
+            "SHOULDN'T PRINT THIS",
+            [ qw( a b c ) ],
+            { a => 0, b => 0, c => 0, d => 10 }
+         );
+   }
+);
+$obj->filter_zeroed_rows(0);
 
+is(
+   $print_output,
+   "",
+   "->filter_zeroed_rows works"
+);
 
+for my $method ( qw( delta_against delta_against_ts group_by ) ) {
+   throws_ok(
+      sub { Diskstats->$method() },
+      qr/\QYou must override $method() in a subclass\E/,
+      "->$method has to be overriden"
+   );
+}
+
+is(
+   Diskstats->compute_line_ts( first_ts => 0 ),
+   sprintf( "%5.1f", 0 ),
+   "compute_line_ts has a sane default",
+);
+
+$obj->{_print_header} = 0;
+
+is(
+   output( sub { $obj->print_header } ),
+   "",
+   "INTERNAL: _print_header works"
+);
+
+$obj->current_ts(0);
+$obj->previous_ts(0);
+
+throws_ok(
+   sub { $obj->_calc_deltas() },
+   qr/Time elapsed is/,
+   "->_calc_deltas fails if the time elapsed is 0"
+);
+
+throws_ok(
+   sub { $obj->parse_from_data( "ASMFHNASJNFASKLFLKHNSKD" ); },
+   qr/isn't in the diskstats format/,
+   "->parse_from and friends fail on malformed data"
+);
+
+}
 # Common tests for all three subclasses
 for my $test (
       {