File Coverage

blib/lib/Text/TestBase/SubTest.pm

Criterion	Covered	Total	%
statement	68	69	98.5
branch	7	8	87.5
condition	4	8	50.0
subroutine	14	14	100.0
pod	2	2	100.0
total	95	101	94.0

package Text::TestBase::SubTest;
use strict;
use warnings;
use 5.008001;
use parent qw(Text::TestBase);
use Text::TestBase::SubTest::Node::Block;
use Text::TestBase::SubTest::Node::SubTest;
use Text::TestBase::SubTest::Node::Root;

use Class::Accessor::Lite (
    rw => [qw/subtest_delim/],
);
use Carp ();
our $VERSION = '0.5';

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{subtest_delim} = '###';
    $self->{block_class}   = 'Text::TestBase::SubTest::Node::Block';
    return $self;
}

sub parse {
    my ($self, $spec) = @_;
    my $block_delim   = $self->block_delim;
    my $subtest_delim = $self->subtest_delim;
    my $root          = Text::TestBase::SubTest::Node::Root->new;
    my $lineno        = 1;
    my $indent        = do {
        my @m = $spec =~ /^(\s{2,}|\t)/m;
        $m[0] || '    ';
    };

    $spec =~ s/
          ^(
             [ \t]* \Q${subtest_delim}\E.*?
             (?= ^[ \t]* \Q${block_delim}\E | ^[ \t]* \Q${subtest_delim}\E | \z )
           )
        | ^(
             [ \t]* \Q${block_delim}\E .*?
             (?= ^[ \t]* \Q${block_delim}\E | ^[ \t]* \Q${subtest_delim}\E | \z )
           )
        | ^( [^\n]* \n )
    /
        # subtest
        if ($1) {
            my $hunk         = _unindent($1);
            my $subtest      = $self->_make_subtest($hunk, $lineno);
            my $prev_subtest = $root->last_subtest( depth => _depth($1, $indent) - 1 ) || $root;

            $lineno++;
            $prev_subtest->append_child($subtest);

        # block
        } elsif ($2) {
            my $hunk         = _unindent($2);
            my $block        = $self->_make_block($hunk, $lineno);
            my $prev_subtest = $root->last_subtest( depth => _depth($2, $indent) - 1 ) || $root;

            $hunk =~ s!\n!$lineno++!ge;
            $prev_subtest->append_child($block);

        } elsif ($3) {
            $lineno++;
        }
        '';
    /msgxe;

    return $root;
}

sub _make_subtest {
    my ($self, $hunk, $lineno) = @_;
    my $subtest_delim = $self->subtest_delim;
    # TODO:
    #  * common filter
    #  * exception
    my ($name) = $hunk =~ /^$subtest_delim\s+(.+)$/;
    return Text::TestBase::SubTest::Node::SubTest->new(
        name    => $name,
        _lineno => $lineno,
    );
    return $name;
}

sub _unindent {
    my $text = shift;
    my ($indent) = $text =~ /^((?:[ \t])*)/;
    $text =~ s/^$indent//mg;
    return $text;
}

sub _depth {
    my ($str, $indent) = @_;
    my ($captured) = $str =~ /^($indent*)/;
    $captured ||= '';
    return (length($captured) / length($indent)) + 1;
}

1;