File Coverage

blib/lib/DTL/Fast/Entity.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	6	8	75.0
condition	11	22	50.0
subroutine	11	11	100.0
pod	0	6	0.0
total	85	104	81.7

package DTL::Fast::Entity;
use strict;
use utf8;
use warnings FATAL => 'all';
# prototype for template entity. Handling current line and current template references

use Scalar::Util qw(weaken);
use Carp qw(confess);

sub new
{
    my ( $proto, %kwargs ) = @_;

    $proto = ref $proto || $proto;

    $DTL::Fast::Template::CURRENT_TEMPLATE->{modules}->{$proto} = $proto->VERSION // DTL::Fast->VERSION;

    my $self = bless { %kwargs }, $proto;

    $self->remember_template;

    return $self;
}

sub remember_template
{
    my ($self) = @_;

    $self->{_template} = $DTL::Fast::Template::CURRENT_TEMPLATE;
    $self->{_template_line} = $DTL::Fast::Template::CURRENT_TEMPLATE_LINE;
    weaken $self->{_template};

    return $self;
}

sub get_parse_error
{
    my ($self, $message, @messages) = @_;

    return $self->compile_error_message(
        'Parsing error' => $message // 'undef'
        , Template      => $DTL::Fast::Template::CURRENT_TEMPLATE->{file_path}
        , Line          => $DTL::Fast::Template::CURRENT_TEMPLATE_LINE
        , @messages
    );
}

sub get_parse_warning
{
    my ($self, $message, @messages) = @_;

    return $self->compile_error_message(
        'Parsing warning' => $message // 'undef'
        , Template        => $DTL::Fast::Template::CURRENT_TEMPLATE->{file_path}
        , Line            => $DTL::Fast::Template::CURRENT_TEMPLATE_LINE
        , @messages
    );
}

sub get_render_error
{
    my ($self, $context, $message, @messages) = @_;

    my @params = (
        'Rendering error' => $message // 'undef'
        , Template        => $self->{_template}->{file_path}
        , Line            => $self->{_template_line}
        , @messages
    );

    confess "No context passed for rendering error generator." unless ($context);

    if (
        exists $context->{ns}->[- 1]->{_dtl_include_path}
            and ref $context->{ns}->[- 1]->{_dtl_include_path} eq 'ARRAY'
            and scalar @{$context->{ns}->[- 1]->{_dtl_include_path}} > 1
    ) # has inclusions, appending stack trace
    {
        push @params, 'Stack trace' => join( "\n", reverse @{$context->{ns}->[- 1]->{_dtl_include_path}});
    }

    return $self->compile_error_message( @params );
}

# format error message from key=>val pair
sub compile_error_message
{
    my ($self, @messages) = @_;

    die 'Odd parameters in messages array'
        if (scalar(@messages) % 2);

    # calculating max padding
    my $padding = 0;
    for (my $i = 0; $i < scalar @messages; $i += 2)
    {
        my $length = length $messages[$i];
        $padding = $length if ($length > $padding);
    }

    my $result = '';
    while ( scalar @messages )
    {
        my $key = shift @messages // 'undef';
        my $value = shift @messages // 'undef';

        chomp($value);

        my $key_length = length $key;

        $result .= sprintf
            '%s%s: '
            , ' ' x ($padding - $key_length)
            , $key;

        my @value = split /\n+/, $value;
        $result .= shift @value;
        $result .= "\n";

        foreach my $value (@value)
        {
            $result .= (' ' x ($padding + 2)).$value."\n";
        }
    }
    return $result;
}

1;