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 3
So 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 2
So, 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