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   257 use strict;
  77         84  
  77         1749  
10 77     77   233 use warnings;
  77         80  
  77         1435  
11 77     77   216 use Carp;
  77         76  
  77         26608  
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 66 my $self = shift;
22 60         57 my $hash = shift;
23 60         51 my $argument = shift;
24              
25 60 50       102 $Petal::TranslationService && do {
26 0   0     0 $argument = eval { $Petal::TranslationService->maketext ($argument) } || $argument;
27 0 0       0 $@ and warn $@;
28             };
29            
30 60         113 my $tokens = $self->_tokenize (\$argument);
31             my @res = map {
32             ($_ =~ /$TOKEN_RE/gsm) ?
33             do {
34 35         84 s/^\$//;
35 35         43 s/^\{//;
36 35         57 s/\}$//;
37 35         77 $hash->fetch ($_);
38             } :
39 116 100       562 do {
40 81         113 s/\\(.)/$1/gsm;
41 81         161 $_;
42             };
43 60         53 } @{$tokens};
  60         92  
44            
45 60 100       80 return join '', map { defined $_ ? $_ : () } @res;
  116         338  
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   70 my $self = shift;
56 69         59 my $data_ref = shift;
57            
58 69         828 my @tokens = $$data_ref =~ /($TOKEN_RE)/gs;
59 69         584 my @split = split /$TOKEN_RE/s, $$data_ref;
60 69         108 my $tokens = [];
61 69         135 while (@split)
62             {
63 92         71 push @{$tokens}, shift (@split);
  92         136  
64 92 100       198 push @{$tokens}, shift (@tokens) if (@tokens);
  40         80  
65             }
66 69         58 push @{$tokens}, (@tokens);
  69         72  
67 69         128 return $tokens;
68             }
69              
70              
71             1;
72              
73              
74             __END__