File Coverage

lib/Petal/Hash/String.pm
Criterion Covered Total %
statement 38 40 95.0
branch 7 10 70.0
condition 0 3 0.0
subroutine 5 5 100.0
pod 0 1 0.0
total 50 59 84.7


line stmt bran cond sub pod time code
1             # ------------------------------------------------------------------
2             # Petal::Hash::String - Interpolates variables with other strings
3             # ------------------------------------------------------------------
4             # Author: Jean-Michel Hiver
5             # This module is redistributed under the same license as Perl
6             # itself.
7             # ------------------------------------------------------------------
8             package Petal::Hash::String;
9 77     77   492 use strict;
  77         129  
  77         2169  
10 77     77   381 use warnings;
  77         140  
  77         1703  
11 77     77   334 use Carp;
  77         133  
  77         36773  
12              
13              
14             our $VARIABLE_RE_SIMPLE = qq |\\\$[A-Za-z_][A-Za-z0-9_\\.:\/]+|;
15             our $VARIABLE_RE_BRACKETS = qq |\\\$(?
16             our $TOKEN_RE = "(?:$VARIABLE_RE_SIMPLE|$VARIABLE_RE_BRACKETS)";
17              
18              
19             sub process
20             {
21 60     60 0 95 my $self = shift;
22 60         77 my $hash = shift;
23 60         90 my $argument = shift;
24              
25 60 50       118 $Petal::TranslationService && do {
26 0   0     0 $argument = eval { $Petal::TranslationService->maketext ($argument) } || $argument;
27 0 0       0 $@ and warn $@;
28             };
29              
30 60         165 my $tokens = $self->_tokenize (\$argument);
31             my @res = map {
32             ($_ =~ /$TOKEN_RE/gsm) ?
33             do {
34 35         118 s/^\$//;
35 35         73 s/^\{//;
36 35         79 s/\}$//;
37 35         126 $hash->fetch ($_);
38             } :
39 116 100       886 do {
40 81         171 s/\\(.)/$1/gsm;
41 81         209 $_;
42             };
43 60         101 } @{$tokens};
  60         136  
44              
45 60 100       140 return join '', map { defined $_ ? $_ : () } @res;
  116         442  
46             }
47              
48              
49             # $class->_tokenize ($data_ref);
50             # ------------------------------
51             # Returns the data to process as a list of tokens:
52             # ( 'some text', '<% a_tag %>', 'some more text', '<% end-a_tag %>' etc.
53             sub _tokenize
54             {
55 69     69   103 my $self = shift;
56 69         86 my $data_ref = shift;
57              
58 69         1143 my @tokens = $$data_ref =~ /($TOKEN_RE)/gs;
59 69         938 my @split = split /$TOKEN_RE/s, $$data_ref;
60 69         165 my $tokens = [];
61 69         221 while (@split)
62             {
63 92         112 push @{$tokens}, shift (@split);
  92         191  
64 92 100       221 push @{$tokens}, shift (@tokens) if (@tokens);
  40         86  
65             }
66 69         91 push @{$tokens}, (@tokens);
  69         135  
67 69         171 return $tokens;
68             }
69              
70              
71             1;
72              
73              
74             __END__