package Time::HiRes;
use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL);
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
require Exporter;
-require DynaLoader;
+use XSLoader;
-@ISA = qw(Exporter DynaLoader);
+@ISA = qw(Exporter);
@EXPORT = qw( );
-@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval);
-
-$VERSION = do{my@r=q$Revision: 1.20 $=~/\d+/g;sprintf '%02d.'.'%02d'x$#r,@r};
-
-bootstrap Time::HiRes $VERSION;
+@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
+ getitimer setitimer ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF);
+
+$VERSION = '1.21';
+
+sub AUTOLOAD {
+ my $constname;
+ ($constname= $AUTOLOAD) =~ s/.*:://;
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($!) {
+ my ($pack,$file,$line) = caller;
+ die "Your vendor has not defined Time::HiRes macro $constname, used at $file line $line.\n";
+ }
+ {
+ no strict 'refs';
+ *$AUTOLOAD = sub { $val };
+ }
+ goto &$AUTOLOAD;
+}
-@EXPORT_FAIL = grep { ! defined &$_ } @EXPORT_OK;
+XSLoader::load 'Time::HiRes', $VERSION;
# Preloaded methods go here.
(${$b}[0] - ${$a}[0]) + ((${$b}[1] - ${$a}[1]) / 1_000_000);
}
-# I'm only supplying this because the version of it in 5.003's Export.pm
-# is buggy (it doesn't shift off the class name).
-
-sub export_fail {
- my $self = shift;
- @_;
-}
-
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
$elapsed = tv_interval ( $t0 );
use Time::HiRes qw ( time alarm sleep );
+
$now_fractions = time;
sleep ($floating_seconds);
alarm ($floating_seconds);
alarm ($floating_seconds, $floating_interval);
+ use Time::HiRes qw( setitimer getitimer
+ ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF );
+
+ setitimer ($which, $floating_seconds, $floating_interval );
+ getitimer ($which);
+
=head1 DESCRIPTION
The C<Time::HiRes> module implements a Perl interface to the usleep, ualarm,
If your system lacks gettimeofday(2) you don't get gettimeofday() or the
one-arg form of tv_interval(). If you don't have usleep(3) or select(2)
you don't get usleep() or sleep(). If your system don't have ualarm(3)
-or setitimer(2) you don't
-get ualarm() or alarm(). If you try to import an unimplemented function
-in the C<use> statement it will fail at compile time.
+or setitimer(2) you don't get ualarm() or alarm().
+If you try to import an unimplemented function in the C<use> statement
+it will fail at compile time.
-The following functions can be imported from this module. No
-functions are exported by default.
+The following functions can be imported from this module.
+No functions are exported by default.
=over 4
behaviour. This function can be imported, resulting in a nice drop-in
replacement for the C<alarm> provided with perl, see the EXAMPLES below.
+=item setitimer ( $which, $floating_seconds [, $interval_floating_seconds ] )
+
+Start up an interval timer: after a certain time, a signal is arrives,
+and more may keep arriving at certain intervals. To disable a timer,
+use time of zero. If interval is set to zero (or unspecified), the
+timer is disabled after the next delivered signal.
+
+Use of interval timers may interfere with alarm(), sleep(), and usleep().
+In standard-speak the "interaction is unspecified", which means that
+I<anything> may happen: it may work, it may not.
+
+In scalar context, the remaining time in the timer is returned.
+
+In list context, both the remaining time and the interval are returned.
+
+There are three interval timers: the $which can be ITIMER_REAL,
+ITIMER_VIRTUAL, or ITIMER_PROF.
+
+ITIMER_REAL results in alarm()-like behavior. Time is counted in
+I<real time>, that is, wallclock time. SIGALRM is delivered when
+the timer expires.
+
+ITIMER_VIRTUAL counts time in (process) I<virtual time>, that is, only
+when the process is running. In multiprocessing/user/CPU systems this
+may be much less than real time. (This time is also known as the
+I<user time>.) SIGVTALRM is delivered when the timer expires.
+
+ITIMER_PROF counts time when either the process virtual time or when
+the operating system is running on behalf of the process (such as
+I/O). (This time is also known as the I<system time>.) (Collectively
+these times are also known as the I<CPU time>.) SIGPROF is delivered
+when the timer expires. SIGPROF can interrupt system calls.
+
+The semantics of interval timers for multithreaded programs are
+system-specific, and some systems may support additional interval
+timers. See your setitimer() documentation.
+
+=item getitimer ( $which )
+
+Return the remaining time in the interval timer specified by $which.
+
+In scalar context, the remaining time is returned.
+
+In list context, both the remaining time and the interval are returned.
+The interval is always what you put in using setitimer().
+
=back
=head1 EXAMPLES
sleep (2.5);
alarm (10.6666666);
+ # Arm an interval timer to go off first at 10 seconds and
+ # after that every 2.5 seconds, in process virtual time
+
+ use Time::HiRes qw ( setitimer ITIMER_VIRTUAL time );
+
+ $SIG{VTLARM} = sub { print time, "\n" };
+ setitimer(ITIMER_VIRTUAL, 10, 2.5);
+
=head1 C API
In addition to the perl API described above, a C API is available for
}
#endif
+static IV
+constant(char *name, int arg)
+{
+ errno = 0;
+ switch (*name) {
+ case 'I':
+ if (strEQ(name, "ITIMER_REAL"))
+#ifdef ITIMER_REAL
+ return ITIMER_REAL;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ITIMER_REALPROF"))
+#ifdef ITIMER_REALPROF
+ return ITIMER_REALPROF;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ITIMER_VIRTUAL"))
+#ifdef ITIMER_VIRTUAL
+ return ITIMER_VIRTUAL;
+#else
+ goto not_there;
+#endif
+ if (strEQ(name, "ITIMER_PROF"))
+#ifdef ITIMER_PROF
+ return ITIMER_PROF;
+#else
+ goto not_there;
+#endif
+ break;
+ }
+ errno = EINVAL;
+ return 0;
+
+not_there:
+ errno = ENOENT;
+ return 0;
+}
+
#if !defined(HAS_GETTIMEOFDAY) && defined(WIN32)
#define HAS_GETTIMEOFDAY
ret[1] = Tp.tv_usec;
}
-static double
+static NV
myNVtime()
{
struct timeval Tp;
hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) myU2time), 0);
#endif
+IV
+constant(name, arg)
+ char * name
+ int arg
+
#ifdef HAS_USLEEP
void
void
sleep(fseconds)
- double fseconds
+ NV fseconds
CODE:
int useconds = fseconds * 1000000;
usleep (useconds);
int
alarm(fseconds,finterval=0)
- double fseconds
- double finterval
+ NV fseconds
+ NV finterval
PREINIT:
int useconds, uinterval;
CODE:
PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
}
-double
+NV
time()
PREINIT:
struct timeval Tp;
#endif
+#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
+
+#define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
+
+void
+setitimer(which, seconds, interval = 0)
+ int which
+ NV seconds
+ NV interval
+ PREINIT:
+ struct itimerval newit;
+ struct itimerval oldit;
+ PPCODE:
+ newit.it_value.tv_sec = seconds;
+ newit.it_value.tv_usec =
+ (seconds - (NV)newit.it_value.tv_sec) * 1000000.0;
+ newit.it_interval.tv_sec = interval;
+ newit.it_interval.tv_usec =
+ (interval - (NV)newit.it_interval.tv_sec) * 1000000.0;
+ if (setitimer(which, &newit, &oldit) == 0) {
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
+ if (GIMME == G_ARRAY) {
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
+ }
+ }
+
+void
+getitimer(which)
+ int which
+ PREINIT:
+ struct itimerval nowit;
+ PPCODE:
+ if (getitimer(which, &nowit) == 0) {
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
+ if (GIMME == G_ARRAY) {
+ EXTEND(sp, 1);
+ PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
+ }
+ }
+
+#endif
+
# $Id: HiRes.xs,v 1.11 1999/03/16 02:27:38 wegscd Exp wegscd $
# $Log: HiRes.xs,v $
@INC = '../lib';
}
-BEGIN { $| = 1; print "1..17\n"; }
+BEGIN { $| = 1; print "1..19\n"; }
END {print "not ok 1\n" unless $loaded;}
import Time::HiRes 'usleep' if $have_usleep;
import Time::HiRes 'ualarm' if $have_ualarm;
+use Config;
+
sub skip {
map { print "ok $_ (skipped)\n" } @_;
}
{
alarm(2.5);
select (undef, undef, undef, 10);
- print "# Select returned! ", Time::HiRes::tv_interval ($r), "\n";
+ print "# Select returned! $i ", Time::HiRes::tv_interval ($r), "\n";
}
sub tick
{
- print "# Tick! ", Time::HiRes::tv_interval ($r), "\n";
$i--;
+ print "# Tick! $i ", Time::HiRes::tv_interval ($r), "\n";
}
$SIG{ALRM} = 'DEFAULT';
print "ok 17\n";
}
+unless (defined &Time::HiRes::setitimer
+ && defined &Time::HiRes::getitimer
+ && exists &Time::HiRes::ITIMER_VIRTUAL
+ && $Config{d_select}) {
+ for (18..19) {
+ print "ok $_ # skipped\n";
+ }
+} else {
+ use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL);
+
+ my $i = 3;
+ my $r = [Time::HiRes::gettimeofday];
+
+ $SIG{VTALRM} = sub {
+ $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0);
+ print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n";
+ };
+
+ print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 3, 0.5)), "\n";
+
+ print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
+
+ while ($i) {
+ my $j; $j++ for 1..1000;
+ }
+
+ print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n";
+
+ $SIG{VTALRM} = 'DEFAULT';
+}
+
projects / p5sagit/p5-mst-13.2.git / commitdiff