simplify anchor handling
[ikiwiki.git] / 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 my $email_regexp = qr/^.+@.+$/;
11 my $url_regexp = qr/^(?:[^:]+:\/\/|mailto:).*/i;
12
13 sub import {
14         hook(type => "getsetup", id => "link", call => \&getsetup);
15         hook(type => "checkconfig", id => "link", call => \&checkconfig);
16         hook(type => "linkify", id => "link", call => \&linkify);
17         hook(type => "scan", id => "link", call => \&scan);
18         hook(type => "renamepage", id => "link", call => \&renamepage);
19 }
20
21 sub getsetup () {
22         return
23                 plugin => {
24                         safe => 1,
25                         rebuild => 1,
26                         section => "core",
27                 },
28 }
29
30 sub checkconfig () {
31         if ($config{prefix_directives}) {
32                 $link_regexp = qr{
33                         \[\[(?=[^!])            # beginning of link
34                         (?:
35                                 ([^\]\|]+)      # 1: link text
36                                 \|              # followed by '|'
37                         )?                      # optional
38                         
39                         ([^\n\r\]#]+)           # 2: page to link to
40                         (?:
41                                 \#              # '#', beginning of anchor
42                                 ([^\s\]]+)      # 3: anchor text
43                         )?                      # optional
44                         
45                         \]\]                    # end of link
46                 }x;
47         }
48         else {
49                 $link_regexp = qr{
50                         \[\[                    # beginning of link
51                         (?:
52                                 ([^\]\|\n\s]+)  # 1: link text
53                                 \|              # followed by '|'
54                         )?                      # optional
55
56                         ([^\s\]#]+)             # 2: page to link to
57                         (?:
58                                 \#              # '#', beginning of anchor
59                                 ([^\s\]]+)      # 3: anchor text
60                         )?                      # optional
61
62                         \]\]                    # end of link
63                 }x;
64         }
65 }
66
67 sub is_externallink ($$;$) {
68         my $page = shift;
69         my $url = shift;
70         my $anchor = shift;
71         
72         if (defined $anchor) {
73                 $url.="#".$anchor;
74         }
75
76         if ($url =~ /$email_regexp/) {
77                 # url looks like an email address, so we assume it
78                 # is supposed to be an external link if there is no
79                 # page with that name.
80                 return (! (bestlink($page, linkpage($url))))
81         }
82         return ($url =~ /$url_regexp/)
83 }
84
85 sub externallink ($$;$) {
86         my $url = shift;
87         my $anchor = shift;
88         my $pagetitle = shift;
89
90         if (defined $anchor) {
91                 $url.="#".$anchor;
92         }
93
94         # build pagetitle
95         if (! $pagetitle) {
96                 $pagetitle = $url;
97                 # use only the email address as title for mailto: urls
98                 if ($pagetitle =~ /^mailto:.*/) {
99                         $pagetitle =~ s/^mailto:([^?]+).*/$1/;
100                 }
101         }
102
103         if ($url !~ /$url_regexp/) {
104                 # handle email addresses (without mailto:)
105                 $url = "mailto:" . $url;
106         }
107
108         return "<a href=\"$url\">$pagetitle</a>";
109 }
110
111 sub linkify (@) {
112         my %params=@_;
113         my $page=$params{page};
114         my $destpage=$params{destpage};
115
116         $params{content} =~ s{(\\?)$link_regexp}{
117                 defined $2
118                         ? ( $1 
119                                 ? "[[$2|$3".(defined $4 ? "#$4" : "")."]]" 
120                                 : is_externallink($page, $3, $4)
121                                         ? externallink($3, $4, $2)
122                                         : htmllink($page, $destpage, linkpage($3),
123                                                 anchor => $4, linktext => pagetitle($2)))
124                         : ( $1 
125                                 ? "[[$3".(defined $4 ? "#$4" : "")."]]"
126                                 : is_externallink($page, $3, $4)
127                                         ? externallink($3, $4)
128                                         : htmllink($page, $destpage, linkpage($3),
129                                                 anchor => $4))
130         }eg;
131         
132         return $params{content};
133 }
134
135 sub scan (@) {
136         my %params=@_;
137         my $page=$params{page};
138         my $content=$params{content};
139
140         while ($content =~ /(?<!\\)$link_regexp/g) {
141                 if (! is_externallink($page, $2, $3)) {
142                         add_link($page, linkpage($2));
143                 }
144         }
145 }
146
147 sub renamepage (@) {
148         my %params=@_;
149         my $page=$params{page};
150         my $old=$params{oldpage};
151         my $new=$params{newpage};
152
153         $params{content} =~ s{(?<!\\)$link_regexp}{
154                 if (! is_externallink($page, $2, $3)) {
155                         my $linktext=$2;
156                         my $link=$linktext;
157                         if (bestlink($page, linkpage($linktext)) eq $old) {
158                                 $link=pagetitle($new, 1);
159                                 $link=~s/ /_/g;
160                                 if ($linktext =~ m/.*\/*?[A-Z]/) {
161                                         # preserve leading cap of last component
162                                         my @bits=split("/", $link);
163                                         $link=join("/", @bits[0..$#bits-1], ucfirst($bits[$#bits]));
164                                 }
165                                 if (index($linktext, "/") == 0) {
166                                         # absolute link
167                                         $link="/$link";
168                                 }
169                         }
170                         defined $1
171                                 ? ( "[[$1|$link".($3 ? "#$3" : "")."]]" )
172                                 : ( "[[$link".   ($3 ? "#$3" : "")."]]" )
173                 }
174         }eg;
175
176         return $params{content};
177 }
178
179 1