Hello, i need function like with_timeout(&;$), it executes first argument with timeout. I can't use fork and storable/json, because of db handlers or something.

also, i cant control passed sub for eval propagate.

for perl 5.8.8 i have such solution:
1) Set alarm,
2) push state,
3) run code,
4) pop state
sigalarm :
1) count outer evals,
2) die several times with safe signals.

But this doesn't work in perl 5.16. How can i modify this solution? Or, maybe exists finer solution?

Here is solution for 5.8.8.

in perl

    _push_timeout_stack();
    local $SIG{USR1} = sub { _raise_alarm };
    local $SIG{ALRM} = sub { 
        _calc_evals_count_to_die(); 
        _raise_alarm();
    };
    alarm($time);
    eval { $work->() };
    _pop_timeout_stack();
[download]

and c-part

    void _push_timeout_stack() {
        timeout_stack* current = (timeout_stack*) calloc (1, sizeof(ti
+meout_stack));
        current->prev = stack;
        current->scope = PL_curstackinfo;
        current->nearest_block = &cxstack[cxstack_ix];
        stack = current;
    }

    void _pop_timeout_stack() {
        if ( stack ) {
            timeout_stack* current = stack;
            stack = stack->prev;
            free(current);
        }
    }

    void _raise_alarm() {
        if ( evals_to_die-- ) {
            PL_psig_pend[SIGUSR1]++;
            PL_sig_pending = 1;
            croak("TIMEDOUT");
        }
    }

    void _calc_evals_count_to_die() {
        evals_to_die = 0;

        bool cont = 1;
        int i = 0;
        PERL_SI * _cxstack = PL_curstackinfo;
        while ( cont ) {
            for (i = _cxstack->si_cxix; i >= 0 && cont; i--) {
                register const PERL_CONTEXT *cx = &_cxstack->si_cxstac
+k[i];
                if ( cx == stack->nearest_block )
                    cont = 0;
                else if ( CxTYPE(cx) == CXt_EVAL )
                    evals_to_die++;
            }
            if ( cont && (cont = _cxstack != stack->scope) )
                _cxstack = _cxstack->si_prev;
            }
            if ( evals_to_die )
                evals_to_die--;
            printf("Calced %d evals to pop\n", evals_to_die);
    }
[download]