File: diskuse

package info (click to toggle)
mgm 1.1.cvs.20020221-2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 1,724 kB
  • ctags: 33
  • sloc: perl: 768; makefile: 32
file content (124 lines) | stat: -rw-r--r-- 2,758 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
# -*-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)

use Tk;
package MGMmodule::diskuse;
use vars qw($xpath $graph $widget $fs $num @data @labels);

sub module_init{
    my$this=shift;
    my$toplevel=$this->{"toplevel"};
    my$xclass=$this->{"xclass"};

    # how many filesystems?
    $this->read_proc;
    unless ($fs>0){
	$toplevel->optionAdd("$xclass*active",'false',21);
    }
    $toplevel->optionAdd("$xclass.order",100,21);
    $this;
}

sub module_instance{
    my$this=shift;
    my$toplevel=$this->{"toplevel"};
    return undef if(defined($xpath));
    $xpath=$this->{"xpath"};
    # modify defaults
    $toplevel->optionAdd("$xpath*scalerefresh",30000,21); # slower
    $this->read_proc;

    undef@labels;
    $num=0;
    for(my$i=0;$i<$fs;$i++){
	my$label=shift @data;
	
	push @labels, ($label);
	my$cap=shift @data;
	my($adj,$mult)=MGM::Graph::scalemod($cap*10);
	$adj=int($adj+.5)/10;

	# modify the label (if needed)

	$toplevel->optionAdd("$xpath.bar.$i.label", "$label $adj$mult",22);
	shift @data;
	$num++;
    }

    $toplevel->optionAdd("$xpath.scalewidadj", 80*$fs,21);  # narrower
    $toplevel->optionAdd("$xpath.bar*litbackground", "#e8d088",21); 

    my($minx,$miny)=&MGM::Graph::calcxysize($this,100,'% used',$fs);

    $toplevel->optionAdd("$xpath.minx",        $minx,21);      
    $toplevel->optionAdd("$xpath.miny",        $miny,21);          
    $this;
}

sub module_run{
    my$this=shift;
    $graph=MGM::Graph->new($this,num=>$fs,
			   prompt=>'% used',fixed=>1,
			   rangesetting=>100,rangecurrent=>100);
    $widget=$graph->{"widget"};
    $this->module_update;
    $widget;
}

sub read_proc{
    my$output=qx{'df' '-k'};
    my@temp=split "\n",$output;
    undef @data;

    $fs=0;
    if($temp[0]=~m/Filesystem/){
	shift @temp;
	while(defined(my$line=shift @temp)){
	    if($line=~m/^\S+\s+(\d+)\s+\d+\s+\d+\s+(\d+)\%\s+(\S+)/){

		# is this a label we want to display?  Filter /proc and AFS
		# for example...

		next if($3=~m/^\/?afs/);
		next if($3=~m/^\/?proc/);
		next if($3=~m/^\/?kern/);

		$fs++;
		push @data, ($3,$1*1024,$2);
	    }
	}
    }
}

sub module_update{
    my$this=shift;
    $this->read_proc;
    my@adj;
    my$i=0;
    while($#data>0){
	return &reconfig if(!defined($labels[$i]));
	return &reconfig if(shift(@data) ne $labels[$i]);
	shift @data;
	push @adj, (shift @data);
	$i++;
    }
    $graph->set(@adj);
    &reconfig if($i!=$num);
}

sub reconfig{
    &main::reinstance() if($widget->optionGet("reconfig","") eq 'true');
}

sub destroy{
    undef $xpath;
}

bless {};