Fossil SCM
| 733e9af… | ron | 1 | #!/usr/bin/perl |
| 733e9af… | ron | 2 | # vim: cin : |
| 733e9af… | ron | 3 | |
| 733e9af… | ron | 4 | $repofile = shift; |
| 733e9af… | ron | 5 | $repocmd = ''; |
| 733e9af… | ron | 6 | $repocmd = "-R $repofile" if -f $repofile; |
| 733e9af… | ron | 7 | $mainpage = ''; |
| 733e9af… | ron | 8 | |
| 733e9af… | ron | 9 | @rep = (); |
| 733e9af… | ron | 10 | if ( ! -f $repofile ) |
| 733e9af… | ron | 11 | { |
| 733e9af… | ron | 12 | @rep = `fossil info | grep 'project-name'`; |
| 733e9af… | ron | 13 | } |
| 733e9af… | ron | 14 | else |
| 733e9af… | ron | 15 | { |
| 733e9af… | ron | 16 | @rep = `fossil info $repofile | grep 'project-name'`; |
| 733e9af… | ron | 17 | } |
| 733e9af… | ron | 18 | |
| 733e9af… | ron | 19 | $mainpage = $rep[0]; |
| 733e9af… | ron | 20 | chomp $mainpage; |
| 733e9af… | ron | 21 | $mainpage =~ s/^project-name:\s+//; |
| 733e9af… | ron | 22 | |
| 733e9af… | ron | 23 | |
| 733e9af… | ron | 24 | @pages = `fossil wiki list $repocmd`; |
| 733e9af… | ron | 25 | |
| 733e9af… | ron | 26 | %pages = (); |
| 733e9af… | ron | 27 | foreach $page ( @pages ) |
| 733e9af… | ron | 28 | { |
| 733e9af… | ron | 29 | chomp $page; |
| 733e9af… | ron | 30 | $text = `fossil wiki export "$page" $repocmd`; |
| 733e9af… | ron | 31 | $pages{$page} = $text; |
| 733e9af… | ron | 32 | } |
| 733e9af… | ron | 33 | |
| 733e9af… | ron | 34 | @orphans = (); |
| 733e9af… | ron | 35 | @nointernals = (); |
| 733e9af… | ron | 36 | @terminals = (); |
| 733e9af… | ron | 37 | @empties = (); |
| 733e9af… | ron | 38 | %badlinks = (); |
| 733e9af… | ron | 39 | %alllinks = (); |
| 733e9af… | ron | 40 | %links = (); |
| 733e9af… | ron | 41 | foreach $page ( keys %pages ) |
| 733e9af… | ron | 42 | { |
| 733e9af… | ron | 43 | my @links = (); |
| 733e9af… | ron | 44 | my $text = $pages{$page}; |
| 733e9af… | ron | 45 | while ( $text =~ m/\[([^][]+)\]/g ) |
| 733e9af… | ron | 46 | { |
| 733e9af… | ron | 47 | push @links,$1; |
| 733e9af… | ron | 48 | } |
| 733e9af… | ron | 49 | |
| 733e9af… | ron | 50 | $numlinks = $#links; |
| 733e9af… | ron | 51 | |
| e757cd3… | jan.nijtmans | 52 | if (@links == ()) |
| 733e9af… | ron | 53 | { |
| 733e9af… | ron | 54 | push @terminals, $page; |
| 733e9af… | ron | 55 | } |
| 733e9af… | ron | 56 | else |
| 733e9af… | ron | 57 | { |
| 733e9af… | ron | 58 | my @internals = grep { $_ !~ /(http:)|(mailto:)|(https:)/ } @links; |
| e757cd3… | jan.nijtmans | 59 | if (@internals == ()) |
| 733e9af… | ron | 60 | { |
| 733e9af… | ron | 61 | push @nointernals, $page; |
| 733e9af… | ron | 62 | } |
| 733e9af… | ron | 63 | else |
| 733e9af… | ron | 64 | { |
| 733e9af… | ron | 65 | @{$links{$page}{'links'}} = map {my ($a,$b) = split /\|/; $a;} @internals; |
| 733e9af… | ron | 66 | foreach $internal ( @internals ) |
| 733e9af… | ron | 67 | { |
| 733e9af… | ron | 68 | my ($int_link, $display) = split /\|/, $internal; |
| 733e9af… | ron | 69 | ${$links{$int_link}{'refs'}}++; |
| 733e9af… | ron | 70 | $alllinks{$int_link} = 1; |
| 733e9af… | ron | 71 | } |
| 733e9af… | ron | 72 | } |
| 733e9af… | ron | 73 | } |
| 733e9af… | ron | 74 | |
| 733e9af… | ron | 75 | if ($text eq '' || $text =~ m/^<i>Empty Page<\/i>/) |
| 733e9af… | ron | 76 | { |
| 733e9af… | ron | 77 | chomp $tail; |
| 733e9af… | ron | 78 | my ($head, $tail) = split /\/i>/ , $text; |
| 733e9af… | ron | 79 | if ($tail =~ m/^\s*$/s) { |
| 733e9af… | ron | 80 | push @empties, $page; |
| 733e9af… | ron | 81 | } |
| 733e9af… | ron | 82 | } |
| 733e9af… | ron | 83 | } |
| 733e9af… | ron | 84 | foreach $page ( keys %links ) |
| 733e9af… | ron | 85 | { |
| 733e9af… | ron | 86 | if ($page ne $mainpage && (${$links{$page}{'refs'}} == 0)) |
| 733e9af… | ron | 87 | { |
| 733e9af… | ron | 88 | push @orphans, $page; |
| 733e9af… | ron | 89 | } |
| 733e9af… | ron | 90 | } |
| 733e9af… | ron | 91 | foreach $link (keys %alllinks ) |
| 733e9af… | ron | 92 | { |
| 733e9af… | ron | 93 | if (! exists($pages{$link}) && $link !~ /^\./ && $link !~ /^\//) |
| 733e9af… | ron | 94 | { |
| 733e9af… | ron | 95 | $badlinks{$link} = 1; |
| 733e9af… | ron | 96 | } |
| 733e9af… | ron | 97 | } |
| 733e9af… | ron | 98 | foreach $empty ( @empties ) |
| 733e9af… | ron | 99 | { |
| 733e9af… | ron | 100 | print ("empty: '$empty'\n"); |
| 733e9af… | ron | 101 | } |
| 733e9af… | ron | 102 | foreach $nointernals ( @nointernals ) |
| 733e9af… | ron | 103 | { |
| 733e9af… | ron | 104 | print ("nointernals: '$nointernals'\n"); |
| 733e9af… | ron | 105 | } |
| 733e9af… | ron | 106 | foreach $terminal ( @terminals ) |
| 733e9af… | ron | 107 | { |
| 733e9af… | ron | 108 | print ("terminal: '$terminal'\n"); |
| 733e9af… | ron | 109 | } |
| 733e9af… | ron | 110 | foreach $orphan ( @orphans ) |
| 733e9af… | ron | 111 | { |
| 733e9af… | ron | 112 | print ("orphan: '$orphan'\n"); |
| 733e9af… | ron | 113 | } |
| 733e9af… | ron | 114 | foreach $link ( keys %badlinks ) |
| 733e9af… | ron | 115 | { |
| 733e9af… | ron | 116 | print ("badlink: '$link'\n"); |
| 733e9af… | ron | 117 | } |
| 733e9af… | ron | 118 | foreach $page ( sort keys %links ) |
| 733e9af… | ron | 119 | { |
| 733e9af… | ron | 120 | my @links = @{$links{$page}{'links'}}; |
| e757cd3… | jan.nijtmans | 121 | if (@links != ()) |
| 733e9af… | ron | 122 | { |
| 733e9af… | ron | 123 | if ($page eq $mainpage) |
| 733e9af… | ron | 124 | { |
| 733e9af… | ron | 125 | print "links: *** '$page' *** -> ", join (", ", @links), "\n"; |
| 733e9af… | ron | 126 | } |
| 733e9af… | ron | 127 | else |
| 733e9af… | ron | 128 | { |
| 733e9af… | ron | 129 | print "links: '$page' -> ", join (", ", @links), "\n"; |
| 733e9af… | ron | 130 | } |
| 733e9af… | ron | 131 | } |
| 733e9af… | ron | 132 | } |