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



Reply via email to