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.02';
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 ($^O =~ /bsd/i && 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;




=head1 NAME

Sys::CpuLoadX - a module to retrieve system load averages.

=head1 SYNOPSIS

    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";

=head1 FUNCTIONS

=over 4

=item C<@loads = Sys::CpuLoadX::load()>

Retrieves the 1 minute, 5 minute, and 15 minute load average
of a machine.

=item C<$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 C<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.

=back

=head1 AUTHOR

Original Sys::CpuLoad module by Clinton Wong, 
E<lt> http://search.cpan.org/search?mode=author&query=CLINTDW E<gt>

Original Win32::SystemInfo::CpuUsage by Jing Kang,
E<lt> kxj@hotmail.com E<gt>.

Updates by Marty O'Brien, E<lt> mob@cpan.org E<gt>.

=head1 LICENSE AND COPYRIGHT

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.

=cut





=cut
