基本上，我想要一个高优先级的线程，它以给定的间隔（这里是0.5毫秒）运行并中断“一切”，执行一个短任务，然后回到'睡眠';使用Ubuntu 11.04和perl v5.10.1。问题是，虽然我得到了某种结果，但我不确定是否有可能获得“紧张时机”。
我制作了三个测试脚本，其中'循环'基本上增加了一个计数器10次，获取时间戳 - 然后它终止，并打印时间戳（以微秒为单位）。
第一个是基于我在Perl- How to call an event after a time delay - Perl中找到的一个片段 - 然而，我无法让那个特定的片段起作用;所以有一些变化，它是：
#!/usr/bin/env perl
# testloop01.pl
use strict;
use warnings;
use Time::HiRes qw ( setitimer ITIMER_VIRTUAL time );
my @tstamps;
my $cnt = 0;
my $numloops = 10;
my $loopperiod = 500e-6; # 0.000500 - 500 us
sub myfunc() {
push(@tstamps, time);
# repeat call for looping
if ($cnt < $numloops) {
$cnt++;
$SIG{VTALRM} = &myfunc; # must have this!
setitimer(ITIMER_VIRTUAL, 1, $loopperiod );
}
}
# take first timestamp at start
push(@tstamps, time);
# start it off
#~ $SIG{VTALRM} = sub { print time, "\n"; }; # no work like this on Linux ?!
$SIG{VTALRM} = &myfunc;
setitimer(ITIMER_VIRTUAL, 1, $loopperiod );
# wait - sleep 2 s
Time::HiRes::sleep(2);
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
执行此报告：
$ ./testloop01.pl
0 (diff: 0)
10 (diff: 10)
25 (diff: 15)
36 (diff: 10)
46 (diff: 10)
57 (diff: 10)
66 (diff: 9)
75 (diff: 8)
83 (diff: 8)
92 (diff: 9)
102 (diff: 9)
118 (diff: 15)
...意味着循环基本上尽可能快地运行，并且所要求的时间不受尊重。我猜，可能ITIMER_VIRTUAL在我的机器上不起作用。
第二个脚本基于Measurements at Regular Intervals in Perl中的示例：
#!/usr/bin/env perl
# testloop02.pl
use strict;
use warnings;
use POSIX qw(pause);
# this does NOT work w/ ITIMER_VIRTUAL
use Time::HiRes qw(setitimer ITIMER_REAL time);
my @tstamps;
my $cnt = 0;
my $numloops = 10;
my $loopperiod = 500e-6; # 0.000500 - 500 us
# take first timestamp at start
push(@tstamps, time);
# how often do we trigger (seconds)?
my $first_interval = $loopperiod;
my $interval = $loopperiod;
# signal handler is empty
$SIG{ALRM} = sub { };
# first value is the initial wait, second is the wait thereafter
setitimer(ITIMER_REAL, $first_interval, $interval);
while (1) {
# wait for alarm from timer
pause;
# do work that takes less than $interval to complete
push(@tstamps, time);
# repeat call for looping
if ($cnt < $numloops) {
$cnt++;
} else {
last;
}
}
Time::HiRes::sleep(2); # helps avoid segfault, but doesn't seem to do anything;
# "it's apparently not safe to use sleep and a timer at
# the same time, as one may reset the other"
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
运行结果：
$ ./testloop02.pl
0 (diff: 0)
717 (diff: 717)
1190 (diff: 473)
1724 (diff: 534)
2206 (diff: 481)
2705 (diff: 499)
3204 (diff: 499)
3705 (diff: 500)
4203 (diff: 498)
4682 (diff: 478)
5206 (diff: 524)
5704 (diff: 498)
......我想，这就像在这样的PC上一样紧张（有'自我测量'）。但问题是，它在单个线程上下文中运行（并且usleep显然不再起作用）。
第三个脚本试图对线程和usleep执行相同的操作：
#!/usr/bin/env perl
# testloop03.pl
use strict;
use warnings;
use Time::HiRes qw ( usleep time );
use threads;
use threads::shared; # for shared variables
my @tstamps :shared;
my $cnt :shared = 0;
my $numloops :shared = 10;
my $loopperiod = 500e-6; # 0.000500 s - 500 us
my $loopperiodus :shared = $loopperiod*1e6; # 500 us
sub myfunc() {
# repeat call for looping
while ($cnt < $numloops) {
push(@tstamps, time);
$cnt++;
usleep($loopperiodus);
}
}
# take first timestamp at start
push(@tstamps, time);
# start it off
my $mthr = threads->create('myfunc');
$mthr->join();
# wait - sleep 2 s
Time::HiRes::sleep(2);
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
当我运行它时，我得到类似的东西：
$ ./testloop03.pl
0 (diff: 0)
7498 (diff: 7498)
8569 (diff: 1070)
9300 (diff: 731)
9992 (diff: 691)
10657 (diff: 664)
11328 (diff: 671)
11979 (diff: 650)
12623 (diff: 643)
13284 (diff: 661)
13924 (diff: 639)
......这有点接近，但距离要求的时期有点偏离 - 我不会把它称为第二个脚本那么紧（事实上，我对此进行了一些实验，以及我的经验是因为它可以相对快速地不稳定 - 即使对于非常简单的任务 - 取决于来自操作系统的压力，如GUI更新等）。
所以我的问题是 - 有没有办法在Perl中获得“紧密”的时间（如例2，w / setitimer） - 但是在线程的上下文中（如例3;作为我当这个'定时循环'正在睡觉时，基本上想要在主线程中完成其他的东西）？不幸的是，尝试将信号发送到线程：
...
sub myfunc() {
setitimer(ITIMER_REAL, $loopperiod, $loopperiod);
# repeat call for looping
while ($cnt < $numloops) {
push(@tstamps, time);
$cnt++;
pause;
# usleep($loopperiodus);
# wait for alarm from timer
}
}
# signal handler is empty
$SIG{ALRM} = sub { };
# take first timestamp at start
push(@tstamps, time);
# start it off
my $mthr = threads->create('myfunc');
# first value is the initial wait, second is the wait thereafter
#~ setitimer(ITIMER_REAL, $loopperiod, $loopperiod);
$mthr->join();
...
......不起作用：
$ ./testloop04.pl
Maximal count of pending signals (120) exceeded at ./testloop04.pl line 48.
Perl exited with active threads:
1 running and unjoined
-1 finished and unjoined
0 running and detached
EDIT2：示例2可与fork一起使用，以提供impression of multithreading;然而，分叉变量不再共享（并且Can't install IPC:Shareable不再共享，这本来就是简单的方法）。
非常感谢任何答案，
干杯!
EDIT3：感谢answer from @daxim，以上是AnyEvent：
#!/usr/bin/env perl
# http://linux.die.net/man/3/anyevent
# http://search.cpan.org/~mlehmann/AnyEvent-6.02/lib/AnyEvent.pm
use 5.010;
use AnyEvent qw();
my @tstamps;
my $cnt = 0;
my $numloops = 10;
my $loopperiod = 500e-6; # 0.000500 - 500 us
my $result_ready = AnyEvent->condvar;
my %events = (
timer => AE::timer(0, $loopperiod, sub {
push(@tstamps, AE::time);
if ($cnt < $numloops) {
$cnt++;
} else {
#~ AE::cv->send; # doesn't exit loop?
$result_ready->broadcast; # exits loop
}
}),
#~ quit => AE::cv->recv,
quit => $result_ready->wait,
);
sleep 1; # this will kick in only after loop is complete!
# output results
my ($firstts, $ts, $td);
$firstts = -1; # init
for(my $ix=0; $ix<scalar(@tstamps); $ix++) {
$ts = $tstamps[$ix];
if ($firstts == -1) { # $ix == 0
$firstts = $ts;
$td = 0;
} else { # $ix > 0
$td = $ts - $tstamps[$ix-1];
}
printf "%10d (diff: %d)\n", ($ts-$firstts)*1e6, $td*1e6 ;
}
请注意，在我的机器上，0.5 ms会产生一些奇怪的措施（左） - 但是，已经在1.5 ms时，有一些不错的结果（右）：
$ ./testloop05.pl
0 (diff: 0) 0 (diff: 0)
34 (diff: 34) 32 (diff: 32)
117 (diff: 82) 2152 (diff: 2120)
1665 (diff: 1548) 3597 (diff: 1445)
1691 (diff: 25) 5090 (diff: 1492)
3300 (diff: 1609) 6547 (diff: 1456)
3319 (diff: 18) 8090 (diff: 1542)
4970 (diff: 1651) 9592 (diff: 1502)
4990 (diff: 20) 11089 (diff: 1497)
6607 (diff: 1616) 12589 (diff: 1500)
6625 (diff: 18) 14091 (diff: 1501)
答案 0 :(得分：8)
线程不是多编程的唯一方法。在Perl世界中，它们是最糟糕的世界之一。想尝试一下事件循环吗？
use 5.010;
use AnyEvent qw();
my %events = (
timer => AE::timer(0, 0.5, sub {
$now = AE::time;
say sprintf 'now: %f difference: %f', $now, $now - $previous;
$previous = $now;
}),
quit => AE::cv->recv,
);
$ perl testloop-ae.pl
now: 1316799028.264925 difference: 1316799028.264925
now: 1316799028.762484 difference: 0.497559
now: 1316799029.262058 difference: 0.499574
now: 1316799029.762640 difference: 0.500582
now: 1316799030.262207 difference: 0.499567
now: 1316799030.762668 difference: 0.500461
now: 1316799031.262242 difference: 0.499574
now: 1316799031.761805 difference: 0.499563
now: 1316799032.262378 difference: 0.500573
now: 1316799032.761953 difference: 0.499575
now: 1316799033.262513 difference: 0.500560
now: 1316799033.762081 difference: 0.499568
now: 1316799034.262674 difference: 0.500593
now: 1316799034.762256 difference: 0.499582
now: 1316799035.261837 difference: 0.499581
^C