line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# See copyright, etc in below POD section. |
2
|
|
|
|
|
|
|
###################################################################### |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Schedule::Load::Reporter::Disk; |
5
|
1
|
|
|
1
|
|
53874
|
use Schedule::Load qw (:_utils); |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
162
|
|
6
|
1
|
|
|
1
|
|
6
|
use Time::HiRes qw (gettimeofday); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
7
|
1
|
|
|
1
|
|
75
|
use IO::File; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
195
|
|
8
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
9
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
752
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $Debug; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
###################################################################### |
14
|
|
|
|
|
|
|
#### Configuration Section |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $_Proc_Filename = "/proc/diskstats"; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
###################################################################### |
19
|
|
|
|
|
|
|
#### Methods |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
1
|
|
|
1
|
1
|
476
|
my $class = shift; |
23
|
1
|
|
|
|
|
68
|
my $self = {_stats => {}, |
24
|
|
|
|
|
|
|
device_regexp => qr/^sd[a-z]$/, # Disks, but not partitions of disks |
25
|
|
|
|
|
|
|
enabled => (-e $_Proc_Filename), |
26
|
|
|
|
|
|
|
@_}; |
27
|
|
|
|
|
|
|
|
28
|
1
|
|
|
|
|
5
|
return bless $self, $class; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
2
|
|
|
2
|
1
|
21
|
sub stats { return $_[0]->{_stats}; } |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub poll { |
34
|
2
|
|
|
2
|
1
|
1000374
|
my $self = shift; |
35
|
2
|
|
|
|
|
4
|
my $now_sec = shift; my $now_usec = shift; |
|
2
|
|
|
|
|
5
|
|
36
|
2
|
50
|
|
|
|
10
|
if (!$now_sec) { ($now_sec, $now_usec) = gettimeofday(); } |
|
2
|
|
|
|
|
21
|
|
37
|
2
|
50
|
|
|
|
13
|
return if !$self->{enabled}; |
38
|
|
|
|
|
|
|
|
39
|
2
|
|
|
|
|
9
|
my @stats = $self->_block_raw_stats(); |
40
|
|
|
|
|
|
|
|
41
|
2
|
100
|
|
|
|
10
|
if (my $last = $self->{_block_last_stats}) { |
42
|
1
|
|
|
|
|
7
|
my $delt = ($now_sec - $self->{_block_last_sec}) |
43
|
|
|
|
|
|
|
+ ($now_usec - $self->{_block_last_usec})*1e-6; |
44
|
|
|
|
|
|
|
# All normalized to per second |
45
|
1
|
|
|
|
|
10
|
$self->{_stats}{disk_rd_num} = _diff($stats[0], $last->[0], $delt); # Num reads |
46
|
|
|
|
|
|
|
#$self->{_stats}{disk_rd_merged} = _diff($stats[1], $last->[1], $delt); # Reads merged |
47
|
1
|
|
|
|
|
6
|
$self->{_stats}{disk_rd_bytes} = _diff($stats[2], $last->[2], $delt); # Bytes read |
48
|
1
|
|
|
|
|
6
|
$self->{_stats}{disk_rd_sec} = _diff($stats[3], $last->[3], $delt); # Seconds reading |
49
|
1
|
|
|
|
|
5
|
$self->{_stats}{disk_wr_num} = _diff($stats[4], $last->[4], $delt); # Num writes |
50
|
|
|
|
|
|
|
#$self->{_stats}{disk_wr_merged} = _diff($stats[5], $last->[5], $delt); # Writes merged |
51
|
1
|
|
|
|
|
5
|
$self->{_stats}{disk_wr_bytes} = _diff($stats[6], $last->[6], $delt); # Bytes written |
52
|
1
|
|
|
|
|
6
|
$self->{_stats}{disk_wr_sec} = _diff($stats[7], $last->[7], $delt); # Seconds writing |
53
|
1
|
|
|
|
|
7
|
$self->{_stats}{disk_inprog_num} = _diff($stats[8], $last->[8], $delt); # IOs in progress (goes to 0) |
54
|
|
|
|
|
|
|
#$self->{_stats}{disk_io_ms} = _diff($stats[9], $last->[9], $delt); # Seconds doing io (goes to 0) |
55
|
|
|
|
|
|
|
#$self->{_stats}{disk_io_ms_weighted} = _diff($stats[10],$last->[10],$delt); # Weighted seconds (goes to 0) |
56
|
|
|
|
|
|
|
} |
57
|
2
|
|
|
|
|
6
|
$self->{_block_last_stats} = \@stats; |
58
|
2
|
|
|
|
|
6
|
$self->{_block_last_sec} = $now_sec; |
59
|
2
|
|
|
|
|
11
|
$self->{_block_last_usec} = $now_usec; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub _block_raw_stats { |
63
|
2
|
|
|
2
|
|
3
|
my $self = shift; |
64
|
|
|
|
|
|
|
# For nfs: /proc/self/mountstats |
65
|
|
|
|
|
|
|
# /sys/block is 3x faster than reading /proc/diskstats |
66
|
|
|
|
|
|
|
# but we often have >3 disks to do.... |
67
|
|
|
|
|
|
|
|
68
|
2
|
|
|
|
|
29
|
my $fh = IO::File->new("<$_Proc_Filename"); |
69
|
2
|
50
|
|
|
|
237
|
if (!$fh) { |
70
|
0
|
0
|
|
|
|
0
|
warn "%Warning: $! $_Proc_Filename," if $Debug; |
71
|
0
|
|
|
|
|
0
|
return undef; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
2
|
|
|
|
|
4
|
my @data; |
75
|
2
|
|
|
|
|
102
|
while (defined(my $line = $fh->getline)) { |
76
|
62
|
|
|
|
|
2777
|
$line =~ s/^ +//; |
77
|
62
|
|
|
|
|
563
|
my @linedata = split(/[ \t:]+/,$line); |
78
|
62
|
50
|
|
|
|
1644
|
next if $linedata[2] !~ /$self->{device_regexp}/; |
79
|
|
|
|
|
|
|
#use Data::Dumper; print "LD ",Dumper(\@linedata),"\n"; |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
0
|
$data[0] += $linedata[3]; # Num reads |
82
|
|
|
|
|
|
|
#$data[1] += $linedata[4]; # Reads merged |
83
|
0
|
|
|
|
|
0
|
$data[2] += $linedata[5]*512; # Sectors read (512 bytes each) |
84
|
0
|
|
|
|
|
0
|
$data[3] += $linedata[6]*1000; # Milliseconds reading |
85
|
0
|
|
|
|
|
0
|
$data[4] += $linedata[7]; # Num writes |
86
|
|
|
|
|
|
|
#$data[5] += $linedata[8]; # Writes merged |
87
|
0
|
|
|
|
|
0
|
$data[6] += $linedata[9]*512; # Sectors written (512 bytes each) |
88
|
0
|
|
|
|
|
0
|
$data[7] += $linedata[10]*1000; # Milliseconds writing |
89
|
0
|
|
|
|
|
0
|
$data[8] += $linedata[11]; # IOs in progress (goes to 0) |
90
|
|
|
|
|
|
|
#$data[9] += $linedata[12]*1000;# Millisec doing io (goes to 0) |
91
|
|
|
|
|
|
|
#$data[10]+= $linedata[13]*1000;# Weighted milliseconds (goes to 0) |
92
|
|
|
|
|
|
|
} |
93
|
2
|
|
|
|
|
91
|
$fh->close(); |
94
|
|
|
|
|
|
|
#print "_block_raw_stats ",join(' ',@data),"\n" if $Debug; |
95
|
2
|
|
|
|
|
73
|
return @data; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
####################################################################### |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub _diff { |
101
|
7
|
|
|
7
|
|
69
|
my $new = shift; |
102
|
7
|
|
|
|
|
11
|
my $old = shift; |
103
|
7
|
|
|
|
|
8
|
my $delt = shift; |
104
|
|
|
|
|
|
|
# Note statistics CAN WRAP! |
105
|
7
|
50
|
|
|
|
31
|
return undef if !defined $new; |
106
|
0
|
0
|
|
|
|
|
if ($old > $new) { $new += 4*1024*1024*1024; } |
|
0
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
return ($new - $old)/$delt; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
###################################################################### |
111
|
|
|
|
|
|
|
#### Package return |
112
|
|
|
|
|
|
|
1; |
113
|
|
|
|
|
|
|
__END__ |