view release on metacpan or  search on metacpan

lib/MojoMojo/Formatter/Wiki.pm  view on Meta::CPAN

package MojoMojo::Formatter::Wiki;

use parent qw/MojoMojo::Formatter/;

use URI;
use Scalar::Util qw/blessed/;
use MojoMojo::Formatter::TOC;

=head1 NAME

MojoMojo::Formatter::Wiki - Handle interpage linking.

=head1 DESCRIPTION

This formatter handles intra-Wiki links specified between double square brackets
or parentheses: [[wiki link]] or ((another wiki link)). It will also indicate
missing links with a question mark and a link to the edit page. Links can be
implicit (like the two above), where the path is derived from the link text
by replacing spaces with underscores (<a href="wiki_link">wiki link</a>), or
explicit, where the path is specified before a '|' sign:

    [[/explicit/path|Link text goes here]]

Note that external links have a different syntax: [Link text](http://foo.com).

=head1 METHODS

=head2 format_content_order

Format order can be 1-99. The Wiki formatter runs on 10.

=cut

sub format_content_order { 10 }

## list of start-end delimiter pairs
my @explicit_delims    = (qw{ \[\[ \]\] \(\( \)\) });
my $explicit_separator = '\|';

my $wikiword_escape = qr{\\};

sub _explicit_start_delims {
    my %delims = @explicit_delims;
    return keys %delims;
}

sub _explicit_end_delims {
    my %delims = @explicit_delims;
    return values %delims;
}

sub _generate_explicit_start {
    my $delims = join '|', _explicit_start_delims();
    return qr{(?: $delims )}x;    # non-capturing match
}

sub _generate_explicit_end {
    my $delims = join '|', _explicit_end_delims();
    return qr{(?: $delims )}x;    # non-capturing match
}

sub _generate_explicit_path {
    # non-greedily match characters that don't match the start-end and text delimiters
    my $not_an_end_delimiter_or_separator = '(?:(?!' . (join '|', _explicit_end_delims(), $explicit_separator) . ').)';  # produces (?: (?! ]] | \)\) | \| ) .)  # a character in a place where neither a ]], nor a )), nor a | is
    return qr{$not_an_end_delimiter_or_separator+?};
}

sub _generate_explicit_text {
    # non-greedily match characters that don't match the start-end delimiters
    my $not_an_end_delimiter = '(?:(?!' . ( join '|', _explicit_end_delims() ) . ').)';  # produces (?: (?! ]] | \)\) ) .)  # a character in a place where neither a ]] nor a )) starts
    return qr{$not_an_end_delimiter+?};
}

my $explicit_start = _generate_explicit_start();
my $explicit_end   = _generate_explicit_end();
my $explicit_path  = _generate_explicit_path();
my $explicit_text  = _generate_explicit_text();


sub _generate_non_wikiword_check {
    # FIXME: this evaluates incorrectly to a regexp that's clearly mistaken: (?x-ism:( ?<! [\[\[\(\((?-xism:\\)\/\?] ))
    # we include '\/' to avoid wikiwords that are parts of urls
    # but why the question mark ('\?') at the end?
    my $non_wikiword_chars =
        ( join '', _explicit_start_delims() ) . $wikiword_escape . '\/' . '\?';
    return qr{(?<! [$non_wikiword_chars])}x;
}

my $non_wikiword_check = _generate_non_wikiword_check();

=head2 strip_pre

Replace <pre ... with a placeholder

=cut

sub strip_pre {
    my $content = shift;
    my ( @parts, $res );
    $res = '';
    while (
        my ($part) =
        $$content =~ m{
            ^(.+?)
            <\s*pre\b[^>]*>}sx
        )
    {
        # $$content =~ s{^.+?<\s*pre\b[^>]*>}{}sx;
        $$content =~ s{^.+?<\s*pre(?:\s+lang=['"]*(.*?)['"]*")?>}{}sx;
        my $lang = $1 || '';
        my ($inner) = $$content =~ m{^(.+?)<\s*/pre\s*>}sx;
        unless ($inner) {
            $res .= $part;
            last;
        }
        push @parts, $inner;
        $res .= $part . "<!--pre_placeholder::$lang-->";
        $$content =~ s{^.+?<\s*/pre\s*>}{}sx;
    }
    $res .= $$content;
    return $res, @parts;
}

=head2 reinsert_pre

Put pre and lang back into place.

=cut