broken_links warnings unterdrücken
[kivitendo-erp.git] / 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 LWP::Simple;
12 use Test::More tests => 1;
13 use URI::Find;
14
15 my @fails;
16
17 my $finder = URI::Find->new(sub {
18   my ($uri_obj, $uri_text) = @_;
19   $uri_text =~ s/^\<//;
20   $uri_text =~ s/\>$//;
21
22   push @fails, "$uri_text in file $File::Find::name"
23     if !defined get($uri_text);
24
25   return $_[1];
26 });
27
28 find(sub {
29   return unless -f $File::Find::name;
30   open(FH, $File::Find::name) or return;
31   my $text;
32   { local $/; $text = <FH>; }
33
34   $finder->find(\$text);
35
36   }, "."
37 );
38
39 if (@fails) {
40   ok(0, join "\n", @fails);
41 } else {
42   ok(1, "no broken links found");
43 }