File Coverage

blib/lib/Linux/Info/PgSwStats.pm
Criterion Covered Total %
statement 65 80 81.2
branch 19 34 55.8
condition 5 12 41.6
subroutine 10 11 90.9
pod 4 4 100.0
total 103 141 73.0


line stmt bran cond sub pod time code
1             package Linux::Info::PgSwStats;
2 1     1   7 use strict;
  1         1  
  1         30  
3 1     1   5 use warnings;
  1         1  
  1         27  
4 1     1   4 use Carp qw(croak);
  1         2  
  1         50  
5 1     1   494 use Time::HiRes 1.9725;
  1         1369  
  1         5  
6 1     1   527 use YAML::XS 0.41;
  1         2688  
  1         1094  
7             our $VERSION = '1.5'; # VERSION
8              
9             =head1 NAME
10              
11             Linux::Info::PgSwStats - Collect linux paging and swapping statistics.
12              
13             =head1 SYNOPSIS
14              
15             use Linux::Info::PgSwStats;
16              
17             my $lxs = Linux::Info::PgSwStats->new;
18             $lxs->init;
19             sleep 1;
20             my $stat = $lxs->get;
21              
22             Or
23              
24             my $lxs = Linux::Info::PgSwStats->new(initfile => $file);
25             $lxs->init;
26             my $stat = $lxs->get;
27              
28             =head1 DESCRIPTION
29              
30             Linux::Info::PgSwStats gathers paging and swapping statistics from the virtual F filesystem (procfs).
31              
32             For more information read the documentation of the front-end module L.
33              
34             =head1 PAGING AND SWAPPING STATISTICS
35              
36             Generated by F or F.
37              
38             pgpgin - Number of pages the system has paged in from disk per second.
39             pgpgout - Number of pages the system has paged out to disk per second.
40             pswpin - Number of pages the system has swapped in from disk per second.
41             pswpout - Number of pages the system has swapped out to disk per second.
42              
43             The following statistics are only available by kernels from 2.6.
44              
45             pgfault - Number of page faults the system has made per second (minor + major).
46             pgmajfault - Number of major faults per second the system required loading a memory page from disk.
47              
48             =head1 METHODS
49              
50             =head2 new()
51              
52             Call C to create a new object.
53              
54             my $lxs = Linux::Info::PgSwStats->new;
55              
56             Maybe you want to store/load the initial statistics to/from a file:
57              
58             my $lxs = Linux::Info::PgSwStats->new(initfile => '/tmp/pgswstats.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::PgSwStats->new(
65             files => {
66             # This is the default
67             path => '/proc',
68             stat => 'stat',
69             vmstat => 'vmstat',
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 1     1 1 2 my $class = shift;
134 1 50       3 my $opts = ref( $_[0] ) ? shift : {@_};
135              
136 1         5 my %self = (
137             files => {
138             path => '/proc',
139             stat => 'stat',
140             vmstat => 'vmstat',
141             }
142             );
143              
144 1 50       4 if ( defined $opts->{initfile} ) {
145 0         0 $self{initfile} = $opts->{initfile};
146             }
147              
148 1         2 foreach my $file ( keys %{ $opts->{files} } ) {
  1         5  
149 0         0 $self{files}{$file} = $opts->{files}->{$file};
150             }
151              
152 1         5 return bless \%self, $class;
153             }
154              
155             sub init {
156 1     1 1 3 my $self = shift;
157              
158 1 50 33     8 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 1         4 $self->{time} = Time::HiRes::gettimeofday();
164 1         3 $self->{init} = $self->_load;
165             }
166             }
167              
168             sub get {
169 1     1 1 4 my $self = shift;
170 1         5 my $class = ref $self;
171              
172 1 50       5 if ( !exists $self->{init} ) {
173 0         0 croak "$class: there are no initial statistics defined";
174             }
175              
176 1         4 $self->{stats} = $self->_load;
177 1         6 $self->_deltas;
178              
179 1 50       3 if ( $self->{initfile} ) {
180 0         0 $self->{init}->{time} = $self->{time};
181 0         0 YAML::XS::DumpFile( $self->{initfile}, $self->{init} );
182             }
183              
184 1         5 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 2     2   4 my $self = shift;
200 2         5 my $class = ref $self;
201 2         5 my $file = $self->{files};
202 2         4 my %stats = ();
203              
204             my $filename =
205 2 50       13 $file->{path} ? "$file->{path}/$file->{stat}" : $file->{stat};
206 2 50       143 open my $fh, '<', $filename
207             or croak "$class: unable to open $filename ($!)";
208              
209 2         163 while ( my $line = <$fh> ) {
210 48 50       141 if ( $line =~ /^page\s+(\d+)\s+(\d+)$/ ) {
    50          
211 0         0 @stats{qw(pgpgin pgpgout)} = ( $1, $2 );
212             }
213             elsif ( $line =~ /^swap\s+(\d+)\s+(\d+)$/ ) {
214 0         0 @stats{qw(pswpin pswpout)} = ( $1, $2 );
215             }
216             }
217              
218 2         53 close($fh);
219              
220             # if paging and swapping are not found in /proc/stat
221             # then let's try a look into /proc/vmstat (since 2.6)
222              
223 2 50       9 if ( !defined $stats{pswpout} ) {
224             my $filename =
225 2 50       11 $file->{path} ? "$file->{path}/$file->{vmstat}" : $file->{vmstat};
226 2 50       69 open my $fh, '<', $filename
227             or croak "$class: unable to open $filename ($!)";
228 2         88 while ( my $line = <$fh> ) {
229             next
230 238 100       584 unless $line =~
231             /^(pgpgin|pgpgout|pswpin|pswpout|pgfault|pgmajfault)\s+(\d+)/;
232 12         52 $stats{$1} = $2;
233             }
234 2         30 close($fh);
235             }
236              
237 2         17 return \%stats;
238             }
239              
240             sub _deltas {
241 1     1   3 my $self = shift;
242 1         5 my $class = ref $self;
243 1         3 my $istat = $self->{init};
244 1         2 my $lstat = $self->{stats};
245 1         7 my $time = Time::HiRes::gettimeofday();
246 1         19 my $delta = sprintf( '%.2f', $time - $self->{time} );
247 1         3 $self->{time} = $time;
248              
249 1         2 while ( my ( $k, $v ) = each %{$lstat} ) {
  7         27  
250 6 50 33     23 if ( !defined $istat->{$k} || !defined $lstat->{$k} ) {
251 0         0 croak "$class: not defined key found '$k'";
252             }
253              
254 6 50 33     41 if ( $v !~ /^\d+\z/ || $istat->{$k} !~ /^\d+\z/ ) {
255 0         0 croak "$class: invalid value for key '$k'";
256             }
257              
258 6 100 66     33 if ( $lstat->{$k} == $istat->{$k} || $istat->{$k} > $lstat->{$k} ) {
    50          
259 4         7 $lstat->{$k} = sprintf( '%.2f', 0 );
260             }
261             elsif ( $delta > 0 ) {
262             $lstat->{$k} =
263 2         15 sprintf( '%.2f', ( $lstat->{$k} - $istat->{$k} ) / $delta );
264             }
265             else {
266 0         0 $lstat->{$k} = sprintf( '%.2f', $lstat->{$k} - $istat->{$k} );
267             }
268              
269 6         13 $istat->{$k} = $v;
270             }
271             }
272              
273             1;