diff options
author | dakkar <dakkar@thenautilus.net> | 2009-08-18 12:27:44 +0200 |
---|---|---|
committer | dakkar <dakkar@thenautilus.net> | 2009-08-18 12:27:44 +0200 |
commit | 78d8e9178e5e0633a1c77a52cc419e4473c9659b (patch) | |
tree | d9a5a3c86733dc2d0155c7a18dd52761e0573200 | |
parent | don't emit the 's' namespace (diff) | |
download | thenautilus-78d8e9178e5e0633a1c77a52cc419e4473c9659b.tar.gz thenautilus-78d8e9178e5e0633a1c77a52cc419e4473c9659b.tar.bz2 thenautilus-78d8e9178e5e0633a1c77a52cc419e4473c9659b.zip |
simple program to check for bad links in the output
-rw-r--r-- | check-links.pl | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/check-links.pl b/check-links.pl new file mode 100644 index 0000000..79f1a48 --- /dev/null +++ b/check-links.pl @@ -0,0 +1,47 @@ +#!/usr/bin/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"; + } +} |