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]

In reply to Ultimate with-timeout by nyaapa

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.