view release on metacpan or  search on metacpan

lib/MojoX/Run.pm  view on Meta::CPAN

 }

=item B<stderr_cb> (coderef, undef):

Code that will be invoked when data were read from processes's stderr. If omitted, stderr output
will be returned as argument to B<exit_cb>. Example:

 stderr_cb => sub {
 	my ($pid, $data) = @_;
 	print "Process $pid stderr: $data";
 }

=item B<stdin_cb> (coderef, undef):

Code that will be invoked when data wrote to process's stdin were flushed. Example:

 stdin_cb => sub {
 	my ($pid) = @_;
 	print "Process $pid: stdin was flushed.";
 }

=item B<exit_cb> (coderef, undef, B<required>)

Code to be invoked after process exits and all handles have been flushed. Function is called
with 2 arguments: Process identifier (pid) and result structure. Example:

 exit_cb => sub {
 	my ($pid, $res) = @_;
 	print "Process $pid exited\n";
 	print "Execution error: $res->{error}\n" if (defined $res->{error});
 	print "Exit status: $pid->{exit_status}\n";
 	print "Killed by signal $pid->{exit_signal}\n" if ($res->{exit_signal});
 	print "Process dumped core.\n" if (res->{exit_core});
 	print "Process was started at: $res->{time_started}\n";
 	print "Process exited at $res->{time_stopped}\n";
 	print "Process execution duration: $res->{time_duration_exec}\n";
 	print "Execution duration: $res->{time_duration_total}\n";
 	print "Process stdout: $res->{stdout}\n";
 	print "Process stderr: $res->{stderr}\n";
 }

=item B<exec_timeout> (float, 0):

If set to positive non-zero value, process will be killed after specified timeout of seconds. Timeout accuracy
depends on IOLoop's timeout() value (Default is 0.25 seconds).

=back

Returns non-zero process identifier (pid) on success, otherwise 0 and sets error.

=cut

sub spawn {
	my ($self, %opt) = @_;
	unless (defined $self && blessed($self) && $self->isa(__PACKAGE__)) {
		my $obj = __PACKAGE__->new();
		return $obj->spawn(%opt);
	}
	$self->{_error} = '';

	# normalize and validate run parameters...
	my $o = $self->_getRunStruct(\%opt);
	return 0 unless ($self->_validateRunStruct($o));

	# start exec!
	return $self->_spawn($o);
}

=head2 spawn_sub

 my $code = sub { return { a => 1, b => 2} };
 my $pid = $mojox_run->spawn_sub(
 	$code,
 	exit_cb => sub {
 		my ($pid, $result, $exception) = @_;
 	}
 );

Spawns new subprocess in which $code subroutine will be executed. Return value of
subroutine will be delivered to B<exit_cb> callback.

The following options are supported:

=over

=item B<stdin_cb> (coderef, undef):

Code that will be invoked when data wrote to process's stdin were flushed. Example:

 stdin_cb => sub {
 	my ($pid) = @_;
 	print "Process $pid: stdin was flushed.";
 }

=item B<exit_cb> (coderef, undef, B<required>)

Code to be invoked after process exits and all handles have been flushed. Function is called
with 2 arguments: Process identifier (pid) and result structure. Example:

 exit_cb => sub {
 	my ($pid, $result, $exception) = @_;
 	if ($exception) {
 		print "Horrible exception accoured while executing subroutine: $exception";
 		return;
 	}
 	
 	# result is always arrayref, becouse subs can return list values!
 	print "Got async sub result: ", Dumper($result), "\n";
 }

=item B<exec_timeout> (float, 0):

If set to positive non-zero value, process will be killed after specified timeout of seconds. Timeout accuracy
depends on IOLoop's timeout() value.

=back

Returns non-zero process identifier (pid) on success, otherwise 0 and sets error.

=cut
sub spawn_sub {
	my ($self, $sub, %opt) = @_;
	unless (defined $sub && ref($sub) eq 'CODE') {

lib/MojoX/Run.pm  view on Meta::CPAN

sub _init {
	my $self = shift;

	# last error message
	$self->{_error} = '';

	# stored exec structs
	$self->{_data} = {};
	
	# ioloop object...
	$self->{_ioloop} = undef;
	
	# maximum running limit
	$self->{_max_running} = 0;

	# install SIGCHLD handler
	$SIG{'CHLD'} = sub { _sig_chld($self, @_) };
}

sub _getProcStruct {
	my ($self, $pid) = @_;
	no warnings;
	my $err = "[process $pid]: Unable to get process data structure: ";
	unless (defined $pid) {
		$self->{_error} = $err . "Undefined pid.";
		return undef;
	}
	unless (exists($self->{_data}->{$pid})
		&& defined $self->{_data}->{$pid})
	{
		$self->{_error} = $err . "Non-managed process pid: $pid";
		return undef;
	}

	return $self->{_data}->{$pid};
}

sub _getRunStruct {
	my ($self, $opt) = @_;
	my $s = {
		cmd          => undef,
		stdout_cb    => undef,
		stderr_cb    => undef,
		error_cb     => undef,
		exit_cb      => undef,
		exec_timeout => 0,
	};

	# apply user defined vars...
	map {
		if (exists($s->{$_}))
		{
			$s->{$_} = $opt->{$_};
		}
	} keys %{$opt};

	return $s;
}

sub _validateRunStruct {
	my ($self, $s) = @_;

	# command?
	unless (defined $s->{cmd}) { #} && length($s->{cmd}) > 0) {
		$self->{_error} = "Undefined command.";
		return 0;
	}
	# check command...
	my $cmd_ref = ref($s->{cmd});
	if ($cmd_ref eq '') {
		unless (length($s->{cmd}) > 0) {
			$self->{_error} = "Zero-length command.";
			return 0;
		}
	} else {
		unless ($cmd_ref eq 'CODE' || $cmd_ref eq 'ARRAY') {
			$self->{_error} = "Command can be pure scalar, arrayref or coderef.";
			return 0;
		}
	}

	# callbacks...
	if (defined $s->{stdout_cb} && ref($s->{stdout_cb}) ne 'CODE') {
		$self->{_error} = "STDOUT callback defined, but is not code reference.";
		return 0;
	}
	if (defined $s->{stderr_cb} && ref($s->{stderr_cb}) ne 'CODE') {
		$self->{_error} = "STDERR callback defined, but is not code reference.";
		return 0;
	}
	if (defined $s->{exit_cb} && ref($s->{exit_cb}) ne 'CODE') {
		$self->{_error} =
		  "Process exit_cb callback defined, but is not code reference.";
		return 0;
	}

	# exec timeout
	{ no warnings; $s->{exec_timeout} += 0; }

	return 1;
}

sub _procCleanup {
	my ($self, $pid, $exit_val, $signum, $core) = @_;
	my $proc = $self->_getProcStruct($pid);
	unless (defined $proc) {
		no warnings;
		$_log->warn(
			"Untracked process pid $pid exited with exit status $exit_val by signal $signum, core: $core."
		);
		return 0;
	}

	$_log->debug(
		"[process $pid]: Got SIGCHLD, " .
		"exited with exit status: $exit_val by signal $signum"
		  . (($core) ? "with core dump" : "")
		  . '.');

	$proc->{exit_val}    = $exit_val;