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   138217 use v5.6;
  7         30  
10              
11 7     7   31 use strict;
  7         10  
  7         117  
12 7     7   28 use warnings;
  7         10  
  7         211  
13              
14 7     7   32 use parent qw(Exporter);
  7         13  
  7         34  
15              
16 7     7   2452 use File::Which qw(which);
  7         4376  
  7         296  
17 7     7   2937 use IO::File;
  7         50598  
  7         714  
18 7     7   3209 use IPC::Run3 qw(run3);
  7         130015  
  7         370  
19 7     7   55 use XSLoader;
  7         15  
  7         3611  
20              
21             our @EXPORT = qw();
22             our @EXPORT_OK = qw(load getloadavg proc_loadavg uptime);
23              
24             our $VERSION = '0.31';
25              
26             XSLoader::load 'Sys::CpuLoad', $VERSION;
27              
28              
29             our $LOAD;
30              
31             sub load {
32 6 100   6 1 29107 return getloadavg(@_) if $LOAD eq 'getloadavg';
33 3 100       19 return proc_loadavg(@_) if $LOAD eq 'proc_loadavg';
34 2 100       20 return uptime(@_) if $LOAD eq 'uptime';
35 1         10 die "Unknown function: $LOAD";
36             }
37              
38              
39             sub proc_loadavg {
40              
41 2 50   2 1 688 if ( -r '/proc/loadavg' ) {
42              
43 2         19 my $fh = IO::File->new( '/proc/loadavg', 'r' );
44 2 50       274 if ( defined $fh ) {
45 2         51 my $line = <$fh>;
46 2         16 $fh->close();
47 2 50       50 if ( $line =~ /^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/ ) {
48 2         18 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 1217 local %ENV = %ENV;
61 3         17 $ENV{'LC_NUMERIC'} = 'POSIX'; # ensure that decimal separator is a dot
62              
63 3 50 66     28 $UPTIME ||= which("uptime") or
64             return undef;
65              
66 3         220 run3($UPTIME, \undef, \my $line);
67 3 50 33     25121 return undef if $? || !defined($line);
68 3 50       91 if ( $line =~ /(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*$/m )
69             {
70 3         41 return ( map { my $n = $_; $n =~ tr/,/./; $n + 0 } ( $1, $2, $3 ) );
  9         61  
  9         27  
  9         615  
71             }
72 0           return undef;
73             }
74              
75             sub BEGIN {
76              
77 7     7   28 my $this = __PACKAGE__;
78 7         36 my $os = lc $^O;
79              
80 7 50 0     56 if ( $os =~ /^(darwin|dragonfly|(free|net|open)bsd|linux|solaris|sunos)$/ ) {
    0          
81 7         214 $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__