File Coverage

blib/lib/Linux/Info/DiskStats.pm
Criterion Covered Total %
statement 77 116 66.3
branch 19 40 47.5
condition 5 12 41.6
subroutine 10 11 90.9
pod 4 4 100.0
total 115 183 62.8


line stmt bran cond sub pod time code
1             package Linux::Info::DiskStats;
2 1     1   7 use strict;
  1         2  
  1         27  
3 1     1   4 use warnings;
  1         2  
  1         27  
4 1     1   4 use Carp qw(croak);
  1         2  
  1         52  
5 1     1   799 use Time::HiRes 1.9725;
  1         1351  
  1         4  
6 1     1   491 use YAML::XS 0.41;
  1         2053  
  1         1242  
7             our $VERSION = '1.3'; # VERSION
8              
9             =head1 NAME
10              
11             Linux::Info::DiskStats - Collect linux disk statistics.
12              
13             =head1 SYNOPSIS
14              
15             use Linux::Info::DiskStats;
16              
17             my $lxs = Linux::Info::DiskStats->new;
18             $lxs->init;
19             sleep 1;
20             my $stat = $lxs->get;
21              
22             Or
23              
24             my $lxs = Linux::Info::DiskStats->new(initfile => $file);
25             $lxs->init;
26             my $stat = $lxs->get;
27              
28             =head1 DESCRIPTION
29              
30             Linux::Info::DiskStats gathers disk statistics from the virtual F filesystem (procfs).
31              
32             For more information read the documentation of the front-end module L.
33              
34             =head1 DISK STATISTICS
35              
36             Generated by F or F.
37              
38             major - The mayor number of the disk
39             minor - The minor number of the disk
40             rdreq - Number of read requests that were made to physical disk per second.
41             rdbyt - Number of bytes that were read from physical disk per second.
42             wrtreq - Number of write requests that were made to physical disk per second.
43             wrtbyt - Number of bytes that were written to physical disk per second.
44             ttreq - Total number of requests were made from/to physical disk per second.
45             ttbyt - Total number of bytes transmitted from/to physical disk per second.
46              
47             =head1 METHODS
48              
49             =head2 new()
50              
51             Call C to create a new object.
52              
53             my $lxs = Linux::Info::DiskStats->new;
54              
55             Maybe you want to store/load the initial statistics to/from a file:
56              
57             my $lxs = Linux::Info::DiskStats->new(initfile => '/tmp/diskstats.yml');
58              
59             If you set C it's not necessary to call sleep before C.
60              
61             It's also possible to set the path to the proc filesystem.
62              
63             Linux::Info::DiskStats->new(
64             files => {
65             # This is the default
66             path => '/proc',
67             diskstats => 'diskstats',
68             partitions => 'partitions',
69             }
70             );
71              
72             =head2 init()
73              
74             Call C to initialize the statistics.
75              
76             $lxs->init;
77              
78             =head2 get()
79              
80             Call C to get the statistics. C returns the statistics as a hash reference.
81              
82             my $stat = $lxs->get;
83              
84             =head2 raw()
85              
86             Get raw values.
87              
88             =head1 EXPORTS
89              
90             Nothing.
91              
92             =head1 SEE ALSO
93              
94             =over
95              
96             =item *
97              
98             B
99              
100             =item *
101              
102             L
103              
104             =back
105              
106             =head1 AUTHOR
107              
108             Alceu Rodrigues de Freitas Junior, Earfreitas@cpan.orgE
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             This software is copyright (c) 2015 of Alceu Rodrigues de Freitas Junior, Earfreitas@cpan.orgE
113              
114             This file is part of Linux Info project.
115              
116             Linux-Info is free software: you can redistribute it and/or modify
117             it under the terms of the GNU General Public License as published by
118             the Free Software Foundation, either version 3 of the License, or
119             (at your option) any later version.
120              
121             Linux-Info is distributed in the hope that it will be useful,
122             but WITHOUT ANY WARRANTY; without even the implied warranty of
123             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
124             GNU General Public License for more details.
125              
126             You should have received a copy of the GNU General Public License
127             along with Linux Info. If not, see .
128              
129             =cut
130              
131             sub new {
132 1     1 1 3 my $class = shift;
133 1 50       4 my $opts = ref( $_[0] ) ? shift : {@_};
134              
135 1         5 my %self = (
136             files => {
137             path => '/proc',
138             diskstats => 'diskstats',
139             partitions => 'partitions',
140             },
141              
142             # --------------------------------------------------------------
143             # The sectors are equivalent with blocks and have a size of 512
144             # bytes since 2.4 kernels. This value is needed to calculate the
145             # amount of disk i/o's in bytes.
146             # --------------------------------------------------------------
147             blocksize => 512,
148             );
149              
150 1 50       8 if ( defined $opts->{initfile} ) {
151 0         0 $self{initfile} = $opts->{initfile};
152             }
153              
154 1         2 foreach my $file ( keys %{ $opts->{files} } ) {
  1         4  
155 0         0 $self{files}{$file} = $opts->{files}->{$file};
156             }
157              
158 1 50       4 if ( $opts->{blocksize} ) {
159 0         0 $self{blocksize} = $opts->{blocksize};
160             }
161              
162 1         5 return bless \%self, $class;
163             }
164              
165             sub init {
166 2     2 1 4 my $self = shift;
167              
168 2 50 33     14 if ( $self->{initfile} && -r $self->{initfile} ) {
169 0         0 $self->{init} = YAML::XS::LoadFile( $self->{initfile} );
170 0         0 $self->{time} = delete $self->{init}->{time};
171             }
172             else {
173 2         11 $self->{time} = Time::HiRes::gettimeofday();
174 2         7 $self->{init} = $self->_load;
175             }
176             }
177              
178             sub get {
179 1     1 1 5 my $self = shift;
180 1         6 my $class = ref $self;
181              
182 1 50       9 if ( !exists $self->{init} ) {
183 0         0 croak "$class: there are no initial statistics defined";
184             }
185              
186 1         8 $self->{stats} = $self->_load;
187 1         6 $self->_deltas;
188              
189 1 50       6 if ( $self->{initfile} ) {
190 0         0 $self->{init}->{time} = $self->{time};
191 0         0 YAML::XS::DumpFile( $self->{initfile}, $self->{init} );
192             }
193              
194 1         5 return $self->{stats};
195             }
196              
197             sub raw {
198 0     0 1 0 my $self = shift;
199 0         0 my $raw = $self->_load;
200              
201 0         0 return $raw;
202             }
203              
204             #
205             # private stuff
206             #
207              
208             sub _load {
209 3     3   7 my $self = shift;
210 3         8 my $class = ref $self;
211 3         8 my $file = $self->{files};
212 3         6 my $bksz = $self->{blocksize};
213 3         7 my ( %stats, $fh );
214              
215             # -----------------------------------------------------------------------------
216             # one of the both must be opened for the disk statistics!
217             # if diskstats (2.6) doesn't exists then let's try to read
218             # the partitions (2.4)
219             #
220             # /usr/src/linux/Documentation/iostat.txt shortcut
221             #
222             # ... the statistics fields are those after the device name.
223             #
224             # Field 1 -- # of reads issued
225             # This is the total number of reads completed successfully.
226             # Field 2 -- # of reads merged, field 6 -- # of writes merged
227             # Reads and writes which are adjacent to each other may be merged for
228             # efficiency. Thus two 4K reads may become one 8K read before it is
229             # ultimately handed to the disk, and so it will be counted (and queued)
230             # as only one I/O. This field lets you know how often this was done.
231             # Field 3 -- # of sectors read
232             # This is the total number of sectors read successfully.
233             # Field 4 -- # of milliseconds spent reading
234             # This is the total number of milliseconds spent by all reads (as
235             # measured from __make_request() to end_that_request_last()).
236             # Field 5 -- # of writes completed
237             # This is the total number of writes completed successfully.
238             # Field 7 -- # of sectors written
239             # This is the total number of sectors written successfully.
240             # Field 8 -- # of milliseconds spent writing
241             # This is the total number of milliseconds spent by all writes (as
242             # measured from __make_request() to end_that_request_last()).
243             # Field 9 -- # of I/Os currently in progress
244             # The only field that should go to zero. Incremented as requests are
245             # given to appropriate request_queue_t and decremented as they finish.
246             # Field 10 -- # of milliseconds spent doing I/Os
247             # This field is increases so long as field 9 is nonzero.
248             # Field 11 -- weighted # of milliseconds spent doing I/Os
249             # This field is incremented at each I/O start, I/O completion, I/O
250             # merge, or read of these stats by the number of I/Os in progress
251             # (field 9) times the number of milliseconds spent doing I/O since the
252             # last update of this field. This can provide an easy measure of both
253             # I/O completion time and the backlog that may be accumulating.
254             # -----------------------------------------------------------------------------
255              
256             my $file_diskstats =
257 3 50       19 $file->{path} ? "$file->{path}/$file->{diskstats}" : $file->{diskstats};
258             my $file_partitions =
259 3 50       14 $file->{path} ? "$file->{path}/$file->{partitions}" : $file->{partitions};
260              
261 3 50       174 if ( open $fh, '<', $file_diskstats ) {
    0          
262 3         554 while ( my $line = <$fh> ) {
263              
264             # -- -- -- F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11
265             # $1 $2 $3 $4 -- $5 -- $6 -- $7 -- -- -- --
266 93 50       550 if ( $line =~
    0          
267             /^\s+(\d+)\s+(\d+)\s+(.+?)\s+(\d+)\s+\d+\s+(\d+)\s+\d+\s+(\d+)\s+\d+\s+(\d+)\s+\d+\s+\d+\s+\d+\s+\d+$/
268             )
269             {
270 93         261 for my $x ( $stats{$3} ) { # $3 -> the device name
271 93         240 $x->{major} = $1;
272 93         210 $x->{minor} = $2;
273 93         191 $x->{rdreq} = $4; # Field 1
274 93         227 $x->{rdbyt} = $5 * $bksz; # Field 3
275 93         191 $x->{wrtreq} = $6; # Field 5
276 93         192 $x->{wrtbyt} = $7 * $bksz; # Field 7
277 93         199 $x->{ttreq} += $x->{rdreq} + $x->{wrtreq};
278 93         424 $x->{ttbyt} += $x->{rdbyt} + $x->{wrtbyt};
279             }
280             }
281              
282             # -----------------------------------------------------------------------------
283             # Field 1 -- # of reads issued
284             # This is the total number of reads issued to this partition.
285             # Field 2 -- # of sectors read
286             # This is the total number of sectors requested to be read from this
287             # partition.
288             # Field 3 -- # of writes issued
289             # This is the total number of writes issued to this partition.
290             # Field 4 -- # of sectors written
291             # This is the total number of sectors requested to be written to
292             # this partition.
293             # -----------------------------------------------------------------------------
294             # -- -- -- F1 F2 F3 F4
295             # $1 $2 $3 $4 $5 $6 $7
296             elsif ( $line =~
297             /^\s+(\d+)\s+(\d+)\s+(.+?)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/ )
298             {
299 0         0 for my $x ( $stats{$3} ) { # $3 -> the device name
300 0         0 $x->{major} = $1;
301 0         0 $x->{minor} = $2;
302 0         0 $x->{rdreq} = $4; # Field 1
303 0         0 $x->{rdbyt} = $5 * $bksz; # Field 2
304 0         0 $x->{wrtreq} = $6; # Field 3
305 0         0 $x->{wrtbyt} = $7 * $bksz; # Field 4
306 0         0 $x->{ttreq} += $x->{rdreq} + $x->{wrtreq};
307 0         0 $x->{ttbyt} += $x->{rdbyt} + $x->{wrtbyt};
308             }
309             }
310             }
311 3         39 close($fh);
312             }
313             elsif ( open $fh, '<', $file_partitions ) {
314 0         0 while ( my $line = <$fh> ) {
315              
316             # -- -- -- -- F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11
317             # $1 $2 -- $3 $4 -- $5 -- $6 -- $7 -- -- -- --
318             next
319 0 0       0 unless $line =~
320             /^\s+(\d+)\s+(\d+)\s+\d+\s+(.+?)\s+(\d+)\s+\d+\s+(\d+)\s+\d+\s+(\d+)\s+\d+\s+(\d+)\s+\d+\s+\d+\s+\d+\s+\d+$/;
321 0         0 for my $x ( $stats{$3} ) { # $3 -> the device name
322 0         0 $x->{major} = $1;
323 0         0 $x->{minor} = $2;
324 0         0 $x->{rdreq} = $4; # Field 1
325 0         0 $x->{rdbyt} = $5 * $bksz; # Field 3
326 0         0 $x->{wrtreq} = $6; # Field 5
327 0         0 $x->{wrtbyt} = $7 * $bksz; # Field 7
328 0         0 $x->{ttreq} += $x->{rdreq} + $x->{wrtreq};
329 0         0 $x->{ttbyt} += $x->{rdbyt} + $x->{wrtbyt};
330             }
331             }
332 0         0 close($fh);
333             }
334             else {
335 0         0 croak "$class: unable to open $file_diskstats or $file_partitions ($!)";
336             }
337              
338 3 50 33     75 if ( !-e $file_diskstats || !scalar %stats ) {
339 0         0 croak
340             "$class: no diskstats found! your system seems not to be compiled with CONFIG_BLK_STATS=y";
341             }
342              
343 3         47 return \%stats;
344             }
345              
346             sub _deltas {
347 1     1   3 my $self = shift;
348 1         2 my $class = ref $self;
349 1         3 my $istat = $self->{init};
350 1         4 my $lstat = $self->{stats};
351 1         7 my $time = Time::HiRes::gettimeofday();
352 1         17 my $delta = sprintf( '%.2f', $time - $self->{time} );
353 1         5 $self->{time} = $time;
354              
355 1         4 foreach my $dev ( keys %{$lstat} ) {
  1         8  
356 31 50       69 if ( !exists $istat->{$dev} ) {
357 0         0 delete $lstat->{$dev};
358 0         0 next;
359             }
360              
361 31         51 my $idev = $istat->{$dev};
362 31         44 my $ldev = $lstat->{$dev};
363              
364 31         46 while ( my ( $k, $v ) = each %{$ldev} ) {
  279         751  
365 248 100       648 next if $k =~ /^major\z|^minor\z/;
366              
367 186 50       396 if ( !defined $idev->{$k} ) {
368 0         0 croak "$class: not defined key found '$k'";
369             }
370              
371 186 50 33     922 if ( $v !~ /^\d+\z/ || $ldev->{$k} !~ /^\d+\z/ ) {
372 0         0 croak "$class: invalid value for key '$k'";
373             }
374              
375 186 100 66     525 if ( $ldev->{$k} == $idev->{$k} || $idev->{$k} > $ldev->{$k} ) {
    50          
376 178         289 $ldev->{$k} = sprintf( '%.2f', 0 );
377             }
378             elsif ( $delta > 0 ) {
379             $ldev->{$k} =
380 8         49 sprintf( '%.2f', ( $ldev->{$k} - $idev->{$k} ) / $delta );
381             }
382             else {
383 0         0 $ldev->{$k} = sprintf( '%.2f', $ldev->{$k} - $idev->{$k} );
384             }
385              
386 186         393 $idev->{$k} = $v;
387             }
388             }
389             }
390              
391             1;