#!/usr/bin/perl -w 
# 
# Prototype Code
# Copyright L A Walsh 2011
#
use strict;
use feature ':5.10';
use Fatal;
use Time::HiRes qw(ualarm);

my ($Devel, $Debuff_Output) = (1, 1);
if ($Debuff_Output) { select STDERR; $| = 1; select STDOUT; $| = 1; }
if ($Devel) {
	$ENV{PERL_HASH_SEED} = 0;
	use Carp qw(cluck confess);
	$SIG{__WARN__} = $SIG{__DIE__} = sub {
		$Carp::CarpLevel = 1 if defined $^S && !$^S;
		$SIG{__WARN__} = $SIG{__DIE__} = undef;
		confess $_[0] if defined $^S;
		die "Fatal Exit: Perl backtrace unavailable\n";
		}
}

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

my $interval         = 2;
my $Iostatargs       = "-dk";
my $clear            = `tput clear`;
my $at00             = `tput cup 0 0`;
my $term_reset_color = `tput sgr0`;
my $norm_color       = $term_reset_color;
my $term_bold        = `tput bold`;
my $term_blue_color  = `tput setaf $colors{blue}`;
my $term_red_color   = `tput setaf $colors{red}`;
my $read_color       = $term_blue_color;
my $write_color      = $term_red_color;
my ($rfds, $wfds, $efds) = ('', '', '');
my $ioh;

foreach (@ARGV) {
	/^(\d+)$/ and do { $interval = $1; next };
	print STDERR "Unknown arg: \"$_\"\n";
	sleep 1;
}

open($ioh, "iostat $interval $Iostatargs|") ||
	die "Can't start iostat $?\n";


my $maxcols;

sub maxcols {
	my $stty = `/bin/stty size </dev/tty`;
	my ($rows, $cols) = ($stty =~ /^(\d+)\s+(\d+)/);
	$maxcols = $cols if defined $cols;
	$maxcols;
}

my @dev_sub_strs = ('[hs]d[abcdefg-z]\s', 'md[0-9]\s', 'dm-\d+');
my $ord_sub_strs = '(?:' . (join '|', @dev_sub_strs) . ')';
my $devexp       = '(' . '.*' . $ord_sub_strs . ')';
my $rest_exp     = '(.*)$';
my $data_exp     = qr{$devexp . $rest_exp};
my $termwidth    = $maxcols ? $maxcols : &maxcols ? $maxcols : 80;

my $mapper_devno = 252;

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

my $use_shortnames = 1;

my $short_regexp    = qr{^.*-([^-]+)$};
my $long_regexp     = qr{^(.*)$};
my $mapper_name_exp = $use_shortnames ? $short_regexp : $long_regexp;

my @map_names;
my @map_namelens;

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;
		};
	}
	$map_names[ $maxdm + 1 ] = "NO_SUCH_DEV";
	my $dmapper_h;
	opendir($dmapper_h, "/dev/mapper") ||
		die "Can't opendir on /dev/mapper\n";
	print "using RE $mapper_name_exp\n";
	while ($_ = readdir $dmapper_h) {
		chomp;
		/$mapper_name_exp/ 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;
			$map_namelens[$minor] = length $1;
			print "min=$minor, name=$1, len=", length $1, "\n";
		};
	}
}

sub map_namelen {
	_populate_mapnames unless @map_names;
	return $map_namelens[$1];
}

sub map_name {
	_populate_mapnames unless @map_names;
	return $map_names[$1];
}

vec($rfds, fileno($ioh), 1) = 1;
$efds = $rfds | $wfds;
my $maxread = 2 * 1024 * 1024;

my $running = 1;
my @data;
while ($running) {
	my $nfound = select $rfds, $wfds, $efds, 0;
	unless ($nfound) {
		print "$clear$at00";
		&print_title;
		&print_devs;
	} else {
		exit 1 if (vec $efds, fileno($ioh), 1);
		sleep 1;
		my $rawdata;
		my $readlen = sysread $ioh, $rawdata, $maxread;
		print "read $readlen/$maxread\n";
		@data = split /\n/, $rawdata;
	}
	for (my $i=0; $i<=$#data; ++$i) {
		printf "data[$i]=%s\n", $data[$i];
	}
	my $max_rate    = 0;
	my $max_namelen = 0;
	foreach (@data,) {
		print "line=".$_."\n";
		if (/$data_exp/) {
			my ($dev, $rest) = ($1, $2);
			print "dev=$dev\n";
			/^(\S+)\s+\S+\s+(\S+)\s+(\S+)\s+/ || die "Unparseable string: '$_'\n";
			my ($name, $rrate, $wrate) = ($1, $2, $3);
			my $namelen;
			if ($name =~ /^dm-(\d+)$/) {
				my $mapdev = $1;
				$name    = map_name $mapdev;
				$namelen = map_namelen $mapdev;
			} else {
				$namelen = length $name;
			}
			my $total = $rrate + $wrate;
			$max_rate    = $total   if $total > $max_rate;
			$max_namelen = $namelen if $namelen > $max_namelen;
			push @data, [ $name, $rrate, $wrate, $total ];
		}
	}
	my @sorted_data = sort { $a->[3] <=> $b->[3] } @data;
	print "mx_rate=$max_rate, mxnmln=$max_namelen, trmwid=$termwidth\n";
	$max_namelen = 20 if ($max_namelen > 20);
	my $device_suffix   = " : ";
	my $dev_sfxlen      = length $device_suffix;
	my $max_scale_space = $termwidth - $max_namelen - $dev_sfxlen;
	my $units_str       = "KB/s";
	my $divisor         = 1;

	if ($max_rate > 9999) {
		$max_rate /= ($divisor = 1024);
		$units_str = "MB/s";
	}

	my @rate_formats = ("%.2f","%.1f","%.0f");
	my $rate_format;
	my $desired_max_rate_format_len = 6;
	my $rate_str;
	my $rate_strlen;
	foreach (@rate_formats) {
		$rate_format	=	$_;
		$rate_str = sprintf $rate_format, $max_rate;
		$rate_strlen = length $rate_str;
		last if $rate_strlen <= $desired_max_rate_format_len;
	}

	my $scale_str		=  ($rate_format . " " . $units_str);
	my $ss_len      = length $scale_str;
	
	my $mid_str0		= " |<-- Read+Write -- ";		#for len calcs

	my $dev_format	=	"%-${max_namelen}.${max_namelen}s";
	my $mid_string	= " |<-- " . $term_bold . $read_color . "Read" .
											"$norm_color" . "+" . $write_color . "Write" . 
											$norm_color . " -- ";
	my $end_string = "-->|";
	my $label_fill_len	=	$termwidth - $max_namelen - $ss_len - 1 -
												length($mid_str0 . $end_string);

	my $label_str = $dev_format . $mid_string . $scale_str .  " " .
									('-' x $label_fill_len) . $end_string;
	print "lab_str=$label_str\n";
	printf "$label_str\n", "Device", $rate_str;
	
	my $rate_per_space = ($max_rate) / $max_scale_space;
	print "units=$units_str, maxrt=$max_rate, rt_p_space=$rate_per_space\n";

	foreach (@sorted_data) {
		my ($dev, $rrate, $wrate, $tot) = @$_;
		$rrate /= $divisor;
		$wrate /= $divisor;
		$tot   /= $divisor;

		my $read_fill  = int($rrate / $rate_per_space);
		my $write_fill = int($wrate / $rate_per_space);
		my $rdfill_ch  = '=';
		my $wrfill_ch  = '=';

		if ($read_fill < 1 && ($rrate / $rate_per_space) > 0) {
			$read_fill = 1;
			$rdfill_ch = "|";
		}
		if ($write_fill < 1 && ($wrate / $rate_per_space) > 0) {
			$write_fill = 1;
			$wrfill_ch  = "|";
		}
		if ($read_fill + $write_fill > $max_scale_space) {
			if   ($write_fill > $read_fill) { --$write_fill; }
			else                            { --$read_fill; }
		}
		printf $dev_format, $dev;
		print " : ";
		#print "(r=$read_fill, w=$write_fill)";
		print $term_bold;
		if ($read_fill > 0) {
			print $read_color . ($rdfill_ch x $read_fill);
		}
		if ($write_fill > 0) {
			print $write_color . ($wrfill_ch x $write_fill);
		}
		print $norm_color. "\n";
	}
	@data = undef;
}

# vim: ts=2 sw=2