How do I disable END blocks in child processes?

I frequently use fork in开发者_运维技巧 programs that also have END { ... } blocks:

...
END { &some_cleanup_code }
...
my $pid = fork();
if (defined($pid) && $pid==0) {
    &run_child_code;
    exit 0;
}

The child process executes the END {} block as it is exiting, but usually I don't want that to happen. Is there a way to prevent a child process from calling the END block at exit? Barring that, is there a way for a program to "know" that it is a child process, so I could say something like

END { unless (i_am_a_child_process()) { &some_cleanup_code } }

?

I don't think there's any way to prevent END blocks from running in a forked process, but this should let you detect it:

my $original_pid; BEGIN { $original_pid = $$ }

... # Program goes here

END { do_cleanup() if $$ == $original_pid }

perldoc -f exit

The exit() function does not always exit immediately. It calls any defined END routines first, but these END routines may not themselves abort the exit. Likewise any object destructors that need to be called are called before the real exit. If this is a problem, you can call POSIX:_exit($status) to avoid END and destructor processing. See perlmod for details.

use B;
@{; eval { B::end_av->object_2svref } || [] } = ();

I thought there was a Devel:: module that also let you do this, but I can't find it now.

Of course, you can't safely do this if you are using arbitrary modules that might be using END blocks for their own purposes...

(edit by OP) You can get control over the END blocks with B::end_av. As a proof-of-concept:

END { print "This is the first end block.\n"; }
my $END_block_2_line = __LINE__ + 1;
END { print "This is the second end block.\n"; }
END { print "This is the third end block.\n" }

sub disable_specific_END_block {
  use B;
  my ($file, $line) = @_;
  eval {
    my @ENDs = B::end_av->ARRAY;
    for (my $i=$#ENDs; $i>=0; $i--) {
      my $cv = $ENDs[$i];
      if ($cv->START->file eq $file && $cv->START->line == $line) {
        splice @{B::end_av->object_2svref}, $i, 1;
      }
    }
  };
}

disable_specific_END_block(__FILE__, $END_block_2_line);

$ perl endblocks.pl
This is the third end block.
This is the first end block.

Usually something like this would be overkill for what I need, but I can see some cases where this would come in handy.

In a manner of speaking, the customary way to avoid them in forked children is with something like:

exec "true";

Or, should you find that too untrustworthy, these all work and are even use use strict compliant:

exec    $^X =>  -eexit;

exec ~~echo => ~~-echo;

exec ~~echo => !!-echo;

and the onomatopoetic

exec reverse reverse echo => ~~-echo;

Rebmemer- In Perl, there are no silly questions, but there may be silly answers… ☺

$ perl -Mstrict '-leprint ucfirst lc reverse-Remember'

This is code used by POE::Wheel::Run to do just what you want. POE::Kernel::RUNNING_IN_HELL is true when $^O eq 'MSWin32'. Adapt it to your needs.

sub _exit_child_any_way_we_can {
  my $class = shift;
  my $exitval = shift || 0;

  # First make sure stdio are flushed.
  close STDIN  if defined fileno(STDIN); # Voodoo?
  close STDOUT if defined fileno(STDOUT);
  close STDERR if defined fileno(STDERR);

  # On Windows, subprocesses run in separate threads.  All the "fancy"
  # methods act on entire processes, so they also exit the parent.

  unless (POE::Kernel::RUNNING_IN_HELL) {
    # Try to avoid triggering END blocks and object destructors.
    eval { POSIX::_exit( $exitval ); };

    # TODO those methods will not exit with $exitval... what to do?
    eval { CORE::kill KILL => $$; };
    eval { exec("$^X -e 0"); };
  } else {
    eval { CORE::kill( KILL => $$ ); };

    # TODO Interestingly enough, the KILL is not enough to terminate this process...
    # However, it *is* enough to stop execution of END blocks/etc
    # So we will end up falling through to the exit( $exitval ) below
  }

  # Do what we must.
  exit( $exitval ); 
}

Just set some kind of globally accessible flag, when you run run_child_code().

There are a number of ways to do this, but I'd probably stick this into a package, and use a package scoped lexical to handle storage. You could use a plain variable flag, too. It's a bit simpler. I like the package solution because it will easily work across multiple modules.

END { &some_cleanup_code unless ImaKid->get; }
my $pid = $fork;
if( defined($pid) && $pid == 0 ) {
    ImaKid->set;
    &run_child_code;
}

BEGIN {
    package ImaKid;

    my $child_flag;

    sub set {
       $child_flag = 1;
    }

    sub get {
       return $child_flag;
    }
}

Consider wrapping your fork management code into the same package to create a single consistent API for all your fork related needs.

This is what I did. at the beginning of the program ( where I know no fork has happend yet ) Store the PID. my $parent_pid = $$;

#Then in the end block
END {
    my $current_pid = $$;
    if ( $parent_pid == $current_id ) 
        ##Here goes my cleanup code.
    }
}

I know this isn't very helpful to you, but I'll say it anyway: Don't use END blocks. There's usually a better way.