view release on metacpan or  search on metacpan

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

sub configure {
    my $obj = shift;
    my %args = @_;
    for my $key (keys %args) {
	my $val = $args{$key};
	if ($key eq 'command') {
	    $obj->command(ref $val eq 'ARRAY' ? @$val : $val);
	} elsif ($key eq 'stdin') {
	    $obj->_set_stdin($val);
	} elsif ($key eq 'stdout') {
	    $obj->{STDOUT_REF} = $val;
	} elsif ($key eq 'stderr') {
	    if (ref $val eq 'SCALAR') {
		$obj->{STDERR_REF} = $val;
		$obj->option(stderr => 'capture');
	    } else {
		$obj->option(stderr => $val);
	    }
	} else {
	    $obj->option($key => $val);
	}
    }
    $obj;
}

sub command {
    my $obj = shift;
    if (@_) {
	$obj->{COMMAND} = [ @_ ];
	$obj;
    } else {
	@{$obj->{COMMAND} // []};
    }
}

sub option {
    my $obj = shift;
    if (@_ == 1) {
	return $obj->{OPTION}->{+shift};
    } else {
	while (my($k, $v) = splice @_, 0, 2) {
	    $obj->{OPTION}->{$k} = $v;
	}
	return $obj;
    }
}

sub run {
    my $obj = shift;
    $obj->update(@_);
    if (my $ref = $obj->{STDOUT_REF}) {
	$$ref = $obj->data;
    }
    if (my $ref = $obj->{STDERR_REF}) {
	$$ref = $obj->error;
    }
    return $obj->result;
}

sub update {
    use Time::localtime;
    my $obj = shift;
    my @command = $obj->command;
    if (@command) {
	$obj->{RESULT} = $obj->execute(\@command, @_);
	# Store stdout in temp file for path access
	my $fh = $obj->fh;
	$fh->seek(0, 0)  or die "seek: $!\n";
	$fh->truncate(0) or die "truncate: $!\n";
	$fh->print($obj->{RESULT}->{data} // '');
	$fh->flush;
	$fh->seek(0, 0)  or die "seek: $!\n";
    }
    $obj->date(ctime());
    $obj;
}

sub result {
    my $obj = shift;
    $obj->{RESULT};
}

sub execute {
    my $obj = shift;
    my $command = shift;
    my %opt = (%{$obj->{OPTION}}, @_);
    my @command = ref $command eq 'ARRAY' ? @$command : ($command);

    # Use nofork path for code references when requested
    if ($opt{nofork} and ref $command[0] eq 'CODE') {
	return $obj->_execute_nofork(\@command, %opt);
    }

    my $stderr = $opt{stderr} // '';

    # Create pipes for stdout and stderr
    pipe(my $stdout_r, my $stdout_w) or die "pipe: $!\n";
    pipe(my $stderr_r, my $stderr_w) or die "pipe: $!\n" if $stderr eq 'capture';

    my $pid = fork // die "fork: $!\n";
    if ($pid == 0) {
	# Child process
	close $stdout_r;
	close $stderr_r if $stderr eq 'capture';

	if (exists $opt{stdin}) {
	    my $tmp = new_tmpfile IO::File or die "tmpfile: $!\n";
	    binmode $tmp, ':encoding(utf8)';
	    $tmp->print($opt{stdin});
	    $tmp->seek(0, 0) or die "seek: $!\n";
	    open STDIN, '<&', $tmp or die "dup: $!\n";
	    binmode STDIN, ':encoding(utf8)';
	} elsif (my $input = $obj->{INPUT}) {
	    open STDIN, "<&=", $input->fileno or die "open: $!\n";
	    binmode STDIN, ':encoding(utf8)';
	}

	open STDOUT, ">&=", $stdout_w->fileno or die "open stdout: $!\n";
	if ($stderr eq 'redirect') {
	    open STDERR, ">&STDOUT" or die "open stderr: $!\n";