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


line stmt bran cond sub pod time code
1             package DTL::Fast::Replacer;
2 98     98   59693 use strict; use utf8; use warnings FATAL => 'all';
  98     98   1266  
  98     98   4802  
  98         490  
  98         1251  
  98         2789  
  98         4637  
  98         171  
  98         5645  
3 98     98   445 use parent 'DTL::Fast::Entity';
  98         3576  
  98         2882  
4              
5 98     98   59758 use DTL::Fast::Replacer::Replacement;
  98         224  
  98         2818  
6 98     98   51385 use DTL::Fast::Variable;
  98         294  
  98         73648  
7              
8             our $VERSION = '1.00';
9              
10             sub backup_strings
11             {
12 1086     1086 0 1964 my( $self, $expression ) = @_;
13              
14             $self->clean_replacement($expression)
15             if not $self->{'replacement'}
16 1086 100 66     5761 or not $self->{'replacement'}->isa('DTL::Fast::Replacer::Replacement');
17            
18 1086         3058 $expression =~ s/(?backup_value($1.$2.$1)/ge;
  214         1179  
19            
20 1086         4960 return $expression;
21             }
22              
23             sub backup_value
24             {
25 214     214 0 394 my( $self, $value ) = @_;
26              
27 214         980 return $self->{'replacement'}->add_replacement(
28             DTL::Fast::Variable->new($value)
29             );
30             }
31              
32             sub backup_expression
33             {
34 11     11 0 27 my( $self, $expression ) = @_;
35              
36             return $self->{'replacement'}->add_replacement(
37             DTL::Fast::Expression->new(
38             $expression
39 11         49 , 'replacement' => $self->{'replacement'}
40             , 'level' => 0
41             )
42             );
43             }
44              
45             sub get_backup
46             {
47 1303     1303 0 4728 return shift->{'replacement'}->get_replacement(shift);
48             }
49              
50              
51             sub get_backup_or_variable
52             {
53 974     974 0 1854 my( $self, $token ) = @_;
54              
55             my $result = $self->get_backup($token)
56 974   66     2359 // DTL::Fast::Variable->new( $token, 'replacement' => $self->{'replacement'} );
57            
58 972         4052 return $result;
59             }
60              
61             sub get_backup_or_expression
62             {
63 329     329 0 668 my( $self, $token, $current_level ) = @_;
64 329   50     675 $current_level //= -1;
65              
66             my $result = $self->get_backup($token)
67             // DTL::Fast::Expression->new(
68             $token
69 329   66     866 , 'replacement' => $self->{'replacement'}
70             , 'level' => $current_level+1
71             );
72            
73 325         1689 return $result;
74             }
75              
76             sub clean_replacement
77             {
78             return shift->set_replacement(
79 713     713 0 3356 DTL::Fast::Replacer::Replacement->new(shift)
80             );
81             }
82              
83             sub set_replacement
84             {
85 713     713 0 1238 my( $self, $replacement ) = @_;
86 713         1283 $self->{'replacement'} = $replacement;
87 713         1357 return $self;
88             }
89              
90             sub parse_sources
91             {
92 95     95 0 179 my( $self, $source ) = @_;
93            
94 95         285 my $sources = $self->backup_strings($source);
95              
96 95 100       349 warn $self->get_parse_warning(
97             sprintf(
98             "comma-separated source values in %s tag are DEPRICATED, please use spaces:\n\t%s"
99             , ref $self
100             , $source
101             )
102             ) if $sources =~ /,/;
103            
104 95         178 my $result = [];
105            
106 95         556 foreach my $source (split /[,\s]+/, $sources)
107             {
108 312 50       655 if( $source =~ /^(__BLOCK_.+?)\|(.+)$/ ) # filtered static variable
109             {
110 0         0 push @$result, $self->get_backup_or_variable($1);
111 0         0 $result->[-1]->{'filter_manager'}->parse_filters($2);
112             }
113             else
114             {
115 312         816 push @$result, $self->get_backup_or_variable($source)
116             }
117             }
118              
119 95         334 return $result;
120             }
121              
122             1;