From c33954b0763e0ba0b27f1a970e23150d92a48fe1 Mon Sep 17 00:00:00 2001
From: Thierry Vignaud <tvignaud@mandriva.org>
Date: Sun, 23 Nov 2003 21:34:40 +0000
Subject: reuse bg_command: - major cleanups - get rid of "kid exited -1 at
 /usr/lib/libDrakX/network/tools.pm line 182."   warnings

---
 perl-install/keyboard.pm      | 12 +++-----
 perl-install/network/tools.pm | 67 ++++++++++++++++---------------------------
 2 files changed, 29 insertions(+), 50 deletions(-)

(limited to 'perl-install')

diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
index 695c8747b..672384eb7 100644
--- a/perl-install/keyboard.pm
+++ b/perl-install/keyboard.pm
@@ -476,19 +476,15 @@ sub setup {
     } elsif (-e (my $f = "$ENV{SHARE_PATH}/keymaps/$kmap.bkmap")) {
 	load(scalar cat_($f));
     } else {
-	my $F;
-	if (my $pid = open $F, "-|") {
-	    local $/ = undef;
-	    eval { load(join('', <$F>)) };
-	    waitpid $pid, 0;
-	} else {
+	my $kid = run_program::bg_command(sub {
 	    eval {
 		require packdrake;
 		my $packer = new packdrake("$ENV{SHARE_PATH}/keymaps.cz2", quiet => 1);
 		$packer->extract_archive(undef, "$kmap.bkmap");
 	    };
-	    c::_exit(0);
-	}
+	});
+	local $/ = undef;
+	eval { my $fd = $kid->{fd}; load(join('', <$fd>)) };
     }
     if (-x "/usr/X11R6/bin/setxkbmap") {
 	setxkbmap($keyboard);
diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm
index ddad3b24d..d67ffc06f 100644
--- a/perl-install/network/tools.pm
+++ b/perl-install/network/tools.pm
@@ -172,19 +172,21 @@ sub type2interface {
 sub connected() { gethostbyname("mandrakesoft.com") ? 1 : 0 }
 
 my $kid_pipe;
-sub connected_bg {
+# request a ref on a bg_connect and a ref on a scalar
+sub connected_bg__raw {
+    my ($kid, $status) = @_;
     local $| = 1;
-    my ($ref) = @_;
-    if (defined $kid_pipe) {
-	fcntl($kid_pipe, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
-	my $a;
-  	if (defined($a = <$kid_pipe>)) {
-	    close($kid_pipe) or warn "kid exited $?";
-	    undef $kid_pipe;
-	    $$ref = $a;
-  	}
-    } else { $kid_pipe = connected2() }
-    1;
+    if (ref($kid_pipe) && ref($$kid_pipe)) {
+	my $fd = $$kid_pipe->{fd};
+	fcntl($fd, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
+	my $a  = <$fd>;
+     $$status = $a if defined $a;
+    } else { $$kid_pipe = connected2() }
+}
+
+sub connected_bg {
+    my ($status) = @_;
+    connected_bg__raw(\$kid_pipe, $status);
 }
 
 # test if connected;
@@ -196,54 +198,35 @@ sub connected_bg {
 #    return : nothing
 # cmd = 3 : return current status even if a test is in progress
 my $kid_pipe_connect;
-my $kid_pid;
 my $current_connection_status;
 
 sub test_connected {
     local $| = 1;
     my ($cmd) = @_;
     
-    if (!defined $current_connection_status) { $current_connection_status = -1 }
+    $current_connection_status = -1 if !defined $current_connection_status;
     
     if ($cmd == 0) {
-        if (defined $kid_pipe_connect) {
-	    fcntl($kid_pipe_connect, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!";
-	    my $a;
-	    if (defined($a = <$kid_pipe_connect>)) {
-		close($kid_pipe_connect) or warn "kid exited $?";
-		undef $kid_pipe_connect;
-		undef $kid_pid;
-		$current_connection_status = $a;
-	    }
-        }
-	return $current_connection_status;
-    }
-    
-    if ($cmd == 1) {
+        connected_bg__raw(\$kid_pipe_connect, \$current_connection_status);
+    } elsif ($cmd == 1) {
         if ($current_connection_status != -2) {
              $current_connection_status = -2;
              $kid_pipe_connect = connected2();
         }
-    }
-    if ($cmd == 2) {
-        if (defined($kid_pid)) {
-	    kill -9, $kid_pid;
-	    undef $kid_pid;
+    } elsif ($cmd == 2) {
+        if (defined($kid_pipe_connect)) {
+	    kill -9, $kid_pipe_connect->{pid};
+	    undef $kid_pipe_connect;
         }
     }
     return $current_connection_status;
 }
 
 sub connected2() {
-    if ($kid_pid = open(my $kid_to_read, "-|")) {
-        #- parent
-        $kid_to_read;
-    } else {
-        #- child
-        require Net::Ping;
-        print Net::Ping->new("icmp")->ping("mandrakesoft.com") ? 1 : 0;
-        c::_exit(0);
-    }
+    bg_command->new(sub {
+                        require Net::Ping;
+                        print Net::Ping->new("icmp")->ping("mandrakesoft.com") ? 1 : 0;
+                    });
 }
 
 sub disconnected() {}
-- 
cgit v1.2.1