# -*-Perl-*- # instances allowed: one # (single instance modules would be silly to use more than one of # anyway, so we use package local storage. This is faster and places # less artificial load on the machine than doing everything through # the object hash) # todo: go back to using disk id numbers as reported rather than # trying to make a contiguous numbering package MGMmodule::diskstat; use vars qw($xpath @rsectors @wsectors @prevr @prevw $widget $graph $numdisks $lastdisks $lastmod $kernel @disknames); use IO::Seekable; # class init sub module_init{ my$this=shift; my$toplevel=$this->{"toplevel"}; my$xclass=$this->{"xclass"}; # how many disks? Call read once to init $numdisks=0; # 2.0 and 2.2 if(defined($MGMmodule::helperST::proc{"disk_rblk"})){ $kernel=0;$this->read_proc; } # 2.4 if(defined($MGMmodule::helperST::proc{"disk_io:"})){ $kernel=4;$this->read_proc; } # 2.6 if(defined(%MGMmodule::helperST::disk26)){ $kernel=6;$this->read_proc; } if(!$numdisks){ $toplevel->optionAdd("$xclass.active",'false',21); } $toplevel->optionAdd("$xclass.order",10,21); $lastdisks=$numdisks; $this; } # instance init sub module_instance{ my$this=shift; my$toplevel=$this->{"toplevel"}; return undef if(defined($xpath)); $xpath=$this->{"xpath"}; # modify defaults for(my$i=0;$i<$numdisks;$i++){ $toplevel->optionAdd("$xpath.bar.".($i*2).".label", "$disknames[$i] read",21); $toplevel->optionAdd("$xpath.bar.".($i*2+1).".label", "$disknames[$i] write",21); $toplevel->optionAdd("$xpath.bar.".($i*2).".litbackground", '#e7ad74',21); $toplevel->optionAdd("$xpath.bar.".($i*2+1).".litbackground", '#ade774',21); } $toplevel->optionAdd("$xpath.scalewidadj", 160*$numdisks,21); # narrower $toplevel->optionAdd("$xpath.scalereturn", 120,21); # this relies on the above defaults my($minx,$miny)=MGM::Graph::calcxysize($this,1024*1024*512, ' sect/s',$numdisks*2); $toplevel->optionAdd("$xpath.minx", $minx,21); $toplevel->optionAdd("$xpath.miny", $miny,21); $this; } # instance widget build sub module_run{ my$this=shift; $graph=MGM::Graph->new($this,num=>$numdisks*2, prompt=>' sect/s', minscale=>128); $lastmod=-1; $widget=$graph->{"widget"}; # must return the widget } sub read_proc{ if($kernel==6){ #2.6-ish undef @rsectors; undef @wsectors; $numdisks=0; foreach my $key (sort(keys %MGMmodule::helperST::disk26)){ # if there are per-parition stats available, skip the whole-disk entries if($key=~m/^[^0-9]+$/){ if(defined($MGMmodule::helperST::disk26{"$key"."1"})){ next; } } if($MGMmodule::helperST::disk26{$key}=~m/\d+\s+\d+\s+(\d+)\s+\d+\s+\d+\s+\d+\s+(\d+)/ || $MGMmodule::helperST::disk26{$key}=~m/\d+\s+(\d+)\s+\d+\s+(\d+)/){ # if this entry is as-yet unused, ignore it next if($1==0 && $2==0); $rsectors[$numdisks]=$1; $wsectors[$numdisks]=$2; $disknames[$numdisks]=$key; $numdisks++; } } }else{ # now uses the 00helper to save on opens if($kernel==4){ #2.4-ish my $disk; my@disks=split ' ',$MGMmodule::helperST::proc{"disk_io:"}; $numdisks=0; undef @rsectors; undef @wsectors; foreach $disk (@disks){ $disk=~m/\(\d+,\d+\):\(\d+,\d+,(\d+),\d+,(\d+)\)/; if ($1 || $2){ $rsectors[$numdisks]=$1; $wsectors[$numdisks]=$2; $disknames[$numdisks]="disk$numdisks"; $numdisks++; } } }else{ #2.0/2.2-ish my@A=split ' ',$MGMmodule::helperST::proc{"disk_rblk"}; my@B=split ' ',$MGMmodule::helperST::proc{"disk_wblk"}; $numdisks=0; map{if ($A[$_] || $B[$_]){$rsectors[$numdisks]=$A[$_]; $wsectors[$numdisks]=$B[$_]; $disknames[$numdisks]="disk$numdisks"; }}(0..$#A); } } } sub module_update{ my$this=shift; # don't update unless the helper has if($lastmod!=$MGMmodule::helperST::lastmod){ my$time=$MGMmodule::helperST::lastmod; $this->read_proc; return &reconfig if($numdisks != $lastdisks); $lastdisks=$numdisks; if(defined(@prevr)){ my @vals; for(my$i=0;$i<=$#rsectors;$i++){ if ($rsectors[$i] or $wsectors[$i]){ my$r=($rsectors[$i]-$prevr[$i])/($time-$lastmod)*100; my$w=($wsectors[$i]-$prevw[$i])/($time-$lastmod)*100; push @vals, $r, $w; } } # don't be clever and only call set if values change; set must # be called each refresh period or the graph will get # confused. $graph->set(@vals); } @prevr=@rsectors; @prevw=@wsectors; $lastmod=$time; } } sub reconfig{ $lastdisks=$numdisks; @prevr=@rsectors; @prevw=@wsectors; &main::reinstance() if($widget->optionGet("reconfig","") eq 'true'); } sub destroy{ undef $xpath; } bless {};