| Forks-Super documentation | Contained in the Forks-Super distribution. |
Sys::CpuLoadX - a module to retrieve system load averages.
use Sys::CpuLoadX;
print '1 min, 5 min, 15 min load average: ',
join(',', Sys::CpuLoadX::load()), "\n";
print "Best estimate of current load = ", Sys::CpuLoadX::get_cpu_load(), "\n";
@loads = Sys::CpuLoadX::load()Retrieves the 1 minute, 5 minute, and 15 minute load average of a machine.
$load = Sys::CpuLoadX::get_cpu_load()Returns the best estimate of the current system load.
For Unix like systems, this is the 1 minute load average like
the one returned from uptime(1), and measures the average
number of active processes that are competing for CPU time.
For Windows machines (include Cygwin), it is computed
from a one second sample of the CPU load, and is a value
between 0 and 1 representing the fraction of CPU utilization
during that second.
This function will return -1 if it cannot determine a suitable method for finding the CPU load on the system.
Original Sys::CpuLoad module by Clinton Wong, < http://search.cpan.org/search?mode=author&query=CLINTDW >
Original Win32::SystemInfo::CpuUsage by Jing Kang, < kxj@hotmail.com >.
Updates by Marty O'Brien, < mob@cpan.org >.
Copyright (c) 1999-2002, 2010 Clinton Wong and Marty O'Brien. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
See http://dev.perl.org/licenses/ for more information.
| Forks-Super documentation | Contained in the Forks-Super distribution. |
package Sys::CpuLoadX; # Copyright (c) 1999-2002 Clinton Wong. All rights reserved. # This program is free software; you can redistribute it # and/or modify it under the same terms as Perl itself. # (This copyright notice is from the original Sys::CpuLoad package) use strict; require Exporter; require DynaLoader; require AutoLoader; our @ISA = qw(Exporter AutoLoader DynaLoader); our @EXPORT = qw(); our @EXPORT_OK = qw(load get_cpu_load); our $VERSION = '0.03'; our $WIN32_INTERVAL = 1000; # milliseconds to run to get CPU usage { local $@; eval { bootstrap Sys::CpuLoadX $VERSION }; if ($@) { warn "bootstrap Sys::CpuLoadX call failed.\n"; } } use IO::File; my $cache = 'unknown'; sub load { # handle bsd getloadavg(). Read the README about why it is freebsd/openbsd. if ($cache eq 'getloadavg()' or lc $^O eq 'freebsd' or lc $^O eq 'openbsd' ) { $cache = 'getloadavg()'; return xs_getbsdload() } # handle linux proc filesystem if ($cache eq 'unknown' or $cache eq 'linux') { my $fh = new IO::File('/proc/loadavg', 'r'); if (defined $fh) { my $line = <$fh>; $fh->close(); if ($line =~ /^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/) { $cache = 'linux'; return ($1, $2, $3); } # if we can parse /proc/loadavg contents } # if we could load /proc/loadavg } # if linux or not cached # last resort... $cache = 'uptimepipe'; local %ENV = %ENV; $ENV{'LC_NUMERIC'}='POSIX'; # ensure that decimal separator is a dot my $uptime_cmd = _configExternalProgram('uptime'); if ($uptime_cmd) { my $uptime_result = qx($uptime_cmd 2> /dev/null); $uptime_result =~ s/\s+$//; my @uptime = (split /\s*,?\s+/, $uptime_result)[-3 .. -1]; if (@uptime == 3) { return @uptime; } } return (undef, undef, undef); } sub get_cpu_load { if ( (lc $^O eq 'freebsd' || lc $^O eq 'openbsd') && defined &xs_getbsdload) { my @bsdload = xs_getbsdload(); _debug("load from bsdload: @bsdload"); if (@bsdload >= 3) { return $bsdload[0]; } } if (defined &xs_getCpuUsage) { my $cpuUsage = xs_getCpuUsage($WIN32_INTERVAL); _debug("load from xs_getCpuUsage: $cpuUsage"); return $cpuUsage > 0 ? $cpuUsage * 0.01 : "0.00"; } if (-r '/proc/loadavg' && $^O ne 'cygwin') { open my $loadavg_fh, '<', '/proc/loadavg'; my $line = <$loadavg_fh>; close $loadavg_fh; _debug("load from /proc/loadavg: $line"); if ($line =~ /^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)/) { return $1; } } my $uptime_cmd = _configExternalProgram('uptime'); if ($uptime_cmd && $^O ne 'cygwin') { my $uptime_result = qx($uptime_cmd 2> /dev/null); $uptime_result =~ s/\s+$//; _debug("load from 'uptime': $uptime_result"); my @uptime = (split /\s*,?\s+/, $uptime_result)[-3 .. -1]; if (@uptime == 3) { return $uptime[0]; } } _debug("no load result: returning -1"); return -1.0; } ############################################################################# our %PROGRAM = (); our @PATH = (); sub _configExternalProgram { my $program = shift; return $PROGRAM{$program} if defined $PROGRAM{$program}; if (-x $program) { _debug("Program $program is available in $program"); return $PROGRAM{$program} = $program; } my $which = qx(which $program 2>/dev/null); $which =~ s/\s+$//; if ($which) { _debug("Program $program is available in $which"); return $PROGRAM{$program} = $which; } # poor man's which if (@PATH == 0) { @PATH = split /:/, $ENV{PATH}; push @PATH, split /;/, $ENV{PATH}; push @PATH, "."; push @PATH, "/sbin", "/usr/sbin"; } foreach my $dir (@PATH) { if (-x "$dir/$program") { _debug("Program $program is available in $dir/$program"); $PROGRAM{$program} = "$dir/$program"; } } return $PROGRAM{$program} = 0; } our $DEBUG = $ENV{DEBUG} || 0; sub _debug { if ($DEBUG) { print STDERR @_,"\n"; } } 1;