#Article 8303 of comp.lang.perl:

#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 <[email protected]>
#Subject: Re: Why doesn't Perl use usleep and ualarm?
#Message-ID: <[email protected]>
#Originator: [email protected]
#Sender: [email protected] (USENET News System)
#Reply-To: [email protected] (Tom Christiansen)
#Organization: University of Colorado, Boulder
#References: <[email protected]>
#Date: Wed, 24 Nov 1993 12:34:25 GMT
#Lines: 116
#
#:-> In comp.lang.perl, [email protected] (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 <[email protected]>
#
# 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 [email protected]
# "Will Hack Perl for Fine Food and Fun"
# Boulder Colorado 303-444-3212
#
#
1;