File Coverage

blib/lib/Template/Liquid/Context.pm
Criterion Covered Total %
statement 116 143 81.1
branch 85 106 80.1
condition 7 20 35.0
subroutine 14 21 66.6
pod 0 7 0.0
total 222 297 74.7


line stmt bran cond sub pod time code
1             our $VERSION = '1.0.21';
2             require Template::Liquid::Utility;
3             require Template::Liquid::Error;
4             use strict;
5 25     25   71760 use warnings;
  25         59  
  25         687  
6 25     25   109 use Scalar::Util;
  25         42  
  25         620  
7 25     25   150  
  25         41  
  25         39513  
8             my ($class, %args) = @_;
9             return bless {scopes => [$args{assigns}],
10 360     360 0 1077 template => $args{template}, # Required
11             errors => []
12             }, $class;
13 360         1860 }
14              
15             my ($s, $context) = @_;
16             return
17             raise Template::Liquid::Error {type => 'Stack',
18 123     123 0 206 template => $s->{template},
19             message => 'Cannot push new scope!'
20             }
21             if scalar @{$s->{'scopes'}} == 100;
22             return push @{$s->{'scopes'}}, (defined $context ? $context : {});
23             }
24 123 50       135  
  123         284  
25 123 100       175 my ($s) = @_;
  123         371  
26             return
27             raise Template::Liquid::Error {type => 'Stack',
28             template => $s->{template},
29 123     123 0 225 message => 'Cannot pop scope!'
30             }
31             if scalar @{$s->{'scopes'}} == 1;
32             return pop @{$s->{'scopes'}};
33             }
34              
35 123 50       141 my ($s, $block) = @_;
  123         270  
36 123         159 my $old_scope = $s->{scopes}[-1];
  123         222  
37             $s->push();
38             $s->merge($old_scope);
39             my $result = $block->($s);
40 105     105 0 197 $s->pop;
41 105         162 return $result;
42 105         212 }
43 105         261  
44 105         247 my ($s, $new) = @_;
45 105         263 return $s->{'scopes'}->[0] = __merge(reverse $s->{scopes}[-1], $new);
46 105         302 }
47              
48             my ($source, $target) = @_;
49             my $return = $target;
50 105     105 0 177 for (keys %$source) {
51 105         241 if ('ARRAY' eq ref $target->{$_} &&
52             ('ARRAY' eq ref $source->{$_} || !ref $source->{$_})) {
53             @{$return->{$_}} = [@{$target->{$_}}, @{$source->{$_}}];
54             }
55 0     0   0 elsif ('HASH' eq ref $target->{$_} &&
56 0         0 ('HASH' eq ref $source->{$_} || !ref $source->{$_})) {
57 0         0 $return->{$_} = _merge($source->{$_}, $target->{$_});
58 0 0 0     0 }
    0 0        
      0        
      0        
59             else { $return->{$_} = $source->{$_}; }
60 0         0 }
  0         0  
  0         0  
  0         0  
61             return $return;
62             }
63             my $merge_precedent;
64 0         0  
65             my $return = $_[1]; # precedent merge function
66 0         0 $merge_precedent ||= {
67             SCALAR => {SCALAR => sub { defined $_[0] ? $_[0] : $_[1] },
68 0         0 ARRAY => sub { $_[1] },
69             HASH => sub { $_[1] },
70             },
71             ARRAY => {
72             SCALAR => sub {
73 105     105   140 [@{$_[0]}, defined $_[1] ? $_[1] : ()];
74             },
75 15 100   15   66 ARRAY => sub { [@{$_[0]}] },
76 0     0   0 HASH => sub { [@{$_[0]}, values %{$_[1]}] },
77 0     0   0 },
78             HASH => {SCALAR => sub { $_[0] },
79             ARRAY => sub { $_[0] },
80             HASH => sub { _merge($_[0], $_[1], $_[2]) },
81 64 50   64   84 }
  64         284  
82             };
83 0     0   0 for my $key (keys %{$_[0]}) {
  0         0  
84 0     0   0 my ($left_ref, $right_ref)
  0         0  
  0         0  
85             = map { ref($_->{$key}) =~ m[^(HASH|ARRAY)$]o ? $1 : 'SCALAR' }
86 41     41   116 ($_[0], $_[1]);
87 0     0   0  
88 0     0   0 #warn sprintf '%-12s [%6s|%-6s]', $key, $left_ref, $right_ref;
89             $return->{$key} = $merge_precedent->{$left_ref}{$right_ref}
90 105   100     406 ->($_[0]->{$key}, $_[1]->{$key});
91 105         133 }
  105         287  
92             return $return;
93 120 100       197 }
  240         928  
94              
95             my ($s, $var) = @_;
96             return if !defined $var;
97             return $2 if $var =~ m[^(["'])(.+)\1$]o;
98 120         427 my @path = split $Template::Liquid::Utility::VariableAttributeSeparator,
99             $var;
100 105         225 my $cursor = \$s->{scopes}[-1];
101             return $var
102             if $var =~ m[^[-\+]?(\d*\.)?\d+$]o && !exists $$cursor->{$path[0]};
103             return if $var eq '';
104 2443     2443 0 4627 return '' if $var eq '""';
105 2443 100       3774 return "" if $var eq "''";
106 2437 100       5784 return if $var eq 'null';
107 2075         6112 return if $var eq 'nil';
108             return if $var eq 'blank';
109 2075         3315 return if $var eq 'empty';
110             return !1 if $var eq 'false';
111 2075 100 100     9370 return !!1 if $var eq 'true';
112 1228 100       2122  
113 1216 100       1802 if ($var =~ m[^\((\S+)\s*\.\.\s*(\S+)\)$]o) {
114 1211 100       1709 return [$s->get($1) .. $s->get($2)]; # range
115 1208 100       1657 }
116 1207 100       1728  
117 1206 100       1708 # print STDERR "DEBUG:var=$var. about to get 1 and 2 from regex";
118 1205 100       1642 # return $s->get($1)->[$2] if $var =~ m'^(.+)\[(\d+)\]$'o; # array index myvar[2]
119 1204 100       1699 if ($var =~ m'^(.+)\[(\d+)\]$'o) {
120 1201 100       1676  
121             # print STDERR "DEBUG:array index. var=$var. 1=$1,2=$2";
122 1197 100       1955 my $arr = $s->get($1);
123 30         68 return $arr->[$2] if $arr;
124             return; # return if nothing
125             }
126              
127             # return $s->get($1)->{$2} if $var =~ m'^(.+)\[(.+)\]$'o;
128 1167 100       1813 if ($var =~ m'^(.+)\[(.+)\]$'o) {
129              
130             # print STDERR "DEBUG:obj property. var=$var. 1=$1,2=$2";
131 4         11 my $obj = $s->get($1);
132 4 50       21 return $obj->{$2} if $obj;
133 0         0 return; # return if nothing
134             }
135             STEP: while (@path) {
136             my $crumb = shift @path;
137 1163 100       1762 my $reftype = ref $$cursor;
138             if (Scalar::Util::blessed($$cursor) && $$cursor->can($crumb)) {
139             my $can = $$cursor->can($crumb);
140 1         5 my $val = $can->($$cursor);
141 1 50       5 return $val if !scalar @path;
142 0         0 $cursor = \$val;
143             next STEP;
144 1162         2257 }
145 1359         1922 elsif ($reftype eq 'HASH') {
146 1359         1987 if (exists $$cursor->{$crumb}) {
147 1359 100 66     3554 return $$cursor->{$crumb} if !@path;
    100          
    100          
148 2         5 $cursor = \$$cursor->{$crumb};
149 2         6 next STEP;
150 2 100       11 }
151 1         2 return ();
152 1         3 }
153             elsif ($reftype eq 'ARRAY') {
154             return scalar @{$$cursor} if $crumb eq 'size';
155 1325 100       2297 $crumb = 0 if $crumb eq 'first';
156 1004 100       2854 $crumb = $#$$cursor if $crumb eq 'last';
157 191         278 return () if $crumb =~ m[\D]o;
158 191         376 return () if scalar @$$cursor < $crumb;
159             return $$cursor->[$crumb] if !scalar @path;
160 321         729 $cursor = \$$cursor->[$crumb];
161             next STEP;
162             }
163 20 100       32 return ();
  2         7  
164 18 100       38 }
165 18 100       31 }
166 18 100       38  
167 17 100       47 my ($s, $var, $val) = @_;
168 13 100       45 my $var_reftype = ref $val;
169 5         8 my @path = split $Template::Liquid::Utility::VariableAttributeSeparator,
170 5         9 $var;
171             my $cursor = \$s->{scopes}[-1];
172 12         36 $cursor = \$$cursor->{shift @path} if (exists $$cursor->{$path[0]});
173             STEP: while (@path) {
174             my $crumb = shift @path;
175             my $reftype = ref $$cursor;
176             if ($reftype eq 'HASH') {
177 854     854 0 1385 if (!@path) {
178 854         1033 if (exists $$cursor->{$crumb}) {
179 854         2317  
180             # TODO: If the reftype is different, mention it
181 854         1395 }
182 854 100       1791 return $$cursor->{$crumb} = $val;
183 854         1462 }
184 280         400 else {
185 280         414 $$cursor->{$crumb} = $path[0] =~ m[\D] ? {} : []
186 280 100       455 if !exists $$cursor->{$crumb};
    100          
187 274 100       454 $cursor = \$$cursor->{$crumb};
188 266 100       464 next STEP;
189             }
190             }
191             elsif ($reftype eq 'ARRAY') {
192 266         685 if ($crumb =~ m[\D]) {
193              
194             # TODO: Let the user know
195             }
196 8 50       29 if (!@path) {
    100          
197 8         13 if (exists $$cursor->[$crumb]) {
198 8         16  
199             # TODO: If the reftype is different, mention it
200             }
201             return $$cursor->[$crumb] = $val;
202 4 50       27 }
203             else {
204             $$cursor->[$crumb] = $path[0] =~ m[\D] ? {} : []
205             if !exists $$cursor->[$crumb];
206 4 100       10 $cursor = \$$cursor->[$crumb];
207 1 50       4 next STEP;
208             }
209             }
210             else {
211 1         7 if (!@path) {
212             if ($crumb =~ m[\D]) {
213             $$cursor = {};
214 3 0       10 return $$cursor->{$crumb} = $val;
    50          
215             }
216 3         5 $$cursor = [];
217 3         4 return $$cursor->[$crumb] = $val;
218             }
219             else {
220             $$cursor->{$crumb} = $path[0] =~ m[\D] ? {} : []
221 2 50       5 if !exists $$cursor->[$crumb];
222 2 50       6 $cursor = \$$cursor->{$crumb};
223 2         5 next STEP;
224 2         9 }
225             }
226 0         0 }
227 0         0 return $$cursor = $val;
228             }
229             1;
230 0 0       0  
    0          
231             =pod
232 0         0  
233 0         0 =encoding UTF-8
234              
235             =head1 NAME
236              
237 585         1111 Template::Liquid::Context - Complex Variable Keeper
238              
239             =head1 Description
240              
241             This is really only to be used internally.
242              
243             =head1 Author
244              
245             Sanko Robinson <sanko@cpan.org> - http://sankorobinson.com/
246              
247             CPAN ID: SANKO
248              
249             =head1 License and Legal
250              
251             Copyright (C) 2009-2022 by Sanko Robinson E<lt>sanko@cpan.orgE<gt>
252              
253             This program is free software; you can redistribute it and/or modify it under
254             the terms of L<The Artistic License
255             2.0|http://www.perlfoundation.org/artistic_license_2_0>. See the F<LICENSE>
256             file included with this distribution or L<notes on the Artistic License
257             2.0|http://www.perlfoundation.org/artistic_2_0_notes> for clarification.
258              
259             When separated from the distribution, all original POD documentation is covered
260             by the L<Creative Commons Attribution-Share Alike 3.0
261             License|http://creativecommons.org/licenses/by-sa/3.0/us/legalcode>. See the
262             L<clarification of the
263             CCA-SA3.0|http://creativecommons.org/licenses/by-sa/3.0/us/>.
264              
265             =cut