1package 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
9use v5.6;
10
11use strict;
12use warnings;
13
14use parent qw(Exporter);
15
16use File::Which qw(which);
17use IO::File;
18use IPC::Run3 qw(run3);
19use XSLoader;
20
21our @EXPORT    = qw();
22our @EXPORT_OK = qw(load getloadavg proc_loadavg uptime);
23
24our $VERSION = '0.31';
25
26XSLoader::load 'Sys::CpuLoad', $VERSION;
27
28
29our $LOAD;
30
31sub load {
32    return getloadavg(@_)   if $LOAD eq 'getloadavg';
33    return proc_loadavg(@_) if $LOAD eq 'proc_loadavg';
34    return uptime(@_)       if $LOAD eq 'uptime';
35    die "Unknown function: $LOAD";
36}
37
38
39sub proc_loadavg {
40
41    if ( -r '/proc/loadavg' ) {
42
43        my $fh = IO::File->new( '/proc/loadavg', 'r' );
44        if ( defined $fh ) {
45            my $line = <$fh>;
46            $fh->close();
47            if ( $line =~ /^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/ ) {
48                return ( $1, $2, $3 );
49            }
50        }
51    }
52
53    return undef;
54}
55
56
57our $UPTIME;
58
59sub uptime {
60    local %ENV = %ENV;
61    $ENV{'LC_NUMERIC'} = 'POSIX'; # ensure that decimal separator is a dot
62
63    $UPTIME ||= which("uptime") or
64        return undef;
65
66    run3($UPTIME, \undef, \my $line);
67    return undef if $? || !defined($line);
68    if ( $line =~ /(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*,?\s+(\d+[,.]\d+)\s*$/m )
69    {
70        return ( map { my $n = $_; $n =~ tr/,/./; $n + 0 } ( $1, $2, $3 ) );
71    }
72    return undef;
73}
74
75sub BEGIN {
76
77    my $this = __PACKAGE__;
78    my $os   = lc $^O;
79
80    if ( $os =~ /^(darwin|dragonfly|(free|net|open)bsd|linux|solaris|sunos)$/ ) {
81        $LOAD = 'getloadavg';
82    }
83    elsif ( -r '/proc/loadavg' && $os ne 'cygwin' ) {
84        $LOAD = 'proc_loadavg';
85    }
86    else {
87        $LOAD = 'uptime';
88    }
89
90}
91
92
931;
94
95__END__
96
97=pod
98
99=encoding UTF-8
100
101=head1 NAME
102
103Sys::CpuLoad - retrieve system load averages
104
105=head1 VERSION
106
107version 0.31
108
109=head1 SYNOPSIS
110
111 use Sys::CpuLoad 'load';
112 print '1 min, 5 min, 15 min load average: ',
113       join(',', load()), "\n";
114
115=head1 DESCRIPTION
116
117This module retrieves the 1 minute, 5 minute, and 15 minute load average
118of a machine.
119
120=head1 EXPORTS
121
122=head2 load
123
124This method returns the load average for 1 minute, 5 minutes and 15
125minutes as an array.
126
127On Linux, Solaris, FreeBSD, NetBSD and OpenBSD systems, it will make a
128call to L</getloadavg>.
129
130If F</proc/loadavg> is available on non-Cygwin systems, it
131will call L</proc_loadavg>.
132
133Otherwise, it will attempt to parse the output of C<uptime>.
134
135On error, it will return an array of C<undef> values.
136
137As of v0.29, you can override the default function by changing
138C<$Sys::CpuLoad::LOAD>:
139
140  use Sys::CpuLoad 'load';
141
142  no warnings 'once';
143
144  $Sys::CpuLoad::LOAD = 'uptimr';
145
146  @load = load();
147
148If you are writing code to work on multiple systems, you should use
149the C<load> function.  But if your code is intended for specific systems,
150then you should use the appropriate function.
151
152=head2 getloadavg
153
154This is a wrapper around the system call to C<getloadavg>.
155
156If this call is unavailable, or it is fails, it will return C<undef>.
157
158Added in v0.22.
159
160=head2 proc_loadavg
161
162If F</proc/loadavg> is available, it will be used.
163
164If the data cannot be parsed, it will return C<undef>.
165
166Added in v0.22.
167
168=head2 uptime
169
170Parse the output of uptime.
171
172If the L<uptime> executable cannot be found, or the output cannot be
173parsed, it will return C<undef>.
174
175Added in v0.22.
176
177As of v0.24, you can override the executable path by setting
178C<$Sys::CpuLoad::UPTIME>, e.g.
179
180  use Sys::CpuLoad 'uptime';
181
182  no warnings 'once';
183
184  $Sys::CpuLoad::UPTIME = '/usr/bin/w';
185
186  @load = uptime();
187
188=head1 SEE ALSO
189
190L<Sys::CpuLoadX>
191
192=head1 SOURCE
193
194The development version is on github at L<https://github.com/robrwo/Sys-CpuLoad>
195and may be cloned from L<git://github.com/robrwo/Sys-CpuLoad.git>
196
197=head1 BUGS
198
199Please report any bugs or feature requests on the bugtracker website
200L<https://github.com/robrwo/Sys-CpuLoad/issues>
201
202When submitting a bug or request, please include a test-file or a
203patch to an existing test-file that illustrates the bug or desired
204feature.
205
206=head1 AUTHORS
207
208=over 4
209
210=item *
211
212Robert Rothenberg <rrwo@cpan.org>
213
214=item *
215
216Clinton Wong <clintdw@cpan.org>
217
218=back
219
220=head1 CONTRIBUTORS
221
222=for stopwords Slaven Rezić Victor Wagner Dmitry Dorofeev Vincent Lefèvre
223
224=over 4
225
226=item *
227
228Slaven Rezić <slaven@rezic.de>
229
230=item *
231
232Victor Wagner
233
234=item *
235
236Dmitry Dorofeev <dima@yasp.com>
237
238=item *
239
240Vincent Lefèvre <vincent@vinc17.net>
241
242=back
243
244=head1 COPYRIGHT AND LICENSE
245
246This software is copyright (c) 1999-2002, 2020 by Clinton Wong <clintdw@cpan.org>.
247
248This is free software; you can redistribute it and/or modify it under
249the same terms as the Perl 5 programming language system itself.
250
251=cut
252