summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2002-07-26 16:25:26 +0000
committerPascal Rigaux <pixel@mandriva.com>2002-07-26 16:25:26 +0000
commit0417a4a4862279d10d9b3d9dfd8a625cf780fdbb (patch)
tree5b1bb47e6bd4ab88ddc74d2a8dc35db7b05e0d46 /perl-install
parentfb353aeccda829a1186bf40842398035d373ab50 (diff)
downloaddrakx-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.pm40
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";
}