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