File Coverage

blib/lib/Pod/AsciiDoctor.pm

Criterion	Covered	Total	%
statement	65	101	64.3
branch	21	40	52.5
condition	4	7	57.1
subroutine	13	17	76.4
pod	10	10	100.0
total	113	175	64.5

package Pod::AsciiDoctor;
$Pod::AsciiDoctor::VERSION = '0.101002';
use 5.014;
use strict;
use warnings FATAL => 'all';

use Pod::Parser 1.65 ();
use parent 'Pod::Parser';


sub initialize
{
    my $self = shift;
    $self->SUPER::initialize(@_);
    $self->_prop;
    return $self;
}


sub adoc
{
    my $self = shift;
    my $data = $self->_prop;
    return join "\n", @{ $data->{text} };
}


sub _prop
{
    my $self = shift;
    return $self->{prop} //= {
        'text'       => [],
        'headers'    => "",
        'topheaders' => {},
        'command'    => '',
        'indent'     => 0
    };
}


sub _sanitise
{
    my $self = shift;
    my $p    = shift;
    chomp($p);
    return $p;
}


sub append
{
    my ( $self, $doc ) = @_;
    my $data = $self->_prop;
    push @{ $data->{text} }, $doc;
}


sub command
{
    my ( $self, $command, $paragraph, $lineno ) = @_;
    my $data = $self->_prop;
    $data->{command} = $command;

    # _sanitise: Escape AsciiDoctor syntax chars that appear in the paragraph.
    $paragraph = $self->_sanitise($paragraph);

    if ( my ($input_level) = $command =~ /head([0-9])/ )
    {
        my $level = $input_level;
        $level //= 2;
        $data->{command} = 'head';
        $data->{topheaders}{$input_level} =
            defined( $data->{topheaders}{$input_level} )
            ? $data->{topheaders}{$input_level}++
            : 1;
        $paragraph = $self->set_formatting($paragraph);
        $self->append( $self->make_header( $command, $level, $paragraph ) );
    }

    if ( $command =~ /over/ )
    {
        $data->{indent}++;
    }
    if ( $command =~ /back/ )
    {
        $data->{indent}--;
    }
    if ( $command =~ /item/ )
    {
        $self->append( $self->make_text( $paragraph, 1 ) );
    }
    return;
}


sub verbatim
{
    my $self      = shift;
    my $paragraph = shift;
    chomp($paragraph);
    $self->append($paragraph);
    return;
}


sub textblock
{
    my $self = shift;
    my ( $paragraph, $lineno ) = @_;
    chomp($paragraph);
    $paragraph = $self->interpolate($paragraph);
    $self->append($paragraph);
}


sub interior_sequence
{
    my ( $parser, $seq_command, $seq_argument ) = @_;
    ## Expand an interior sequence; sample actions might be:
    return "*$seq_argument*" if ( $seq_command eq 'B' );
    return "`$seq_argument`" if ( $seq_command eq 'C' );
    return "_${seq_argument}_'"
        if ( $seq_command eq 'I' || $seq_command eq 'F' );
    if ( $seq_command eq 'L' )
    {
        my $ret = "";
        my $text;
        my $link;
        if ( $seq_argument =~ /(.+)\|(.+)/ )
        {
            $text = $1;
            $link = $2;
        }
        elsif ( $seq_argument =~ /(.+)/ )
        {
            $text = "";
            $link = $1;
        }
        if ( $link =~ /(.+?\:\/\/)(.+)/ )
        {
            $ret .= "$link";
            $ret .= " [$text]" if ( length($text) );
        }
        elsif ( length($link) )
        {
            # Internal link
            if ( my ( $s, $e ) = $link =~ /(.+)\/(.+)/ )
            {
                $ret = "<< $s#$e >>";
                $ret = "<< $s#$e,$text >>" if ($text);
            }
            else
            {
                $ret = "<< $link >>";
                $ret = "<< $link,$text >>" if ($text);
            }
        }
        return $ret;
    }
}


sub make_header
{
    my ( $self, $command, $level, $paragraph ) = @_;
    if ( $command =~ /head/ )
    {
        my $h = sprintf( "%s %s", "=" x ( $level + 1 ), $paragraph );
        return $h;
    }
    elsif ( $command =~ /item/ )
    {
        return "* $paragraph";
    }
    die "unimplemented";
}


sub make_text
{
    my ( $self, $paragraph, $list ) = @_;
    my @lines = split "\n", $paragraph;
    my $data  = $self->_prop;
    my @i_paragraph;
    my $pnt = $list ? "*" : "";
    for my $line (@lines)
    {
        push @i_paragraph, $pnt x $data->{indent} . " " . $line . "\n";
    }
    return join "\n", @i_paragraph;
}


sub set_formatting
{
    my $self      = shift;
    my $paragraph = shift;
    $paragraph =~ s/I<(.*)>/_$1_/;
    $paragraph =~ s/B<(.*)>/*$1*/;

    # $paragraph =~ s/B<(.*)>/*$1*/;
    $paragraph =~ s/C<(.*)>/\`$1\`/xms;
    return $paragraph;
}


1;

__END__