File Coverage

blib/lib/DTL/Fast/Tag/Url.pm
Criterion Covered Total %
statement 75 79 94.9
branch 15 20 75.0
condition 3 5 60.0
subroutine 13 13 100.0
pod 0 6 0.0
total 106 123 86.1


line stmt bran cond sub pod time code
1             package DTL::Fast::Tag::Url;
2 2     2   1030 use strict; use utf8; use warnings FATAL => 'all';
  2     2   3  
  2     2   57  
  2         8  
  2         4  
  2         11  
  2         51  
  2         4  
  2         80  
3 2     2   8 use parent 'DTL::Fast::Tag::Simple';
  2         4  
  2         9  
4              
5             $DTL::Fast::TAG_HANDLERS{'url'} = __PACKAGE__;
6              
7 2     2   136 use DTL::Fast::Utils;
  2         3  
  2         2234  
8              
9             #@Override
10             sub parse_parameters
11             {
12 4     4 0 4 my( $self ) = @_;
13              
14 4 50       39 if( $self->{'parameter'} =~ /^\s*(.+?)(?:\s+as\s+([^\s]+))?\s*$/s )
15             {
16 4         5 $self->{'target_name'} = $2;
17 4         13 my @params = split /\s+/, $self->backup_strings($1);
18            
19 4         14 $self->{'model_path'} = $self->get_backup_or_variable(shift @params);
20 4 100       6 if( scalar @params )
21             {
22 3 100       6 if( $params[0] =~ /\=/ )
23             {
24 2         5 $self->parse_named_parameters(\@params);
25             }
26             else
27             {
28 1         3 $self->parse_positional_parameters(\@params);
29             }
30             }
31             }
32             else
33             {
34 0         0 die $self->get_parse_error("unable to parse url parameters: $self->{'parameter'}");
35             }
36            
37 4         6 return $self;
38             }
39              
40             #@Override
41             sub render
42             {
43 4     4 0 3 my( $self, $context ) = @_;
44            
45 4         4 my $result = '';
46            
47 4         4 my $url_source = $context->{'ns'}->[-1]->{'_dtl_url_source'};
48            
49 4 50 33     12 if(
50             defined $url_source
51             and ref $url_source eq 'CODE'
52             )
53             {
54 4         10 my $model_path = $self->{'model_path'}->render($context);
55 4         6 my $arguments = $self->render_arguments($context);
56 4         9 my $url_template = $url_source->($model_path, $arguments);
57            
58 4 50       28 if( $url_template )
59             {
60 4         5 $result = $self->restore_url($url_template, $arguments);
61             }
62             else
63             {
64 0         0 die $self->get_render_error("url source returned false value by model path: $model_path");
65             }
66             }
67             else
68             {
69 0         0 die $self->get_render_error("in order to render url's you must provide `url_source` argument to the template constructor");
70             }
71            
72 4         10 return $result;
73             }
74              
75             sub restore_url
76             {
77 4     4 0 5 my( $self, $template, $arguments ) = @_;
78            
79 4 100       5 if( ref $arguments eq 'ARRAY' )
80             {
81             my $replacer = sub{
82 4   100 4   25 return DTL::Fast::Utils::escape((shift @$arguments) // '');
83 2         9 };
84 2         10 $template =~ s/
85             \(
86             [^)(]+
87             \)
88             \??
89 4         6 /$replacer->()/xge; # @todo: this one is dumb, need improve
90             }
91             else # MUST be a hash
92             {
93             my $replacer = sub{
94 4     4   6 my( $key ) = @_;
95 4         20 return DTL::Fast::Utils::escape($arguments->{$key});
96 2         6 };
97 2         10 $template =~ s/
98             \(\?<(.+?)>
99             [^)(]+
100             \)
101             \??
102 4         6 /$replacer->($1)/xge; # @todo: this one is dumb, need improve
103             }
104            
105             # removing regexp remains
106 4         31 $template =~ s/(
107             ^\^
108             |\$$
109             |\(\?\:
110             |\(
111             |\)
112             )//xgs;
113            
114 4         11 return '/'.$template;
115             }
116              
117              
118             sub render_arguments
119             {
120 4     4 0 3 my( $self, $context ) = @_;
121            
122 4         3 my $result = [];
123              
124 4 100       7 if( $self->{'arguments'} )
125             {
126 3 100       7 if( ref $self->{'arguments'} eq 'ARRAY' )
127             {
128 1         1 $result = [];
129            
130 1         1 foreach my $argument (@{$self->{'arguments'}})
  1         1  
131             {
132 2         5 push @$result, $argument->render($context);
133             }
134             }
135             else # MUST be a HASH
136             {
137 2         1 $result = {};
138 2         2 foreach my $key (keys( %{$self->{'arguments'}}))
  2         4  
139             {
140 4         8 $result->{$key} = $self->{'arguments'}->{$key}->render($context);
141             }
142             }
143             }
144            
145 4         5 return $result;
146             }
147              
148             sub parse_named_parameters
149             {
150 2     2 0 2 my( $self, $params ) = @_;
151            
152 2         3 my $result = {};
153 2         3 foreach my $param (@$params)
154             {
155 4 50       13 if( $param =~ /^(.+)\=(.+)$/ )
156             {
157 4         7 $result->{$1} = $self->get_backup_or_variable($2);
158             }
159             else
160             {
161 0         0 die $self->get_parse_error("you can't mix positional and named arguments in url tag: $self->{'parameter'}");
162             }
163             }
164 2         2 $self->{'arguments'} = $result;
165 2         3 return $self;
166             }
167              
168             sub parse_positional_parameters
169             {
170 1     1 0 5 my( $self, $params ) = @_;
171            
172 1         2 my $result = [];
173 1         2 foreach my $param (@$params)
174             {
175 2 50       3 die $self->get_parse_error("you can't mix positional and named arguments in url tag: $self->{'parameter'}")
176             if $param =~ /\=/;
177            
178 2         5 push @$result, $self->get_backup_or_variable($param);
179             }
180 1         1 $self->{'arguments'} = $result;
181 1         2 return $self;
182             }
183              
184             1;