> > Though with modules like DBI it might not help.
> >
> > Actualy how does perl clone the data? Does it traverse all references
> > copying what it sees like a copying garbage collector ?
>
> Yes.
Would it be too expensive to check whether the reference is blessed
to a package that's in a set of classes to null? And if it is to skip
the reference?
I guess this is exactly the time you'd have to call
the CLONE callback anyway, isn't it?
We could even mark whole structures as "null on fork" this way if we'd
have only one unblessed reference into them (at the time of fork()).
We'd just bless the reference to "Null_on_fork" class ...
> > sub null_on_fork {
> > my $obj = shift;
> > my $ref= $obj;
> > weaken $ref;
>
> this won't work, weaken weakens only the ref it currently exists on, you
> need to push @objects, $ref;
> weak($objects[-1]);
Tried that, doesn't seem to work either.
I did not test the module properly. I attach a new version plus a
test script. This one seems to work OK.
We could actualy allow the objects to install a "fork() handler"
with code very similar to this.
Jenda
== [EMAIL PROTECTED] == http://Jenda.Krynicky.cz ==
: What do people think?
What, do people think? :-)
-- Larry Wall in <[EMAIL PROTECTED]>
use IThread::Jenda;
use WeakRef;
sub Foo::DESTROY {print "Called destroy from $$\n"}
sub newFoo {
my $r = {};
bless $r, 'Foo';
# null_on_fork $r; # uncomment to register for nulling
return $r;
}
$r1 = newFoo();
$r2 = newFoo();
$r3 = newFoo();
$pid = Fork();
# this is just to ensure (or rather try to ensure) that the DESTROY is called
undef $r1;
undef $r2;
undef $r3;
sleep(2);
package IThread::Jenda; # don't know a good name
$VERSION = 0.2;
use Exporter;
use WeakRef;
@ISA = qw(Exporter);
@EXPORT = qw(null_on_fork Fork);
my @objects;
sub null_on_fork {
my $obj = shift;
my $ref= \$obj;
weaken $ref;
push @objects, $ref;
1;
}
sub Fork {
my $pid = fork();
# my $pid = 0; # for testing!
return unless defined $pid; # fork() failed
return $pid if $pid; # we are in parent
my $ref;
foreach $ref (@objects) {
next unless defined $ref;
bless $$ref, 'rotfl_this_if_insane';
undef $$ref;
undef $ref;
}
undef @objects;
return 0;
}
1;
