Hi All,
I am using mp1, and wanting to do the following:
* Fork a process from within my code, but then keep printing an updated
status to the browser until the child process has finished its work, at
which point i want to redirect the browser to a "thankyou page".
I have attached a bit of code that seems to be doing this... although i
have borrowed heavily from various bits of code found on the internet,
i'm not sure the way i have done things is "correct" (especialy when it
will come to zombie processes etc).
>From my understanding what the code is doing is:
1. The display method is getting called (i know this as i call it :-)
2. It prints the header to the browser and "spawn"'s another subroutine
in the same module
3. It keeps printing to the browser until it realises that the chlid
process (pid) no longer exists
4. It then calls another subroutine that will send a content
(meta/javascript) redirect to the browser
If anyone knows another (/a better) way to do this.. i would be most
interested, as i will have such a requirement in a few places in my code
(eg. massive database file uploads, and then inserts might take 10-15
minutes, but i want to keep printing a status bit to the screen).
I have cut down my code as much as i could... the only bits its using
from other modules (that it inherits from) are:
* $self->request ... which is the Apache::Request object
Some notes:
* I copied the "spawn" sub from a cookbook somewhere, but changed exit
to CORE::exit (as otherwise the process was not really exiting, i know
this is a performance hit, as another apache child will need to start,
but don't know how to get around this).
* I do not have the REAPER subroutine (as per routines in some
cookbook)...
simran.
package NetChant::Component::Sample::Test;
use strict;
use NetChant::Component::BaseHTML;
use POSIX;
use Data::Dumper;
use Proc::ProcessTable;
$| = 1;
our @ISA = qw(NetChant::Component::BaseHTML);
#
#
#
sub spawn {
my $coderef = shift;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
die "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
print STDERR "cannot fork: $!\n";
return;
}
elsif ($pid) {
return $pid; # i'm the parent
}
CORE::exit(&$coderef());
}
sub display {
my $self = shift;
my $request = $self->request;
#
#
$| = 1;
print "HTTP/1.0 200 OK\n";
print "Content-type: text/plain\n\n";
print "This module will keep printing to the browser until its child process does its work and exists...\n\n";
my $pid = &spawn(sub {
my $retval = $self->childSub();
if (! $retval) {
print "Child Returned Error\n";
return;
}
else {
print "Child returned success\n";
return $self->sendBrowserRedirect();
}
});
for (my $i = 0; $i <= 10; $i++) {
print "Waiting for the child ... pid=$pid i=$i\n";
my $child = $self->waitForChild($pid);
sleep(1);
last if (! $self->pidExists($pid));
}
exit;
}
sub pidExists {
my $self = shift;
my $pid = shift;
my $process_table = new Proc::ProcessTable;
foreach my $p (@{$process_table->table}) {
# return 1 if ($pid == $p->pid);
if ($pid == $p->pid) {
return 1;
}
}
return 0;
}
sub sendBrowserRedirect {
my $self = shift;
print "I would send a content (meta/javascript) redirect to the browser here\n";
return;
}
sub childSub {
my $self = shift;
sleep(3);
print "I am the child subroutine\n";
return 1;
}
sub waitForChild {
my $self = shift;
my $pid = shift;
return scalar waitpid($pid, &POSIX::WNOHANG);
}
--
Report problems: http://perl.apache.org/bugs/
Mail list info: http://perl.apache.org/maillist/modperl.html
List etiquette: http://perl.apache.org/maillist/email-etiquette.html
