]> git.vanrenterghem.biz Git - git.ikiwiki.info.git/blob - IkiWiki/Plugin/link.pm
(no commit message)
[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                         section => "core",
24                 },
25 }
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
53                         ([^\s\]#]+)             # 2: page to link to
54                         (?:
55                                 \#              # '#', beginning of anchor
56                                 ([^\s\]]+)      # 3: anchor text
57                         )?                      # optional
59                         \]\]                    # end of link
60                 }x,
61         }
62 }
64 sub linkify (@) {
65         my %params=@_;
66         my $page=$params{page};
67         my $destpage=$params{destpage};
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 }
84 sub scan (@) {
85         my %params=@_;
86         my $page=$params{page};
87         my $content=$params{content};
89         while ($content =~ /(?<!\\)$link_regexp/g) {
90                 add_link($page, linkpage($2));
91         }
92 }
94 sub renamepage (@) {
95         my %params=@_;
96         my $page=$params{page};
97         my $old=$params{oldpage};
98         my $new=$params{newpage};
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;
121         return $params{content};