summaryrefslogtreecommitdiff
path: root/Porting
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-11-29 02:18:30 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-11-29 02:18:30 +0000
commit0d6d723397915f15904338d75c50e8db0ddae953 (patch)
treefb027602f0f242f3860ab33a527fd10aed75bcc8 /Porting
parentc165c82a39073f1daa2442bcc803fd803b65958c (diff)
downloadperl-0d6d723397915f15904338d75c50e8db0ddae953.tar.gz
Tweak the forking logic.
p4raw-id: //depot/perl@13350
Diffstat (limited to 'Porting')
-rw-r--r--Porting/checkURL.pl68
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__