Excellent... thankyou.. i look forward to a solution from someone who
knows what they are doing...i have managed to come up with something
that works for me... (code attached if anyone is interested), but not
being that familiar with zombie processes and the likes, i'm sure its
done in a less than efficient manner..
oh well, it'll suffice until i can get my hands on your solution :-)
> simran wrote:
> >>From initial look though, it looked like it was a generic solution...
> > not ideal, but one that might work...
>
> It seems like a pretty generic problem to me, so a generic solution
> would be ideal in my opinion. I'm going to need one of these soon for
> myself, and if I end up with anything interesting I will try to put it
> up on CPAN. I think that there's not much too it though.
>
> > I was hoping there might have been an integrated way in mod_perl to do
> > such a thing as i have seen the apache upload meter before... and that
> > does a "send a status to the browser while still uploading a file"... so
> > its not too dissimilar to what i wanted to do...
>
> That's what all of these do: one process does the work, while another
> one monitors it and shows the progress on a page with an auto-refresh
> header. The code you posted was continuously writing to a single page
> instead of doing the refresh, but otherwise it's about the same.
> UploadMeter looks a bit strange to me in that it opens a pop-up window
> instead of forking, and it seems to require a patch to Apache::Request.
> I'm sure it works fine though.
>
> - Perrin
##################################################################################################################
#
# Source : $Source$
# Revision : $Revision$
# Modified By : $Author$
# Last Modified: $Date$
#
##################################################################################################################
package NetChant::Component::Sample::ForkProcess;
##################################################################################################################
#
# include all required library directories!
#
##################################################################################################################
#
# load modules as required...
#
#
use strict;
use NetChant::Component::BaseHTML;
use POSIX;
#
#
#
##################################################################################################################
##################################################################################################################
# Inheritance...
our @ISA = qw(NetChant::Component::BaseHTML);
#
##################################################################################################################
##################################################################################################################
#
# GLOBALS
#
#
#
##################################################################################################################
=pod
=head1 NAME
NetChant::Component::Sample::ForkProcess - Component ForkProcess for Sample
=head1 INHERITANCE
Inherits from NetChant::Component::BaseHTML
=head1 SYNOPSIS
use NetChant::Component::Sample::ForkProcess;
my $obj = $self->loadComponent(component => 'NetChant::Component::Sample::ForkProcess');
return $obj->display();
=head1 DESCRIPTION
Component ForkProcess for Sample
=head1 METHODS
=cut
##################################################################################################################
#
# CONSTANTS
#
##################################################################################################################
#
# PUBLIC METHODS
#
####################################
# display
#
=head2 display
=over
=item Description
Display 'ForkProcess's results
=item Input
* None
=item Return
* HTML Content
=back
=cut
sub display {
my $self = shift;
#
# Work out the request type and do stuff appropriately...
#
if ($ENV{"REQUEST_METHOD"} eq "GET") { return $self->_handleGET(); }
elsif ($ENV{"REQUEST_METHOD"} eq "POST") { return $self->_handlePOST(); }
else { return $self->errorHTML("Request Method '$ENV{REQUEST_METHOD}' not supported"); }
}
##################################################################################################################
#
# PRIVATE METHODS
#
#
#
#
sub _handleGET {
my $self = shift;
my $query = $self->query;
#
# unbuffer output...
#
$| = 1;
#
#
#
print "HTTP/1.0 200 OK\n";
print "Content-type: text/html\n\n";
#
#
#
print "This module will keep printing to the browser until its child process does its work and exists...<br><br>\n\n";
print "Here are the possible outcomes of the child process (for the purposes of this demo)<br>\n";
print " - Worker process finishes and returns success<br>\n";
print " - Worker process finishes but returns with an error<br>\n";
print " - Worker process does not finish in maximum alloted time (10 seconds)<br><br>\n\n";
#
# Spawn the child process
#
my $pid = $self->_spawn(sub {
#
# Run the worker method...
#
$self->_workerMethod() || do {
my $error = $self->getError;
print "<br>Child returned error: $error<br><br>\n\n";
CORE::exit;
};
#
#
#
print "<br>Child returned success<br>\n";
print "This is where we would normally send a javascript/meta refresh to another page<br><br>\n\n";
CORE::exit;
}) || do {
print "Could not spawn child process: ".$self->getError;
CORE::exit;
};
#
# This is the parent process... if we are here, then we have spawned the child process and are now going to be
# waiting for it...
#
my $i = 0;
while ($i++ < 10) {
#
#
#
sleep(1);
#
# Check to see if the child process still exists...
#
#
# Print the time to the output stream... but "exit" if we could not.
# If we could not print, it means that the user must have pressed "stop" in the browser
# or similar...
#
if (waitpid($pid, &POSIX::WNOHANG) == 0) {
print "We are waiting for the child (pid: $pid) process to finish. The time is: ".scalar localtime()."<br>\n" || exit;
}
else {
exit;
}
}
#
#
#
print "<br><br>\n\n";
print "I can see that the child process did not finish its duty in the 10 seconds allocated to it<br><br>\n\n";
#
#
#
exit;
}
#
#
#
sub _workerMethod {
my $self = shift;
my $timenow = time;
#
# Currently we do nothing other than just sleep for 5 seconds...
#
if ( ($timenow % 3) == 0 ) {
sleep(15);
}
else {
sleep(4);
}
#
#
#
if ( ($timenow % 2) == 0 ) {
return $self->setError("The time now ($timenow) is divisible by two");
}
else {
return 1;
}
}
#
#
#
sub _handlePOST {
&_handleGET(@_);
}
#
#
#
sub _spawn {
my $self = shift;
my $coderef = shift;
#
#
#
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
die "usage: spawn CODEREF";
}
#
#
#
my $pid;
if (!defined($pid = fork)) {
die "cannot fork: $!\n";
return $self->setError("cannot fork: $!");
}
elsif ($pid) {
return $pid; # i'm the parent
}
#
#
#
CORE::exit(&$coderef());
}
1;
=head1 BUGS
There are no known bugs with this module
=cut
--
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
