view release on metacpan or  search on metacpan

lib/App/MtAws/ForkEngine.pm  view on Meta::CPAN

			# child code
			my $first_time = 1;
			my @signals = qw/INT TERM USR2 HUP/;
			for my $sig (@signals) {
				$SIG{$sig} = sub {
					if ($first_time) {
						$first_time = 0;
						exit(1); # we need exit, it will call all destructors which will destroy tempfiles
					}
				};
			}
			$self->run_children($child_fromchild, $child_tochild);
			exit(1);
		}
	}

	my $first_time = 1;
	for my $sig (qw/INT TERM CHLD USR1 HUP/) {
		$SIG{$sig} = sub {
			local ($!,$^E,$@);
			my $status = undef;
			if ($sig eq 'CHLD') {
				my $pid = waitpid(-1, WNOHANG);
				$status = $?;
				# make sure we caugth signal from our children, not from external command executionin 3rd party module
				# easy to test by adding `whoami` to parent after-fork-code
				return unless $pid > 0 and defined delete $self->{children}{$pid}; # we also remove $pid
			}
			if ($first_time) {
				$first_time = 0;
				kill (POSIX::SIGUSR2, keys %{$self->{children}});
				while( wait() != -1 ){};
				$self->parent_exit_on_signal($sig, $status);
			}
		};
	}

	return $self->run_parent($disp_select);
}

#
# child/parent code
#
sub create_child
{
	my ($self, $disp_select) = @_;

	my $fromchild = new IO::Pipe;
	#log("created fromchild pipe $!", 10) if level(10);
	my $tochild = new IO::Pipe;
	#log("created tochild pipe $!", 10) if level(10);
	my $pid;
	my $parent_pid = $$;

	if($pid = fork()) { # Parent
		$|=1;
		STDERR->autoflush(1);
		$fromchild->reader();
		$fromchild->autoflush(1);
		$fromchild->blocking(1);
		binmode $fromchild;

		$tochild->writer();
		$tochild->autoflush(1);
		$tochild->blocking(1);
		binmode $tochild;

		$disp_select->add($fromchild);
		$self->{children}->{$pid} = { pid => $pid, fromchild => $fromchild, tochild => $tochild };

		print "PID $pid Started worker\n";
		return (0, undef, undef);
	} elsif (defined ($pid)) { # Child
		$|=1;
		STDERR->autoflush(1);
		$fromchild->writer();
		$fromchild->autoflush(1);
		$fromchild->blocking(1);
		binmode $fromchild;

		$tochild->reader();
		$tochild->autoflush(1);
		$tochild->blocking(1);
		binmode $tochild;

		undef $disp_select; # we discard tonns of unneeded pipes !
		undef $self->{children};

		return (1, $fromchild, $tochild);
	} else {
		die "Cannot fork()";
	}
}


sub terminate_children
{
	my ($self) = @_;
	$SIG{CHLD} = 'DEFAULT'; # don't set SIGCHLD to IGNORE, prevents wait() from working under 5.12.2,3 undef OpenBSD
	$SIG{INT} = $SIG{USR2}='IGNORE';

	# close all pipes, just in case select() in child is not interruptable (seems it is under 5.14.2?)
	# https://rt.perl.org/Ticket/Display.html?id=93428
	for (values %{$self->{children}}) {
		close $_->{fromchild};
		close $_->{tochild};
	}
	kill (POSIX::SIGUSR2, keys %{$self->{children}}); # TODO: we terminate all children with SIGUSR2 even on normal exit
	$SIG{TERM} = 'DEFAULT';
	while( wait() != -1 ){};
}
1;