t/007broken_links.t

   1 #!/usr/bin/perl
   2
   3 # adapted from Michael Stevens' test script posted in p5p
   4 # in the thread "broken links in blead" from 01/19/2011
   5 #
   6 # caveats: wikipedia seems to have crawler protection and
   7 # will give 403 forbidden unless the user agent is faked.
   8
   9 use strict;
  10 use File::Find;
  11 use Test::More;
  12
  13 if (eval " use LWP::Simple; use URI::Find; 1 ") {
  14   plan tests => 1;
  15 } else {
  16   plan skip_all => "LWP::Simple or URI::Find not installed";
  17 }
  18
  19 my @fails;
  20
  21 my $finder = URI::Find->new(sub {
  22   my ($uri_obj, $uri_text) = @_;
  23   $uri_text =~ s/^\<//;
  24   $uri_text =~ s/\>$//;
  25
  26   push @fails, "$uri_text in file $File::Find::name"
  27     if !defined get($uri_text);
  28
  29   return $_[1];
  30 });
  31
  32 find(sub {
  33   return unless -f $File::Find::name;
  34   open(FH, $File::Find::name) or return;
  35   my $text;
  36   { local $/; $text = <FH>; }
  37
  38   $finder->find(\$text);
  39
  40   }, "./templates", "./doc",
  41   );
  42
  43 if (@fails) {
  44   ok(0, join "\n", @fails);
  45 } else {
  46   ok(1, "no broken links found");
  47 }