http://qs321.pair.com?node_id=669925

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

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

I want to do the above:

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