view release on metacpan or  search on metacpan

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

sub _tmpfile {
    my ($obj, $key, %opt) = @_;
    $key .= '_RAW' if $opt{raw};
    my $fh = $obj->{$key} //= do {
	my $f = new_tmpfile IO::File or die "tmpfile: $!\n";
	binmode $f, $opt{raw} ? ':utf8' : ':encoding(utf8)';
	$f;
    };
    $fh->seek(0, 0)  or die "seek: $!\n";
    $fh->truncate(0) or die "truncate: $!\n";
    $fh;
}

sub _execute_nofork {
    my $obj = shift;
    my $command = shift;
    my %opt = @_;
    my @command = @$command;
    my $stderr_mode = $opt{stderr} // '';
    my $raw = $opt{raw};

    my $code = shift @command;

    my $tmp_stdout = $obj->_tmpfile('NOFORK_STDOUT', raw => $raw);

    # Save and redirect STDOUT (always needed)
    open my $save_stdout, '>&', \*STDOUT or die "dup STDOUT: $!\n";
    open STDOUT, '>&', $tmp_stdout or die "redirect STDOUT: $!\n";
    binmode STDOUT, $raw ? ':utf8' : ':encoding(utf8)';

    # Handle STDERR — only save/redirect when needed
    my ($save_stderr, $tmp_stderr);
    if ($stderr_mode eq 'redirect') {
	open $save_stderr, '>&', \*STDERR or die "dup STDERR: $!\n";
	open STDERR, '>&', \*STDOUT or die "redirect STDERR: $!\n";
    } elsif ($stderr_mode eq 'capture') {
	$tmp_stderr = $obj->_tmpfile('NOFORK_STDERR', raw => $raw);
	open $save_stderr, '>&', \*STDERR or die "dup STDERR: $!\n";
	open STDERR, '>&', $tmp_stderr or die "redirect STDERR: $!\n";
    }

    # Handle STDIN — only save/redirect when needed
    my $save_stdin;
    if (exists $opt{stdin}) {
	my $tmp_stdin = $obj->_tmpfile('NOFORK_STDIN', raw => $raw);
	$tmp_stdin->print($opt{stdin});
	$tmp_stdin->seek(0, 0) or die "seek: $!\n";
	open $save_stdin, '<&', \*STDIN or die "dup STDIN: $!\n";
	open STDIN, '<&', $tmp_stdin or die "redirect STDIN: $!\n";
	binmode STDIN, $raw ? ':utf8' : ':encoding(utf8)';
    } elsif (my $input = $obj->{INPUT}) {
	$input->seek(0, 0) or die "seek: $!\n";
	open $save_stdin, '<&', \*STDIN or die "dup STDIN: $!\n";
	open STDIN, '<&', $input->fileno or die "redirect STDIN: $!\n";
	binmode STDIN, $raw ? ':utf8' : ':encoding(utf8)';
    }

    # Set global state
    local $_;
    local @ARGV = @command;
    my $orig_0;
    if (my $name = code_name($code)) {
	$orig_0 = $0;
	$0 = $name;
    }

    # Execute
    my $result = 0;
    eval { $code->(@command) };
    if ($@) {
	$result = -1;
    }

    # Flush and restore — only what was redirected
    STDOUT->flush;
    open STDOUT, '>&', $save_stdout or die "restore STDOUT: $!\n";
    if ($save_stderr) {
	STDERR->flush;
	open STDERR, '>&', $save_stderr or die "restore STDERR: $!\n";
    }
    if ($save_stdin) {
	open STDIN, '<&', $save_stdin or die "restore STDIN: $!\n";
    }
    if (defined $orig_0) {
	$0 = $orig_0;
    }

    # Read captured output from tmpfiles
    $tmp_stdout->seek(0, 0) or die "seek: $!\n";
    my $stdout_data = do { local $/; <$tmp_stdout> };

    my $stderr_data = '';
    if ($tmp_stderr) {
	$tmp_stderr->seek(0, 0) or die "seek: $!\n";
	$stderr_data = do { local $/; <$tmp_stderr> };
    }

    return {
	result => $result,
	data   => $stdout_data,
	error  => $stderr_data,
    };
}

sub data {
    my $obj = shift;
    if (@_) {
	my $data = shift;
	$obj->{RESULT}->{data} = $data;
	my $fh = $obj->fh;
	$fh->seek(0, 0)  or die "seek: $!\n";
	$fh->truncate(0) or die "truncate: $!\n";
	$fh->print($data);
	$fh->flush;
	$fh->seek(0, 0)  or die "seek: $!\n";
	return $obj;
    }
    $obj->{RESULT}->{data};
}

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

cumulative performance degradation in Perl's PerlIO subsystem.  This
affects B<all> PerlIO operations in the process, not just the ones
using the encoding layer.

In benchmarks, nofork with C<:encoding(utf8)> is actually B<slower>
than fork after many iterations, due to this leak.  Raw mode avoids
the issue entirely.

    # Benchmark: code ref with stdin (100-byte input, 1000 iterations)
    fork:                  399/s (baseline)
    nofork + :encoding:    316/s (0.8x — slower than fork!)
    nofork + :utf8 (raw): 13,433/s (34x faster)

=head2 Zero-Modification Callee Integration

A key advantage of this mechanism is that B<callee modules typically
require no modification> to work with nofork+raw mode.

Many Perl modules use C<use open> pragma or equivalent to set up
encoding layers on standard I/O:

    package App::ansicolumn;
    use open IO => ':utf8', ':std';    # sets :encoding(utf8) on STDIO

This works transparently because of execution order.  When using
nofork mode with method chaining:

    require App::ansicolumn;           # (1) module loaded here
    Command::Run->new
        ->command(\&ansicolumn, @args)
        ->with(stdin => $text, nofork => 1, raw => 1)
        ->update                       # (2) STDOUT redirected here
        ->data;

At step (1), C<require> loads the module and C<use open ':std'>
applies C<:encoding(utf8)> to the B<original> STDOUT.  At step (2),
C<_execute_nofork> redirects STDOUT to a fresh temporary file with
C<:utf8> layer.  The callee's encoding setup has already fired on the
original STDOUT and does not affect the redirected one.

This means existing modules like L<App::ansicolumn> and
L<App::ansifold> work unchanged with nofork+raw mode, achieving
significant speedups with zero code changes on the callee side.

=head2 Caller Protection

Nofork mode executes the code reference in the same process, so care
is needed to prevent the callee from corrupting the caller's state.
The following protections are applied:

=over 4

=item C<local $_;>

Prevents the callee from modifying the caller's C<$_>.  This is
critical when the caller aliases C<$_> to important data (e.g.,
greple's C<local *_ = shift> to alias C<$_> to the content buffer).
Without this protection, a callee's C<< while (E<lt>E<gt>) >> loop
would set C<$_> to C<undef> at EOF, destroying the caller's data.

=item C<local @ARGV>

Prevents the callee from modifying the caller's C<@ARGV>.

=item C<$0> save/restore

Prevents the callee from permanently changing the program name.

=back

=head1 COMPARISON WITH SIMILAR MODULES

There are many modules on CPAN for executing external commands.
This module is designed to be simple and lightweight, with minimal
dependencies.

This module was originally developed as L<App::cdif::Command> and
has been used in production as part of the L<App::cdif> distribution
since 2014.  It has also been adopted by several unrelated modules,
which motivated its release as an independent distribution.

=over 4

=item L<IPC::Run>

Full-featured module for running processes with support for
pipelines, pseudo-ttys, and timeouts.  Very powerful but large
(135KB+) with non-core dependencies (L<IO::Pty>).  Overkill for
simple command execution.

=item L<Capture::Tiny>

Excellent for capturing STDOUT/STDERR from Perl code or external
commands.  Does not provide stdin input functionality.

=item L<IPC::Run3>

Simpler than L<IPC::Run>, handles stdin/stdout/stderr.  Good
alternative but does not support code reference execution.

=item L<Command::Runner>

Modern interface with timeout support and code reference execution.
Has non-core dependencies.

=item L<Proc::Simple>

Simple process management with background execution support.
Focused on process control rather than I/O capture.

=back

B<Command::Run> differs from these modules in several ways:

=over 4

=item * B<Core modules only> - No non-core dependencies

=item * B<Code reference support> - Execute Perl code with $0 and @ARGV setup

=item * B<File descriptor path> - Output accessible via C</dev/fd/N>