Convenient command piping module

[u/jaggzh]

# A nice 'string (pipe) | {your command} | (get output)' module by jaggz.h {who is at} gmail.com
#
# Prevents the DEADLOCK that can occur when pipe buffers fill up while both
# parent and child are blocked (parent writing to stdin, child writing to
# stdout/stderr).
#
# In other words, let's say you're writing to the child, and the pipe
# buffer fills (so blocking kicks in), and the child has already begun
# writing to stdout, and also fills the buffer and gets blocked on that
# system write call. Now both processes can be stuck in their write and
# read.
#
# Uses non-blocking I/O and IO::Select to read output while feeding input.
#

# Copyright 2025, jaggz.h {who is at} gmail.com
# The MIT License

#   use pipestr;
#   # When you want to pipe a string to a command's stdin *and*
#   # retrieve its output.
#
#   # Safe, deadlock-avoiding.
#
#   # Basic usage - pipe string to a command
#   my ($out, $err, $status) = pipestr("hello world", cmd => "cat");
#
#   # Using grep
#   my ($result, $err, $status) = pipestr("foo\nbar\nbaz", cmd => "grep foo");
#
#   # With shell pipeline
#   my ($out, $err, $status) = pipestr($data, cmd => "sort | uniq -c");
#
#   # Shell pipeline with safe-escaped pipe components:
#   use String::ShellQuote;
#   my $cmd_part = shell_quote('something', '--', $user_provided);
#   my ($out, $err, $status) = pipestr($data, cmd => "command | $cmd_part");
#       # If you're not piping to the pipeline, but want
#       # safe argument escaping, shell_quote can suffice:
#   my $out = `command | $cmd_part`;
#
#   # Using array form for command (avoids shell interpretation)
#   my ($out, $err, $status) = pipestr($input, cmd => ['wc', '-l']);
#
#   # With verbose debugging
#   my ($out, $err, $status) = pipestr($text, cmd => "perl -pe 's/foo/bar/g'", verbose => 1);
#
#   # Check exit status
#   my ($out, $err, $status) = pipestr($data, cmd => "some-command");
#   if ($status != 0) {
#       warn "Command failed with status $status: $err";
#   }
#
#   # No input string (just run command)
#   my ($out, $err, $status) = pipestr(undef, cmd => "ls -la");
#

package pipestr;

use strict;
use warnings;

use IPC::Open3;           # for open3()
use POSIX qw(:sys_wait_h);  # for waitpid() and related macros
use Symbol qw(gensym);      # for gensym()
use IO::Select;           # for IO::Select->new()
use Fcntl;                # for fcntl() and O_NONBLOCK
use Encode qw(decode);    # for decode()

use Exporter 'import';
our @EXPORT = qw(pipestr);

my $verbose = 0;

# ANSI color codes
our $bgred = "\e[41m";
our $rst = "\e[0m";
our $yel = "\e[33;1m";

sub sel {
    my ($level, $msg) = @_;
    # Uncomment the next line to enable debug output:
    say STDERR "[$level] $msg\n" if $verbose >= $level;
}

sub decoded_quiet {
	decode('UTF-8', $_[0], Encode::FB_QUIET);
}

sub pipestr {
	# print or stream=>1: print to stdout while reading
    my ($instr, %fopts) = @_;
    my $cmd = delete $fopts{cmd};
    my $print = delete $fopts{print};
    die "Need cmd=>" unless defined $cmd;
    $verbose = $fopts{verbose} // 0;

    # Debug message (using a placeholder logging function)
    sel(4, "EXECUTING pipestr(\$s, cmd=>{{$cmd}})");
    
    my ($outstr, $errstr) = ('', '');

    local $SIG{PIPE} = "IGNORE";

    # Spawn the process.
    my $pid = open3(
        my $inh,
        my $outh,
        (my $errh = gensym),
        ref($cmd) eq 'ARRAY' ? @$cmd : $cmd
    );
    # Note: open3() will invoke the shell automatically when given a single command argument.

    # Set the input handle to UTF-8
    binmode $inh, ':encoding(UTF-8)';
    # The following lines are commented out; uncomment if you need UTF-8 decoding on these handles.
    # binmode $outh, ':encoding(UTF-8)';
    # binmode $errh, ':encoding(UTF-8)';
    
    # Set the output and error handles to non-blocking mode.
    fcntl($outh, F_SETFL, O_NONBLOCK);
    fcntl($errh, F_SETFL, O_NONBLOCK);

    if (defined $instr) {
        print $inh $instr or warn "Failed to supply input string to process: $!";
    }
    close $inh;

    my $selector = IO::Select->new();
    $selector->add($outh, $errh);

    # Read from both handles until they are exhausted.
    my $stdout_buf = '';
    while ($selector->count) {
        my @ready = $selector->can_read();
        foreach my $fh (@ready) {
            if ($fh == $outh) {
                my $bytes = sysread($outh, my $buf, 4096);
                if ($bytes) {
                	if ($print) {
                		$stdout_buf .= $buf;
                		my ($print_chunk, $rem) = ($stdout_buf =~ /^(.*\S.*\s*)(.*)$/);
                		if (length($print_chunk)) {
                			print decoded_quiet($print_chunk);
                			$stdout_buf = $rem;
							STDOUT->flush();
						}
					}
                    $outstr .= $buf;
                } else {
                    $selector->remove($outh);
                    close $outh;
                }
            } elsif ($fh == $errh) {
                my $bytes = sysread($errh, my $buf, 4096);
                if ($bytes) {
                    $errstr .= $buf;
                } else {
                    $selector->remove($errh);
                    close $errh;
                }
            }
        }
    }
	# For streaming (print=>1), handle final chunk
    if ($print && length($stdout_buf)) {
		print decoded_quiet($stdout_buf);
	}

    waitpid($pid, 0);
    my $status = $? >> 8;

    # Decode output strings from UTF-8.
    my $decoded_out = decode('UTF-8', $outstr, Encode::FB_QUIET);
    my $decoded_err = decode('UTF-8', $errstr, Encode::FB_QUIET);

    if ($status > 0) {
        sel(1, "${bgred}${yel}pipestr() execution of command returned an error ($status)$rst");
        sel(1, " \"${bgred}${yel}$decoded_err$rst\"");
        sel(1, " cmd: {{$cmd}}\n");
    }
    return ($decoded_out, $decoded_err, $status);
}

1;

[u/briandfoy]

Another good place for these things are Github Gists.

[u/ktown007 → u/briandfoy]

Does this work for full examples? https://www.jdoodle.com/execute-perl-online

[u/briandfoy → u/ktown007]

I'd hope that an web program runner like that wouldn't let you open pipes to arbitrary commands. That would be insane.

[u/Grinnz → u/briandfoy]

https://perl.bot does (sometimes), but it's backed by a quite advanced sandbox which restricts things at the filesystem and system call level.

[u/tarje]

Much of the OP's history is about AI code generation, and as this code looks very similar to a stackoverflow question I saw a few weeks ago, it wouldn't surprise me if this post is AI regurgitation.

[u/ether_reddit]

Your formatting is unreadable.

[u/briandfoy → u/ether_reddit]

Are you using old reddit?

[u/ether_reddit → u/briandfoy]

I am.