summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/keyboard.pm12
-rw-r--r--perl-install/network/tools.pm67
2 files changed, 29 insertions, 50 deletions
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() {}