Stas Bekman wrote: [...]
Great hack Stas, but alas, I suspect(all right, I *know*) that there are interpreters that are getting reaped in my situation. Is there a similar magic BLOCK for gc like the 'CLONE' convention?
I think the END block is run for every clone, I'll write a test later.
I was wrong, it doesn't. It runs only by the main interpreter (I'm talking pure perl here, it's not special to mod_perl).
Here is a package that will do the accounting for you. I've used a dummy object to use its DESTROY method to emulate END for cloned interpreters. All you need is to load this package at the server startup and look at your error_log during the server life and at its very end.
Here is the package:
# My/InterpreterCounter.pm package My::InterpreterCounter;
use strict; use warnings FATAL => 'all';
use threads; use threads::shared;
use subs qw(say);
# a special object created in the parent interpreter which will call # DESTROY when each interpreter goes down, providing the END # equivalent for spawned ithreads # # we also use it to track the thread id, while we have it my $obj = My::InterpreterCounter->new();
my $ctr : shared = &share({});
# 1 is the parent interpreter which already exists
$ctr->{cnt} = 1;
$ctr->{max} = 1;
$ctr->{tot} = 1;sub new {
my $class = shift;
my $self = 0;
return bless \$self, $class;
}sub CLONE {
my $tid = threads->self->tid;
say "a cloned interpreter #$tid was spawned";
$$obj = $tid;
lock $ctr;
$ctr->{tot}++;
$ctr->{cnt}++;
$ctr->{max}++ if $ctr->{cnt} > $ctr->{max};
status();
}sub DESTROY {
my $self = shift;
my $tid = $$self;
lock $ctr;
$ctr->{cnt}--;
say "a cloned interpreter #$tid went down";
status();
}sub END {
say "the main interpreter goes down";
status();
}sub status {
lock $ctr;
printf STDERR " " x 9 .
"total: $ctr->{tot}, count $ctr->{cnt}, at most $ctr->{max}\n";
}sub say {
(my $caller = (caller(1))[3]) =~ s/.*:://;
printf STDERR "%-7s: %s\n", $caller, join '', @_;
}1;
here is a standalone program that requires no mod_perl. As you can see it does nothing to the package besides loading it *before* it spawns any new threads:
#test.pl use My::InterpreterCounter;
use threads; use threads::shared;
for (0..1) {
my $thr1 = threads->new(\&worker);
my $thr2 = threads->new(\&worker);
$thr1->join;
$thr2->join;
}sub worker {
my $tid = threads->self->tid;
#print STDERR "TID is $tid\n";
}Running it:
% perl -I. test.pl
CLONE : a cloned interpreter #1 was spawned
total: 2, count 2, at most 2
CLONE : a cloned interpreter #2 was spawned
total: 3, count 3, at most 3
DESTROY: a cloned interpreter #2 went down
total: 3, count 2, at most 3
DESTROY: a cloned interpreter #1 went down
total: 3, count 1, at most 3
CLONE : a cloned interpreter #3 was spawned
total: 4, count 2, at most 3
CLONE : a cloned interpreter #4 was spawned
total: 5, count 3, at most 3
DESTROY: a cloned interpreter #4 went down
total: 5, count 2, at most 3
DESTROY: a cloned interpreter #3 went down
total: 5, count 1, at most 3
END : the main interpreter goes down
total: 5, count 1, at most 3
DESTROY: a cloned interpreter #0 went down
total: 5, count 0, at most 3So you can see that during the program life, at any given time there were at most 3 perl interpreters running (1 parent + 2 clones). And you can see that there were a total of 4 clones started (plus one parent perl).
So I loaded this module from modperl-2.0/t/conf/modperl_extra.pl and run the threads tests (this is just a preforked mpm which spawn ithreads from the test):
t/TEST -v perl/ithreads
the error_log had:
CLONE : a cloned interpreter #1 was spawned
total: 2, count 2, at most 2
Attempt to free unreferenced scalar: SV 0x9842900 during global destruction.
DESTROY: a cloned interpreter #1 went down
total: 2, count 1, at most 2
CLONE : a cloned interpreter #2 was spawned
total: 3, count 2, at most 2
Attempt to free unreferenced scalar: SV 0x99de3f4 during global destruction.
DESTROY: a cloned interpreter #2 went down
total: 3, count 1, at most 2So, as you can see the test has spawned two clones, but only one was active at any given time. Indeed looking at modperl-2.0/t/response/TestPerl/ithreads.pm you can see that the first ithread was joined before a new one was spawned.
Give it a try under a worker mpm and see if you get a nice report in a nice progress and the totals at the shutdown.
__________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
-- 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
