Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Pipe processes and Perl subroutines together

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

Description: 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';


Comment on Pipe processes and Perl subroutines together
Select or Download Code
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

Back to Snippets Section

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (7)
As of 2014-07-10 08:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (203 votes), past polls