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