IPC::ShellCmd - Run a command with a given environment and capture output

IPC-ShellCmd documentation Contained in the IPC-ShellCmd distribution.

Index

Code Index:

NAME

Top

IPC::ShellCmd - Run a command with a given environment and capture output

SYNOPSIS

Top

    my $isc = IPC::ShellCmd->new(["perl", "Makefile.PL"])
	    ->working_directory("/path/to/IPC_ShellCmd-0.01")
	    ->stdin(-filename => "/dev/null")
	    ->add_envs(PERL5LIB => "/home/mbm/cpanlib/lib/perl5")
	    ->chain_prog(
	        IPC::ShellCmd::Sudo->new(
		        User => 'cpanbuild',
		        SetHome => 1,
		    )
	    )->run();

    my $stdout = $isc->stdout();
    my $status = $isc->status();

DESCRIPTION

Top

This module comes from the nth time I've had to implement a select loop and wanted appropriate sudo/su privilege magic, environment variables that are set in the child, working directories set etc.

It aims to provide a reasonable interface for setting up command execution environment (working directory, environment variables, stdin, stdout and stderr redirection if necessary), but allowing for ssh and sudo and magicing in the appropriate shell quoting.

It tries to be flexible about how you might want to capture output, exit status and other such, but in such a way as it's hopefully easy to understand and make it work.

Setup method calls are chainable in a File::Find::Rule kind of a way.

my $isc = IPC::ShellCmd->new(\@cmd, %opts)

Creates a new IPC::ShellCmd object linking to the command and arguments. Possible options:

-nowarn

Don't throw warnings for overwriting values that have already been set

-debug

Set the debug level

$isc->set_umask($mask)

Sets the umask that this command is going to have, and returns so that it can be chained.

$isc->working_dir([$path])

Sets the working directory that this command is going to run under, and returns so that it can be chained, or returns the current setting with no arguments.

$isc->add_envs($env1 => $val1 [, $env2 => $val2, ...])

Adds environment variables to be setup when the command is run. Returns so that it can be chained.

$isc->chain_prog($chain_obj, [$opt => $val, ...])

Adds a chain object, for example IPC::ShellCmd::Sudo->new(User => 'root') into the chain. Returns so that it can be chained.

Valid options are:

-include-stdin

If set, and stdin is a filename (rather than a pipe, open filehandle, or other type of descriptor) then the file will be included in the chain.

-include-stdout

As above but with stdout.

-include-stderr

As above but with stderr.

$isc->stdin($stdin)

$isc->stdin($type, $stdin)

The 1 argument form takes either

A scalar

This is the input to the command in full.

A scalar ref

This is a reference to the input that will be passed.

A code ref

This is expected to generate the text to send to stdin. It is called with an argument of the number of bytes that the caller wants to read. If it generates more, some may be lost - you have been warned.

The 2 argument form takes a type and then a ref, handle or other. Valid types:

-inherit

The argument to this is ignored. If specified this takes stdin from whatever the caller is reading from.

-file

The argument to this is a perl filehandle.

-fd

The argument to this is a system file descriptor.

-filename

The argument to this is a filename which is opened.

Both of these return for chaining. The default is an empty scalar.

$isc->stdout()

$isc->stderr()

These 0-argument forms return the captured stdout/stderr if the default stdout/stderr handler is set and run() has been called. If either has been setup elsewhere, then these will croak() an error.

$isc->stdout($value)

$isc->stderr($value)

$isc->stdout($type, $value)

$isc->stderr($type, $value)

These setup stdout/stderr as appropriate. The forms are similar to the stdin method above.

The 1 argument form takes either

A scalar ref

This is a reference to a scalar that will have the output appended to it.

A code ref

This code will be called (probably more than once) with a scalar of text to be appended which has been read from stdout/stderr.

The 2 argument form takes a type and then a ref, handle or other. Valid types:

-inherit

The argument to this is ignored. If specified this takes stdout/stderr from whatever the caller is set to.

-file

The argument to this is a perl filehandle.

-fd

The argument to this is a system file descriptor.

-filename

The argument to this is a filename which is opened.

All of these forms return for chaining. The default is that it will populate an internal variable to be used by the corresponding 0-argument form.

$isc->status()

Returns the exit status of the command if it got run.

$isc->run()

Runs the command with all the setup that has been done.

BUGS

Top

Apart from the ones that are probably in there and that I don't know about, this is a very UNIX-centric view of the world, it really should cope with Win32 concepts etc.

SEE ALSO

Top

IPC::ShellCmd::Generic, IPC::ShellCmd::Sudo, IPC::ShellCmd::SSH, IO::Select, IPC::Open3

AUTHORS

Top

    Matthew Byng-Maddick <matthew.byng-maddick@bbc.co.uk> <mbm@colondot.net>

    Tomas Doran (t0m) <bobtfish@bobtfish.net>

COPYRIGHT

Top

Copyright (c) 2009 the British Broadcasting Corperation.

LICENSE

Top

This library is free software and may be distributed under the same terms as perl itself.

IPC-ShellCmd documentation Contained in the IPC-ShellCmd distribution. 
package IPC::ShellCmd;

use strict;
use Carp qw(carp croak);
use Scalar::Util;
use IO::Pipe;
use POSIX qw(:sys_wait_h);
use 5.008004; # May work with lower, unwilling to support unless you provide patches :)

our $VERSION = '0.001';
$VERSION = eval $VERSION;

$IPC::ShellCmd::BufferLength = 16384;


sub new {
    my $package = shift;
    my $cmd = shift;
    my %options = @_;

    if(!$cmd || !ref($cmd) || ref($cmd) ne "ARRAY") {
	    croak "Expecting an ARRAYREF for the command";
    }

    my @cmd = @$cmd;

    if(!@cmd) {
	    croak "Must specify at least one thing to run";
    }

    for my $cmd_el (@cmd) {
	    croak "Command arguments must all be strings"
	        if(!defined $cmd_el || ref($cmd_el)); 
    }

    my $self = bless {cmd => [@cmd], opts => {}}, $package;

    $self->_init(\%options);

    $self->_debug(2, "Constructor succeeded");

    return $self;
}

sub _init {
    my $self = shift;
    my $opts = shift;

    $self->{opts}->{warn} = 1
	    unless $opts->{'-nowarn'};

    $self->{select}->[0] =
	$self->{select}->[1] =
	$self->{select}->[2] = 1;

    $self->{debug} = 0;
    $self->{debug} = $opts->{'-debug'}
	    if($opts->{'-debug'} && $opts->{'-debug'} =~ /^\d+$/);

    $self->{'argv0'} = $self->{cmd}->[0];
    $self->{'argv0'} = $opts->{'-argv0'}
	    if($opts->{'-argv0'} && !ref $opts->{'-argv0'});
}

sub _debug {
    my $self = shift;
    my $level = shift;
    my $string = shift;

    carp sprintf("%s::debug%d: %s", ref($self), $level, $string)
	    if ($level <= $self->{debug});
}


sub set_umask {
    my $self = shift;
    my $umask = shift;

    if($self->{opts}->{warn} && defined $self->{umask}) {
	    carp "Overwriting umask";
    }

    if(!defined $umask) {
	    croak "Can't use an undefined umask";
    }

    if($self->{run}) {
	    croak "Can't change setup after command has been run";
    }

    if(ref $umask || $umask !~ /^\d+$/) {
	    croak "Invalid umask";
    }

    $self->{umask} = $umask;

    return $self;
}


sub working_dir {
    my $self = shift;

    if(@_ && !defined $_[0]) {
	    croak "Can't set working directory to undefined path";
    }

    my $path = shift;

    if($self->{opts}->{warn} && defined $self->{wd}) {
	    carp "Overwriting working directory";
    }

    if($self->{run} && defined $path) {
	    croak "Can't change setup after command has been run";
    }

    if(defined $path && !ref $path) {
	    $self->_debug(2, "Setting working directory to \"$path\"");
	    $self->{wd} = $path;
	    return $self;
    }
    elsif(defined $path) {
	    croak "Expecting a string as working dir path";
    }
    return $self->{wd};
}


sub add_envs {
    my $self = shift;
    my %env = @_;

    croak "Can't change setup after command has been run"
	    if($self->{run});

    croak "No envs specified"
	    unless @_;

    my $count = 0;

    for my $e (keys %env) {
	    $count++;
	    if($self->{opts}->{warn} && exists $self->{env}->{$e}) {
	        carp "Overwriting environment \"$e\"";
	    }
	    $self->{env}->{$e} = $env{$e};
	    $self->_debug(2, "Adding environment '$e' => '$env{$e}'");
    }

    return $self;
}


sub chain_prog {
    my $self = shift;
    my $obj = shift;
    my %opts = @_;

    croak "Can't change setup after command has been run"
	    if($self->{run});

    croak "Expecting a IPC::ShellCmd::Chain type of object"
	    unless Scalar::Util::blessed($obj) && $obj->can("chain");

    $self->{chain} = []
	unless $self->{chain};

    my $opt = {};
    if($opts{'-include-stdin'}) {
	    $opt->{stdin} = 1;
    }
    if($opts{'-include-stdout'}) {
	    $opt->{stdout} = 1;
    }
    if($opts{'-include-stderr'}) {
	    $opt->{stderr} = 1;
    }

    $self->_debug(2, "chaining a " . ref($obj) . " object");

    push(@{$self->{chain}}, {obj => $obj, opt => $opt});

    return $self;
}


sub stdin {
    my $self = shift;

    croak "Can't change setup after command has been run"
	    if ($self->{run});

    carp "Overwriting stdin"
	    if ($self->{opts}->{warn} && $self->{stdin});

    if(@_ == 1) {
	    if (!defined $_[0]) {
	        croak "Argument wasn't defined";
	    }

	    if (ref $_[0] && ref $_[0] ne "CODE" && ref $_[0] ne "SCALAR") {
	        croak "Expecting string, coderef or scalarref for one-argument form";
	    }
	    elsif(!ref $_[0]) {
	        $self->{stdin} = [plain => $_[0]];
	        $self->{select}->[0] = 1;
	    }
	    elsif(ref $_[0] eq "CODE") {
	        $self->{stdin} = [coderef => $_[0]];
	        $self->{select}->[0] = 1;
	    }
	    elsif(ref $_[0] eq "SCALAR") {
	        $self->{stdin} = [scalarref => $_[0]];
	        $self->{select}->[0] = 1;
	    }
	    else {
	        die "Should be unreachable";
	    }
    }
    elsif(@_ == 2) {
	    if(!defined $_[0]) {
	        croak "Type wasn't defined";
	    }

	    if($_[0] eq "-inherit") {
	        $self->{stdin} = [file => \*STDIN];
	        $self->{select}->[0] = 0;
	    }
	    elsif($_[0] eq "-file") {
	        $self->{stdin} = [file => $_[1]];
	        $self->{select}->[0] = 0;
	    }
	    elsif($_[0] eq "-filename") {
	        if(!defined $_[1] || ref $_[1] || $_[1] =~ /\000/) {
		        croak "Argument to -filename wasn't a valid filename";
	        }
	        $self->{stdin} = [filename => $_[1]];
	        $self->{select}->[0] = 0;
	    }
	    elsif($_[0] eq "-fd") {
	        if(!defined $_[1] || ref $_[1] || $_[1] !~ /^\d+$/) {
		        croak "Argument to -fd wasn't a file descriptor";
	        }
	        $self->{stdin} = [fd => $_[1]];
	        $self->{select}->[0] = 0;
	    }
	    else {
	        croak "Unknown type \"$_[0]\"";
	    }
    }
    else {
	    croak "Expecting 1 or 2 arguments";
    }

    $self->_debug(2, "Updating stdin to be of type '" . $self->{stdin}->[0] . "'");

    return $self;
}


sub stdout {
    my $self = shift;
    return $self->_access_out("stdout", 1, @_);
}

sub stderr {
    my $self = shift;
    return $self->_access_out("stderr", 2, @_);
}

sub _access_out {
    my $self = shift;
    my $name = shift;
    my $fd = shift;

    if(@_ == 0) {
	    if($self->{run}) {
	        if(exists $self->{$name . "_text"}) {
		        return $self->{$name . "_text"};
	        }
	        else {
		        croak "Can't read $name from type \"" . $self->{$name}->[0] . \"";
	        }
	    }
	    else {
	        croak "Can't get $name until run() has happened";
	    }
    }

    # At this point, we're in a >0 argument form

    croak "Can't change setup after command has been run"
	    if($self->{run});

    if(@_ == 1) {
	    if(!defined $_[0]) {
	        croak "Argument wasn't defined";
	    }

	    if(!ref $_[0] || ref $_[0] ne "CODE" && ref $_[0] ne "SCALAR") {
	        croak "Expecting coderef or scalarref for one-argument form";
	    }
	    elsif(ref $_[0] eq "CODE") {
	        $self->{$name} = [coderef => $_[0]];
	        $self->{select}->[$fd] = 1;
	    }
	    elsif(ref $_[0] eq "SCALAR") {
	        $self->{$name} = [scalarref => $_[0]];
	        $self->{select}->[$fd] = 1;
	    }
	    else {
	        die "Should be unreachable";
	    }
    }
    elsif(@_ == 2) {
	    if(!defined $_[0]) {
	        croak "Type wasn't defined";
	    }

	    if($_[0] eq "-inherit") {
	        if($name eq "stdout") {
		        $self->{$name} = [file => \*STDOUT];
	        }
	        else {
		        $self->{$name} = [file => \*STDERR];
	        }
	        $self->{select}->[$fd] = 0;
	    }
	    elsif($_[0] eq "-file") {
	        $self->{$name} = [file => $_[1]];
	        $self->{select}->[$fd] = 0;
	    }
	    elsif($_[0] eq "-filename") {
	        if(!defined $_[1] || ref $_[1] || $_[1] =~ /\000/) {
		        croak "Argument to -filename wasn't a valid filename";
	        }
	        $self->{$name} = [filename => $_[1]];
	        $self->{select}->[$fd] = 0;
	    }
	    elsif($_[0] eq "-fd") {
	        if(!defined $_[1] || ref $_[1] || $_[1] !~ /^\d+$/) {
                croak "Argument to -fd wasn't a file descriptor";
            }
            $self->{$name} = [fd => $_[1]];
            $self->{select}->[$fd] = 0;
        }
        else {
            croak "Unknown type \"$_[0]\"";
        }
    }
    else {
        croak "Expecting 0, 1 or 2 arguments";
    }

    $self->_debug(2, "Updating $name to be of type '" . $self->{$name}->[0] . "'");

    return $self;
}


sub status {
    my $self = shift;

    if($self->{run}) {
        return($self->{status});
    }
    else {
        croak "Can't get status before command has been run";
    }
}


sub run {
    my $self = shift;

    my @cmd = $self->_transform_cmd();

    $self->_debug(1, "About to run \`" . join("', \`", @cmd) . "'");

    $self->_verify_fh();

    for my $fh (qw(stdin stdout stderr)) {
	my $select = $self->{select}->[{stdin => 0, stdout => 1, stderr => 2}->{$fh}];
    if($select) {
        my $pipe = IO::Pipe->new();
        if(!defined $pipe) {
            die "pipe(): $!";
        }
        push(@{$self->{$fh}}, $pipe);
    }
}

    my $pid = fork();

    if(!defined $pid) {
        die "fork(): $!";
    }
    if(!$pid) {
        # child
        # In here, we only die, we don't croak, as the caller is very definitely parent only

        my $ret;
        if(defined $self->{umask}) {
            $ret = umask $self->{umask};
            if(!defined $ret) {
                die "umask(): $!\n";
            }
        }
        if(defined $self->{wd}) {
            $ret = chdir($self->{wd});
            if(!defined $ret) {
                die "chdir(): $!\n";
            }
        }
        if(keys %{$self->{env}||{}}) {
            for my $e (keys %{$self->{env}}) {
                $ENV{$e} = $self->{env}->{$e};
            }
        }

        if($self->{stdin}->[0] eq "file") {
            if(!open(STDIN, "<&", $self->{stdin}->[1])) {
                die("dup2(stdin): $!\n");
            }
        }
        else {
            $self->{stdin}->[2]->reader();
            if(!open(STDIN, "<&", $self->{stdin}->[2])) {
                die("dup2(stdin): $!\n");
            }
        }

        if($self->{stdout}->[0] eq "file") {
            if(!open(STDOUT, ">>&", $self->{stdout}->[1])) {
                die("dup2(stdout): $!\n");
            }
        }
        else {
            $self->{stdout}->[2]->writer();
            if(!open(STDOUT, ">>&", $self->{stdout}->[2])) {
                die("dup2(stdout): $!\n");
            }
        }

        if($self->{stderr}->[0] eq "file") {
            if(!open(STDERR, ">>&", $self->{stderr}->[1])) {
                die("dup2(stderr): $!\n");
            }
        }
        else {
            $self->{stderr}->[2]->writer();
            if(!open(STDERR, ">>&", $self->{stderr}->[2])) {
                die("dup2(stderr): $!\n");
            }
        }

        for(my $i = 3 ; $i < 16384; $i++) {
            POSIX::close($i);
        }

        exec(@cmd);
        die("exec: $!\n");
    }
    else {
        # parent

        $self->_debug(2, "After fork: child $pid");

        for my $fh (qw(stdin stdout stderr)) {
            if($self->{$fh}->[0] eq "file") {
                if($self->{$fh}->[2]) {
                    $self->_debug(2, "Closing $fh in parent due to being a file");
                    close($self->{$fh}->[1]);
                }
            }
            else {
                if($fh eq "stdin") {
                    $self->_debug(2, "Setting $fh as non-block writer in parent");
                    $self->{$fh}->[2]->writer();
                    $self->{$fh}->[2]->blocking(0);
                }
                else {
                    $self->_debug(2, "Setting $fh as non-block reader in parent");
                    $self->{$fh}->[2]->reader();
                    $self->{$fh}->[2]->blocking(0);
                }
            }
        }

        $self->_select_wait($pid);
    }

    $self->{run} = 1;

    return $self;
}

sub _select_wait {
    my $self = shift;
    my $pid = shift;

    local $Carp::CarpLevel = 1;

    # select loop
    my($rin, $win, $ein, $rout, $wout, $eout) = ("", "", "");

    if($self->{stdin}->[0] ne "file") {
        $self->_debug(3, "Adding stdin to writers");
        vec($win, fileno($self->{stdin}->[2]), 1) = 1;
    }

    for my $fh (qw(stdout stderr)) {
        if($self->{$fh}->[0] ne "file") {
            $self->_debug(3, "Adding $fh to readers");
            vec($rin, fileno($self->{$fh}->[2]), 1) = 1;
        }
    }

    while($rin =~ /[^\0]/ || $win =~ /[^\0]/) {
        select($rout = $rin, $wout = $win, $eout = $ein, 0.01);

        if($self->{stdin}->[0] ne "file" && vec($wout, fileno($self->{stdin}->[2]), 1)) {
            if($self->{stdin}->[0] eq "plain") {
                my $length = length($self->{stdin}->[1]);
                if($length) {
                    $length = $IPC::ShellCmd::BufferLength
                    if($length > $IPC::ShellCmd::BufferLength);
                    $self->_debug(3, "Writing into stdin from plain scalar");
                    my $rc = syswrite($self->{stdin}->[2], $self->{stdin}->[1], $length);
                    if(!defined $rc) {
                        die("write(->stdin): $!\n");
                    }

                    $self->{stdin}->[1] = substr($self->{stdin}->[1], $rc);
                }
                if(!length($self->{stdin}->[1])) {
                    $self->_debug(3, "Removing stdin from writers, and closing");
                    vec($win, fileno($self->{stdin}->[2]), 1) = 0;
                    close($self->{stdin}->[2]);
                }
            }
            elsif($self->{stdin}->[0] eq "scalarref") {
                $self->{stdin}->[3] = 0 unless defined $self->{stdin}->[3];
                my $length = length(${$self->{stdin}->[1]}) - $self->{stdin}->[3];
                if($length) {
                    $length = $IPC::ShellCmd::BufferLength
                    if($length > $IPC::ShellCmd::BufferLength);
                    $self->_debug(3, "Writing into stdin from scalarref");
                    my $rc = syswrite($self->{stdin}->[2],
                        substr(${$self->{stdin}->[1]}, $self->{stdin}->[3]), $length);
                        if(!defined $rc) {
                            die("write(->stdin): $!\n");
                        }

                        $self->{stdin}->[3] += $rc;
                    }
                    if(length(${$self->{stdin}->[1]}) == $self->{stdin}->[3]) {
                        $self->_debug(3, "Removing stdin from writers, and closing");
                        vec($win, fileno($self->{stdin}->[2]), 1) = 0;
                        close($self->{stdin}->[2]);
                    }
                }
                elsif($self->{stdin}->[0] eq "coderef") {
                    $self->{stdin}->[3] = ""
                    unless defined $self->{stdin}->[3];

                    $self->{stdin}->[4] = 0
                    unless defined $self->{stdin}->[4];
                    my $finished = $self->{stdin}->[4];

                    if(!$finished && length $self->{stdin}->[3] < $IPC::ShellCmd::BufferLength) {
                        my $data = $self->{stdin}->[1]->($IPC::ShellCmd::BufferLength - length($self->{stdin}->[3]));
                        if(!defined $data) {
                            $finished = 1;
                        }

                        $self->{stdin}->[3] .= $data;
                        if(length($self->{stdin}->[3]) > $IPC::ShellCmd::BufferLength) {
                            $self->{stdin}->[3] = substr($self->{stdin}->[3], 0, $IPC::ShellCmd::BufferLength);

                        }
                    }

                    if(length($self->{stdin}->[3])) {
                        $self->_debug(3, sprintf("Writing %d into stdin from coderef", length($self->{stdin}->[3])));
                        my $rc = syswrite($self->{stdin}->[2], $self->{stdin}->[3], length($self->{stdin}->[3]));
                        if(!defined $rc) {
                            die("write(->stdin): $!\n");
                        }

                        $self->{stdin}->[3] = substr($self->{stdin}->[3], $rc);
                    }

                    $self->{stdin}->[4] = $finished;

                    if($finished && !length($self->{stdin}->[3])) {
                        $self->_debug(3, "Removing stdin from writers, and closing");
                        vec($win, fileno($self->{stdin}->[2]), 1) = 0;
                        close($self->{stdin}->[2]);
                    }
                }
            }

            for my $fh (qw(stdout stderr)) {
                if($self->{$fh}->[0] ne "file" && vec($rout, fileno($self->{$fh}->[2]), 1)) {
                    my $buff = "";
                    $self->_debug(3, "Reading $IPC::ShellCmd::BufferLength from $fh");
                    my $rc = sysread($self->{$fh}->[2], $buff, $IPC::ShellCmd::BufferLength);
                    if(!defined $rc) {
                        die("read(->$fh): $!\n");
                    }
                    if(!$rc) {
                        $self->_debug(3, "Removing $fh from readers, and closing");
                        vec($rin, fileno($self->{$fh}->[2]), 1) = 0;
                        close($self->{$fh}->[2]);
                    }
                    else {
                        if($self->{$fh}->[0] eq "scalarref") {
                            ${$self->{$fh}->[1]} .= $buff;
                        }
                        elsif($self->{$fh}->[0] eq "coderef") {
                            $self->{$fh}->[1]->($buff);
                        }
                    }
                }
            }

            if(!defined $self->{status} && waitpid($pid, WNOHANG)) {
                $self->_debug(3, "Reaped child $pid in loop");
                $win = "";
                $self->{status} = $?;
            }
        }

        if($rin !~ /[^\0]/ && $win !~ /[^\0]/ && !defined $self->{status}) {
            $self->_debug(3, "Trying to reap child $pid");
            my $rc = waitpid($pid, 0);
            $self->_debug(3, "Reaped child $pid");
            if(defined $rc) {
                $self->{status} = $?;
            }
            else {
                die("waitpid: $!\n");
            }
        }
        return;
    }

    sub _verify_fh {
        my $self = shift;

        for my $fh (qw(stdin stdout stderr)) {
            if(!$self->{$fh}) {
                croak "Defaulting didn't happen for $fh";
            }

            my $type = $self->{$fh}->[0];
            my $select = $self->{select}->[{stdin => 0, stdout => 1, stderr => 2}->{$fh}];

            # all of the "filename" and "fd" types should have been got rid of as a part
            # of the _transform_cmd called before this.

            # First check the types of all the fhs
            if($type ne "plain" && $type ne "coderef" && $type ne "scalarref" &&
            $type ne "file") {
                # this is an assert so there's no CarpLevel...
                croak "Unrecognised type $type for $fh";
            }
            elsif($type eq "plain" && $fh ne "stdin") {
                croak "Plain is only useful for stdin, not $fh";
            }

            # Then we check that select is correctly set.
            if($type eq "plain" || $type eq "coderef" || $type eq "scalarref") {
                if(!$select) {
                    croak "$type should be selected on but isn't for $fh";
                }
            }
            else {
                if($select) {
                    croak "$type shouldn't be selected on but is for $fh";
                }
            }
        }
    }

    sub _transform_cmd {
        my $self = shift;

        my $count = 1;

        my $file = { stdin => 0, stdout => 0, stderr => 0 };

        for my $fh (qw(stdin stdout stderr)) {
            if($self->{$fh} && $self->{$fh}->[0] eq "filename") {
                $file->{$fh} = 1;
            }
        }

        my @cmd = @{$self->{cmd}};

        for my $el (@{$self->{chain}||[]}) {
            $self->_debug(2, "Before chain $count cmd = \`" . join("', \`", @cmd) . "'");

            my @args = ();
            if($count == 1) {
                if(defined($self->{wd})) {
                    push(@args, "-wd", $self->{wd});
                    delete $self->{wd};
                }
                if(keys %{$self->{env}}) {
                    push(@args, "-env", {%{$self->{env}}});
                    delete $self->{env};
                }
                if(defined($self->{umask})) {
                    push(@args, "-umask", $self->{umask});
                    delete $self->{umask};
                }
            }

            for my $fh (qw(stdin stdout stderr)) {
                if($file->{$fh} && $el->{opt}->{$fh}) {
                    push(@args, "-" . $fh, $self->{$fh}->[1]);
                    $file->{$fh} = 0;
                    # in this sub bit, because of $file->{fh}, this must be
                    # a filename, so we can do the following.
                    $self->{$fh}->[1] = "/dev/null";
                }
            }

            $self->_debug(2, "Calling chain $count with args = \`" . join("', \`", @args) . "'");
            @cmd = $el->{obj}->chain([@cmd], {@args});

            $self->_debug(2, "After chain $count cmd = \`" . join("', \`", @cmd) . "'");

            $count++;
        }

        # Figure out all the command defaults
        if(!$self->{stdin}) {
            $self->{stdin} = [filename => "/dev/null"];
            $self->{select}->[0] = 0;
        }
        for my $fh (qw(stdout stderr)) {
            if(!$self->{$fh}) {
                $self->{$fh . "_text"} = "";
                my $ref = \$self->{$fh . "_text"};
                $self->{$fh} = [scalarref => $ref];
            }
        }

        # as a side effect of this sub, we also end up transforming filenames and fds
        # into file handles.
        for my $fh (qw(stdin stdout stderr)) {
            local $Carp::CarpLevel = 1;
            if($self->{$fh} && $self->{$fh}->[0] eq "filename") {
                my $pfh;
                if(open($pfh, ($fh eq "stdin"?"<":">>"), $self->{$fh}->[1])) {
                    $self->{$fh} = [file => $pfh, 1];
                }
                else {
                    croak "Couldn't open file \"" . $self->{$fh}->[1] . "\": $!";
                }
            }
            elsif($self->{$fh} && $self->{$fh}->[0] eq "fd") {
                my $pfh;
                if(open($pfh, ($fh eq "stdin"?"<&=":">>&="), $self->{$fh}->[1])) {
                    $self->{$fh} = [file => $pfh];
                }
                else {
                    croak "Couldn't fdopen " . $self->{$fh}->[1] . ": $!";
                }
            }
        }

        return @cmd;
    }


1;