package Proc::NiceSleep;

#############################################################################
# Proc::NiceSleep - quasi-intelligent sleeping library
# Copyright (c) 2002 Josh Rabinowitz, see COPYRIGHT below
# $Id: NiceSleep.pm,v 1.22 2002/02/21 23:27:37 root Exp $ 
# originally generated by joshr 20020216
#############################################################################
use 5.004;	# tested this far back and up to 5.6.1...
use strict;	# please
#use warnings;	# hook 'em up	# these don't exist in 5.004

require Exporter;
#use AutoLoader qw(AUTOLOAD);	# we don't use this yet

# we check for get/setpriority(), Proc::Processtable, and Time::HiRes 
# in a fault-tolerant manner in init()

# We do 'use vars' like this so we can work nice in old perls
use vars qw($VERSION);
$VERSION = '0.50';

# these are 'public'
use vars qw ( %EXPORT_TAGS @EXPORT_OK @ISA
	$SLEEPMODE_WALLCLOCK $SLEEPMODE_TOTALCPU 
	$SLEEPMODE_USERCPU   $SLEEPMODE_SYSTEMCPU ); 

# these are private. 
use vars qw ( $_lastsleeptime $_sleepfactor $_sleepmode $_minruntime 
		$_totalruntime $_totalsleeptime $_havetimehires 
		$_havetimehires $_havesetpriority 
		$_haveprocprocesstable);	

@ISA = qw(Exporter);

	
# Items to export into callers namespace by default. 

# This allows declaration	use Proc::NiceSleep ':all';
# Note to self: If we do not need this, moving things directly 
# into @EXPORT or @EXPORT_OK will save memory.
#our 
%EXPORT_TAGS = ( 'all' => [ qw(
	maybesleep sleepfactor minruntime nice
) ] );

# sleepmode not yet implemented
#our 
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

# these are constants for sleepmode(), they are for public use...later
$SLEEPMODE_WALLCLOCK = 	0;	# wallclock (default)
$SLEEPMODE_TOTALCPU =	1;	# total CPU time
$SLEEPMODE_USERCPU =	2;	# only user CPU time
$SLEEPMODE_SYSTEMCPU =	3;	# only system CPU time 

# variables prefixed by _ are intended to be private
#$_lastsleeptime;	# the last time we slept, from time()
#$_sleepfactor;	# 1.0 means to sleep 1.0 times as long as we 'run'
#$_sleepmode;	# the mode, see SLEEPMODE_ constants
#$_minruntime;	# how long we run before considering yielding
#$_totalruntime;	# how long we were running, in sleepmode units.
#					# does not include time sleeping in maybesleep()
#$_totalsleeptime;	# how long we slept in maybesleep(), 
#						# in apparent wallclock seconds
#$_havetimehires;		# do we have Time::HiRes ?
#$_haveprocprocesstable;	# do we have Proc::ProcessTable?
#$_havesetpriority;		# do we have a setpriority() call?

# all through we use built-in or Time::HiRes versions of
# time() and sleep(), and get microsecond res ... or not.

#############################################################################
# Preloaded methods go here.
#############################################################################

# nice() this renices the process, like /bin/nice, if it can.
# if passed an integer parameter (between -20 to 20 inclusive)
#   it attempts to set the priority and returns the priority 
#   it tried to set the process to.
# if called without a parameter, returns what we think the priority is
# does not work on win32 (always should return 0); use maybesleep() ! :)
sub nice {
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	my $param = shift;
	# 'man setpriority' on rh7.2: The setpriority call returns 0 if there 
	# is no error, or -1 if there is.
	if (defined($param)) {
		$param = int($param);	# pass me an int, holmes
		if ($_havesetpriority && setpriority(0,0,$param) != -1) {
			# even though man page says the above, setpriority(0,0,5) returns 1
			# on RH7.2
			return $param;
		} else {
			return 0;
		} 
	} 
	return ($_havesetpriority ? getpriority(0,0) : 0); 
	# no param, return what we think the nice value is.
} 

# checks to see if we should sleep.
# returns how long we think we slept if we did, 0 otherwise
sub maybesleep {	
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	my $timepassed = get_time_passed();	
	# NOTE: above may not use wallclock time when sleepmodes are complete.
	my $slept = 0;
	if ($timepassed >= $_minruntime) {
		# for some reason Time::HiRes::time() doesn't override time() here
		my $t1 = ($_havetimehires ? Time::HiRes::time() : CORE::time());
		#print "t1: $t1\n";
		$_totalruntime += ($t1 - $_lastsleeptime);
		my $timetosleep = $_sleepfactor * $timepassed;
		#print "timetosleep: $timetosleep\n";
		if($_havetimehires) {
			Time::HiRes::sleep($timetosleep);	# YIELD the system via SLEEP
		} else {
			$timetosleep = int($timetosleep + .5);	# round off.
			if ($timetosleep <= 0) { $timetosleep = 1; } # can't be neg or 0
			CORE::sleep($timetosleep);	# actually YIELD the system via SLEEP
		}
		my $t2 = ($_havetimehires ? Time::HiRes::time() : CORE::time());
		#print "t2: $t2\n";
		my $actualsleeptime = $t2 - $t1;
		$_totalsleeptime += $actualsleeptime;	# how long we slept
		$_lastsleeptime = $t2;					# record this
		$slept = $actualsleeptime;								# for return
	}
	return $slept;							# in case they wonder
}
# sets or gets, depending on whether it gets param or not
sub sleepfactor {
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	my $param = shift;
	if (defined($param)) { $_sleepfactor = $param; } 
	else { return $_sleepfactor; }
} 
# sets or gets, depending on whether it gets param or not
sub minruntime {
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	my $param = shift;
	if (defined($param)) { $_minruntime = $param; } 
	else { return $_minruntime; } 
}
# returns a ref to a hash with data about the progress...
# for informational purposes only. return values subject to change.
sub Dump {
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	my %hash = (
		TOTAL_RUN_TIME => $_totalruntime,
		TOTAL_SLEEP_TIME => $_totalsleeptime,
		HAVE_TIME_HIRES => $_havetimehires,
		HAVE_PROC_PROCESSTABLE => $_haveprocprocesstable,
		HAVE_SETPRIORITY => $_havesetpriority,
		SLEEP_FACTOR => $_sleepfactor,
		MIN_RUN_TIME => $_minruntime,
		TOTAL_SLEEP_TIME => $_totalsleeptime,
		LAST_SLEEP_TIME => scalar(localtime($_lastsleeptime)),
		TOTAL_RUN_TIME => $_totalruntime, 	# extra comma here is ok, cool!  
	);
	return \%hash;
}
# this is for informational purposes only. Data and its output subject to change
# written to remove dependence on Data::Dumper in our example.pl
sub DumpText { 
	# a convenient method to ascii-ify return of Dump() nicely for reporting.
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	my $hashref = Dump();
	my $str = "";
	for my $e (sort keys(%$hashref)) {
		$str .= sprintf("  %-23s: %s\n", $e, $$hashref{$e});
	}
	return $str;	# returns a nice, ascii text page of the name/vals :)
}

#############################################################################
#  THINGS AFTER HERE (until perldocs) ARE PRIVATE METHODS !!!
#############################################################################
# time() and sleep() are so test programs don't have to test for Time::HiRes
sub time  { ($_havetimehires ? Time::HiRes::time()    : CORE::time());    }
sub sleep { ($_havetimehires ? Time::HiRes::sleep(@_) : CORE::sleep(@_)); }
sub init {		# intended to be private
	# try to load Time::HiRes and ProcessTable

	eval("require Time::HiRes");
	if ($@) { $_havetimehires = 0; } else { $_havetimehires = 1; }
	# eval alone can't seem to import sleep() and time() from Time::HiRes.
	# 'use Time::HiRes qw(sleep time);' from here doesn't seem to get 
	# sleep() and time() imported outside this function, either.

	eval("use Proc::ProcessTable");  # we don't use this.... yet.
	if ($@) { $_haveprocprocesstable = 0 } else { $_haveprocprocesstable = 1 }

	eval('my $pri=getpriority(0,0); setpriority(0,0,$pri);');  
		# check for setpriority() and setpriority() with a (hopefully) no-op
	if ($@) { $_havesetpriority = 0 } else { $_havesetpriority = 1 }

	$_sleepfactor = 1;
	$_sleepmode = $SLEEPMODE_WALLCLOCK;
	$_minruntime = 1;	# can be shorter if we have Time::HiRes
	$_totalruntime = 0;
	$_totalsleeptime = 0;
	$_lastsleeptime = Proc::NiceSleep::time();
}
# sets or gets, depending on whether it gets param or not. not public yet
sub sleepmode {	
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	my $param = shift;
	if (defined($param)) { $_sleepmode = $param; } 
	else { return $_sleepmode; }
}
# sets or gets, depending on whether it gets param or not
sub get_time_passed {	# intended to be private
	# init will already have been done by our single caller
	if ($_sleepmode == $SLEEPMODE_WALLCLOCK) { 
		my $t1 = ($_havetimehires ? Time::HiRes::time() : CORE::time());
		return ($t1 - $_lastsleeptime);
	} elsif ($_sleepmode == $SLEEPMODE_TOTALCPU) {
		die "Not yet implemented";
	} elsif ($_sleepmode == $SLEEPMODE_USERCPU) {
		die "Not yet implemented";
	} elsif ($_sleepmode == $SLEEPMODE_SYSTEMCPU)  {
		die "Not yet implemented";
	} else {
		die "Unknown sleepmode: $_sleepmode!";
	}
}
# Invariant(): attempt to check that the vars are self-consistent.
# returns 1 if OK, 0 if object 'bad'
sub Invariant {	# intended to be private.  Used in tests
	unless (defined($_lastsleeptime)) { init(); }	# autoinit on first use
	# check obvious things:
	# if we think we have Time::HiRes, is time() fractional? Inverse?
	# we used to test that we did or didn't get fractional times, but
	# it turns out that just cause you have Time::HiRes doesn't mean you
	# get fractional times and sleeps.
	if ($_havetimehires) { # could still be integer-based 
		#my ($t1, $t2) = (time(), time());	# at least ONE shouldn't be int
		#return 0 if ($t1 == int($t1) && $t2 == int($t2));
	} else {
		# we assume no version of perl has a sub-second time() in CORE (!)
		my ($t1, $t2) = (CORE::time(), CORE::time());	# both should be ints
		return 0 if ($t1 != int($t1) || $t2 != int($t2));
	}
	return 1;	# that's all we test... seems ok!
}

# Autoload methods go after =cut, and are processed by the autosplit program.
# we have none ... yet.
#############################################################################
1;

__END__

# Below is documentation for Proc::NiceSleep 

=head1 NAME

Proc::NiceSleep - yield system in a quasi-intelligent fashion

=head1 SYNOPSIS

  use Proc::NiceSleep qw( sleepfactor minruntime maybesleep nice ); 
  nice(5);                 # lower our priority if our OS supports it 
  sleepfactor(2);          # sleep 2x as long as we run
  minruntime(2);           # run at least 2 seconds without sleep
  while($somecondition) {
    dosomething();
    $slept = maybesleep(); # sleep some amount of time if appropriate 
  }

=head1 DESCRIPTION

Proc::NiceSleep is a Perl 5 module which defines subroutines
to allow a process to yield use of the system in a method consistent 
with the configured policy.  

Proc::NiceSleep is intended for use in situations where the 
operating system does not support priorities, or where using the 
operating system's built-in priorities does not yield the system 
sufficiently. 

A convenient nice() function, which acts much like the shell 
command and executable of the same name, is also provided 
for easy, platform independent access to your system's 
priorities (if available). 

If Proc::NiceSleep autodetects the presence of the Time::HiRes 
module and your operating system supports it then timing and yielding
operations will occur with sub-second granularity.
If not, no warning or error will be issued but Proc::NiceSleep operations 
will occur with a granularity of about one second.  

By default Proc::NiceSleep expects to yield the process for an amount
of time equal to the amount of time that process runs without sleeping 
(wallclock time). This is expressed by the default Sleep Factor of 1.0.

The following functions can be imported from this module.
No functions are exported by default.

=over 4

=item nice ()

Sets or gets the priority of the process, as understood by the operating system.
If passed an integer, nice() attempts to set priority of the process to the 
value specified, and returns that value.  If no parameter is passed, 
nice() attempts to query the operating system for the priority of the 
process and return it.  If your OS doesn't support priorities then 
nice() will likely always return 0.  

The exact nice() values returned and recognized, and their meanings 
to the system, are system dependent, but usually range from about 
-20 (signifying highest priority) to 20 (signifying lowest priority, 
'nicest'). 

=item maybesleep ()

Checks to see if this process should yield use of the system by
issuing some kind of sleep at this point, and if so, does so 
for an appropriate amount of time.  Returns 0 if no sleep was 
performed, otherwise returns the amount of seconds we think
maybesleep() actually slept for.

=item sleepfactor ()

Sets or gets the sleep factor depending on whether a number is 
passed or not.  A sleep factor of 1 means to sleep an equal amount 
of time as we run, 2 means to sleep twice as long, and so on. The default
value is 1.

=item minruntime ()

Sets or gets the minimum run time, in seconds, depending on whether 
a number is passed or not. The minumum run time is the least amount of time 
that Proc::NiceSleep will allow the process to run between sleeps. 
The default value is 1.

=item Dump ()

Returns a reference to a hash with internal information about
Proc::NiceSleep configuration and statistics. The names and presence
of Dump()'s returned hash names and values are for informational and debugging
purposes only and are subject to change without notice. Modifying this 
hash will have no effect on the operation of Proc::NiceSleep

=back

Proc::NiceSleep is loosely modeled on Lincoln Stein's CGI.pm and 
on D. Wegscheid and other's Time::HiRes.pm.  

=head1 EXPORT

None by default.  

=head1 AUTHOR

Josh Rabinowitz, E<lt>joshr-proc-nicesleep@joshr.comE<gt>

=head1 CAVEATS

sleepfactor() and minruntime() require numeric parameters if present,
but no check is made that the passed scalar is a number.  

Uncoordinated use of sleep() (and possibly of signal() and alarm()) in 
your perl program may cause your program to yield the system more or 
less than specified via Proc::NiceSleep policies.

=head1 SEE ALSO

L<Time::HiRes>, L<Proc::Queue>, L<Proc::Swarm>

=head1 COPYRIGHT

  Copyright (c) 2002 Josh Rabinowitz
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl itself.  

=head1 ACKNOWLEDGEMENTS

Thanks to D. Wegscheid and others for Time::HiRes.pm.  Thanks also
to Michael G Schwern, Terrence Brannon, and David Alban for their valuable 
input.

=cut

#############################################################################
# future doc
# L<Process::ProcessTable>.
#Proc::NiceSleep will also attempt to load the (at the time of writing) beta 
#Proc::ProcessTable module for its experimental (and undocumented) Sleep Modes.
