File Coverage

blib/lib/Text/Xslate/PP/Method.pm
Criterion Covered Total %
statement 17 110 15.4
branch 0 48 0.0
condition 0 3 0.0
subroutine 6 21 28.5
pod 0 2 0.0
total 23 184 12.5


line stmt bran cond sub pod time code
1             package Text::Xslate::PP::Method;
2             # xs/xslate-methods.xs in pure Perl
3 1     1   5 use strict;
  1         2  
  1         28  
4 1     1   4 use warnings;
  1         2  
  1         23  
5              
6              
7 1     1   5 use Scalar::Util ();
  1         2  
  1         13  
8 1     1   4 use Carp ();
  1         2  
  1         1156  
9              
10             require Text::Xslate::PP;
11             require Text::Xslate::PP::State;
12             require Text::Xslate::PP::Type::Pair;
13              
14             if(!Text::Xslate::PP::_PP_ERROR_VERBOSE()) {
15             our @CARP_NOT = qw(
16             Text::Xslate::PP::Opcode
17             );
18             }
19              
20             our $_st;
21             *_st = *Text::Xslate::PP::_current_st;
22              
23             our $_context;
24              
25             sub _array_first {
26 0     0   0 my($array_ref) = @_;
27 0 0       0 return $_st->bad_arg('first') if @_ != 1;
28 0         0 return $array_ref->[0];
29             }
30              
31             sub _array_last {
32 0     0   0 my($array_ref) = @_;
33 0 0       0 return $_st->bad_arg('last') if @_ != 1;
34 0         0 return $array_ref->[-1];
35             }
36              
37             sub _array_size {
38 0     0   0 my($array_ref) = @_;
39 0 0       0 return $_st->bad_arg('size') if @_ != 1;
40 0         0 return scalar @{$array_ref};
  0         0  
41             }
42              
43             sub _array_join {
44 0     0   0 my($array_ref, $sep) = @_;
45 0 0       0 return $_st->bad_arg('join') if @_ != 2;
46 0         0 return join $sep, @{$array_ref};
  0         0  
47             }
48              
49             sub _array_reverse {
50 0     0   0 my($array_ref) = @_;
51 0 0       0 return $_st->bad_arg('reverse') if @_ != 1;
52 0         0 return [ reverse @{$array_ref} ];
  0         0  
53             }
54              
55             sub _array_sort {
56 0     0   0 my($array_ref, $callback) = @_;
57 0 0 0     0 return $_st->bad_arg('sort') if !(@_ == 1 or @_ == 2);
58 0 0       0 if(@_ == 1) {
59 0         0 return [ sort @{$array_ref} ];
  0         0  
60             }
61             else {
62             return [ sort {
63 0         0 push @{ $_st->{ SP } }, [ $a, $b ];
  0         0  
64 0         0 $_st->proccall($callback, $_context) + 0; # need to numify
65 0         0 } @{$array_ref} ];
  0         0  
66             }
67             }
68              
69             sub _array_map {
70 0     0   0 my($array_ref, $callback) = @_;
71 0 0       0 return $_st->bad_arg('map') if @_ != 2;
72             return [ map {
73 0         0 push @{ $_st->{ SP } }, [ $_ ];
  0         0  
74 0         0 $_st->proccall($callback, $_context);
75 0         0 } @{$array_ref} ];
  0         0  
76             }
77              
78             sub _array_reduce {
79 0     0   0 my($array_ref, $callback) = @_;
80 0 0       0 return $_st->bad_arg('reduce') if @_ != 2;
81 0 0       0 return $array_ref->[0] if @{$array_ref} < 2;
  0         0  
82              
83 0         0 my $x = $array_ref->[0];
84 0         0 for(my $i = 1; $i < @{$array_ref}; $i++) {
  0         0  
85 0         0 push @{ $_st->{ SP } }, [ $x, $array_ref->[$i] ];
  0         0  
86 0         0 $x = $_st->proccall($callback, $_context);
87             }
88 0         0 return $x;
89             }
90              
91             sub _array_merge {
92 0     0   0 my($array_ref, $value) = @_;
93 0 0       0 return $_st->bad_arg('merge') if @_ != 2;
94 0 0       0 return [ @{$array_ref}, ref($value) eq 'ARRAY' ? @{$value} : $value ];
  0         0  
  0         0  
95             }
96              
97             sub _hash_size {
98 0     0   0 my($hash_ref) = @_;
99 0 0       0 return $_st->bad_arg('size') if @_ != 1;
100 0         0 return scalar keys %{$hash_ref};
  0         0  
101             }
102              
103             sub _hash_keys {
104 0     0   0 my($hash_ref) = @_;
105 0 0       0 return $_st->bad_arg('keys') if @_ != 1;
106 0         0 return [sort { $a cmp $b } keys %{$hash_ref}];
  0         0  
  0         0  
107             }
108              
109             sub _hash_values {
110 0     0   0 my($hash_ref) = @_;
111 0 0       0 return $_st->bad_arg('values') if @_ != 1;
112 0         0 return [map { $hash_ref->{$_} } @{ _hash_keys($hash_ref) } ];
  0         0  
  0         0  
113             }
114              
115             sub _hash_kv {
116 0     0   0 my($hash_ref) = @_;
117 0 0       0 $_st->bad_arg('kv') if @_ != 1;
118             return [
119 0         0 map { Text::Xslate::PP::Type::Pair->new(key => $_, value => $hash_ref->{$_}) }
120 0         0 @{ _hash_keys($hash_ref) }
  0         0  
121             ];
122             }
123              
124             sub _hash_merge {
125 0     0   0 my($hash_ref, $other_hash_ref) = @_;
126 0 0       0 $_st->bad_arg('merge') if @_ != 2;
127              
128 0         0 return { %{$hash_ref}, %{$other_hash_ref} };
  0         0  
  0         0  
129             }
130              
131             BEGIN {
132 1     1   281 our %builtin_method = (
133             'array::first' => \&_array_first,
134             'array::last' => \&_array_last,
135             'array::size' => \&_array_size,
136             'array::join' => \&_array_join,
137             'array::reverse' => \&_array_reverse,
138             'array::sort' => \&_array_sort,
139             'array::map' => \&_array_map,
140             'array::reduce' => \&_array_reduce,
141             'array::merge' => \&_array_merge,
142              
143             'hash::size' => \&_hash_size,
144             'hash::keys' => \&_hash_keys,
145             'hash::values' => \&_hash_values,
146             'hash::kv' => \&_hash_kv,
147             'hash::merge' => \&_hash_merge,
148             );
149             }
150              
151             sub tx_register_builtin_methods {
152 1     1 0 2 my($hv) = @_;
153 1         2 our %builtin_method;
154 1         7 foreach my $name(keys %builtin_method) {
155 14         31 $hv->{$name} = $builtin_method{$name};
156             }
157             }
158              
159             sub tx_methodcall {
160 0     0 0   my($st, $context, $method, $invocant, @args) = @_;
161              
162 0 0         if(Scalar::Util::blessed($invocant)) {
163 0           my $retval = eval { $invocant->$method(@args) };
  0            
164 0 0         $st->error($context, "%s", $@) if $@;
165 0           return $retval;
166             }
167              
168 0 0         my $type = ref($invocant) eq 'ARRAY' ? 'array::'
    0          
    0          
169             : ref($invocant) eq 'HASH' ? 'hash::'
170             : defined($invocant) ? 'scalar::'
171             : 'nil::';
172 0           my $fq_name = $type . $method;
173              
174 0 0         if(my $body = $st->symbol->{$fq_name}){
175 0           push @{ $st->{ SP } }, [ $invocant, @args ]; # re-pushmark
  0            
176 0           local $_context = $context;
177 0           return $st->proccall($body, $context);
178             }
179 0 0         if(!defined $invocant) {
180 0           $st->warn($context, "Use of nil to invoke method %s", $method);
181 0           return undef;
182             }
183              
184 0           $st->error($context, "Undefined method %s called for %s",
185             $method, $invocant);
186              
187 0           return undef;
188             }
189              
190             1;
191             __END__