perl - 是否有可能在 EV 回调中使用 Perl 进行 longjump 之类的操作？

Question

我正在尝试在异步环境中模拟同步控制流。

目的是在没有回调或请求阻塞的情况下支持数据库请求。

我正在尝试使用 Coro模块，但我想我没有完全理解它。

代码片段如下:

sub execute {
    my ($sth, @vars) = @_;

    my $res   = $sth->SUPER::execute(@vars);
    my $dbh   = $sth->{Database};
    my $async = new Coro::State;
    my $new;
    $new = new Coro::State sub {
        my $w;
        while (!$dbh->pg_ready) {
            $w = AnyEvent->io(
                fh   => $dbh->{pg_socket},
                poll => 'r',
                cb   => sub {
                    if($dbh->pg_ready) {
                        $w = undef;
                        $new->transfer($async);
                    } 
                }
            ) if not $w;
            print "run once before statement: $sth->{Statement}\n";
            EV::run EV::RUN_ONCE;
        }
    };
    $async->transfer($new);
    $res = $dbh->pg_result;
    $res;
}

测试代码如下:

my $cv = AE::cv;

ok(my $dbh = db_connect(), 'connected');
ok(my $sth = $dbh->prepare('select pg_sleep(2)'), 'prepared');

my $start_time = time;
ok($sth->execute(), 'executed');

my $duration = time - $start_time;
ok(($duration > 1 && $duration < 3), 'slept');
is(ref($dbh), 'DBIx::PgCoroAnyEvent::db', 'dbh class');
is(ref($sth), 'DBIx::PgCoroAnyEvent::st', 'sth class');

my $status   = 0;
my $finished = 0;

for my $t (1 .. 10) {
    $finished += 1 << $t;
}

for my $t (1 .. 10) {

    my $timer;

    $timer = AE::timer 0.01 + $t/100, 0, sub {

        ok(my $dbh = db_connect(), "connected $t");
        ok(my $sth = $dbh->prepare('select pg_sleep(' . $t . ')'), "prepared $t");
        my $start_time = time;
        ok($sth->execute(), "executed $t");

        my $duration = time - $start_time;
        ok(($duration > $t - 1 && $duration < $t + 1), "slept $t");

        print "duration: $t: $duration\n";

        $status += 1 << $t;
        if ($status == $finished) {
            $cv->send;
        }

        undef $timer;
    };
}

$cv->recv;

完整的模块和测试脚本在这里 DBIx::PgCoroAnyEvent在这里 01_sleeps.t

谁能帮我看看哪里出了问题？

Answer 1

eval+die 是 Perl 中的典型方法。

eval { some_function( @args ); };
if( $@ ){
    # caught longjmp
}
...
sub some_function {
    ...
    if( some_condition ){
        die "throw longjmp"
    }
    ...
}