path: root/IkiWiki/Plugin/link.pm

#!/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