182 lines
3.9 KiB
Perl
182 lines
3.9 KiB
Perl
#!/usr/bin/perl
|
|
package IkiWiki::Plugin::link;
|
|
|
|
use warnings;
|
|
use strict;
|
|
use IkiWiki 3.00;
|
|
|
|
my $link_regexp;
|
|
|
|
my $email_regexp = qr/^.+@.+$/;
|
|
my $url_regexp = qr/^(?:[^:]+:\/\/|mailto:).*/i;
|
|
|
|
sub import {
|
|
hook(type => "getsetup", id => "link", call => \&getsetup);
|
|
hook(type => "checkconfig", id => "link", call => \&checkconfig);
|
|
hook(type => "linkify", id => "link", call => \&linkify);
|
|
hook(type => "scan", id => "link", call => \&scan);
|
|
hook(type => "renamepage", id => "link", call => \&renamepage);
|
|
}
|
|
|
|
sub getsetup () {
|
|
return
|
|
plugin => {
|
|
safe => 1,
|
|
rebuild => 1,
|
|
section => "core",
|
|
},
|
|
}
|
|
|
|
sub checkconfig () {
|
|
if ($config{prefix_directives}) {
|
|
$link_regexp = qr{
|
|
\[\[(?=[^!]) # beginning of link
|
|
(?:
|
|
([^\]\|]+) # 1: link text
|
|
\| # followed by '|'
|
|
)? # optional
|
|
|
|
([^\n\r\]#]+) # 2: page to link to
|
|
(?:
|
|
\# # '#', beginning of anchor
|
|
([^\s\]]+) # 3: anchor text
|
|
)? # optional
|
|
|
|
\]\] # end of link
|
|
}x;
|
|
}
|
|
else {
|
|
$link_regexp = qr{
|
|
\[\[ # beginning of link
|
|
(?:
|
|
([^\]\|\n\s]+) # 1: link text
|
|
\| # followed by '|'
|
|
)? # optional
|
|
|
|
([^\s\]#]+) # 2: page to link to
|
|
(?:
|
|
\# # '#', beginning of anchor
|
|
([^\s\]]+) # 3: anchor text
|
|
)? # optional
|
|
|
|
\]\] # end of link
|
|
}x;
|
|
}
|
|
}
|
|
|
|
sub is_externallink ($$;$$) {
|
|
my $page = shift;
|
|
my $url = shift;
|
|
my $anchor = shift;
|
|
my $force = shift;
|
|
|
|
if (defined $anchor) {
|
|
$url.="#".$anchor;
|
|
}
|
|
|
|
if (! $force && $url =~ /$email_regexp/) {
|
|
# url looks like an email address, so we assume it
|
|
# is supposed to be an external link if there is no
|
|
# page with that name.
|
|
return (! (bestlink($page, linkpage($url))))
|
|
}
|
|
|
|
return ($url =~ /$url_regexp/)
|
|
}
|
|
|
|
sub externallink ($$;$) {
|
|
my $url = shift;
|
|
my $anchor = shift;
|
|
my $pagetitle = shift;
|
|
|
|
if (defined $anchor) {
|
|
$url.="#".$anchor;
|
|
}
|
|
|
|
# build pagetitle
|
|
if (! $pagetitle) {
|
|
$pagetitle = $url;
|
|
# use only the email address as title for mailto: urls
|
|
if ($pagetitle =~ /^mailto:.*/) {
|
|
$pagetitle =~ s/^mailto:([^?]+).*/$1/;
|
|
}
|
|
}
|
|
|
|
if ($url !~ /$url_regexp/) {
|
|
# handle email addresses (without mailto:)
|
|
$url = "mailto:" . $url;
|
|
}
|
|
|
|
return "<a href=\"$url\">$pagetitle</a>";
|
|
}
|
|
|
|
sub linkify (@) {
|
|
my %params=@_;
|
|
my $page=$params{page};
|
|
my $destpage=$params{destpage};
|
|
|
|
$params{content} =~ s{(\\?)$link_regexp}{
|
|
defined $2
|
|
? ( $1
|
|
? "[[$2|$3".(defined $4 ? "#$4" : "")."]]"
|
|
: is_externallink($page, $3, $4)
|
|
? externallink($3, $4, $2)
|
|
: htmllink($page, $destpage, linkpage($3),
|
|
anchor => $4, linktext => pagetitle($2)))
|
|
: ( $1
|
|
? "[[$3".(defined $4 ? "#$4" : "")."]]"
|
|
: is_externallink($page, $3, $4)
|
|
? externallink($3, $4)
|
|
: htmllink($page, $destpage, linkpage($3),
|
|
anchor => $4))
|
|
}eg;
|
|
|
|
return $params{content};
|
|
}
|
|
|
|
sub scan (@) {
|
|
my %params=@_;
|
|
my $page=$params{page};
|
|
my $content=$params{content};
|
|
|
|
while ($content =~ /(?<!\\)$link_regexp/g) {
|
|
if (! is_externallink($page, $2, $3, 1)) {
|
|
add_link($page, linkpage($2));
|
|
}
|
|
}
|
|
}
|
|
|
|
sub renamepage (@) {
|
|
my %params=@_;
|
|
my $page=$params{page};
|
|
my $old=$params{oldpage};
|
|
my $new=$params{newpage};
|
|
|
|
$params{content} =~ s{(?<!\\)$link_regexp}{
|
|
if (! is_externallink($page, $2, $3)) {
|
|
my $linktext=$2;
|
|
my $link=$linktext;
|
|
if (bestlink($page, linkpage($linktext)) eq $old) {
|
|
$link=pagetitle($new, 1);
|
|
$link=~s/ /_/g;
|
|
if ($linktext =~ m/.*\/*?[A-Z]/) {
|
|
# preserve leading cap of last component
|
|
my @bits=split("/", $link);
|
|
$link=join("/", @bits[0..$#bits-1], ucfirst($bits[$#bits]));
|
|
}
|
|
if (index($linktext, "/") == 0) {
|
|
# absolute link
|
|
$link="/$link";
|
|
}
|
|
}
|
|
defined $1
|
|
? ( "[[$1|$link".($3 ? "#$3" : "")."]]" )
|
|
: ( "[[$link". ($3 ? "#$3" : "")."]]" )
|
|
}
|
|
}eg;
|
|
|
|
return $params{content};
|
|
}
|
|
|
|
1
|