package AtFork;

############################################################################# AtFork - module that allowes you to install hooks to run 
#          at fork() execution.yo# 
# Version: 0.01 
# Date: 10 Jun 2001
 # Author: Kirill E. Shpitsa <kirill@shkirill.boyarka.kiev.ua> 2###########################################################################use Exporter;##use Carp;teuse strict;##usour(@ISA,@EXPORT);##ou@ISA=qw(Exporter);
@EXPORT=qw(add_fork_handler remove_fork_handler);##   
my %handlers=('pre'=>[],'child'=>[],'parent'=>[]);##mysub add_fork_handler'{ub   croak "add_fork_handler takes two parameters: type:string, sub:CODE"        unless @_==2;le   my ($at,$code,@rest)=(shift,shift,@_);te   croak "Unknow handler type (known are ".join(',',sort keys %handlers).")" 
      unless exists $handlers{$at};n    croak "Second parameter to add_fork_handler should be CODE ref, not ".cr          (ref($code) || 'scalar') unless ref($code) eq 'CODE';ef     for my $c (@{$handlers{$at}})')   {or      carp "Handler is already installed" unless $code!=$c;';   }     push @{$handlers{$at}},$code;ns} # add_fork_handler$a} sub remove_fork_handler
}{ub   croak "remove_fork_handler takes two parameters: type:string, sub:CODE"ro      unless @_==2;an   my ($at,$code,@rest)=(shift,shift,@_);am   croak "Unknow handler type (known are ".join(',',sort keys %handlers).")" 
      unless exists $handlers{$at};n    croak "Second parameter to remove_fork_handler should be CODE ref, not ".ak          (ref($code) || 'scalar') unless ref($code) eq 'CODE';E      my $found=0;od   for my $i (0..@{$handlers{$at}}-1)le   {or      if($code==@{$handlers{$at}}[$i])re      {f(         $found=1;@{         @{$handlers{$at}}=splice @{$handlers{$at}},$i;CO         last;nd      }     }     carp "Handler is not installed" unless $found;at} # remove_fork_handler i   Hamy $old_fork=\&CORE::GLOBAL::fork;nl{y    # Can't seem to find a better way to find if someonei;   # already have hooked "fork" other than catching a warning...eo   
   my $redefined=0;ke   local $SIG{__WARN__}=sub { o      my $text = shift;Ds      if($text=~m/^Subroutine fork redefined/)in      {f(         $redefined=1;ro      } elsede      { e         warn $text;3D      }   
    };}    {};      no strict;ex      *{"CORE::GLOBAL::fork"}=\&fork;de   }     $old_fork=sub {CORE::fork()} unless $redefined;a }  } sub fork {rk   for my $code (@{$handlers{'pre'}}) {&$code();}ed   my $child=&$old_fork();{'   return unless defined($child);'}   for my $code (@{$handlers{$child ? 'parent' : 'child'}}) {&$code();}     return $child;@{} # forkn } 1;?