Now let's put all the bits of code together and show a well-written example that solves all the problems discussed so far. We will use an Apache::Registryscript for this purpose. Our script is shown in Example 10-19.

Example 10-19. proper_fork1.pl

use strict;
use POSIX 'setsid';
use Apache::SubProcess;

my $r = shift;
$r->send_http_header("text/plain");

$SIG{CHLD} = 'IGNORE';
defined (my $kid = fork) or die "Cannot fork: $!\n";
if ($kid) {
    print "Parent $$ has finished, kid's PID: $kid\n";
}
else {
    $r->cleanup_for_exec( ); # untie the socket
    chdir '/'                 or die "Can't chdir to /: $!";
    open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
    open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
    open STDERR, '>/tmp/log'  or die "Can't write to /tmp/log: $!";
    setsid                    or die "Can't start a new session: $!";

    my $oldfh = select STDERR;
    local $| = 1;
    select $oldfh;
    warn "started\n";

    # do something time-consuming
    sleep 1, warn "$_\n" for 1..20;
    warn "completed\n";

    CORE::exit(0); # terminate the process
}

The script starts with the usual declaration of strict mode, then loads the POSIX and Apache::SubProcess modules and imports the setsid( )symbol from the POSIX package.

The HTTP header is sent next, with the Content-Type of text/plain. To avoid zombies, the parent process gets ready to ignore the child, and the fork is called.

The if condition evaluates to a true value for the parent process and to a false value for the child process; therefore, the first block is executed by the parent and the second by the child.

The parent process announces its PID and the PID of the spawned process, and finishes its block. If there is any code outside the ifstatement, it will be executed by the parent as well.

The child process starts its code by disconnecting from the socket, changing its current directory to /, and opening the STDIN and STDOUTstreams to /dev/null (this has the effect of closing them both before opening them). In fact, in this example we don't need either of these, so we could just close( ) both. The child process completes its disengagement from the parent process by opening the STDERRstream to /tmp/log, so it can write to that file, and creates a new session with the help of setsid( ). Now the child process has nothing to do with the parent process and can do the actual processing that it has to do. In our example, it outputs a series of warnings, which are logged to /tmp/log:

my $oldfh = select STDERR;
local $| = 1;
select $oldfh;
warn "started\n";
# do something time-consuming
sleep 1, warn "$_\n" for 1..20;
warn "completed\n";

We set $|=1 to unbuffer the STDERRstream, so we can immediately see the debug output generated by the program. We use the keyword localso that buffering in other processes is not affected. In fact, we don't really need to unbuffer output when it is generated by warn( ). You want it if you use print( ) to debug.

Finally, the child process terminates by calling:

CORE::exit(0);

which makes sure that it terminates at the end of the block and won't run some code that it's not supposed to run.

This code example will allow you to verify that indeed the spawned child process has its own life, and that its parent is free as well. Simply issue a request that will run this script, see that the process starts writing warnings to the file /tmp/log, and issue a complete server stop and start. If everything is correct, the server will successfully restart and the long-term process will still be running. You will know that it's still running if the warnings are still being written into /tmp/log. If Apache takes a long time to stop and restart, you may need to raise the number of warnings to make sure that you don't miss the end of the run.

If there are only five warnings to be printed, you should see the following output in the /tmp/log file:

started
1
2
3
4
5
completed