blob: 1d81cac781374e22c3a6c690c9816779eed64e38 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
#!/usr/bin/perl
use strict;
use warnings 'all';
use LWP::Simple qw /$ua getstore/;
use Errno;
my $out = "links.out";
my %urls;
my @dummy = qw(
http://something.here
http://www.pvhp.com
);
my %dummy;
@dummy{@dummy} = ();
foreach my $file (<pod/*.pod README README.* INSTALL>) {
open my $fh => $file or die "Failed to open $file: $!\n";
while (<$fh>) {
if (m{(?:http|ftp)://(?:(?!\w<)[-\w~?@=.])+} && !exists $dummy{$&}) {
my $url = $&;
$url =~ s/\.$//;
$urls {$url} ||= { };
$urls {$url} {$file} = 1;
}
}
close $fh;
}
my @urls = keys %urls;
while (@urls) {
my @list = splice @urls, 0, 10;
my $pid;
my $retry;
my $retrymax = 3;
my $nap = 5;
do {
$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) {
# Child.
foreach my $url (@list) {
my $code = getstore $url, "/dev/null";
next if $code == 200;
my $f = join ", " => keys %{$urls {$url}};
printf "%03d %s: %s\n" => $code, $url, $f;
}
exit;
}
}
1 until -1 == wait;
__END__
|
