File Coverage

blib/lib/Swim/Markup.pm

Criterion	Covered	Total	%
statement	39	70	55.7
branch	8	30	26.6
condition	1	2	50.0
subroutine	9	13	69.2
pod	1	9	11.1
total	58	124	46.7

package Swim::Markup;
use Pegex::Base;
extends 'Swim::Tree';

has option => {};

sub BUILD {
    $_[0]->{option} ||= {};
}

sub final {
    my ($self, $tree) = @_;
    $self->{stack} = [];
    $self->{bullet} = [];
    my $out = $self->render($tree);
    if ($self->option->{'complete'}) {
        if ($self->can('render_complete')) {
            $out = $self->render_complete($out);
        }
    }
    $out;
}

sub render {
    my ($self, $node) = @_;
    my $out;
    if (not ref $node) {
        $out = $self->render_text($node);
    }
    elsif (ref($node) eq 'HASH') {
        $out = $self->render_node($node);
    }
    else {
        my $separator = $self->get_separator($node);
        $out = join $separator, grep $_, map { $self->render($_) } @$node;
    }
    return $out;
}

sub render_node {
    my ($self, $hash) = @_;
    my ($name, $node) = each %$hash;
    my $number = $name =~ s/(\d)$// ? $1 : 0;
    my $method = "render_$name";
    push @{$self->{stack}}, $name;
    my $out = $self->$method($node, $number);
    pop @{$self->{stack}};
    $out;
}

sub render_pfunc {
    my ($self, $node) = @_;
    if ($node =~ /^([\-\w]+)(?:[\ \:]|\z)((?s:.*)?)$/) {
        my ($name, $args) = ($1, $2);
        my $out = $self->_render_func(phrase => $name, $args);
        return $out if defined $out;
    }
    return "<$node>";
}

sub render_bfunc {
    my ($self, $content) = @_;
    my ($name, $args) = @$content;
    $args = '' unless defined $args;
    my $out = $self->_render_func(block => $name, $args);
    return $out if defined $out;
    if ($args) {
        chomp $args;
        return "<<<$name\n$args\n>>>\n";
    }
    else {
        return "<<<$name>>>\n";
    }
}

sub _render_func {
    my ($self, $type, $name, $args) = @_;
    (my $method = "${type}_func_$name") =~ s/-/_/g;
    (my $plugin = "Swim::Plugin::$name") =~ s/-/::/g;
    while (1) {
        if ($self->can($method)) {
            my $out = $self->$method($args);
            return $out if defined $out;
        }
        last if $plugin eq "Swim::Plugin";
        eval "require $plugin";
        $plugin =~ s/(.*)::.*/$1/;
    }
    return;
}

my $phrase_types = {
    map { ($_, 1) } qw(
        code
        bold
        emph
        del
        under
        hyper
        link
        pfunc
        text
    ) };

#------------------------------------------------------------------------------
# Separator controls
#------------------------------------------------------------------------------
use constant default_separator => '';
use constant top_block_separator => '';

sub get_separator {
    my ($self, $node) = @_;
    $self->at_top_level ? $self->top_block_separator : $self->default_separator;
}

sub at_top_level {
    @{$_[0]->{stack}} == 0
}

sub node_is_block {
    my ($self, $node) = @_;
    my ($type) = keys %$node;
    return($phrase_types->{$type} ? 0 : 1);
}

1;