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   159976 use v5.6;
  7         35  
10              
11 7     7   38 use strict;
  7         11  
  7         143  
12 7     7   30 use warnings;
  7         12  
  7         218  
13              
14 7     7   37 use parent qw(Exporter);
  7         14  
  7         40  
15              
16 7     7   2928 use File::Which qw(which);
  7         5261  
  7         372  
17 7     7   3444 use IO::File;
  7         60618  
  7         820  
18 7     7   3907 use IPC::Run3 qw(run3);
  7         156223  
  7         431  
19 7     7   66 use XSLoader;
  7         15  
  7         4130  
20              
21             our @EXPORT = qw();
22             our @EXPORT_OK = qw(load getloadavg proc_loadavg uptime);
23              
24             our $VERSION = '0.30';
25              
26             XSLoader::load 'Sys::CpuLoad', $VERSION;
27              
28              
29             our $LOAD;
30              
31             sub load {
32 6 100   6 1 36143 return getloadavg(@_) if $LOAD eq 'getloadavg';
33 3 100       18 return proc_loadavg(@_) if $LOAD eq 'proc_loadavg';
34 2 100       24 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 658 if ( -r '/proc/loadavg' ) {
42              
43 2         19 my $fh = IO::File->new( '/proc/loadavg', 'r' );
44 2 50       277 if ( defined $fh ) {
45 2         65 my $line = <$fh>;
46 2         17 $fh->close();
47 2 50       55 if ( $line =~ /^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/ ) {
48 2         24 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 1454 local %ENV = %ENV;
61 3         19 $ENV{'LC_NUMERIC'} = 'POSIX'; # ensure that decimal separator is a dot
62              
63 3 50 66     47 $UPTIME ||= which("uptime") or
64             return undef;
65              
66 3         241 run3($UPTIME, \undef, \my $line);
67 3 50 33     20555 return undef if $? || !defined($line);
68 3 50       148 if ( $line =~ /(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*$/m )
69             {
70 3         64 return ( map { my $n = $_; $n =~ tr/,/./; $n + 0 } ( $1, $2, $3 ) );
  9         72  
  9         38  
  9         828  
71             }
72 0           return undef;
73             }
74              
75             sub BEGIN {
76              
77 7     7   35 my $this = __PACKAGE__;
78 7         43 my $os = lc $^O;
79              
80 7 50 0     70 if ( $os =~ /^(darwin|dragonfly|(free|net|open)bsd|linux|solaris|sunos)$/ ) {
    0          
81 7         248 $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__