]> git.vanrenterghem.biz Git - git.ikiwiki.info.git/blob - IkiWiki/Plugin/link.pm
Merge branch 'master' of ssh://git.ikiwiki.info/srv/git/ikiwiki.info
[git.ikiwiki.info.git] / IkiWiki / Plugin / link.pm
1 #!/usr/bin/perl
2 package IkiWiki::Plugin::link;
4 use warnings;
5 use strict;
6 use IkiWiki 3.00;
8 my $link_regexp;
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 }
18 sub getsetup () {
19         return
20                 plugin => {
21                         safe => 1,
22                         rebuild => 1,
23                 },
24 }
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
52                         ([^\s\]#]+)             # 2: page to link to
53                         (?:
54                                 \#              # '#', beginning of anchor
55                                 ([^\s\]]+)      # 3: anchor text
56                         )?                      # optional
58                         \]\]                    # end of link
59                 }x,
60         }
61 }
63 sub linkify (@) {
64         my %params=@_;
65         my $page=$params{page};
66         my $destpage=$params{destpage};
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 }
83 sub scan (@) {
84         my %params=@_;
85         my $page=$params{page};
86         my $content=$params{content};
88         while ($content =~ /(?<!\\)$link_regexp/g) {
89                 add_link($page, linkpage($2));
90         }
91 }
93 sub renamepage (@) {
94         my %params=@_;
95         my $page=$params{page};
96         my $old=$params{oldpage};
97         my $new=$params{newpage};
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;
120         return $params{content};