diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2002-07-26 16:25:26 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2002-07-26 16:25:26 +0000 |
commit | 0417a4a4862279d10d9b3d9dfd8a625cf780fdbb (patch) | |
tree | 5b1bb47e6bd4ab88ddc74d2a8dc35db7b05e0d46 /perl-install | |
parent | fb353aeccda829a1186bf40842398035d373ab50 (diff) | |
download | drakx-0417a4a4862279d10d9b3d9dfd8a625cf780fdbb.tar drakx-0417a4a4862279d10d9b3d9dfd8a625cf780fdbb.tar.gz drakx-0417a4a4862279d10d9b3d9dfd8a625cf780fdbb.tar.bz2 drakx-0417a4a4862279d10d9b3d9dfd8a625cf780fdbb.tar.xz drakx-0417a4a4862279d10d9b3d9dfd8a625cf780fdbb.zip |
add 2 functionalities to run_program:
- run_program::run(prog, '>', 'STDOUT', ...)
run_program::run(prog, '2>', 'STDERR, ...)
which will run with verbatim stdout or stderr
- run_program::run(prog, '>', \$s, ...)
run_program::run(prog, '2>', \$s, ...)
which will return the stdout (resp. stderr) of the program in $s
Diffstat (limited to 'perl-install')
-rw-r--r-- | perl-install/run_program.pm | 40 |
1 files changed, 28 insertions, 12 deletions
diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm index 2db504bec..a0d5c98dc 100644 --- a/perl-install/run_program.pm +++ b/perl-install/run_program.pm @@ -3,6 +3,7 @@ package run_program; # $Id$ use diagnostics; use strict; +use MDK::Common; use log; 1; @@ -27,23 +28,38 @@ sub rooted { $root ? $root .= '/' : ($root = ''); install_any::check_prog (ref $name ? $name->[0] : $name) if !$root && $::isInstall; + + my ($stdout_raw, $stdout_mode, $stderr_raw, $stderr_mode); + ($stdout_mode, $stdout_raw, @args) = @args if $args[0] =~ /^>>?$/; + ($stderr_mode, $stderr_raw, @args) = @args if $args[0] =~ /^2>>?$/; + + $ENV{HOME} || $::isInstall or die q($HOME is unset, so I don't know where to put my temporary files); + my $stdout = $stdout_raw && (ref($stdout_raw) ? "$ENV{HOME}/tmp/.drakx-stdout.$$" : $stdout_raw); + my $stderr = $stderr_raw && (ref($stderr_raw) ? "$ENV{HOME}/tmp/.drakx-stderr.$$" : $stderr_raw); + if (my $pid = fork) { waitpid $pid, 0; - return $? == 0; - } - { - my ($stdout, $stdoutm, $stderr, $stderrm); - ($stdoutm, $stdout, @args) = @args if $args[0] =~ /^>>?$/; - ($stderrm, $stderr, @args) = @args if $args[0] =~ /^2>>?$/; - - if ($stderr) { - $stderrm =~ s/2//; - open STDERR, "$stderrm $root$stderr" or die "run_program can't output in $root$stderr (mode `$stderrm')"; + $? == 0 or return; + if ($stdout_raw && ref($stdout_raw)) { + $$stdout_raw = cat_($stdout); + unlink $stdout; + } + if ($stderr_raw && ref($stderr_raw)) { + $$stderr_raw = cat_($stderr); + unlink $stderr; + } + 1; + } else { + if ($stderr && $stderr eq 'STDERR') { + } elsif ($stderr) { + $stderr_mode =~ s/2//; + open STDERR, "$stderr_mode $root$stderr" or die "run_program can't output in $root$stderr (mode `$stderr_mode')"; } elsif ($::isInstall) { open STDERR, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or die "run_program can't log, give me access to /tmp/ddebug.log"; } - if ($stdout) { - open STDOUT, "$stdoutm $root$stdout" or die "run_program can't output in $root$stdout (mode `$stdoutm')"; + if ($stdout && $stdout eq 'STDOUT') { + } elsif ($stdout) { + open STDOUT, "$stdout_mode $root$stdout" or die "run_program can't output in $root$stdout (mode `$stdout_mode')"; } elsif ($::isInstall) { open STDOUT, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or die "run_program can't log, give me access to /tmp/ddebug.log"; } |