Можно ли сделать что-то вроде longjump в Perl внутри EV-обратных вызовов?

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" 
    } 
    ... 
}