Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Pipe processes and Perl subroutines together

by repellent (Priest)
on Feb 25, 2008 at 03:47 UTC ( [id://669925]=CUFP: print w/replies, xml ) Need Help??

UPDATE: (4/17/2009) Latest version of IPC::Exe is uploaded to CPAN.

Most of the time, whenever I execute an external program:

  • in the foreground, I wish to process its output back in my Perl script.
  • in the background, I wish to leave it running behind-the-scenes, so I can carry on with my Perl script.
I want to do the above:

  • without invoking the shell (my Perl script should interact directly with the external program).
  • with the flexibility of redirecting stdout and stderr however I wish, with as little work as possible.
Update: (3/3/2008) I have completely restructured the code to allow for multiple processes or Perl subroutines to be piped together.

Example:

&{ bg exe sub { "2>#" }, qw( ls /tmp does_not_exist ), exe "tac", exe sub { print "2nd cmd: @_\n"; print "three> $_" while <STDIN +> }, bg exe "sort", exe qw(cat -n), exe sub { print "six> $_" while <STDIN>; print "5th cmd: @_\n" +}, };
is like
{ ls /tmp does_not_exist 2> /dev/null | tac | [perlsub] | { sort | cat + -n | [perlsub] } & } &
Both exe() & bg() return CODE references that need to be called.

SYNTAX:

exe &PREEXEC, LIST, &READER exe &PREEXEC, &READER exe &READER
LIST is exec() in the child process after the parent is forked, where the child's stdout is redirected to &READER's stdin.

&PREEXEC is called right before exec() in the child process, so you may reopen filehandles or do some child-only operations beforehand.

Optionally, &PREEXEC could return a list of strings to perform common filehandle redirections. For example,

"2>null" # silence stderr ">#" # silence stdout "2>&1" # redirect stderr to stdout "1>&2" # redirect stdout to stderr "1><2" # swap stdout and stderr
&READER is called with LIST as its arguments.
&PREEXEC inherits the LIST passed to the previous &READER, which is where it was called from.

&READER is always called in the parent process.
&PREEXEC is always called in the child process.

&PREEXEC and &READER are very similar and may be treated the same.

It is important to note that the actions & return of &PREEXEC matters, as it may be used to redirect filehandles before &PREEXEC becomes the exec process.

If LIST is not provided, &PREEXEC will still be called.
If &PREEXEC is not provided, LIST will still exec().
If &READER is not provided, it defaults to: sub { print while <STDIN> }

exe( &READER ) returns &READER

bg &BACKGROUND

Call &BACKGROUND after sending it to the init process.

Upon failure of background to init process, fall back by calling &BACKGROUND in parent or child process.

CODE:

package IPC::Exe; #===================================================================== +========= # # DESCRIPTION: # # Execute processes or Perl subroutines & string them via IPC. # Think shell pipes. # # # SYNTAX: # # Both exe() & bg() # - are exported by :DEFAULT # - return CODE references that need to be called # # exe &PREEXEC, LIST, &READER # exe &PREEXEC, &READER # exe &READER # # LIST is exec() in the child process after the parent is forked, # where the child's stdout is redirected to &READER's stdin. # # &PREEXEC is called right before exec() in the child process, so +you may # reopen filehandles or do some child-only operations beforehand +. # # Optionally, &PREEXEC could return a list of strings to perform c +ommon # filehandle redirections. For example, # # "2>null" silence stderr # ">#" silence stdout # "2>&1" redirect stderr to stdout # "1>&2" redirect stdout to stderr # "1><2" swap stdout and stderr # # &READER is called with LIST as its arguments. # &PREEXEC inherits the LIST passed to the previous &READER, which + is # where it was called from. # # &READER is always called in the parent process. # &PREEXEC is always called in the child process. # # &PREEXEC and &READER are very similar and may be treated the sam +e. # # It is important to note that the actions & return of &PREEXEC ma +tters, # as it may be used to redirect filehandles before &PREEXEC beco +mes the # exec process. # # close( $IPC::Exe::PIPE ) in &READER to get exit status $? of pro +cess executing # last on the pipe # # If LIST is not provided, &PREEXEC will still be called. # If &PREEXEC is not provided, LIST will still exec(). # If &READER is not provided, it defaults to: # sub { print while <STDIN>; close($IPC::Exe::PIPE); $? } # # exe( &READER ) returns &READER # # exe( ) returns an empty list. # # bg &BACKGROUND # # Call &BACKGROUND after sending it to the init process. # # Upon failure of background to init process, fall back by calling # &BACKGROUND in parent or child process. # # If &BACKGROUND is not a CODE reference, return an empty list. # # # EXAMPLE: # # &{ # bg exe sub { "2>#" }, qw( ls /tmp does_not_exist ), # exe "tac", # exe sub { print "2nd cmd: @_\n"; print "three> $_" while <S +TDIN> }, # bg exe "sort", # exe qw(cat -n), # exe sub { print "six> $_" while <STDIN>; print "5th cmd: @_ +\n" }, # }; # # is like # # { ls /tmp does_not_exist 2> /dev/null | tac | [perlsub] | { sort | + cat -n | [perlsub] } & } & # #===================================================================== +========= BEGIN { use Exporter qw(import); our $VERSION = 2.00; our @EXPORT = qw(&exe &bg); } use warnings; use strict; # closure allows exe() to do its magical arguments arrangement sub exe { # return empty list if no arguments return () if @_ == 0; # return only single CODE argument # e.g. exe sub { .. }; # returns # sub { .. } my ($code) = @_; return $code if defined($code) && ref($code) eq "CODE" && @_ == 1; # otherwise return closure my @args = @_; return sub { my @_closure = @_; _exe(\@_closure, @args); } } sub _exe { # obtain reference to arguments passed to closure my $_closure = shift(); # obtain CODE references, if available, for READER & PREEXEC subro +utines my ($Reader, $Preexec); $Reader = pop() if defined($_[$#_]) && ref($_[$#_]) eq "CODE"; $Preexec = shift() if defined($_[0]) && ref($_[0]) eq "CODE"; # safe pipe open to forked child connected to opened filehandle my ($FGPIPE, $gotchild); $gotchild = open($FGPIPE, "-|"); # check if fork was successful defined($gotchild) or warn("exe() cannot fork child :: $!") and re +turn (); # parent reads stdout of child process if ($gotchild) { my ($ORIGSTDIN, @ret); # dup(2) stdin open($ORIGSTDIN, "<&STDIN") and open(STDIN, "<&", $FGPIPE); # call READER subroutine if ($Reader) { # create package-scope $IPC::Exe::PIPE our $PIPE = $FGPIPE; @ret = &$Reader(@_); } else { # if undefined, just print stdin print while <$FGPIPE>; close($FGPIPE); $ret[0] = $?; # return exit status of last pipe process } # restore stdin open(STDIN, "<&", $ORIGSTDIN); # collect child PIDs unshift(@ret, $gotchild); return @ret; } else # child performs exec() { # call PREEXEC subroutine if defined my @FHop = &$Preexec(@$_closure) if defined($Preexec); # exec() LIST if defined exit(0) unless @_; require File::Spec; my $DEVNULL = File::Spec->devnull(); for (@FHop) { if (defined() && !ref()) { # silence stderr /^\s*2>\s*(?:null|#)\s*$/ and open(STDERR, ">", $DEVN +ULL); # silence stdout /^\s*1?>\s*(?:null|#)\s*$/ and open(STDOUT, ">", $DEVN +ULL); # redirect stderr to stdout /^\s*2>&\s*1\s*$/ and open(STDERR, ">&", STDO +UT); # redirect stdout to stderr /^\s*1?>&\s*2\s*$/ and open(STDOUT, ">&", STDE +RR); # swap stdout and stderr if (/^\s*1><2\s*$/) { my $SWAP; open($SWAP, ">&", STDOUT) and open(STDOUT, ">&", STDERR) and open(STDERR, ">&", $SWAP); } } } exec(@_) or die("exe() cannot exec '@_' :: $!"); } } # closure allows bg() to do its magical call placement sub bg ($) { # only take first CODE reference, ignore rest of arguments # return empty list if argument is not a CODE reference my ($code) = @_; return () unless defined($code) && ref($code) eq "CODE"; # otherwise return closure return sub { my @_closure = @_; _bg(\@_closure, $code); } } sub _bg { # obtain reference to arguments passed to closure my $_closure = shift(); # obtain CODE reference for BACKGROUND subroutine my $Background = shift(); # dup(2) stdout my $ORIGSTDOUT; open($ORIGSTDOUT, ">&", STDOUT); # double fork -- immediately wait() for child, # and init daemon will wait() for grandchild, once child exi +ts # safe pipe open to forked child connected to opened filehandle my ($BGPIPE, $gotchild); $gotchild = open($BGPIPE, "-|"); # check if fork was successful warn("bg() cannot fork child, will try forking again :: $!") unless defined($gotchild); # parent reads stdout of child process if ($gotchild) { # background: parent reads output from child, # and waits for child to exit my $grandpid = <$BGPIPE>; close($BGPIPE); return $? ? $gotchild : -+-$grandpid; } else { # background: perform second fork my $gotgrand; $gotgrand = fork(); # check if second fork was successful if (defined($gotchild)) { warn("bg() cannot fork grandchild, using child instead (pa +rent must wait) :: $!") unless defined($gotgrand); } else { if (defined($gotgrand)) { warn("bg() managed to fork child, using child now (par +ent must wait) :: $!") if $gotgrand; } else { warn("bg() cannot fork child again, using parent inste +ad (parent does all the work) :: $!"); } } # send grand/child's PID to parent process somehow my $childpid; if (defined($gotgrand) && $gotgrand) { if (defined($gotchild)) { # child writes grandchild's PID to parent process print $gotgrand; } else { # parent returns child's PID later $childpid = $gotgrand; } } # child exits once grandchild is forked # grandchild calls BACKGROUND subroutine unless ($gotgrand) { # restore stdout open(STDOUT, ">&", $ORIGSTDOUT); # BACKGROUND subroutine does not need to return &$Background(@$_closure); } elsif (!defined($gotchild)) { # parent must wait to reap child waitpid($gotgrand, 0); } # $gotchild $gotgrand exit() # --------- --------- ------ # childpid grandpid both child & grandchild # childpid undef child # undef childpid child # undef undef none (parent executes BACKGROUND su +broutine) exit(0) if defined($gotchild) && defined($gotgrand); exit(10) if defined($gotchild) && !defined($gotgrand); exit(10) if !defined($gotchild) && defined($gotgrand) && !$go +tgrand; # falls back here if forks were unsuccessful return $childpid; } } 'IPC::Exe';

Replies are listed 'Best First'.
Re: Wrapper function to execute process
by jasonk (Parson) on Mar 02, 2008 at 16:39 UTC

    Have you looked at IPC::Run?


    We're not surrounded, we're in a target-rich environment!
      Thanks for the reference. Yes, I have read through its documentation before. It is very powerful. No, I have not played with it.

      In my opinion, however, there's something about its syntax and setup that leaves me wanting. I get confused wrapping my mind around (\$in, \$out) and the various ways of specifying handle references for the commands.

      It's probably due to my inexperience. Let me look into IPC::Run some more.
      And while we're at it, have a look at IPC::Cmd. It seems more actively maintained and equipped with a more intuitive (for some) API.

      Bye
       PetaMem
          All Perl:   MT, NLP, NLU

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://669925]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2024-07-22 11:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.