File Coverage

blib/lib/Linux/Info/ProcStats.pm
Criterion Covered Total %
statement 68 81 83.9
branch 18 30 60.0
condition 5 12 41.6
subroutine 11 12 91.6
pod 4 4 100.0
total 106 139 76.2


line stmt bran cond sub pod time code
1             package Linux::Info::ProcStats;
2 2     2   14 use strict;
  2         3  
  2         60  
3 2     2   10 use warnings;
  2         4  
  2         55  
4 2     2   9 use Carp qw(croak);
  2         4  
  2         122  
5 2     2   1049 use Time::HiRes 1.9725;
  2         2772  
  2         10  
6 2     2   1094 use YAML::XS 0.41;
  2         5501  
  2         2195  
7             our $VERSION = '1.5'; # VERSION
8              
9             =head1 NAME
10              
11             Linux::Info::ProcStats - Collect linux process statistics.
12              
13             =head1 SYNOPSIS
14              
15             use Linux::Info::ProcStats;
16              
17             my $lxs = Linux::Info::ProcStats->new;
18             $lxs->init;
19             sleep 1;
20             my $stat = $lxs->get;
21              
22             Or
23              
24             my $lxs = Linux::Info::ProcStats->new(initfile => $file);
25             $lxs->init;
26             my $stat = $lxs->get;
27              
28             =head1 DESCRIPTION
29              
30             Linux::Info::ProcStats gathers process statistics from the virtual F filesystem (procfs).
31              
32             For more information read the documentation of the front-end module L.
33              
34             =head1 IMPORTANT
35              
36             I renamed key C to C!
37              
38             =head1 LOAD AVERAGE STATISTICS
39              
40             Generated by F and F.
41              
42             new - Number of new processes that were produced per second.
43             runqueue - The number of currently executing kernel scheduling entities (processes, threads).
44             count - The number of kernel scheduling entities that currently exist on the system (processes, threads).
45             blocked - Number of processes blocked waiting for I/O to complete (Linux 2.5.45 onwards).
46             running - Number of processes in runnable state (Linux 2.5.45 onwards).
47              
48             =head1 METHODS
49              
50             =head2 new()
51              
52             Call C to create a new object.
53              
54             my $lxs = Linux::Info::ProcStats->new;
55              
56             Maybe you want to store/load the initial statistics to/from a file:
57              
58             my $lxs = Linux::Info::ProcStats->new(initfile => '/tmp/procstats.yml');
59              
60             If you set C it's not necessary to call sleep before C.
61              
62             It's also possible to set the path to the proc filesystem.
63              
64             Linux::Info::ProcStats->new(
65             files => {
66             # This is the default
67             path => '/proc',
68             loadavg => 'loadavg',
69             stat => 'stat',
70             }
71             );
72              
73             =head2 init()
74              
75             Call C to initialize the statistics.
76              
77             $lxs->init;
78              
79             =head2 get()
80              
81             Call C to get the statistics. C returns the statistics as a hash reference.
82              
83             my $stat = $lxs->get;
84              
85             =head2 raw()
86              
87             Get raw values.
88              
89             =head1 EXPORTS
90              
91             Nothing.
92              
93             =head1 SEE ALSO
94              
95             =over
96              
97             =item *
98              
99             B
100              
101             =item *
102              
103             L
104              
105             =back
106              
107             =head1 AUTHOR
108              
109             Alceu Rodrigues de Freitas Junior, Earfreitas@cpan.orgE
110              
111             =head1 COPYRIGHT AND LICENSE
112              
113             This software is copyright (c) 2015 of Alceu Rodrigues de Freitas Junior, Earfreitas@cpan.orgE
114              
115             This file is part of Linux Info project.
116              
117             Linux-Info is free software: you can redistribute it and/or modify
118             it under the terms of the GNU General Public License as published by
119             the Free Software Foundation, either version 3 of the License, or
120             (at your option) any later version.
121              
122             Linux-Info is distributed in the hope that it will be useful,
123             but WITHOUT ANY WARRANTY; without even the implied warranty of
124             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
125             GNU General Public License for more details.
126              
127             You should have received a copy of the GNU General Public License
128             along with Linux Info. If not, see .
129              
130             =cut
131              
132             sub new {
133 2     2 1 6 my $class = shift;
134 2 50       8 my $opts = ref( $_[0] ) ? shift : {@_};
135              
136 2         10 my %self = (
137             files => {
138             path => '/proc',
139             loadavg => 'loadavg',
140             stat => 'stat',
141             }
142             );
143              
144 2 50       8 if ( defined $opts->{initfile} ) {
145 0         0 $self{initfile} = $opts->{initfile};
146             }
147              
148 2         3 foreach my $file ( keys %{ $opts->{files} } ) {
  2         9  
149 0         0 $self{files}{$file} = $opts->{files}->{$file};
150             }
151              
152 2         16 return bless \%self, $class;
153             }
154              
155             sub init {
156 2     2 1 4 my $self = shift;
157              
158 2 50 33     16 if ( $self->{initfile} && -r $self->{initfile} ) {
159 0         0 $self->{init} = YAML::XS::LoadFile( $self->{initfile} );
160 0         0 $self->{time} = delete $self->{init}->{time};
161             }
162             else {
163 2         8 $self->{time} = Time::HiRes::gettimeofday();
164 2         6 $self->{init} = $self->_load;
165             }
166             }
167              
168             sub get {
169 2     2 1 7 my $self = shift;
170 2         9 my $class = ref $self;
171              
172 2 50       11 if ( !exists $self->{init} ) {
173 0         0 croak "$class: there are no initial statistics defined";
174             }
175              
176 2         10 $self->{stats} = $self->_load;
177 2         15 $self->_deltas;
178              
179 2 50       8 if ( $self->{initfile} ) {
180 0         0 $self->{init}->{time} = $self->{time};
181 0         0 YAML::XS::DumpFile( $self->{initfile}, $self->{init} );
182             }
183              
184 2         11 return $self->{stats};
185             }
186              
187             sub raw {
188 0     0 1 0 my $self = shift;
189 0         0 my $stat = $self->_load;
190              
191 0         0 return $stat;
192             }
193              
194             #
195             # private stuff
196             #
197              
198             sub _load {
199 4     4   11 my $self = shift;
200 4         9 my $class = ref $self;
201 4         8 my $file = $self->{files};
202 4         12 my $lavg = $self->_procs;
203              
204             my $filename =
205 4 50       22 $file->{path} ? "$file->{path}/$file->{loadavg}" : $file->{loadavg};
206 4 50       151 open my $fh, '<', $filename
207             or croak "$class: unable to open $filename ($!)";
208 4         118 ( $lavg->{runqueue}, $lavg->{count} ) =
209             ( split m@/@, ( split /\s+/, <$fh> )[3] );
210 4         118 close($fh);
211              
212 4         38 return $lavg;
213             }
214              
215             sub _procs {
216 4     4   8 my $self = shift;
217 4         8 my $class = ref $self;
218 4         8 my $file = $self->{files};
219 4         9 my %stat = ();
220              
221             my $filename =
222 4 50       24 $file->{path} ? "$file->{path}/$file->{stat}" : $file->{stat};
223 4 50       270 open my $fh, '<', $filename
224             or croak "$class: unable to open $filename ($!)";
225              
226 4         351 while ( my $line = <$fh> ) {
227 96 100       341 if ( $line =~ /^processes\s+(\d+)/ ) {
    100          
228 4         33 $stat{new} = $1;
229             }
230             elsif ( $line =~ /^procs_(blocked|running)\s+(\d+)/ ) {
231 8         38 $stat{$1} = $2;
232             }
233             }
234              
235 4         78 close($fh);
236 4         33 return \%stat;
237             }
238              
239             sub _deltas {
240 2     2   6 my $self = shift;
241 2         7 my $class = ref $self;
242 2         5 my $istat = $self->{init};
243 2         6 my $lstat = $self->{stats};
244 2         15 my $time = Time::HiRes::gettimeofday();
245 2         25 my $delta = sprintf( '%.2f', $time - $self->{time} );
246 2         7 $self->{time} = $time;
247              
248 2 50 33     22 if ( !defined $istat->{new} || !defined $lstat->{new} ) {
249 0         0 croak "$class: not defined key found 'new'";
250             }
251 2 50 33     27 if ( $istat->{new} !~ /^\d+\z/ || $lstat->{new} !~ /^\d+\z/ ) {
252 0         0 croak "$class: invalid value for key 'new'";
253             }
254              
255 2         6 my $new_init = $lstat->{new};
256              
257 2 100 66     36 if ( $lstat->{new} == $istat->{new} || $istat->{new} > $lstat->{new} ) {
    50          
258 1         3 $lstat->{new} = sprintf( '%.2f', 0 );
259             }
260             elsif ( $delta > 0 ) {
261             $lstat->{new} =
262 1         11 sprintf( '%.2f', ( $new_init - $istat->{new} ) / $delta );
263             }
264             else {
265 0         0 $lstat->{new} = sprintf( '%.2f', $new_init - $istat->{new} );
266             }
267              
268 2         8 $istat->{new} = $new_init;
269             }
270              
271             1;