check-links.pl


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

#!/usr/bin/env perl 
use strict;
use warnings;
use File::Next;
use autodie;
use Path::Class;
 
chdir '/var/www/localhost/htdocs';
 
sub collect_links {
    my ($name)=@_;
 
    my @res;
 
    open my $fh,'<',$name;
    while (my $line=<$fh>) {
        push @res,
            map { s{/[^/]+/\.\.}{}g; $_ }
            map { $_ =~ m{^/} ?
                   file($_)->relative('/')->absolute()->cleanup->stringify
                       :
                   file($_)->absolute(file($name)->parent)->cleanup->stringify
               }
            ($line =~ m{href="(?!\w+:)([^#]*?)"}g);
    }
    return @res;
}
 
my $files=File::Next::files(file_filter=>sub {/\.html$/},'.');
 
my %links;
while (defined (my $file=$files->())) {
    my @links=collect_links($file);
    @links{@links}=();
}
 
for my $f (keys %links) {
    if (-f $f) {
        next;
    }
    elsif (-d $f && ( -f "$f/document.it.html" or -f "$f/document.en.html")) {
        next;
    }
    else {
        warn "$f missing\n";
    }
}