#!/usr/bin/perl
#Modify the line below ($PIO =...) as needed.
#topio: This Perl script launches pio (Process I/O) to probe all processes
#on the system and sort them based on a desired I/O counter.
#(C) Yong Huang, 2010
#http://yong321.freeshell.org/freeware/pio.html

unless (-e "/proc/self/io")
{ print "This Linux kernel doesn't support TASK_IO_ACCOUNTING!\n";
  exit 1;
}

$PIO = "./pio";	#path to pio; absolute path is recommended, e.g., "/usr/local/bin/pio"

########## No need to modify below this line but hacking is welcome. ##########

use Getopt::Std;

getopts('s:n:k:h');

if (defined $opt_h)
 { print "Usage: $0 [-s Delay] [-n Top_n_lines] [-k sortkey] [-h]
    -s: Number of seconds delay between calls (default 5)
    -n: Only show top n processes (default 10)
    -k: sort key (default DltRC)
        r: for DltRC (delta read chars); w: DltWC (delta write chars); R: RChars; W: WChars;
        scr: DltRds (delta read syscalls); scw: DltWts; SCR: Rds; SCW: Wts
        rb: DltRB (delta read bytes); wb: DltWB; RB: RBytes; WB: WBytes;
        cwb: DltCWB (delta cancelled write bytes); CWB: cancelled write bytes
	See www.mjmwired.net/kernel/Documentation/filesystems/proc.txt#1282 for detailed description
	\"read/write bytes\" is about I/O from/to physical storage; \"read/write chars/syscalls\" 
	indiscriminately counts all I/Os, even from/to memory, terminal, or network
    -h: Show this Usage
    Example (show top 3 processes every 2 seconds, sorted by DltRCs): $0 -s2 -n3 -kr
    Best viewed with terminal width 150 or greater\n";
   exit;
 }

$opt_s = 5 if !defined $opt_s;
$opt_n = 10 if !defined $opt_n;
$opt_k = "r" if !defined $opt_k;

#Format to be used by write:
#pid, name, rchars, dlt
#-PID ProcName----- -----RdChars DltRChs ------WtChrs DltWChs -------Rds -DltRds ------Wts DltW ------RdBytes DltRBts -----WtByts DtWB ---CWBts DltCWB
format =
@>>>> @<<<<<<<<<<<< @>>>>>>>>>>> @>>>>>> @>>>>>>>>>>> @>>>>>> @>>>>>>>>> @>>>>>> @>>>>>>>> @>>> @>>>>>>>>>>>> @>>>>>> @>>>>>>>>>> @>>> @>>>>>>> @>>>>>
$_,$HoA{$_}[0],$HoA{$_}[1],$dltrc{$_},$HoA{$_}[2],$dltwc{$_},$HoA{$_}[3],$dltscr{$_},$HoA{$_}[4],$dltscw{$_},$HoA{$_}[5],$dltrb{$_},$HoA{$_}[6],$dltwb{$_},$HoA{$_}[7],$dltcwt{$_}
.

undef $/;
while (1)
 { $_ = qx{$PIO};	#slurp in all `pio' output

   @lines = split /\n/;
   %allpids = ();	#%allpids is used to delete pid's that're gone between calls to pio
   foreach (@lines)
    { #Each line is: pid ProcName RdChars WtChars Rds Wts RdBytes WtBytes CnclWtBytes
      next unless /^(\d+)\t(.*)/;
      $pid = $1;
      #@pval: all last 8 columns of one line, i.e. values for this pid
      #pval[0]:ProcName; [1]:RdChars; [2]:WtChars; [3]:Rds; [4]:Wts; [5]:RdBytes; [6]:WtBytes; [7]:CnclWtBytes
      @pval = split /\t/,$2;

      if (defined $HoA{$pid}[2]) #it's not defined in first iteration
       { $dltrc{$pid} = $pval[1] - $HoA{$pid}[1];   #Delta RdChars
         $dltwc{$pid} = $pval[2] - $HoA{$pid}[2];   #Delta WtChars
         $dltscr{$pid} = $pval[3] - $HoA{$pid}[3];  #Delta Rds
         $dltscw{$pid} = $pval[4] - $HoA{$pid}[4];  #Delta Wts
         $dltrb{$pid} = $pval[5] - $HoA{$pid}[5];   #Delta RdBytes
         $dltwb{$pid} = $pval[6] - $HoA{$pid}[6];   #Delta WtBytes
         $dltcwt{$pid} = $pval[7] - $HoA{$pid}[7];  #Delta CnclWtBytes
       }
      $HoA{$pid} = [ @pval ];	#$pid is key to this Hash of Array

      $allpids{$pid} = 1;	#hash for all current processes
    }

   foreach (keys %HoA)
    { if (! exists $allpids{$_}) #this process has disappeared, clean the hashes
       { delete $HoA{$_}; delete $dltrc{$_}; delete $dltwc{$_}; delete $dltscr{$_};
	 delete $dltscw{$_}; delete $dltrb{$_}; delete $dltwb{$_}; delete $dltcwt{$_};
       }
    }

   if (defined $show)	#prevent printing all 0's the first time around
    { $n = 0;
      print "--PID ProcName----- -----RdChars DltRChs ------WtChrs DltWChs -------Rds -DltRds ------Wts DltW ------RdBytes DltRBts -----WtByts DtWB ---CWBts DltCWB\n";

      if ($opt_k eq "r")    #sort on delta rchars
       { foreach (sort { $dltrc{$b} <=> $dltrc{$a} } keys %dltrc)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "w") #sort on delta wchars
       { foreach (sort { $dltwc{$b} <=> $dltwc{$a} } keys %dltwc)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "R") #sort on rchars
       { foreach (sort { $HoA{$b}[1] <=> $HoA{$a}[1] } keys %HoA)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "W") #sort on wchars
       { foreach (sort { $HoA{$b}[2] <=> $HoA{$a}[2] } keys %HoA)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "scr")    #sort on delta Rds
       { foreach (sort { $dltscr{$b} <=> $dltscr{$a} } keys %dltscr)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "scw") #sort on delta Wts
       { foreach (sort { $dltscw{$b} <=> $dltscw{$a} } keys %dltscw)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "SCR") #sort on Rds
       { foreach (sort { $HoA{$b}[3] <=> $HoA{$a}[3] } keys %HoA)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "SCW") #sort on Wts
       { foreach (sort { $HoA{$b}[4] <=> $HoA{$a}[4] } keys %HoA)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "rb")    #sort on delta rbytes
       { foreach (sort { $dltrb{$b} <=> $dltrb{$a} } keys %dltrb)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "wb") #sort on delta wbytes
       { foreach (sort { $dltwb{$b} <=> $dltwb{$a} } keys %dltwb)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "RB") #sort on rbytes
       { foreach (sort { $HoA{$b}[5] <=> $HoA{$a}[5] } keys %HoA)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "WB") #sort on wbytes
       { foreach (sort { $HoA{$b}[6] <=> $HoA{$a}[6] } keys %HoA)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "cwb") #sort on delta cancelled write bytes
       { foreach (sort { $dltcwt{$b} <=> $dltcwt{$a} } keys %dltcwt)
          { write; last if ++$n == $opt_n; }
       }
      elsif ($opt_k eq "CWB") #sort on cancelled write bytes
       { foreach (sort { $HoA{$b}[7] <=> $HoA{$a}[7] } keys %HoA)
          { write; last if ++$n == $opt_n; }
       }

     }
   $show = 1;

   sleep $opt_s;
 }