IkiWiki/Plugin/link.pm

   1 #!/usr/bin/perl
   2 package IkiWiki::Plugin::link;
   3
   4 use warnings;
   5 use strict;
   6 use IkiWiki 3.00;
   7
   8 my $link_regexp;
   9
  10 sub import {
  11         hook(type => "getsetup", id => "link", call => \&getsetup);
  12         hook(type => "checkconfig", id => "link", call => \&checkconfig);
  13         hook(type => "linkify", id => "link", call => \&linkify);
  14         hook(type => "scan", id => "link", call => \&scan);
  15         hook(type => "renamelink", id => "link", call => \&renamelink);
  16 }
  17
  18 sub getsetup () {
  19         return
  20                 plugin => {
  21                         safe => 1,
  22                         rebuild => 1,
  23                 },
  24 }
  25
  26 sub checkconfig () {
  27         if ($config{prefix_directives}) {
  28                 $link_regexp = qr{
  29                         \[\[(?=[^!])            # beginning of link
  30                         (?:
  31                                 ([^\]\|]+)      # 1: link text
  32                                 \|              # followed by '|'
  33                         )?                      # optional
  34
  35                         ([^\n\r\]#]+)           # 2: page to link to
  36                         (?:
  37                                 \#              # '#', beginning of anchor
  38                                 ([^\s\]]+)      # 3: anchor text
  39                         )?                      # optional
  40
  41                         \]\]                    # end of link
  42                 }x;
  43         }
  44         else {
  45                 $link_regexp = qr{
  46                         \[\[                    # beginning of link
  47                         (?:
  48                                 ([^\]\|\n\s]+)  # 1: link text
  49                                 \|              # followed by '|'
  50                         )?                      # optional
  51
  52                         ([^\s\]#]+)             # 2: page to link to
  53                         (?:
  54                                 \#              # '#', beginning of anchor
  55                                 ([^\s\]]+)      # 3: anchor text
  56                         )?                      # optional
  57
  58                         \]\]                    # end of link
  59                 }x,
  60         }
  61 }
  62
  63 sub linkify (@) {
  64         my %params=@_;
  65         my $page=$params{page};
  66         my $destpage=$params{destpage};
  67
  68         $params{content} =~ s{(\\?)$link_regexp}{
  69                 defined $2
  70                         ? ( $1
  71                                 ? "[[$2|$3".($4 ? "#$4" : "")."]]"
  72                                 : htmllink($page, $destpage, linkpage($3),
  73                                         anchor => $4, linktext => pagetitle($2)))
  74                         : ( $1
  75                                 ? "[[$3".($4 ? "#$4" : "")."]]"
  76                                 : htmllink($page, $destpage, linkpage($3),
  77                                         anchor => $4))
  78         }eg;
  79
  80         return $params{content};
  81 }
  82
  83 sub scan (@) {
  84         my %params=@_;
  85         my $page=$params{page};
  86         my $content=$params{content};
  87
  88         while ($content =~ /(?<!\\)$link_regexp/g) {
  89                 push @{$links{$page}}, linkpage($2);
  90         }
  91 }
  92
  93 sub renamelink (@) {
  94         my %params=@_;
  95         my $page=$params{page};
  96         my $old=$params{oldpage};
  97         my $new=$params{newpage};
  98
  99         $params{content} =~ s{(?<!\\)$link_regexp}{
 100                 my $linktext=$2;
 101                 my $link=$linktext;
 102                 if (bestlink($page, linkpage($linktext)) eq $old) {
 103                         $link=pagetitle($new, 1);
 104                         $link=~s/ /_/g;
 105                         if ($linktext =~ m/.*\/*?[A-Z]/) {
 106                                 # preserve leading cap of last component
 107                                 my @bits=split("/", $link);
 108                                 $link=join("/", @bits[0..$#bits-1], ucfirst($bits[$#bits]));
 109                         }
 110                         if (index($linktext, "/") == 0) {
 111                                 # absolute link
 112                                 $link="/$link";
 113                         }
 114                 }
 115                 defined $1
 116                         ? ( "[[$1|$link".($3 ? "#$3" : "")."]]" )
 117                         : ( "[[$link".   ($3 ? "#$3" : "")."]]" )
 118         }eg;
 119
 120         return $params{content};
 121 }
 122
 123 1