line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DTL::Fast::Replacer::Replacement; |
2
|
98
|
|
|
98
|
|
473
|
use strict; use utf8; use warnings FATAL => 'all'; |
|
98
|
|
|
98
|
|
153
|
|
|
98
|
|
|
98
|
|
2471
|
|
|
98
|
|
|
|
|
495
|
|
|
98
|
|
|
|
|
181
|
|
|
98
|
|
|
|
|
670
|
|
|
98
|
|
|
|
|
2451
|
|
|
98
|
|
|
|
|
1486
|
|
|
98
|
|
|
|
|
28465
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
sub new |
5
|
|
|
|
|
|
|
{ |
6
|
713
|
|
|
713
|
0
|
1118
|
my $proto = shift; |
7
|
713
|
|
|
|
|
1051
|
my $expression = shift; |
8
|
|
|
|
|
|
|
|
9
|
713
|
|
|
|
|
1015
|
my $blocksep = ''; |
10
|
713
|
|
|
|
|
940
|
my $block_num = 0; |
11
|
713
|
|
66
|
|
|
2190
|
while( not $blocksep or $expression =~ /$blocksep/ ) |
12
|
|
|
|
|
|
|
{ |
13
|
713
|
|
|
|
|
7208
|
$blocksep = sprintf '_BL_%s_', $block_num++; |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
713
|
|
|
|
|
3377
|
my $self = bless { |
17
|
|
|
|
|
|
|
'block_counter' => 0 |
18
|
|
|
|
|
|
|
, 'block_ph' => $blocksep.'%s_' |
19
|
|
|
|
|
|
|
, 'blocks' => {} |
20
|
|
|
|
|
|
|
}, $proto; |
21
|
|
|
|
|
|
|
|
22
|
713
|
|
|
|
|
3335
|
return $self; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub add_replacement |
26
|
|
|
|
|
|
|
{ |
27
|
225
|
|
|
225
|
0
|
362
|
my $self = shift; |
28
|
225
|
|
|
|
|
397
|
my $value = shift; |
29
|
|
|
|
|
|
|
|
30
|
225
|
|
|
|
|
844
|
my $key = sprintf $self->{'block_ph'}, $self->{'block_counter'}++; |
31
|
225
|
|
|
|
|
525
|
$self->{'blocks'}->{$key} = $value; |
32
|
|
|
|
|
|
|
|
33
|
225
|
|
|
|
|
1161
|
return $key; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub get_replacement |
37
|
|
|
|
|
|
|
{ |
38
|
2088
|
|
|
2088
|
0
|
2925
|
my $self = shift; |
39
|
2088
|
|
|
|
|
2842
|
my $key = shift; |
40
|
2088
|
|
|
|
|
2599
|
my $value = undef; |
41
|
|
|
|
|
|
|
|
42
|
2088
|
100
|
|
|
|
5496
|
if( exists $self->{'blocks'}->{$key} ) |
43
|
|
|
|
|
|
|
{ |
44
|
223
|
|
|
|
|
402
|
$value = $self->{'blocks'}->{$key}; |
45
|
223
|
|
|
|
|
513
|
delete $self->{'blocks'}->{$key}; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
2088
|
|
|
|
|
11380
|
return $value; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
1; |