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