Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

• branch=trunk inherited from [bf1c21ba16]
• sym-trunk inherited from [bf1c21ba16]

Added tools/fossilwiki

                                                                                        >     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
                                                                                        >    59                  if (@internals == ())
                                                                                        >    60                  {
                                                                                        >    61                          push @nointernals, $page;
                                                                                        >    62                  }
                                                                                        >    63                  else
                                                                                        >    64                  {
                                                                                        >    65                          @{$links{$page}{'links'}} = map {my ($a,$b) = split /\|/
                                                                                        >    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}{'links'}};
                                                                                        >   121          if (@links != ())
                                                                                        >   122          {
                                                                                        >   123                  if ($page eq $mainpage)
                                                                                        >   124                  {
                                                                                        >   125                          print "links: *** '$page' *** -> ", join (", ", @links),
                                                                                        >   126                  }
                                                                                        >   127                  else
                                                                                        >   128                  {
                                                                                        >   129                          print "links: '$page' -> ", join (", ", @links), "\n";
                                                                                        >   130                  }
                                                                                        >   131          }
                                                                                        >   132  }