File Coverage

blib/lib/Sys/CpuLoad.pm
Criterion Covered Total %
statement 48 52 92.3
branch 13 22 59.0
condition 3 9 33.3
subroutine 12 12 100.0
pod 3 3 100.0
total 79 98 80.6


line stmt bran cond sub pod time code
1             package Sys::CpuLoad;
2              
3             # ABSTRACT: retrieve system load averages
4              
5             # Copyright (c) 1999-2002 Clinton Wong. All rights reserved.
6             # This program is free software; you can redistribute it
7             # and/or modify it under the same terms as Perl itself.
8              
9 7     7   2246142 use v5.6;
  7         26  
10              
11 7     7   43 use strict;
  7         17  
  7         200  
12 7     7   34 use warnings;
  7         12  
  7         517  
13              
14 7     7   37 use parent qw(Exporter);
  7         56  
  7         59  
15              
16 7     7   3589 use File::Which qw(which);
  7         8545  
  7         575  
17 7     7   3774 use IO::File;
  7         81707  
  7         1171  
18 7     7   4339 use IPC::Run3 qw(run3);
  7         223736  
  7         536  
19 7     7   77 use XSLoader;
  7         18  
  7         7617  
20              
21             our @EXPORT = qw();
22             our @EXPORT_OK = qw(load getloadavg proc_loadavg uptime);
23              
24             our $VERSION = '0.32';
25              
26             XSLoader::load 'Sys::CpuLoad', $VERSION;
27              
28              
29             our $LOAD;
30              
31             sub load {
32 6 100   6 1 529923 return getloadavg(@_) if $LOAD eq 'getloadavg';
33 3 100       15 return proc_loadavg(@_) if $LOAD eq 'proc_loadavg';
34 2 100       14 return uptime(@_) if $LOAD eq 'uptime';
35 1         13 die "Unknown function: $LOAD";
36             }
37              
38              
39             sub proc_loadavg {
40              
41 2 50   2 1 802 if ( -r '/proc/loadavg' ) {
42              
43 2         21 my $fh = IO::File->new( '/proc/loadavg', 'r' );
44 2 50       299 if ( defined $fh ) {
45 2         78 my $line = <$fh>;
46 2         30 $fh->close();
47 2 50       112 if ( $line =~ /^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/ ) {
48 2         27 return ( $1, $2, $3 );
49             }
50             }
51             }
52              
53 0         0 return undef;
54             }
55              
56              
57             our $UPTIME;
58              
59             sub uptime {
60 3     3 1 1534 local %ENV = %ENV;
61 3         29 $ENV{'LC_NUMERIC'} = 'POSIX'; # ensure that decimal separator is a dot
62              
63 3 50 66     23 $UPTIME ||= which("uptime") or
64             return undef;
65              
66 3         263 run3($UPTIME, \undef, \my $line);
67 3 50 33     38821 return undef if $? || !defined($line);
68 3 50       95 if ( $line =~ /(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*$/m )
69             {
70 3         44 return ( map { my $n = $_; $n =~ tr/,/./; $n + 0 } ( $1, $2, $3 ) );
  9         86  
  9         114  
  9         794  
71             }
72 0           return undef;
73             }
74              
75             sub BEGIN {
76              
77 7     7   38 my $this = __PACKAGE__;
78 7         47 my $os = lc $^O;
79              
80 7 50 0     68 if ( $os =~ /^(darwin|dragonfly|(free|net|open)bsd|linux|solaris|sunos)$/ ) {
    0          
81 7         462 $LOAD = 'getloadavg';
82             }
83             elsif ( -r '/proc/loadavg' && $os ne 'cygwin' ) {
84 0         0 $LOAD = 'proc_loadavg';
85             }
86             else {
87 0         0 $LOAD = 'uptime';
88             }
89              
90             }
91              
92              
93             1;
94              
95             __END__