File Coverage

blib/lib/Text/Xatena.pm

Criterion	Covered	Total	%
statement	78	79	98.7
branch	19	22	86.3
condition	6	8	75.0
subroutine	15	15	100.0
pod	1	3	33.3
total	119	127	93.7

package Text::Xatena;

use strict;
use warnings;
use UNIVERSAL::require;

use Text::Xatena::LineScanner;
use Text::Xatena::Node;
use Text::Xatena::Node::Root;
use Text::Xatena::Inline;
use Text::Xatena::Util;

our $VERSION = '0.18';

our $SYNTAXES = [
    'Text::Xatena::Node::SeeMore',
    'Text::Xatena::Node::SuperPre',
    'Text::Xatena::Node::StopP',
    'Text::Xatena::Node::Blockquote',
    'Text::Xatena::Node::Pre',
    'Text::Xatena::Node::List',
    'Text::Xatena::Node::DefinitionList',
    'Text::Xatena::Node::Table',
    'Text::Xatena::Node::Section',
    'Text::Xatena::Node::Comment',
];

sub new {
    my ($class, %opts) = @_;

    my $self = bless { %opts }, $class;

    $self->{templates} ||= {};
    $self->{templates} = {
        map {
            my $pkg = $_ =~ /::/ ? $_ : "Text::Xatena::Node::$_";
            $pkg => $self->{templates}->{$_};
        }
        keys %{ $self->{templates} }
    };

    $self->{syntaxes} = [
        map {
            my $pkg = $_ =~ /::/ ? $_ : "Text::Xatena::Node::$_";
            $pkg->use or die $@;
            $pkg;
        }
        @{ $opts{syntaxes} || $SYNTAXES }
    ];

    $self->{inline}   ||= Text::Xatena::Inline->new;

    $self;
}

sub format {
    my ($self, $string, %opts) = @_;
    $string =~ s{\r\n?|\n}{\n}g;

    $self->inline($opts{inline}) if $opts{inline};

    if ($self->{hatena_compatible}) {
        $self->{templates}->{'Text::Xatena::Node::Section'} = q[
            {{= $title }}
            {{= $content }}
        ];

        no warnings "once", "redefine";
        local *Text::Xatena::Node::as_html_paragraph = sub {
            my ($self, $context, $text, %opts) = @_;
            $text = $context->inline->format($text, %opts);

            $text =~ s{\n$}{}g;
            if ($opts{stopp}) {
                $text;
            } else {
                "" . join("",
                    map {
                        if (/^(\n+)$/) {
                            "" . ("\n" x (length($1) - 2)) . "";
                        } else {
                            $_;
                        }
                    }
                    split(/(\n+)/, $text)
                ) . "\n";
            }
        };

        $self->_parse($string)->as_html($self);
    } else {
        $self->_parse($string)->as_html($self);
    }
}

sub inline {
    my ($self, $new) = @_;
    if (@_ > 1) {
        $self->{inline} = $new;
    } else {
        $self->{inline};
    }
}

sub _parse {
    my ($self, $string) = @_;

    my @syntaxes = @{ $self->{syntaxes} };
    my $s        = Text::Xatena::LineScanner->new($string);
    my $root     = Text::Xatena::Node::Root->new ;
    my $stack    = [ $root ];
    loop: until ($s->eos) {
        my $parent = $stack->[-1];

        for my $pkg (@syntaxes) {
            $pkg->parse($s, $parent, $stack) and next loop;
        }

        # plain lines
        push @$parent, $s->next;
    }

    $root;
}

sub _tmpl {
    my ($self, $pkg, $default, $stash) = @_;
    my $tmpl = $self->{templates}->{$pkg};
    my $sub  = ref($tmpl) eq 'CODE' ? $tmpl : template($tmpl || $default, [ keys %$stash ]);
    $self->{templates}->{$pkg} = $sub;
    $sub->($stash);
}

1;
__END__