simple program to check for bad links in the output

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";
+    }
+}