Perl FCGI Exit Without Dieing

问题:

How to end script without using using exit if using Perl FCGI. After searching for days the only solution I found is to jump at label in the main script. below is the code of the main index.fcgi.

    $fcgi_requests = 0; # the number of requests this fcgi process handled.
$handling_request = 0;
$exit_requested = 0;
$app_quit_request = 0; # End the application but not the FCGI process

# workaround for known bug in libfcgi
while (($ignore) = each %ENV) { }

$fcgi_request = FCGI::Request();
#$fcgi_request = FCGI::Request( \*STDIN, \*STDOUT, \*STDERR, \%ENV, $socket);

sub sig_handler {
    my ($callpackage, $callfile, $callline) = caller;
    if ($app_quit_request) {
        $app_quit_request = 0;
        goto ABORTLABEL;
    }

    $exit_requested = 1;
    exit(0) if !$handling_request;
}

$SIG{USR1} = \&sig_handler;
$SIG{TERM} = \&sig_handler;
$SIG{PIPE} = 'IGNORE';

#The goal of fast cgi is to load the program once, and iterate in a loop for every request.
while ($handling_request = ($fcgi_request->Accept() >= 0)) {
    process_fcgi_request();
    $handling_request = 0;
    last if $exit_requested;
    #exit if -M $ENV{SCRIPT_FILENAME} < 0; # Autorestart
}

$fcgi_request->Finish();
exit(0);
#=========================================================#
sub process_fcgi_request() {
    $fcgi_requests++;

    # dispatch current request
    my_app();

    $fcgi_request->Finish();
}
#=========================================================#
# let it think we are done, used by abort
ABORTLABEL:
    $fcgi_request->Finish();
#=========================================================#

The main request is I want to stop the program execution from inside sub insidi modules that may be called by long depth for example inside a login function in a accounts module. Of course I can not use exit because it will terminate the fcgi process, I tried all error and throw and try modules all use die which also ends the process. Of course I can use the return from each sub but this will require to rewrite the whole program for fcgi.

回答1:

The normal way to model exceptions in Perl is to call die inside eval BLOCK, which catches the die and so doesn't terminate the process. It'll just terminate the eval and the program continues to run from immediately afterwards. As far as I've seen, the exception-handling modules on CPAN are mostly wrappers around this basic functionality to give it different syntax or make it easier to write catch blocks. Therefore I'm surprised these don't work for you. Did you actually try them or did you just assume die always kills the process? The name is slightly misleading, because it really means 'throw an exception'. Just if you do that outside an eval the interpreter catches it, and its only response is to terminate the process.

eval {
  say "Hello world";
  die;
  say "Not printed";
};
say "Is printed";

You don't want to call exit inside an eval though. Nothing catches that.

I would recommend though rewriting the entire control flow for FCGI. The lifecycle of your code changes significantly, so you have to make a certain amount of modifications to make sure that variable re-use is working properly and you're not leaking memory. Often it's better to do that up front rather than spend days tracking down odd bugs later.

回答2:

After several questions and deep research, I got this solution. This coding example allows you to return from any nested levels of calls. The module Scope::Upper is XS so it should be fast.

use Scope::Upper qw/unwind CALLER/;

sub level1 {
    print "before level 1 \n";
    level2();
    print "after level 1 \n";
}

sub level2 {
    print "before level 2 \n";
    level3();
    print "after level 2 \n";
}

sub level3 {
    print "before level 3 \n";
    level4();
    print "after level 3 \n";
}

sub level4 {
    print "before level 4 \n";

    #unwind CALLER 2;

    my @frame;
    my $i;
    #$i++ while @frame = caller($i);# and $frame[0] ne "main";
    $i++ while @frame = caller($i);
    #print "i=: $i \n";
    #unwind CALLER (@frame ? $i : $i - 1);
    unwind CALLER $i-1;

    print "after level 4 \n";
}

print level1();

If you run this code the output will be:

before level 1 
before level 2 
before level 3 
before level 4 

You can return to any up level using:

my intLevel = 2;    
unwind CALLER intLevel;