File Coverage

blib/lib/DTL/Fast/Replacer.pm

Criterion	Covered	Total	%
statement	47	49	95.9
branch	5	6	83.3
condition	7	11	63.6
subroutine	15	15	100.0
pod	0	9	0.0
total	74	90	82.2

package DTL::Fast::Replacer;
use strict;
use utf8;
use warnings FATAL => 'all';
use parent 'DTL::Fast::Entity';

use DTL::Fast::Replacer::Replacement;
use DTL::Fast::Variable;

our $VERSION = '1.00';

sub backup_strings
{
    my ( $self, $expression ) = @_;

    $self->clean_replacement($expression)
        if (not $self->{replacement}
            or not $self->{replacement}->isa('DTL::Fast::Replacer::Replacement'));

    $expression =~ s/(?backup_value($1.$2.$1)/ge;

    return $expression;
}

sub backup_value
{
    my ( $self, $value ) = @_;

    return $self->{replacement}->add_replacement(
        DTL::Fast::Variable->new($value)
    );
}

sub backup_expression
{
    my ( $self, $expression ) = @_;

    return $self->{replacement}->add_replacement(
        DTL::Fast::Expression->new(
            $expression
            , replacement => $self->{replacement}
            , level       => 0
        )
    );
}

sub get_backup
{
    return shift->{replacement}->get_replacement(shift);
}


sub get_backup_or_variable
{
    my ( $self, $token ) = @_;

    my $result = $self->get_backup($token)
        // DTL::Fast::Variable->new( $token, replacement => $self->{replacement} );

    return $result;
}

sub get_backup_or_expression
{
    my ( $self, $token, $current_level ) = @_;
    $current_level //= - 1;

    my $result = $self->get_backup($token)
        // DTL::Fast::Expression->new(
        $token
        , replacement => $self->{replacement}
        , level       => $current_level + 1
    );

    return $result;
}

sub clean_replacement
{
    return shift->set_replacement(
        DTL::Fast::Replacer::Replacement->new(shift)
    );
}

sub set_replacement
{
    my ( $self, $replacement ) = @_;
    $self->{replacement} = $replacement;
    return $self;
}

sub parse_sources
{
    my ( $self, $source ) = @_;

    my $sources = $self->backup_strings($source);

    warn $self->get_parse_warning(
            sprintf(
                "comma-separated source values in %s tag are DEPRICATED, please use spaces:\n\t%s"
                , ref $self
                , $source
            )
        ) if ($sources =~ /,/);

    my $result = [ ];

    foreach my $source (split /[,\s]+/, $sources)
    {
        if ($source =~ /^(__BLOCK_.+?)\|(.+)$/)   # filtered static variable
        {
            push @$result, $self->get_backup_or_variable($1);
            $result->[- 1]->{filter_manager}->parse_filters($2);
        }
        else
        {
            push @$result, $self->get_backup_or_variable($source)
        }
    }

    return $result;
}

1;