#!/usr/bin/perl -w
my $_perl_bin_='/usr/bin/perl';
# iomon - show io for mounted partitions
#
# Copyright L A Walsh 2011
# 
# Also licenced under Mozilla Public Licence (MPL) 1.1
# See http://www.opensource.org/licenses/mozilla1.1 for full text
#
# Note: nothing is guaranteed to work, so use this only if you find it useful
#
# ( Warranteed under the 'It Works For Me' program )
#
# 345678901234567890123456789012345678901234567890123456789012345678901234567890

use feature ":5.10";
my $_sudo_bin_ = '/usr/bin/sudo';
$> == 0 || (-x $_sudo_bin_ && 
	exec $_sudo_bin_, ($_perl_bin_, "-S", "$0", @ARGV)) or
	die "sudo exec failed...";

sub __USE_POSIX{1}
my $VERSION = '1.0';
use Fatal;
use Time::HiRes qw(ualarm usleep gettimeofday tv_interval);
use Readonly;	sub RO(\[$@%]@) {goto &Readonly};
use utf8;
use charnames qw{:full};

use lib "$ENV{HOME}/bin/lib";
#use Term::Size;


binmode STDOUT, ':encoding(UTF-8)';
binmode STDERR, ':encoding(UTF-8)';

my $Progname								= ($0 =~ m{([^/]+)$})[0];
my ($Devel, $Debuff_Output) = ($Progname =~ /^iomon.*/) ? (0, 0) : (1, 1);

if ($Debuff_Output) { select STDERR; $| = 1; select STDOUT; $| = 1; }

#define length to always return an 'int'
my $bogo_msg = "Use of uninitialized value in length at";
sub bogowarn { $_[0] =~ /^$bogo_msg/ and return };
$SIG{__WARN__} = \&bogowarn;

our @CARP_NOT = qw(Math::Simple); #doesn't work - why not?

sub mywarn {
	use Carp qw(cluck confess);
	printf "Warning:...";
	if ($_[0] =~ /^$bogo_msg/){
		printf "(Bogo msg)...";
		return;
	}
	$Carp::CarpLevel = $Carp::CarpLevel ? ++$Carp::CarpLevel:1 if defined $^S && !$^S;
	$SIG{__WARN__} = $SIG{__DIE__} = undef;
	if (defined $^S) {
			confess $_[0];
	} else {
		printf "Not confessing about %s, as ^S=%s\n", $_[0]//"undef", $^S//"undef";
	}
	die "Fatal Exit: Perl backtrace unavailable\n";
}

if ($Devel) { $ENV{PERL_HASH_SEED} = 0 }
if ($Devel) { $SIG{__WARN__} = $SIG{__DIE__} = \&mywarn }

RO my %clrs 	=> (
			'black'	=> 0, 'red'			=> 1, 'green'			=> 2, 'yellow'	=> 3,
			'blue'	=> 4, 'magenta'	=> 5, 'turquoise' => 6, 'white'		=> 7);

RO my $bin_prfx_base	=> 1024;
RO my $K							=> $bin_prfx_base**1;
RO my $M							=> $bin_prfx_base**2;
RO my $G							=> $bin_prfx_base**3;
RO my $T							=> $bin_prfx_base**4;
RO my $P							=> $bin_prfx_base**5;
RO my $E							=> $bin_prfx_base**6;

RO my $Treset_clr 	=> `tput sgr0`;
RO my $Tbold				=> `tput bold`;
RO my $Tdim					=> `tput dim`;
RO my $Trev					=> `tput rev`;

RO my $Tblack_clr		=> `tput setaf $clrs{black}`;
RO my $Tred_clr			=> `tput setaf $clrs{red}`;
RO my $Tgreen_clr		=> `tput setaf $clrs{green}`;
RO my $Tblue_clr		=> `tput setaf $clrs{blue}`;
RO my $Tturq_clr		=> `tput setaf $clrs{turquoise}`;
RO my $Twhite_clr		=> `tput setaf $clrs{white}`;

RO my $Tbred_clr		=> `tput setab $clrs{red};`;
RO my $Tbgreen_clr	=> `tput setab $clrs{green}`;
RO my $Tbblue_clr		=> `tput setab $clrs{blue};`;
RO my $Tbturq_clr		=> `tput setab $clrs{turquoise}`;

RO my $Tired_clr		=>	$Tbred_clr	. $Twhite_clr;
RO my $Tigreen_clr	=>	$Tbgreen_clr. $Tblack_clr;
RO my $Titurq_clr		=>	$Tbturq_clr. $Tblack_clr;
RO my $Tiblue_clr		=>	$Tbblue_clr . $Twhite_clr;

RO my $Tnl					=> "\n";

sub dirch () { return "/" }

my $res_name					= ".iomonrc";
my $res_dir						= $ENV{'HOME'} // $ENV{'USERPROFILE'};
my $res_path					= $res_dir . dirch . $res_name if $res_dir;

my $Interval					= 7;				# refresh interval
my $Scroll						= $Devel;		# Default scroll in Devel, else refresh 

my ($StdOut, $StdErr) = (\&STDOUT, \&STDERR);

unless ($Debuff_Output) {	# not needed
	use IO::Handle;
	my	$_io	= new IO::Handle;
	$StdOut	= $_io->new_from_fd(fileno(STDOUT),"w") or 
						die "Can't get STDOUT handle\n";
}

RO my $stat_ctime_i => 11;

sub get_system_start_time () { 
	state $sys_start_time;
	$sys_start_time = (stat "/dev/.")[$stat_ctime_i] unless $sys_start_time;
	$sys_start_time;
}



################################################################################
package Messaging;
use strict; 

sub sp ($) {
	my $thing=$_[0];
	defined $thing or return "<undef>";		# 1st handle "double undef"
	given (ref $thing) {
		when ('')				{ return $thing		// "undef" }
		when ('SCALAR')	{ return $$thing	// "*undef" }
		when ('ARRAY')	{ return map { $_	// "*undef" } @$thing }
		default					{ return *$thing }
	}
}

sub safe_printf {
	my $fh =shift;
	my $fmt;
	if (ref $fh eq 'GLOB') {
		$fmt = shift;
	} else {	# didn't get a FH, so 1st param = fmt
		$fmt = $fh;
		$fh = *STDERR;
	}
	my @args;
	my $_;
	foreach(@_) {
		push @args, $_ // sp $_;
	}
	if ($fh) {
		printf $fh $fmt,@args;
	} else {
		sprintf $fmt, @args;
	}
}

sub yelp {
	use Carp qw(cluck confess);
	confess safe_printf @_;
}

################################################################################
package Math::Simple;
#$Carp::Internal{__PACKAGE__::min}++;
use strict; 
sub logb ($$) { state @logs; return log($_[1]) / ($logs[$_[0]] ||= log $_[0]) }
sub max($$) { $_[0] > $_[1]	?	$_[0] : $_[1] }
sub min($$) { $_[0] < $_[1]	?	$_[0] : $_[1] }


################################################################################
package Term::Funcs;
use strict; 
use Readonly;	sub RO(\[$@%]@) {goto &Readonly};
RO my $Tclear		=> `tput clear`;
RO my $Tat00				=> `tput cup 0 0`;
sub Tclear { $Tclear }
sub Tat00 {$Tat00}

	
	
################################################################################
package Display;
use strict;
BEGIN {*yelp = \&Messaging::yelp}

sub lines(;$) {
	my $p=shift;
	$p->{lines}=$_[0] if defined $_[0];;
	$p->{lines};
}
sub width(;$) {
	my $p=shift;
	$p->{width}=$_[0] if defined $_[0];;
	$p->{width};
}

sub new ($) {
	my Display $class=shift;
	my $p = {};
	unless (ref $class) {
		bless $p, $class;
		my $params=$_[0];
		if (ref $params eq 'HASH') {
			foreach (keys %$params) {
				$p->{$_}=$params->{$_};
			}
		} else {
			yelp "Package %s, line %d: expected hash, got ref=%s\n",
		 				__PACKAGE__, __LINE__, (ref $params)//"undef";
		}
	} else {
		$p = $class;
	}
	return $p;
}

	
################################################################################
#use Array::Decay_Average;

package Array::Decay_Average;
use warnings; use strict;
use feature ":5.10";

my $Version = 1.0;
our $__debug;

sub max($$) { $_[0] > $_[1]     ?       $_[0] : $_[1] }
sub min($$) { $_[0] < $_[1]     ?       $_[0] : $_[1] }
sub _max_size(;$) {
	my $p = shift;
	my $new_max = $_[0];
	$new_max && do {
		if ($new_max < 0 ) {
			warnings::warn("Size of Array may not be negative");
		} else {
			$p->{max_size}=$new_max;
		}
	};
	$p->{max_size};
}


sub new () {
	my $p=shift;
	my $paramsp=$_[0];
	my $t = { 
						'max_size'	=> 10,
						'nxt_idx'	=>	0,
						'Datap'			=> [],
				 	};
	my $size;
	foreach (keys %$paramsp) {
		given($_) {
			when ('history')	{$size = $paramsp->{history}}
			when ('size')			{$size = $paramsp->{size}} 
			when ('init-debug')	{$__debug=1; test_init()}
		}
	}
	bless $t, $p;
	$size && $t->_max_size($size);
	$t;
}


sub prev($$) {
	my ($idx,$limit)=@_;
	--$idx < 0 ? $idx += $limit : $idx;
}


sub max_size (;$) {
	my $p=shift;
	my $new_max = $_[0];
	$new_max && do {
		if ($new_max < 0) {
			warnings::warn("Size of Array may not be negative");
			return $p->{max_size};
		}
		my $Datap=$p->{Datap};
		my $cur_max = min($p->{max_size}, $#$Datap+1);

		my $delta		= $new_max - $cur_max;
		my $maxcpy	= min($cur_max, $new_max);

		my $startcpy	= $p->{nxt_idx} - $maxcpy;
		my $endcpy		= $p->{nxt_idx} - 1;
		$endcpy		+= $cur_max if $endcpy < 0;
		$startcpy	+= $cur_max if $startcpy < 0;

		my ($new_idx, @newDatap);
		if ($startcpy < $endcpy) {
			@newDatap	= @$Datap[$startcpy..$endcpy];
			$new_idx	= $endcpy - $startcpy + 1;
		} else {
			@newDatap = @$Datap[$startcpy..$#$Datap];
			@newDatap[$#newDatap+1 .. $#newDatap+$endcpy+1] = @$Datap[0 .. $endcpy];
			$new_idx = $#newDatap + $endcpy + 1;
		}
		$new_idx = 0 if $new_idx >= $new_max;
		$p->{Datap}			= \@newDatap;
		$p->{nxt_idx}		= $new_idx;
		$p->{max_size}	= $new_max;

	};
	$p->{max_size};
}


sub ave () {
	my $p=shift;
	my $tot = 0.0;
	my $div = 0.0;
	my $Datap	= $p->{Datap};
	my $nxt_idx = $p->{nxt_idx};
	my $max_size = $p->{max_size};
	#printf STDERR "mx_sz=%d, #Dp=%d\n",$max_size, $#$Datap;
	for (my $i = 0; $i<=$#$Datap; ++$i) {
		my $idx = $nxt_idx - 1;
		$idx = ($#$Datap+$idx-$i) % @$Datap;
		unless (defined $Datap->[$idx]) {
			die sprintf "%s:ave:(Line %d): Attempt to use undefined mem %d\n",
				__PACKAGE__, __LINE__, $idx;
		}
		$tot += ($max_size-$i) * $Datap->[$idx];
		$div += ($max_size-$i);
	}
	$tot /= $div;
}

# add a new max to array
sub add ($) {
	my $p = shift;
	unless (defined $_[0]) {
		die __PACKAGE__ . "::add: Cannot store 'undef' as a value.\n";
	}
	$p->{Datap}->[$p->{nxt_idx}++] = $_[0];
	$p->{nxt_idx} %= $p->{max_size};
}

sub max_cur_ave ($) {
	my $p=shift;
	$p->add($_[0]);
	max($_[0], $p->ave)
}

################################################################################
package BarGraph;
use base qw(Display);

use strict;
use Readonly;	sub RO(\[$@%]@) {goto &Readonly};

BEGIN {*yelp = \&Messaging::yelp}
BEGIN {*safe_printf = \&Messaging::safe_printf}

BEGIN {*Cols = \&Term::Size::Cols}
BEGIN {*logb = \&Math::Simple::logb}
BEGIN {*min = \&Math::Simple::min}

#if ($main::Devel) { $SIG{__WARN__} = $SIG{__DIE__} = \&main::mywarn }

# whether or not we try to support variable # of subfields (may not work, but
# here for a place holder for places where code is available); Not quite
# as efficient as assuming only 2 fields

RO my $var_subflds => 0;

# 		number of 8th's fill:  0 1 2 3 4 5 6 7 8  
my @BlockFills = split /,/, " ,▏,▎,▍,▌,▋,▊,▉,█";
RO my $FullBlk => $BlockFills[$#BlockFills];

# label chars: ◄━► :
my	($lbl_sol, $lbl_fillch, $lbl_eol, $fillch, 	$thinfillch) = 
		("◄",				"━", 				"►",		 	$FullBlk, undef);

my $thickline	= "━";
my $thinline	= "―";

my $norm_clr										= $Treset_clr;
my ($read_clr, $inv_read_clr)		= ($Tblue_clr, $Tiblue_clr);
my ($write_clr, $inv_write_clr)	= ($Tred_clr,  $Tired_clr);

my @ascii_substitutes = ('<', '-', '>', '#', '|');

sub sub_ascii() {
	my $p=shift;
	($p->{lsol}, $p->{lflch}, $p->{leol}, $p->{flch}, $p->{tflch}) =
		@ascii_substitutes;
}

sub lsol		{ $_[0]->{lsol}		// $lbl_sol }
sub lflch		{ $_[0]->{lflch}	// $lbl_fillch }
sub leol		{ $_[0]->{leol}		// $lbl_eol }
sub flch		{ $_[0]->{flch}		// $fillch }
sub tflch		{ $_[0]->{tflch}	// $thinfillch }
sub blkfls	{ $_[0]->{blkfls}	// \@BlockFills}
sub nrmclr	{ $_[0]->{nrmclr}	// $norm_clr }



RO my $len_zerodot => length("0.");
RO my @prefixes		=> ("",	"K",	"M",	"G");
RO my @divs				=> (1,	$K,		$M,		$G );

sub r8_str ($;$) {
	my $r8 = $_[0];
	#$_[1]:unused:
	#my $desired_r8_strlen = $_[1] // 3; $desired_r8_strlen -= $len_zerodot;
	my $desired_r8_strlen = 1;
	my ($si, $digs) = (0, 1);
	if (int $r8) {
		$si 	= min( int logb(1024, $r8), $#divs);
		$digs	= int logb(10, $r8 /= $divs[$si]);
	}
	my $frac_digs		= $desired_r8_strlen - $digs;
	$frac_digs = 0 if $frac_digs < 0;
	while ($frac_digs) {
		last if (int($r8 * 10**$frac_digs+.5) % 10);
		--$frac_digs;
	}
	sprintf "%.${frac_digs}f %s", $r8, $prefixes[$si];
}

sub Bps_str($) { r8_str($_[0]) ."B/s" }



# create_fill_str:
# args = 1: #spaces of fill needed,
#        2: 2 element array 2 r8 strings 1st being center, 2nd right-justified
#           (either one can be null meaning don't print)
#        3: optional 3 element array of characters to use for fill
#        		3a) middle chars; 3b) leftmost; 3c) right most
#        4: optional 3 element clr array
#           4a) start of fill clr; 4b) endfill clr; 4c) text-on-fill clr
#        5: option 'length' to use for the mid-r8-strlen (needed to 
#           accomodate hidden chars embedded in lbl string on 'legend')
sub create_fill_str ($$;$$$) {
	my ($fill_amount, $r8_str_p, $fills_p, $clrs_p, $mid_r8_strlen) = @_;
	my ($mid_r8_str, $total_r8_str) = @$r8_str_p;
	my ($sol_fill, $fill_ch, $eol_fill) = $fills_p ?  @$fills_p : ("", " ", "");
	my ($fill_clr, $filltext_clr) = $clrs_p ?  
			@$clrs_p : ("", "", "");
	$_ //= "" foreach ($total_r8_str, $sol_fill, $eol_fill, $mid_r8_str);
	$fill_ch			//= " ";		# empty fill_ch defaults to space fill;
	my $total_r8_strlen = length $total_r8_str;
	my $minpad 			= length($sol_fill) + length($eol_fill);
	$mid_r8_strlen	= length $mid_r8_str unless $mid_r8_strlen;
	my $totpad = $fill_amount - $mid_r8_strlen - $total_r8_strlen - $minpad;
	my ($prepad, $postpad) = (int ($totpad+1)/2, int $totpad/2);
	return $fill_clr .			( $totpad >= $minpad ?
			$sol_fill	. ($fill_ch x $prepad) .	$filltext_clr . $mid_r8_str .
			$fill_clr	. ($fill_ch x $postpad) . $total_r8_str	. $eol_fill :
		$fill_amount >= $minpad ?
			$sol_fill . ($fill_ch x $fill_amount) .  $eol_fill :
			$fill_ch x $fill_amount )		. $norm_clr;
}



sub lname 		{ $_[0]->{subdatsp}->[$_[1]]->[0] }
sub sname 		{ $_[0]->{subdatsp}->[$_[1]]->[1] }
sub color 		{ $_[0]->{subdatsp}->[$_[1]]->[2] }
sub inv_color	{ $_[0]->{subdatsp}->[$_[1]]->[3] }
	
RO my $rounding_power	=> 2.0;		#round graphs up to nearest power of this 


use POSIX qw{ceil};

sub Dcyave {$_[0]->{Dcyave}=$_[1] if $#_==1; $_[0]->{Dcyave}}
sub sclspc {$_[0]->{sclspc}=$_[1] if $#_==1; $_[0]->{sclspc}}
sub lblstr {$_[0]->{lblstr}=$_[1] if $#_==1; $_[0]->{lblstr}}
sub sclr8 {$_[0]->{sclr8}=$_[1] if $#_==1; $_[0]->{sclr8}}


sub create_data_plot ($;$) {			
	my $p = shift;
	my $class = ref $p;
	unless ($class) {
		$class = $p;
		$p	= {
				"subdatsp"	=> [],	#@ of [long_name,short_name,color,inv_color]
				"objfmt"		=> "%s",
				"sclspc"		=> undef,
				"getdat"		=> sub {undef},
				"pltdat"		=> sub {undef},
				"maxBps"		=> undef,
				"maxval"		=> undef,
				"totval"		=> undef,
				"Dcyave"		=> undef,
				"sclr8"			=> undef,
				"lblstr"		=> undef,
		};
		bless $p, $class;
	}
	$p->sclspc($p->width);
	my $params=$_[0];
	if (ref $params eq 'HASH') {
		foreach (keys %$params) {
			$p->{$_} = $params->{$_};
		} 
	} else {
		yelp "Package %s, line %d: expected hash, got ref=%s\n",
					__PACKAGE__, __LINE__, (ref $params)//"undef";
	}
	
	$p->Dcyave(Array::Decay_Average->new({history => 5})) unless $p->Dcyave;

	die sprintf "\nERROR: maxval <0 (%d) ", $p->maxval if $p->maxval<0;

	my $new_r8 = $p->Dcyave->max_cur_ave($p->maxval); 

	die "\nERROR: new_r8 < 0 ($new_r8);"  if $new_r8 < 0;

	$p->sclr8( $new_r8 ? 
		$rounding_power ** ceil logb $rounding_power, $new_r8 : 0);

	my $noclr_lbl_inffmt_len	= 0;
	my $clr_lfp								= "";

	if ($var_subflds) {	#not recently tested...(var_subflds == 0)
		for (my $subfld = 0; $subfld <= $#{$p->subdatsp}; ++$subfld) {
			my $str								 = $p->lname($subfld);
			my $lbl_info_fmt 			 = $subfld > 1  ?  "  & %s%s%s" : "%s%s%s";
			$noclr_lbl_inffmt_len += length sprintf $lbl_info_fmt,"",$str,"";
			$clr_lfp 							.= sprintf	$lbl_info_fmt, $p->color($subfld), 
																				$str, $norm_clr;
		}
	} else {
		my ($str1, $str2)				 = ($p->lname(0), $p->lname(1));
		my $lbl_info_fmt				 =	" %s${str1}%s & %s${str2}%s ";
		$noclr_lbl_inffmt_len		 =	length sprintf $lbl_info_fmt,"","","","";
		$clr_lfp								 = sprintf $lbl_info_fmt, $p->color(0), 
																			$norm_clr, $p->color(1), $norm_clr;
	}
	my $lbl_str			= Bps_str($p->sclr8) . " Scale ";
	my $total_str 	= "";

	if ($p->totval) {
		$total_str		= "(Tot: " .  Bps_str( $p->totval) . ")" . $lbl_fillch;
	}
	my $lbl_strlen	= (length $lbl_str) + $noclr_lbl_inffmt_len;
	$lbl_str				= $clr_lfp . $lbl_str;

	$p->lblstr(create_fill_str(	$p->sclspc, [$lbl_str,$total_str],
															[$lbl_sol, $lbl_fillch, $lbl_eol],
															undef, $lbl_strlen ));
	$p;
}
	


sub get_fill ($$$) {
	my ($r8, $scale_r8, $fill_width) = @_;
	my $fill = $fill_width * $r8 / $scale_r8;
	$fill = $fill_width if $fill > $fill_width;

	# if thinfill isn't set; use fractional Blockfills for fractions
	
	if (!$thinfillch  && $fill && !int $fill) {
		(1, $BlockFills[int ($#BlockFills*$fill+.5)]);
	} else {
		(int ($fill + .5) , $fillch);
	}
}



sub process_oneline {
	my $p=shift;

	my ($obj, $rr8, $wr8, $tr8, $objid) = @{$_[0]};

	#safe_printf "obj=%12.12s, rwt=(%-7.1f, %-7.1f, %-7.1f), oid=%-5d\n",
	#	$obj, $rr8//-1, $wr8//-1, $tr8//-1, $objid//-1;

	return "" if $tr8<1;										#
	my $tr8_str 									= Bps_str($tr8);
	my $display_line 							= sprintf $p->objfmt, $obj, $objid;
	my ($read_fill, $rdfill_ch)		= get_fill($rr8, $p->sclr8, $p->sclspc);
	my ($write_fill, $wrfill_ch)	= get_fill($wr8, $p->sclr8, $p->sclspc);
	my $tot_fill 									= $read_fill+$write_fill;
	if ($tot_fill > $p->sclspc) {
		$write_fill > $read_fill ?  --$write_fill : --$read_fill;
		--$tot_fill;
	}
	if ((my $fill		 = $tot_fill/$p->sclspc) > 1) {
			$read_fill	/= $fill;
			$write_fill /= $fill;
	}

	$Tnl . $display_line 
		. create_fill_str($read_fill, 
						["(" . Bps_str($rr8) . " ". $p->sname(0). ")", ],
																	[ undef , $rdfill_ch, ], 
																	[$p->color(0), $p->inv_color(0)])

		.	create_fill_str($write_fill,	
						["(" . Bps_str($wr8) . " " . $p->sname(1) . ")", ],
																	[undef, $wrfill_ch, ], 
																	[$p->color(1), $p->inv_color(1)])

		.  $norm_clr . create_fill_str($p->sclspc - ($read_fill + $write_fill), 
																	[undef, Bps_str($tr8) . " "] );
}



sub datap {$_[0]->{datap}=$_[1] if $#_==1; $_[0]->{datap}}
sub Dspl_oname {$_[0]->{Dspl_oname}=$_[1] if $#_==1; $_[0]->{Dspl_oname}}
sub Fix_oname_len {$_[0]->{Fix_oname_len}=$_[1] if $#_==1; $_[0]->{Fix_oname_len}}
sub inc_time {$_[0]->{inc_time}=$_[1] if $#_==1; $_[0]->{inc_time}}
sub lbl_oname {$_[0]->{lbl_oname}=$_[1] if $#_==1; $_[0]->{lbl_oname}}
sub lbl_oid {$_[0]->{lbl_oid}=$_[1] if $#_==1; $_[0]->{lbl_oid}}
sub lbl_fmt {$_[0]->{lbl_fmt}=$_[1] if $#_==1; $_[0]->{lbl_fmt}}
sub lbl_len {$_[0]->{lbl_len}=$_[1] if $#_==1; $_[0]->{lbl_len}}
sub max_oname_len {$_[0]->{max_oname_len}=$_[1] if $#_==1; $_[0]->{max_oname_len}}
sub maxoid_len {$_[0]->{maxoid_len}=$_[1] if $#_==1; $_[0]->{maxoid_len}}
sub maxval {$_[0]->{maxval}=$_[1] if $#_==1; $_[0]->{maxval}}
sub newdatap {$_[0]->{newdatap}=$_[1] if $#_==1; $_[0]->{newdatap}}
sub obj {$_[0]->{obj}=$_[1] if $#_==1; $_[0]->{obj}}
sub objfmt {$_[0]->{objfmt}=$_[1] if $#_==1; $_[0]->{objfmt}}
sub objfmt_len {$_[0]->{objfmt_len}=$_[1] if $#_==1; $_[0]->{objfmt_len}}
sub obj_fld_wdth {$_[0]->{obj_fld_wdth}=$_[1] if $#_==1; $_[0]->{obj_fld_wdth}}
sub objlbl {$_[0]->{objlbl}=$_[1] if $#_==1; $_[0]->{objlbl}}
sub subdatsp {$_[0]->{subdatsp}=$_[1] if $#_==1; $_[0]->{subdatsp}}
sub totval {$_[0]->{totval}=$_[1] if $#_==1; $_[0]->{totval}}




sub create_formats {
	my $p=$_[0];
	unless ($p->obj_fld_wdth) {
		my ($oidlen, $oidfmt_base);
		if ($p->maxoid_len) {
			$oidlen			= $p->maxoid_len;
			$oidfmt_base = "${oidlen}.${oidlen}s:";
		}
		my $namelen			= $p->max_oname_len;
		my ($fmt, $len)	= ("", 0);
		#safe_printf "oidl=%s, nmel=%s\n",$oidlen, $namelen;
		my @vals;
		if ($p->lbl_oname && $p->Dspl_oname or !$p->lbl_oid) {
			$fmt		= "%-${namelen}.${namelen}s:";
			$len		= $namelen+1;
			push		@vals, $p->lbl_oname;
		}
		if ($p->lbl_oid) {
			$fmt		.=	"%" . (@vals?"-":"") . $oidfmt_base;
			$len		+= $oidlen+1;
			push		@vals, $p->lbl_oid;
		}
		$p->lbl_fmt($fmt);
		$p->objfmt($fmt);
		$p->lbl_len($len);
		$p->obj_fld_wdth($len);
		$p->objlbl(sprintf $fmt, @vals);
	}
}

RO my $ObjName	=> 0;
RO my $ObjRr8		=> 1;
RO my $ObjWr8		=> 2;
RO my $ObjTr8		=> 3;
RO my $ObjId		=> 4;


sub get_output ($$){
	my $p = shift;
	my ($max_show_lines, $line_width) = @_;
	return if ($max_show_lines < 1);

	use Carp qw(cluck confess);
	confess "line_width=undef\n" unless $line_width;
	
	if ($p->newdatap) {	
		my $newdatap = $p->newdatap;
		$p->newdatap(undef);
		$p->datap($p->process_data($newdatap));
		#printf "%s::get_output(%s), #newdatap=%d\n", __PACKAGE__, $p->obj, $#{$p->datap};
	} else {
		printf STDERR "%s::get_output:No newdatap\n", __PACKAGE__;
	}
	unless ($p->maxval) {
		safe_printf "No %s values > 0\n", $p->obj;
		return ("", 0);
	}

	$p->max_oname_len(min($p->max_oname_len, $p->Fix_oname_len)) 
											if $p->max_oname_len && $p->Fix_oname_len;

	$p->create_formats;

	# safe_printf "lw=%s, ofw=%s\n",$line_width, $p->obj_fld_wdth;
	$p->create_data_plot ({
			'sclspc'		=> $line_width - $p->obj_fld_wdth,
		});

	my $datap = $p->datap;
	#printf "%s::get_output(%s) #data=%d\n", $p->obj, __PACKAGE__, $#$datap;
	my $obj_output = $p->objlbl . $p->lblstr;
	my $lines=1;
	my ($dsp_rr8_tot, $dsp_wr8_tot) = (0.0, 0.0);
	foreach (@$datap) {
		return ($obj_output, $lines) if $lines >= $max_show_lines;
		next unless ($_ && $_->[0]);
#		if ($p->obj eq 'Netio') {
#			printf STDERR  "oname=%s, rr8=%d, wr8=%d, tr8=%d\n", @$_;
#		}
		++$lines;
		$obj_output .= $p->process_oneline($_);
		$dsp_rr8_tot += $_->[$ObjRr8];
		$dsp_wr8_tot += $_->[$ObjWr8];
	}

	if ($lines < $max_show_lines && $p->can("post_output")) {
		my ($pout, $line) = 
			$p->post_output($dsp_rr8_tot, $dsp_wr8_tot);
		if ($line) { ++$lines; $obj_output .= $pout }
	}

	($obj_output, $lines);
}


################################################################################
package Sysmeter::Diskio;
use parent -norequire,  qw(BarGraph);

BEGIN {*min = \&Math::Simple::min}
BEGIN {*max = \&Math::Simple::max}
BEGIN {*safe_printf = \&Messaging::safe_printf}
BEGIN {*yelp = \&Messaging::yelp}
BEGIN {*get_params = \&Utils::get_params}

use Readonly;	sub RO(\[$@%]@) {goto &Readonly};


RO my $_pkg_ => __PACKAGE__;

# only use last 'segment' of a mapper name: ( /-[^-]+$/ )

RO my $short_mapper_RE	=> qr{^.*-([^-]+)$};
RO my $long_mapper_RE		=> qr{^(.*)$};

my $use_shortnames = 1;
my $mapper_name_RE = $use_shortnames ? 
										 $short_mapper_RE : $long_mapper_RE;
my @map_names;

sub _populate_mapnames() {
	my $maxdm = -1;
	my $devh;
	opendir($devh, "/dev") || die "Can't opendir on /dev\n";
	while ($_ = readdir $devh) {
		/^dm-(\d+)$/ and do {
			$maxdm = $1 if $maxdm < $1;
		};
	}
	return if $maxdm<0;
	my $nodev="NO_SUCH_DEV";
	$map_names[ $maxdm + 1 ] = [$nodev, length $nodev];
	my $dmapper_h;
	opendir($dmapper_h, "/dev/mapper") ||
		die "Can't opendir on /dev/mapper\n";
	while ($_ = readdir $dmapper_h) {
		chomp;
		/$mapper_name_RE/ and do {
			# my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
			#		$atime,$mtime,$ctime,$blksize,$blocks) = stat(...);
			my $rdev	= (stat "/dev/mapper/$_")[6];
			my $minor = $rdev & 0xff;
			$map_names[$minor]		= [$1, length $1];
		};
	}
}

sub map_name ($){ 
	_populate_mapnames unless @map_names; 
	$map_names[$_[0]]
}

# TODO: dynamically populate devmoi & associated regex
our @devmoi = (8, 252);
our $devmoi = qr{(?:8|252)}o;	#@devmoi as regex

# fields as of linux V2.6.x in /proc/diskstats:
# 1-4		reads, rmerge, rsecs, rtime, 
# 5-8		writes, wmerge, wsecs, wtime, 
# 9-11	cur_iorq, rwtime, weighted_io
# interested in keeping track of 'rsecs(3) & wsecs(7)' / interested dev(0)
	
#indexes into array
RO my $proc_diskstats_base					=> 3;	# offsets for 'split'
RO my $sys_dev_block_id_stat_base		=> 0;
# same info in sysfs under /sys/dev/block/Maj:min/stat w/o 'devi'
# believe it faster to read all stat info in 1 read call & parse output
RO my $ibase	=> $proc_diskstats_base;
RO my $devi		=>	0 + $ibase;
RO my $rsecsi	=>	3 + $ibase;
RO my $wsecsi	=>	7 + $ibase;

our %prev_io;				# read & write sector counts/dev
our $diskstats_h;

sub print_datum($$) { my $loct=$_[0]; my $_=$_[1];
	printf STDERR "$loct: dev=%-5s, rsec=%9.2e, wsec=%9.2e, tsec=%9.2e\n", 
		$_->[0], $_->[1],$_->[2],$_->[3];
}
sub print_data ($$) { my $loct=$_[0]; my $datap=$_[1];
	printf STDERR "print_data from %s\n", $loct;
	foreach (@$datap) { print_datum($loct, $_) }
}

sub new () {
	my $class=shift;
	my $params = $_[0];
	my Sysmeter::Diskio $p = {
		'inc_time'		=>	undef,
		'lbl_oname'		=>	'Device',
		'obj'					=>	'Devio',
		'subdatsp'		=>	[["Read",	"Rd", $read_clr, 	$inv_read_clr], 
											 ["Write",	"Wr", $write_clr, $inv_write_clr]], 
	};
	bless $p, $class;	
	get_params($p, $params);
	$p;
}

sub get_data() {
	my $p=shift;
	my $params=$_[0];
	get_params($p, $params);
	$diskstats_h || open($diskstats_h, "/proc/diskstats") || return undef;
	seek ($diskstats_h,0,0) or die "Error Can't seek on diskstats: $?\n";

	my @data = grep /^\s+$devmoi\s/, <$diskstats_h>;
	#printf "%s::get_data #data=%d\n",$_pkg_, $#data;
	$p->newdatap(\@data);
}
	

my %dev2lab_mp;
my %dev2mp;
sub _read_mount_info () {		#get lbls or mountpoints from output of 'mount'
	open (my $mh,"mount -l|") || die "Unable to run mount";
	while (<$mh>) {
		if ( m{^/dev/(sd[a-z]\d+)\son\s(\S+)\s(.*)$} ) {
			my ($dev, $mountp, $rest) = ($1, $2, $3);
			my $lbl;
			if ($rest =~ m{^[^\[]*\[([^\]]+)\]\s*$}) { $lbl=$1 }
			$lbl=$lbl||$mountp;
			#safe_printf \*STDERR, "dev=%s, mountp=%s, lbl=%s\n",$dev, $mountp, $lbl;
			$dev2lab_mp{$dev}	=	[$lbl, length $lbl];
			$dev2mp{$dev}			= [$mountp, length $mountp];
		}
	}
}
sub lbl_or_mp ($) { _read_mount_info unless %dev2lab_mp; $dev2lab_mp{$_[0]} }
sub dev2mp($) { _read_mount_info unless %dev2mp; $dev2mp{$_[0]} }



# note: mapped = a mounted 'device', where dev = partition or logical drive
# Tracking IO for mapped and whole block devs ('devs')

sub process_data ($) {
	my $p						= shift;
	my $newdatap		= $_[0];

	RO my $namelen_limit 								=> 20;
	RO my $Bytes_per_sector 						=> 512;
	my $max_namelen 										=	0;
	my ($maxval, $totval)		 						= (0, 0);					# mapped stats
	my ($total_dev_rr8, $total_dev_wr8) = (0, 0);	# IO by blockdev
	my $Bpdt														= $Bytes_per_sector/$p->inc_time;
	my @data;

	foreach (@$newdatap) {
		my ($dev, $trsec, $twsec) = (split /\s+/) [$devi, $rsecsi, $wsecsi];
		my ($p_rsec, $p_wsec) = exists $prev_io{$dev} ? @{$prev_io{$dev}} : (0,0);
		$prev_io{$dev} = [$trsec, $twsec];
	
		# note next r8's are in #sec's during last interval	(not an abs rate)
		my ($rr8, $wr8) = ($trsec-$p_rsec, $twsec-$p_wsec);
		
		next unless my $tr8 = $rr8 + $wr8;

		$_ *= $Bpdt foreach ($rr8, $wr8, $tr8);			#convert to Bps abs rate

		
		my ($mapped_name, $mapped_namelen);

		if ($dev =~ /^dm-(\d+)$/) {		# I/O by logical dev
			my $valp = map_name $1;
			$valp and ($mapped_name, $mapped_namelen) = @$valp;
		} elsif ($dev =~ /^sd[a-z](.*$)/) {
			my $part = $1;
			if ($part =~ /^\d+$/) {		# I/O by partition
				my $valp = lbl_or_mp $dev;
				$valp and ($mapped_name, $mapped_namelen) = @$valp;
			}	elsif (!$part) {		# I/O by whole devs
				$total_dev_rr8 += $rr8;
				$total_dev_wr8 += $wr8;
			}
		}
		next unless $mapped_name;
		push @data,		[$mapped_name, $rr8, $wr8, $tr8];
		$max_namelen	= max($max_namelen, $mapped_namelen);
		$maxval				= max($maxval, $tr8);
		$totval			 += $tr8;
	}
	my @sdata = sort { $b->[$ObjTr8] <=> $a->[$ObjTr8] } @data;
	#printf "%s::process_data #data=%d\n",$_pkg_, $#$datap;
	$p->datap(							\@sdata);
	my $datap = $p->datap;
	$p->maxval(							$maxval);
	$p->max_oname_len( 			min($max_namelen, $namelen_limit) );
	$p->totval(							$totval);
	$p->{tot_dev_rBps}		= $total_dev_rr8;
	$p->{tot_dev_wBps}		= $total_dev_wr8;
	$p->{tot_dev_Bps}			= $total_dev_rr8 + $total_dev_wr8;
	$p->datap;
}



sub post_output {
	my $p = shift;
	my ($dsp_rr8_tot, $dsp_wr8_tot) = @_;
	my $hidden_io =  max($p->{tot_dev_Bps}  - $p->totval, 0);
	
	# only print hidden_io if >10%, otherwise it prints 'noise' 
	# due to mostly to non-'snapshot' read of io stats
	if ($p->{sclr8} && $hidden_io >= $p->{sclr8}/10) {
		my $hidden_rr8 = max($p->{tot_dev_rBps} - $dsp_rr8_tot, 0);
		my $hidden_wr8 = max($p->{tot_dev_wBps} - $dsp_wr8_tot, 0);
		return ($p->process_oneline(
									["<Unknown>", $hidden_rr8, $hidden_wr8, $hidden_io]), 1);
	}
	("", 0);
}



################################################################################
package Sysmeter::Procio;
use parent -norequire,  qw(BarGraph);
BEGIN {*max = \&Math::Simple::max}
BEGIN {*min = \&Math::Simple::min}
BEGIN {*yelp = \&Messaging::yelp}
BEGIN {*get_params = \&Utils::get_params}
use Time::HiRes qw(gettimeofday);

use Readonly;	sub RO(\[$@%]@) {goto &Readonly};

my $Fix_procname_len	= 5;		# max procname chars to display
my $Dspl_procnames = 1;				# display names vs. pids only

RO my $p2n_cache_age_tick			=> 60;
RO my $p2n_cache_expire_tick	=> 600;

my %pid2name_cache;
my %pid2name_age;
my $p2n_cache_age_time;
my $p2n_cache_expire_time;
my ($p2n_lookups, $p2n_hits) = (0, 0);

sub _age_pid2names {
	foreach (keys %pid2name_age) {
		$pid2name_age{$_} += 1;
	}
}

sub _expire_pid2names($) {
	my $limit=$_[0];
	foreach (keys %pid2name_age) {
		if ($pid2name_age{$_} >= $limit) {
			delete $pid2name_cache{$_};
			delete $pid2name_age{$_};
		}
	}
}

sub age_pid2name_cache { 
	my $cur_time = gettimeofday;
	unless ($p2n_cache_age_time) {
		$p2n_cache_age_time			= $cur_time + $p2n_cache_age_tick;
		$p2n_cache_expire_time	= $cur_time + $p2n_cache_expire_tick
	} elsif ($cur_time > $p2n_cache_age_time) {
		&_age_pid2names;
		$p2n_cache_age_time += $p2n_cache_age_tick;
	} elsif ($cur_time > $p2n_cache_expire_time) {
		&_expire_pid2names;
		$p2n_cache_expire_time += $p2n_cache_expire_tick;
	}
}

sub cached_pid2name($) {
	my $pid = $_[0];
	++$p2n_lookups;
	if (exists $pid2name_cache{$pid}) {
		++$p2n_hits;
		$pid2name_age{$pid} = 0;
		return $pid2name_cache{$pid}
	}
	return undef;
}

sub reset_p2n_cache_age($) { $pid2name_age{$_[0]} = 0 }

sub add2_p2n_cache($$) {
	my ($pid, $name) = @_;
	$pid2name_age{$_[0]} = 0;
	$pid2name_cache{$_[0]} = $_[1];
}


sub _lookup_pid2name ($) {
	my $pid = $_[0];
	my ($name, $prog);

	{ open my $fh, "/proc/$pid/status" or do { 
			printf STDERR "WARNING: Error opening \"/proc/$pid/status\": $?\n";
			return undef;
		};
		my $line = <$fh>;
		$name = ($line =~ m{Name:\s+(\S+)\s*$})[0];
	}
	{ open my $fh, "/proc/$pid/cmdline" or do { 
			printf STDERR "WARNING: Error opening \"/proc/$pid/cmdline\": $?\n";
			return $name? "($name)" : undef;
		};
		local $/;
		my $line = <$fh>;
		$prog = (split "\000", $line)[0];
	}
	if ($prog) {
		if ($prog =~ m{^.*/([^/]+)$} ) {
			$prog = $1;
		} elsif ($prog =~ m{^-(.*)$}) {
			$prog = $1;
		}
		$prog = $name unless $prog =~ m{^-\w};
	}
	$name = $prog ?  $prog : $name ?  "[$name]" : undef;
}

sub _map_pid2name ($) {
	my $pid = $_[0];
	my $name;
	return $name = cached_pid2name($pid) if $name;
	add2_p2n_cache($pid,_lookup_pid2name($pid));
}



RO my $Rbytes	=> 0;
RO my $Wbytes	=> 1;
RO my $Tbytes	=> 2;
RO my $procdir => "/proc";


my ($proc_fmt, $proc_field_width, $proc_lbl);
my $max_pidlen = 5;
my $max_procnamelen;

sub new ($) {
	my $class = shift;
	my $params = $_[0];
	my $p = {
		'use_names'			=>	1,
		'inc_time'			=>	undef,
		'lbl_oid'				=>	'PID',
		'lbl_oname'			=>	'Name',
		'obj'						=> 'Procio',
		'subdatsp'			=> [["Read",	"Rd", $Tgreen_clr, 	$Tigreen_clr], 
												["Write",	"Wr", $write_clr, $inv_write_clr]], 
		'Fix_oname_len'	=> $Fix_procname_len,
		'Dspl_oname'		=> $Dspl_procnames,
	};
	get_params($p,$params);
	bless $p, $class;
}

sub get_data() {
	my $p=shift;
	my $params = $_[0];
	get_params($p, $params);

	&age_pid2name_cache;

	opendir my $proch, $procdir or do {
		printf STDERR "Error opening $procdir: $?\n";
		return undef;
	};
	
	my @procs_io;
	while (my $_ = readdir($proch)) {
		next unless /^\d+$/ && -d "$procdir/$_";
		my $ioh;
		open ($ioh, "$procdir/$_/io") || do {
			printf STDERR "Error opening %s: $?\n", "$procdir/$_/io";
			next;
		};
		my @procio_data = grep { /^(?:read|writ)/ && chomp} <$ioh>;
		push @procs_io, [$_, \@procio_data];
		reset_p2n_cache_age($_);
	}
	#printf "%s::get_data, #newdatap=%d\n",__PACKAGE__, $#procs_io;
	$p->newdatap(\@procs_io);
}

my $prev_procs_iop;

sub process_data($) {
	my $p = shift;
	my $newdatap = $_[0];
	my ($total_io, $max_TBps, $max_procid_len) = (0,0,0);	

	my @procs_w_io;
	my @next_prev_procs_iop;

	my $max_procname_len = 0;
	my $it = $p->inc_time;
	foreach (@$newdatap) {
		my ($pid, $procio_datap) = @$_;
		my ($rb,$wb);
		foreach (@$procio_datap) {
			my ($fld,$val) = split / /;
			given($fld) {
				when(/^read/) {$rb=$val}
				when(/^writ/) {$wb=$val; last}
			}
		}
		my @phys_fileio = ($rb, $wb, $rb+$wb);
		
		my @Δio;
		my $prev_prociop = $prev_procs_iop && $prev_procs_iop->[$pid] // [0,0,0];

		for($_ = 0; $_ <= $#phys_fileio; ++$_) {
			$Δio[$_] = ($phys_fileio[$_] - $prev_prociop->[$_]) / $it;
		}

		$next_prev_procs_iop[$pid] = \@phys_fileio;

		next unless $Δio[$Tbytes] >= 1;

		$total_io	+= $Δio[$Tbytes];

		$max_TBps	 = max($max_TBps, $Δio[$Tbytes]);

		my $procid_len = length "$pid";

		if ($p->Dspl_oname) {
			my $name = _map_pid2name($pid) // "";
			$max_procname_len  = max($max_procname_len, length $name);
			push @procs_w_io, [ $name, @Δio, $pid ];
		} else {
			push @procs_w_io, [ $pid , @Δio];
		}

	}
	$p->max_oname_len(min($max_procname_len, $p->Fix_oname_len));
	$prev_procs_iop = \@next_prev_procs_iop;

	my @sprocs_w_io = sort { $b->[$ObjTr8] <=> $a->[$ObjTr8] } @procs_w_io;
	$p->datap(\@sprocs_w_io);
	$p->totval($total_io);
	$p->maxval($max_TBps);
	$p->maxoid_len($max_pidlen);

	$p->datap;
}


################################################################################
package Utils;
BEGIN {*yelp = \&Messaging::yelp}

sub get_params ($$;$) {
	my ($objref, $allowed_and_default, $params) = @_;
	if ($#_ == 1) {
		($objref, $params) = @_;
		$allowed_and_default = $objref;
	} elsif ($#_ == 2) {
		($objref, $allowed_and_default, $params) = @_;
		my $a_n_d_type = ref $allowed_and_default;
		yelp "Unexpected param of type $a_n_d_type in %s::get_params\n",
	 					__PACKAGE__ unless $a_n_d_type  eq 'HASH'; 
	} else {
		yelp "Need 2 or 3 params to %s::get_params, got $#$ (line %s).\n",
	 				__PACKAGE__, __LINE__;
	}
	yelp "Need ref for param#1  in %s::get_params (line %s)\n", __PACKAGE__, 
				__LINE__ unless ref $objref;
	
	my $params_type = ref $params;

	yelp "Unexpected param of type $params_type in %s::get_params\n", __PACKAGE__
				unless  $params_type eq 'HASH';

	foreach (keys %$params) {
		if (exists $allowed_and_default->{$_}) {
			$objref->{$_} = $params->{$_};
		} else {
			yelp "Unknown param %s passed to %s::get_params (line %s)\n", $_, 
					__PACKAGE__, __LINE__;
		}
	}
	$objref;
}


################################################################################

package Sysmeter::Netdevio;
BEGIN {*get_params = \&Utils::get_params}
BEGIN {*max = \&Math::Simple::max}
BEGIN {*min = \&Math::Simple::min}
BEGIN {*safe_printf = \&Messaging::safe_printf}
use Readonly;	sub RO(\[$@%]@) {goto &Readonly};
use parent -norequire,  qw(BarGraph);

sub get_data {
	my $p = shift;
	my $params=$_[0];
	get_params($p, $params);
	RO my $procnetdev => "/proc/net/dev";
	#printf STDERR "Netio-get_data called with p=%s\n", $p;
	state $procnetdevh;
	unless ($procnetdevh) {
		open $procnetdevh, "<", $procnetdev or die "Can't open $procnetdev\n";
	} else {
		seek($procnetdevh, 0, 0) or die "Can't seek on $procnetdev\n";
	}
	my @net=<$procnetdevh>;
	$p->newdatap(\@net);
}

my $prev_objs_iop;

my ($netdev_fmt, $netdev_field_width, $netdev_lbl);
my $Fix_netdevname_len = 6;

# fields (2.6) 1=dev, (Rcv (2-9), Trx(10-17) x 
# 						(bytes, pck, err, drop, fifo, frame/coll cmp/carrier, muli/cmp)
# with leading space+dev+space stripped off, Rcv & Trx = 0-7 + 8-15
# Index constants for bytes:
RO my $RcvBytei	=> 0;
RO my $TrxBytei	=> 8;

sub process_data ($) {
	my $p=shift;
	my $newdatap=$_[0];
	#printf STDERR "Netio-processdata called\n";
	my @actives;
	my %next_prev_objs_iop;
	my $max_scale_val = 0;
	my $totBps = 0;
	my $max_netdev_len = 0;
	my $it = $p->inc_time;
	foreach(@$newdatap) {
		/^\s*(\S+):\s+(.*)$/ and do {
			my $dev	= $1;
			next if $dev eq 'lo';
			$_			= $2;
			$max_netdev_len = max($max_netdev_len, length $dev);
			my ($rb, $wb) = (split /\s+/)[$RcvBytei, $TrxBytei];
			my $tb = $rb + $wb;
			my @delta;
			my $prev_obj_iop = $prev_objs_iop &&  $prev_objs_iop->{$dev} // [0,0,0];
			$delta[0] = ($rb - $prev_obj_iop->[0]) / $it;
			$delta[1] = ($wb - $prev_obj_iop->[1]) / $it;
			my $dtb = $delta[2] = ($tb - $prev_obj_iop->[2]) / $it;
			push @actives, [ $dev, @delta] if $dtb;
			#safe_printf ("dev=%s, rb=%s, wb=%s, tb=%s\n", $dev, @delta) if $dtb;
			$max_scale_val = max($max_scale_val, $dtb);
			$totBps += $dtb;
			$next_prev_objs_iop{$dev} = [$rb, $wb, $tb];
		};
	}
	$max_netdev_len = min($max_netdev_len, $p->Fix_oname_len) 
		if $p->Fix_oname_len;
	$p->max_oname_len($max_netdev_len);
	$prev_objs_iop=\%next_prev_objs_iop;
	$p->totval($totBps);
	$p->maxval($max_scale_val);

	#printf "t=%d, mx=%d\n",$totBps, $max_scale_val;
	
	my @data  = sort { $b->[3] <=> $a->[3] } @actives;
	$p->datap(\@data);
}



sub new ($) {
	my $class = shift;
	my $params = $_[0];
	my Sysmeter::Netdevio $p = {
		'inc_time'					=> undef,
		'lbl_oid'						=> undef,
		'lbl_oname'					=> 'NetIF',	
		'obj'								=> 'Netio',
		'Fix_oname_len'			=> $Fix_netdevname_len,
		'objfmt'						=> "%s",
		'objfmt_len'				=> undef,
		'objlbl'						=> undef,
		'maxval'						=> undef,
		'subdatsp'					=> [["Receive",  "Rcv", $Tturq_clr, 	$Titurq_clr], 
														["Transmit", "Trx", $Tred_clr, $Tired_clr]], 
		'sclspc'						=> undef,
	};
	bless $p, $class;
	get_params($p, $params);
	$p;
}






################################################################################


################################################################################
package main;
BEGIN {*max = \&Math::Simple::max}
BEGIN {*min = \&Math::Simple::min}
BEGIN {*Tclear=\&Term::Funcs::Tclear}
BEGIN {*safe_printf = \&Messaging::safe_printf}

my ($do_devio, $do_procio, $do_netdevio) = (1, 1, 1);


#need accessors for graphics chars set by arg_process
sub arg_process($) {
	$_=$_[0];
	/^(\d+)$/ and do { $Interval = $1; return };
	/^--?(\S+)$/ and do {
		given ($1) {
			when("clear")						{$Scroll = 0;				return}
			when("scroll")					{$Scroll = 1;				return}
#			when(/sol=(\S+)/)				{$lbl_sol	= $1;			return}
#			when(/eol=(\S+)/)				{$lbl_eol	= $1;			return}
#			when(/line=(\S+)/)			{$lbl_fillch = $1; 	return}
#			when(/fill=(\S+)/)			{$fillch = $1;			return}
#			when(/thinfill=(\S+)/)	{$thinfillch = $1;	return}
#			when("ascii")						{BarGraph->sub_ascii;	return}
#			when(/procnamelen=(\d+)/)	{	$Fix_procname_len = $1; 
#																	$Display_procnames = 1; 
#																	return}
#			when("procnames")				{$Display_procnames = 1; return}

		}
	};
	print STDERR "Unknown arg: \"$_\" \n";
	sleep 1;
}


sub process_args($) { arg_process($_) foreach (@{$_[0]}) }



my $nl_sep="";
my $add_sep = 1;

sub thinline($) { my $width=$_[0]; $thinline x $width }
sub thickline($) { my $width=$_[0]; $thickline x $width }



sub display_output($$) {
	my ($metersp, $myterm) = @_;
	my $dspl_lines = $myterm->Rows;
	my $output = "";

	foreach my $meter (@$metersp) {
		my ($meter_out, $nlines) = $meter->get_output($dspl_lines, $myterm->Cols);
		if ($meter_out) {
			$dspl_lines -= $nlines;
			$output .=	$nl_sep . 
									($add_sep ? &thinline($myterm->Cols) . $nl_sep : "") .
									$meter_out;
			$nl_sep = $Tnl;
		}
	}

	return unless length $output;

	if ($Scroll) {
		print $Tnl;
	} else {
		print $Tclear;
		$nl_sep = "";
	}
	print $output .$Tnl;
	
	$StdOut->flush() unless ($Debuff_Output);
}




sub process_key($){
	my $key=$_[0];
	given ($key) {
		when("-") {$Interval>=2? --$Interval : $Interval >= .5 ? $Interval-=.1:0}
		when("+") {$Interval>=1 ? ++$Interval : ($Interval += 0.1)}
		when("d") {$do_devio=not $do_devio}
		when("p") {$do_procio=not $do_procio}
		when (3)	{continue};
		when("q") {print "\n";exit (0)}
	}
}


use Term::Size;
my $myterm;

sub try_read {
	my $testin_out=`testin`;
	chomp $testin_out;
	$testin_out =~ s/\((.*)\)/$1/s;
	$testin_out eq 'undef' and return undef;
	return $testin_out;
}

sub wait4key_or_time($) {
	my $wait = $_[0];
	my $poll_interval = .1;
	my $key;
	while (!($key=try_read()) && $wait>0 && !$myterm->need_winsize_update) {
		sleep min($wait, $poll_interval);
		$wait -= $poll_interval;
	}
	return $key;
}

sub main () {
	my @meters;
	my $last_data_get_time = 1.0*get_system_start_time;
	
	$myterm = new Term::Size;


	process_args(\@ARGV);
	
	push @meters, Sysmeter::Diskio->new( { }) if ($do_devio);
	
	push @meters, Sysmeter::Procio->new( { }) if ($do_procio);

	push @meters, Sysmeter::Netdevio->new( { }) if ($do_netdevio);

	my $fast_cycles = 2;
	
	while (1) {
		my $inc_time= 1.0*gettimeofday() - $last_data_get_time;
		my $wakeup_time = $fast_cycles ? 
											1.0*$last_data_get_time + min(1.5,$Interval):
											1.0*$last_data_get_time + $Interval;
		my $now;
		my $need_winsize_upd;
		$fast_cycles && --$fast_cycles;
		while (($now = 1.0*gettimeofday()) < $wakeup_time ) {
			my $char = wait4key_or_time($wakeup_time - $now);
			if ($myterm->need_winsize_update) {
				display_output(\@meters, $myterm);
				next;
			}
			$char && process_key($char);
		}
		
		$inc_time = $now - $last_data_get_time;
		$last_data_get_time = $now;

		foreach(@meters) {
			$_->get_data({ 'inc_time'	=>	$inc_time, });
		}

		display_output(\@meters, $myterm);	

	}
}

main();


=head1 NAME

iomon - a perl script that display active io for mounted partitions
 
=head1 DESCRIPTION
 
This script uses /proc/partitions to monitor I/O to and from mounted
partitions.  Each refresh (scrolled or new screen) will calculate the
I/O rate/partition and display a bar showing read/write speeds for
active partions.  The graph scale is resized over the past several data
points.

Read, write and total speeds may be shown for each partition if the
rates are high enough and if there is enough 'free space' to display the
total.  Read and write speeds are overlayed and centered over the 
scaled bar, or not displayed if the scaled area is too narrow.   
The total rate is displayed if there is enough blank room at the 
end of the line.   

Each cycle displays a legend that also shows the total I/O rate for all
devices.



=cut


# vim=:SetNumberAndWidth
# vim: ts=2 sw=2