modules/links.pl

   1 # Copyright (C) 2004  Alex Schroeder <alex@emacswiki.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the
  15 #    Free Software Foundation, Inc.
  16 #    59 Temple Place, Suite 330
  17 #    Boston, MA 02111-1307 USA
  18
  19 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/links.pl">links.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Link_Data_Extension">Link Data Extension</a></p>';
  20
  21 $Action{links} = \&DoLinks;
  22
  23 sub DoLinks {
  24   my @args = (GetParam('raw', 0), GetParam('url', 0), GetParam('inter', 0), GetParam('links', 1));
  25   if (GetParam('raw', 0)) {
  26     print GetHttpHeader('text/plain');
  27     PrintLinkList(GetFullLinkList(@args));
  28   } else {
  29     print GetHeader('', QuoteHtml(T('Full Link List')), '');
  30     PrintLinkList(GetFullLinkList(@args));
  31     PrintFooter();
  32   }
  33 }
  34
  35 sub PrintLinkList {
  36   my %links = %{(shift)};
  37   my $existingonly = GetParam('exists', 0);
  38   if (GetParam('raw', 0)) {
  39     foreach my $page (sort keys %links) {
  40       foreach my $link (@{$links{$page}}) {
  41         print "\"$page\" -> \"$link\"\n" if not $existingonly or $IndexHash{$link};
  42       }
  43     }
  44   } else {
  45     foreach my $page (sort keys %links) {
  46       print $q->p(GetPageLink($page) . ': ' . join(' ', @{$links{$page}}));
  47     }
  48   }
  49 }
  50
  51 sub GetFullLinkList { # opens all pages!
  52   my ($raw, $url, $inter, $link) = @_;
  53   my @pglist = AllPagesList();
  54   my %result;
  55   InterInit();
  56   foreach my $name (@pglist) {
  57     OpenPage($name);
  58     my @links = GetLinkList($raw, $url, $inter, $link);
  59     @{$result{$name}} = @links if @links;
  60   }
  61   return \%result;
  62 }
  63
  64 sub GetLinkList { # for the currently open page
  65   my ($raw, $url, $inter, $link) = @_;
  66   my @blocks = split($FS, $Page{blocks});
  67   my @flags = split($FS, $Page{flags});
  68   my %links;
  69   foreach my $block (@blocks) {
  70     if (shift(@flags)) {  # dirty block and interlinks or normal links
  71       if ($inter and ($BracketText && $block =~ m/^(\[$InterLinkPattern\s+([^\]]+?)\])$/o
  72                       or $BracketText && $block =~ m/^(\[\[$FreeInterLinkPattern\|([^\]]+?)\]\])$/o
  73                       or $block =~ m/^(\[$InterLinkPattern\])$/o
  74                       or $block =~ m/^(\[\[\[$FreeInterLinkPattern\]\]\])$/o
  75                       or $block =~ m/^($InterLinkPattern)$/o
  76                       or $block =~ m/^(\[\[$FreeInterLinkPattern\]\])$/o)) {
  77         $links{$raw ? $2 : GetInterLink($2, $3)} = 1 if $InterSite{substr($2,0,index($2, ':'))};
  78       } elsif ($link
  79                and (($WikiLinks and $block !~ m/!$LinkPattern/o
  80                      and ($BracketWiki && $block =~ m/^(\[$LinkPattern\s+([^\]]+?)\])$/o
  81                           or $block =~ m/^(\[$LinkPattern\])$/o
  82                           or $block =~ m/^($LinkPattern)$/o))
  83                     or ($FreeLinks
  84                         and ($BracketWiki && $block =~ m/^(\[\[$FreeLinkPattern\|([^\]]+)\]\])$/o
  85                              or $block =~ m/^(\[\[\[$FreeLinkPattern\]\]\])$/o
  86                              or $block =~ m/^(\[\[$FreeLinkPattern\]\])$/o)))) {
  87         $links{$raw ? FreeToNormal($2) : GetPageOrEditLink($2, $3)} = 1;
  88       } elsif ($url and $block =~ m/^\[$FullUrlPattern\]$/og) {
  89         $links{$raw ? $1 : GetUrl($1)} = 1;
  90       }
  91     } elsif ($url) {            # clean block and url
  92       while ($block =~ m/$UrlPattern/og) {
  93         $links{$raw ? $1 : GetUrl($1)} = 1;
  94       }
  95       while ($block =~ m/\[$FullUrlPattern\s+[^\]]+?\]/og) {
  96         $links{$raw ? $1 : GetUrl($1)} = 1;
  97       }
  98     }
  99   }
 100   return sort keys %links;
 101 }