#Article 8303 of comp.lang.perl:
#Xref: feenix.metronet.com comp.lang.perl:8303
#Newsgroups: comp.lang.perl
#Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!agate!library.ucla.edu!europa.eng.gtefsd.com!uunet!boulder!wraeththu.cs.colorado.edu!tchrist
#From: Tom Christiansen <tchrist@cs.Colorado.EDU>
#Subject: Re: Why doesn't Perl use usleep and ualarm?
#Message-ID: <CGzxLE.7uM@Colorado.EDU>
#Originator: tchrist@wraeththu.cs.colorado.edu
#Sender: news@Colorado.EDU (USENET News System)
#Reply-To: tchrist@cs.colorado.edu (Tom Christiansen)
#Organization: University of Colorado, Boulder
#References: <1993Nov23.165554.15373@wisipc.weizmann.ac.il>
#Date: Wed, 24 Nov 1993 12:34:25 GMT
#Lines: 116
#
#:-> In comp.lang.perl, dov@menora.weizmann.ac.il (Dov Grobgeld) writes:
#:One on the nice things about Perl is that there is that
#:floating points and integers are treated with equal respect.
#:But an exeption to this is the sleep and alarm commands. If I
#:write sleep(0.5) I expect the program to sleep for half a
#:second or 500_000 micro seconds. Shouldn't the Perl sleep
#:command really call usleep(2)? The same thing is true about the
#:alarm command which should call ualarm(). Is there a deep
#:reason which I'm missing?
#:
#:Another relevent question is about timers. Would it be possible
#:to have some interface to setitimers() in order to get a
#:periodic interrupt? Of course I can send a new alarm signal
#:inside my ISR, but that won't be as exect, and is not as
#:nicelooking, IMHO.
#
#Here's something I wrote long ago but haven't played with much lately.
#
#	itimers.pl - timer manipulation functions
#	written by tom christiansen <tchrist@cs.colorado.com>
#
#	alarm		      - like libc call but can take and returns floats
#
#	getitimer, setitimer  - like syscalls but return true on success
#				NB: require packed data for args
#
#	itimer		      - conversion function for packing and 
#				unpacking itimers.  packs in scalar context,
#				unpacks in array context.


package itimers;
require 'sys/syscall.ph';
require 'sys/time.ph';

defined &alarm;
defined &getitimer;
defined &setitimer;
defined &itimer;


if (defined &itimer'sizeof) {
    $itimer_t = &itimer'typedef();
    $itimer_s = &itimer'sizeof();
} else {
    # careful: implementation dependent!
    #
    $itimer_t = 'L4';  # itimers consist of four longs
    $itimer_s = length(pack($itimer_t, 0,0,0,0));
}

###########################################################################
# 
# alarm; send me a SIGALRM in this many seconds (fractions ok)
# 
#
sub alarm {
    local($ticks) = @_;
    local($itimer,$otimer);
    local($isecs, $iusecs, $secs, $usecs);

    $secs = int($ticks);
    $usecs = ($ticks - $secs) * 1e6;

    $otimer = &itimer(0,0,0,0);
    $itimer = &itimer(0,0,$secs,$usecs);

    &setitimer(&ITIMER_REAL, $itimer, $otimer) 
	|| warn "alarm: setitimer failed: $!";

    ($isecs, $iusecs, $secs, $usecs) = &itimer($otimer);
    return $secs + ($usecs/1e6);
} 

###########################################################################
sub setitimer {
    local($which) = shift;
    local($retval);

    die "setitimer: input itimer not length $itimer_s"
	unless length($_[0]) == $itimer_s;

    $_[1] = &itimer(0,0,0,0);
    !syscall(&SYS_setitimer, $which, $_[0], $_[1]);
} 

###########################################################################
sub getitimer {
    local($which) = shift;

    $_[0] = &itimer(0,0,0,0);

    !syscall(&SYS_getitimer, $which, $_[0]);
} 

###########################################################################
# itimer conversion function; this one goes both ways
#
sub itimer {
    if (wantarray) {
	warn "itimer: only expected one arg in array context" 	
	    if @_ > 1;
	warn "itimer: itimer to unpack not length $itimer_s"    
	    unless length($_[0]) == $itimer_s;
	return unpack($itimer_t, $_[0]);
    } else {
	warn "itimer: only expected 4 args in scalar context" 	
	    if @_ > 4;
	return pack($itimer_t, $_[0], $_[1], $_[2], $_[3]); 
    } 
} 
#-- 
#    Tom Christiansen      tchrist@cs.colorado.edu       
#      "Will Hack Perl for Fine Food and Fun"
#	Boulder Colorado  303-444-3212
#
#
1;