]> sipb.mit.edu Git - ikiwiki.git/blob - IkiWiki/Plugin/link.pm
bugfix: record email-like links as page links
[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         my $force = shift;
72         
73         if (defined $anchor) {
74                 $url.="#".$anchor;
75         }
76
77         if (! $force && $url =~ /$email_regexp/) {
78                 # url looks like an email address, so we assume it
79                 # is supposed to be an external link if there is no
80                 # page with that name.
81                 return (! (bestlink($page, linkpage($url))))
82         }
83
84         return ($url =~ /$url_regexp/)
85 }
86
87 sub externallink ($$;$) {
88         my $url = shift;
89         my $anchor = shift;
90         my $pagetitle = shift;
91
92         if (defined $anchor) {
93                 $url.="#".$anchor;
94         }
95
96         # build pagetitle
97         if (! $pagetitle) {
98                 $pagetitle = $url;
99                 # use only the email address as title for mailto: urls
100                 if ($pagetitle =~ /^mailto:.*/) {
101                         $pagetitle =~ s/^mailto:([^?]+).*/$1/;
102                 }
103         }
104
105         if ($url !~ /$url_regexp/) {
106                 # handle email addresses (without mailto:)
107                 $url = "mailto:" . $url;
108         }
109
110         return "<a href=\"$url\">$pagetitle</a>";
111 }
112
113 sub linkify (@) {
114         my %params=@_;
115         my $page=$params{page};
116         my $destpage=$params{destpage};
117
118         $params{content} =~ s{(\\?)$link_regexp}{
119                 defined $2
120                         ? ( $1 
121                                 ? "[[$2|$3".(defined $4 ? "#$4" : "")."]]" 
122                                 : is_externallink($page, $3, $4)
123                                         ? externallink($3, $4, $2)
124                                         : htmllink($page, $destpage, linkpage($3),
125                                                 anchor => $4, linktext => pagetitle($2)))
126                         : ( $1 
127                                 ? "[[$3".(defined $4 ? "#$4" : "")."]]"
128                                 : is_externallink($page, $3, $4)
129                                         ? externallink($3, $4)
130                                         : htmllink($page, $destpage, linkpage($3),
131                                                 anchor => $4))
132         }eg;
133         
134         return $params{content};
135 }
136
137 sub scan (@) {
138         my %params=@_;
139         my $page=$params{page};
140         my $content=$params{content};
141
142         while ($content =~ /(?<!\\)$link_regexp/g) {
143                 if (! is_externallink($page, $2, $3, 1)) {
144                         add_link($page, linkpage($2));
145                 }
146         }
147 }
148
149 sub renamepage (@) {
150         my %params=@_;
151         my $page=$params{page};
152         my $old=$params{oldpage};
153         my $new=$params{newpage};
154
155         $params{content} =~ s{(?<!\\)$link_regexp}{
156                 if (! is_externallink($page, $2, $3)) {
157                         my $linktext=$2;
158                         my $link=$linktext;
159                         if (bestlink($page, linkpage($linktext)) eq $old) {
160                                 $link=pagetitle($new, 1);
161                                 $link=~s/ /_/g;
162                                 if ($linktext =~ m/.*\/*?[A-Z]/) {
163                                         # preserve leading cap of last component
164                                         my @bits=split("/", $link);
165                                         $link=join("/", @bits[0..$#bits-1], ucfirst($bits[$#bits]));
166                                 }
167                                 if (index($linktext, "/") == 0) {
168                                         # absolute link
169                                         $link="/$link";
170                                 }
171                         }
172                         defined $1
173                                 ? ( "[[$1|$link".($3 ? "#$3" : "")."]]" )
174                                 : ( "[[$link".   ($3 ? "#$3" : "")."]]" )
175                 }
176         }eg;
177
178         return $params{content};
179 }
180
181 1