File Coverage

blib/lib/Schedule/Load/Reporter/Disk.pm
Criterion Covered Total %
statement 52 64 81.2
branch 7 16 43.7
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 72 93 77.4


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__