Tweak the forking logic.

p4raw-id: //depot/perl@13350

1 files changed, 39 insertions, 29 deletions

diff --git a/Porting/checkURL.pl b/Porting/checkURL.pl
index 1d81cac781..230121ead7 100644
--- a/Porting/checkURL.pl
+++ b/Porting/checkURL.pl
@@ -4,9 +4,7 @@ use strict;
 use warnings 'all';
 
 use LWP::Simple qw /$ua getstore/;
-use Errno;
 
-my $out = "links.out";
 my %urls;
 
 my @dummy = qw(
@@ -30,36 +28,51 @@ foreach my $file (<pod/*.pod README README.* INSTALL>) {
     close $fh;
 }
 
+sub fisher_yates_shuffle {
+    my $deck = shift;  # $deck is a reference to an array
+    my $i = @$deck;
+    while (--$i) {
+	my $j = int rand ($i+1);
+	@$deck[$i,$j] = @$deck[$j,$i];
+    }
+}
+
 my @urls = keys %urls;
 
+fisher_yates_shuffle(\@urls);
+
+sub todo {
+    warn "(", scalar @urls, " URLs)\n";
+}
+
+my $MAXPROC = 40;
+my $MAXURL  = 10;
+my $MAXFORK = $MAXPROC < $MAXURL ? 1 : $MAXPROC / $MAXURL;
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
 while (@urls) {
-    my @list = splice @urls, 0, 10;
+    my @list;
     my $pid;
-    my $retry;
-    my $retrymax = 3;
-    my $nap = 5;
-    do {
+    my $i;
+
+    todo();
+
+    for ($i = 0; $i < $MAXFORK; $i++) {
+	$list[$i] = [ splice @urls, 0, $MAXURL ];
 	$pid = fork;
-	unless (defined $pid) {
-	    if ($!{EAGAIN}) {
-		warn "Failed to fork: $!\n";
-		if ($retry++ < $retrymax) {
-		    warn "(sleeping...)\n";
-		    sleep $nap;
-		} else {
-		    $nap  *= 2;
-		    $retry = 0;
-		}
-		redo;
-	    } else {
-		die "Failed to fork: $!\n" unless defined $pid;
-	    }
-	}
-    } until (defined $pid);
-
-    unless ($pid) {
+	die "Failed to fork: $!\n" unless defined $pid;
+	last unless $pid; # Child.
+    }
+
+    if ($pid) {
+        # Parent.
+	warn "(waiting)\n";
+	1 until -1 == wait; # Reap.
+    } else {
         # Child.
-        foreach my $url (@list) {
+        foreach my $url (@{$list[$i]}) {
             my $code = getstore $url, "/dev/null";
             next if $code == 200;
             my $f = join ", " => keys %{$urls {$url}};
@@ -70,7 +83,4 @@ while (@urls) {
     }
 }
 
-1 until -1 == wait;
-
-
 __END__