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
