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   475 use strict;
  77         130  
  77         2130  
10 77     77   367 use warnings;
  77         136  
  77         1620  
11 77     77   314 use Carp;
  77         141  
  77         35039  
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 96 my $self = shift;
22 60         76 my $hash = shift;
23 60         84 my $argument = shift;
24              
25 60 50       119 $Petal::TranslationService && do {
26 0   0     0 $argument = eval { $Petal::TranslationService->maketext ($argument) } || $argument;
27 0 0       0 $@ and warn $@;
28             };
29            
30 60         156 my $tokens = $self->_tokenize (\$argument);
31             my @res = map {
32             ($_ =~ /$TOKEN_RE/gsm) ?
33             do {
34 35         115 s/^\$//;
35 35         74 s/^\{//;
36 35         77 s/\}$//;
37 35         95 $hash->fetch ($_);
38             } :
39 116 100       867 do {
40 81         171 s/\\(.)/$1/gsm;
41 81         227 $_;
42             };
43 60         90 } @{$tokens};
  60         104  
44            
45 60 100       111 return join '', map { defined $_ ? $_ : () } @res;
  116         432  
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   124 my $self = shift;
56 69         77 my $data_ref = shift;
57            
58 69         1144 my @tokens = $$data_ref =~ /($TOKEN_RE)/gs;
59 69         800 my @split = split /$TOKEN_RE/s, $$data_ref;
60 69         151 my $tokens = [];
61 69         197 while (@split)
62             {
63 92         121 push @{$tokens}, shift (@split);
  92         188  
64 92 100       231 push @{$tokens}, shift (@tokens) if (@tokens);
  40         84  
65             }
66 69         85 push @{$tokens}, (@tokens);
  69         104  
67 69         152 return $tokens;
68             }
69              
70              
71             1;
72              
73              
74             __END__