view release on metacpan or  search on metacpan

lib/Carrot/Individuality/Singular/Process/Child.pm  view on Meta::CPAN

	#FIXME: can't this become a monad?
	require Carrot::Continuity::Coordination::Episode::Local;

	my $expressiveness = Carrot::individuality;
	$expressiveness->provide(
		my $distinguished_exceptions = '::Individuality::Controlled::Distinguished_Exceptions');
	#	my $kindergarden = '::Individuality::Singular::Process::Kindergarden');

	$expressiveness->class_names->provide_instance(
		my $local_subscription = 'Continuity::Coordination::Episode::Local');
	$local_subscription->register_event('pid_change');

	$distinguished_exceptions->provide(
		my $perl_fork_failed = 'perl_fork_failed',
		my $perl_setxid_failed = 'perl_setxid_failed');

	$expressiveness->declare_provider;

# =--------------------------------------------------------------------------= #

sub attribute_construction
# /type method
# /effect "Constructs the attribute(s) of a newly created instance."
# //parameters
#	value  ::Personality::Abstract::Number
# //returns
{
	my ($this) = @ARGUMENTS;

	$$this = (exists($_[SPX_PID]) ? $_[SPX_PID] : $PROCESS_PID);
	return;
}

sub subscribe_pid_change
# /type method
# /effect ""
# //parameters
#	instance  +multiple
# //returns
{
	my $this = shift(\@ARGUMENTS);

	$local_subscription->subscribe('pid_change', @ARGUMENTS);
	return;
}

sub unsubscribe_pid_change
# /type method
# /effect ""
# //parameters
#	instances
# //returns
{
	my $this = shift(\@ARGUMENTS);

	$local_subscription->unsubscribe('pid_change', @ARGUMENTS);
	return;
}


sub update
# /type method
# /effect ""
# //parameters
# //returns
{
	return if (${$_[THIS]} == $PROCESS_PID);
	${$_[THIS]} = $PROCESS_PID;
	$local_subscription->trigger_event('pid_change');
	return;
}

sub fork
# /type method
# /effect ""
# //parameters
# //returns
#	?
{
	my $parent_pid = $PROCESS_PID;

	#FIXME: change to $fatal_syscalls
	my $child_pid = CORE::fork();
	unless (defined($child_pid))
	{
		$perl_fork_failed->raise_exception(
			{'pid' => $PROCESS_PID,
			 'name' => $PROGRAM_NAME,
			 'os_error' => $OS_ERROR},
			ERROR_CATEGORY_OS);
	}

	if ($child_pid > 0)
	{
		return($child_pid);
	} else {
		$_[THIS]->update;
		return(-$parent_pid);
	}
}

sub set_name
# /type method
# /effect ""
# //parameters
#	name
# //returns
{
	$PROGRAM_NAME = $_[SPX_NAME];
	return;
}
sub get_name
# /type function
# /effect ""
# //parameters
# //returns
#	?
{
	return($PROGRAM_NAME);
}