view release on metacpan or  search on metacpan

lib/Command/Run.pm  view on Meta::CPAN

    for my $key (keys %args) {
        my $val = $args{$key};
        if ($key eq 'command') {
            $obj->command(ref $val eq 'ARRAY' ? @$val : $val);
        } elsif ($key eq 'stdin') {
            $obj->_set_stdin($val);
        } elsif ($key eq 'stdout') {
            $obj->{STDOUT_REF} = $val;
        } elsif ($key eq 'stderr') {
            if (ref $val eq 'SCALAR') {
                $obj->{STDERR_REF} = $val;
                $obj->option(stderr => 'capture');
            } else {
                $obj->option(stderr => $val);
            }
        } else {
            $obj->option($key => $val);
        }
    }
    $obj;
}

sub command {
    my $obj = shift;
    if (@_) {
        $obj->{COMMAND} = [ @_ ];
        $obj;
    } else {
        @{$obj->{COMMAND} // []};
    }
}

sub option {
    my $obj = shift;
    if (@_ == 1) {
        return $obj->{OPTION}->{+shift};
    } else {
        while (my($k, $v) = splice @_, 0, 2) {
            $obj->{OPTION}->{$k} = $v;
        }
        return $obj;
    }
}

sub run {
    my $obj = shift;
    my %args = @_;
    my $stdout_ref = delete $args{stdout};
    my $stderr_ref = ref $args{stderr} eq 'SCALAR' ? delete $args{stderr} : undef;
    $args{stderr} = 'capture' if $stderr_ref;
    $obj->update(%args);
    if (my $ref = $stdout_ref // $obj->{STDOUT_REF}) {
        $$ref = $obj->data;
    }
    if (my $ref = $stderr_ref // $obj->{STDERR_REF}) {
        $$ref = $obj->error;
    }
    return $obj->result;
}

sub update {
    use Time::localtime;
    my $obj = shift;
    my %args = @_;
    my $command = delete $args{command};
    my @command = defined $command ?
        (ref $command eq 'ARRAY' ? @$command : $command) : $obj->command;
    if (@command) {
        $obj->{RESULT} = $obj->execute(\@command, %args);
        # Store stdout in temp file for path access
        my $fh = $obj->fh;
        $fh->seek(0, 0)  or die "seek: $!\n";
        $fh->truncate(0) or die "truncate: $!\n";
        $fh->print($obj->{RESULT}->{data} // '');
        $fh->flush;
        $fh->seek(0, 0)  or die "seek: $!\n";
    }
    $obj->date(ctime());
    $obj;
}

sub result {
    my $obj = shift;
    $obj->{RESULT};
}

sub execute {
    my $obj = shift;
    my $command = shift;
    my %opt = (%{$obj->{OPTION}}, @_);
    my @command = ref $command eq 'ARRAY' ? @$command : ($command);

    # Use nofork path for code references when requested
    if ($opt{nofork} and ref $command[0] eq 'CODE') {
        return $obj->_execute_in_place(\@command, %opt);
    }

    my $stderr = $opt{stderr} // '';

    # Create pipes for stdout and stderr
    pipe(my $stdout_r, my $stdout_w) or die "pipe: $!\n";
    pipe(my $stderr_r, my $stderr_w) or die "pipe: $!\n" if $stderr eq 'capture';

    my $pid = fork // die "fork: $!\n";
    if ($pid == 0) {
        # Child process
        close $stdout_r;
        close $stderr_r if $stderr eq 'capture';

        if (exists $opt{stdin}) {
            my $tmp = new_tmpfile IO::File or die "tmpfile: $!\n";
            binmode $tmp, ':encoding(utf8)';
            $tmp->print($opt{stdin});
            $tmp->seek(0, 0) or die "seek: $!\n";
            open STDIN, '<&', $tmp or die "dup: $!\n";
            binmode STDIN, ':encoding(utf8)';
        } elsif (my $input = $obj->{INPUT}) {
            open STDIN, "<&=", $input->fileno or die "open: $!\n";
            binmode STDIN, ':encoding(utf8)';
        }