File Coverage

blib/lib/Text/Xslate/PP/State.pm
Criterion Covered Total %
statement 29 102 28.4
branch 4 46 8.7
condition 2 16 12.5
subroutine 8 19 42.1
pod 0 11 0.0
total 43 194 22.1


line stmt bran cond sub pod time code
1             package Text::Xslate::PP::State; # implement tx_state_t
2 1     1   416 use Mouse;
  1         22745  
  1         5  
3              
4 1     1   336 use Text::Xslate::Util qw(neat p $DEBUG);
  1         2  
  1         168  
5 1     1   14 use Text::Xslate::PP;
  1         2  
  1         37  
6 1         1172 use Text::Xslate::PP::Const qw(
7             TXframe_NAME TXframe_RETADDR TXframe_OUTPUT
8 1     1   4 TX_VERBOSE_DEFAULT);
  1         1  
9              
10             if(!Text::Xslate::PP::_PP_ERROR_VERBOSE()) {
11             our @CARP_NOT = qw(
12             Text::Xslate::PP::Opcode
13             Text::Xslate::PP::Booter
14             Text::Xslate::PP::Method
15             );
16             }
17              
18             has vars => (
19             is => 'rw',
20             );
21              
22             has tmpl => (
23             is => 'rw',
24             );
25              
26             has engine => (
27             is => 'rw',
28             weak_ref => 1,
29             );
30              
31             has frame => (
32             is => 'rw',
33             );
34              
35             has current_frame => (
36             is => 'rw',
37             );
38              
39             # opinfo is integrated into code
40             #has info => (
41             # is => 'rw',
42             #);
43              
44             has code => (
45             is => 'rw',
46             );
47              
48             has code_len => (
49             is => 'rw',
50             );
51              
52             has symbol => (
53             is => 'rw',
54             );
55              
56             has local_stack => (
57             is => 'rw',
58             );
59              
60             has encoding => (
61             is => 'ro',
62             init_arg => undef,
63             lazy => 1,
64             default => sub {
65             require Encode;
66             return Encode::find_encoding('UTF-8');
67             },
68             );
69              
70             sub fetch {
71             # my ( $st, $var, $key, $frame, $line ) = @_;
72 0     0 0 0 my $ret;
73              
74 0 0       0 if ( Scalar::Util::blessed($_[1]) ) {
    0          
    0          
    0          
75 0         0 my $key = $_[2];
76 0         0 $ret = eval { $_[1]->$key() };
  0         0  
77 0 0       0 $_[0]->error( [ $_[3], $_[4] ], "%s", $@ ) if $@;
78             }
79             elsif ( ref $_[1] eq 'HASH' ) {
80 0 0       0 if ( defined $_[2] ) {
81 0         0 $ret = $_[1]->{ $_[2] };
82             }
83             else {
84 0         0 $_[0]->warn( [ $_[3], $_[4] ], "Use of nil as a field key" );
85             }
86             }
87             elsif ( ref $_[1] eq 'ARRAY' ) {
88 0 0       0 if ( Scalar::Util::looks_like_number($_[2]) ) {
89 0         0 $ret = $_[1]->[ $_[2] ];
90             }
91             else {
92 0         0 $_[0]->warn( [ $_[3], $_[4] ], "Use of %s as an array index", neat( $_[2] ) );
93             }
94             }
95             elsif ( $_[1] ) {
96 0         0 $_[0]->error( [ $_[3], $_[4] ], "Cannot access %s (%s is not a container)", neat($_[2]), neat($_[1]) );
97             }
98             else {
99 0         0 $_[0]->warn( [ $_[3], $_[4] ], "Use of nil to access %s", neat( $_[2] ) );
100             }
101              
102 0         0 return $ret;
103             }
104              
105             sub fetch_symbol {
106 0     0 0 0 my ( $st, $name, $context ) = @_;
107              
108 0         0 my $symbol_table = $st->symbol;
109 0 0       0 if ( !exists $symbol_table->{ $name } ) {
110 0 0       0 if(defined $context) {
111 0         0 my($frame, $line) = @{$context};
  0         0  
112 0 0       0 if ( defined $line ) {
113 0         0 $st->{ pc } = $line;
114 0         0 $st->frame->[ $st->current_frame ]->[ TXframe_NAME ] = $frame;
115             }
116             }
117 0         0 Carp::croak( sprintf( "Undefined symbol %s", $name ) );
118             }
119              
120 0         0 return $symbol_table->{ $name };
121             }
122              
123             sub localize {
124 0     0 0 0 my($st, $key, $newval) = @_;
125 0         0 my $vars = $st->vars;
126 0         0 my $preeminent = exists $vars->{$key};
127 0         0 my $oldval = delete $vars->{$key};
128              
129             my $cleanup = $preeminent
130 0     0   0 ? sub { $vars->{$key} = $oldval; return }
  0         0  
131 0 0   0   0 : sub { delete $vars->{$key}; return };
  0         0  
  0         0  
132              
133 0   0     0 push @{ $st->{local_stack} ||= [] },
  0         0  
134             bless($cleanup, 'Text::Xslate::PP::Guard');
135              
136 0         0 $vars->{$key} = $newval;
137 0         0 return;
138             }
139              
140             sub push_frame {
141 1     1 0 1 my ( $st, $name, $retaddr ) = @_;
142              
143 1 50       5 if ( $st->current_frame > 100 ) {
144 0         0 Carp::croak("Macro call is too deep (> 100)");
145             }
146              
147 1   50     15 my $new = $st->frame->[ $st->current_frame( $st->current_frame + 1 ) ]
148             ||= [];
149 1         2 $new->[ TXframe_NAME ] = $name;
150 1         2 $new->[ TXframe_RETADDR ] = $retaddr;
151 1         2 return $new;
152             }
153              
154             sub pop_frame {
155 0     0 0 0 my( $st, $replace_output ) = @_;
156 0         0 $st->current_frame( $st->current_frame - 1 );
157 0 0       0 if($replace_output) {
158 0         0 my $top = $st->frame->[ $st->current_frame + 1];
159             ($st->{output}, $top->[ TXframe_OUTPUT ])
160 0         0 = ($top->[ TXframe_OUTPUT ], $st->{output});
161             }
162              
163 0         0 return;
164             }
165              
166             sub pad {
167 0     0 0 0 return $_[0]->{frame}->[ $_[0]->{current_frame} ];
168             }
169              
170             sub op_arg {
171 3     3 0 7 $_[0]->{ code }->[ $_[0]->{ pc } ]->{ arg };
172             }
173              
174             sub print {
175 1     1 0 2 my($st, $sv, $frame_and_line) = @_;
176 1 50       3 if ( ref( $sv ) eq Text::Xslate::PP::TXt_RAW ) {
    0          
177 1 50       1 if(defined ${$sv}) {
  1         34  
178             $st->{output} .=
179             (utf8::is_utf8($st->{output}) && !utf8::is_utf8(${$sv}))
180             ? eval {$st->encoding->decode(${$sv}, Encode::FB_CROAK())} || ${$sv}
181 1 50 33     8 : ${$sv};
  1   0     2  
182             }
183             else {
184 0         0 $st->warn($frame_and_line, "Use of nil to print" );
185             }
186             }
187             elsif ( defined $sv ) {
188 0         0 $sv =~ s/($Text::Xslate::PP::html_metachars)/$Text::Xslate::PP::html_escape{$1}/xmsgeo;
  0         0  
189             $st->{output} .=
190             (utf8::is_utf8($st->{output}) && !utf8::is_utf8($sv))
191 0 0 0     0 ? eval {$st->encoding->decode($sv, Encode::FB_CROAK())} || $sv
      0        
192             : $sv;
193             }
194             else {
195 0         0 $st->warn( $frame_and_line, "Use of nil to print" );
196             }
197 1         2 return;
198             }
199              
200             sub _doerror {
201 0     0     my ( $st, $context, $fmt, @args ) = @_;
202 0 0         if(defined $context) { # hack to share it with PP::Booster and PP::Opcode
203 0           my($frame, $line) = @{$context};
  0            
204 0 0         if ( defined $line ) {
205 0           $st->{ pc } = $line;
206 0           $st->frame->[ $st->current_frame ]->[ TXframe_NAME ] = $frame;
207             }
208             }
209 0           Carp::carp( sprintf( $fmt, @args ) );
210 0           return;
211             }
212              
213             sub warn :method {
214 0     0 0   my $st = shift;
215 0 0         if( $st->engine->{verbose} > TX_VERBOSE_DEFAULT ) {
216 0           $st->_doerror(@_);
217             }
218 0           return;
219             }
220              
221              
222             sub error :method {
223 0     0 0   my $st = shift;
224 0 0         if( $st->engine->{verbose} >= TX_VERBOSE_DEFAULT ) {
225 0           $st->_doerror(@_);
226             }
227 0           return;
228             }
229              
230             sub bad_arg {
231 0     0 0   my $st = shift;
232 0 0         unshift @_, undef if @_ == 1; # hack to share it with PP::Booster and PP::Opcode
233 0           my($context, $name) = @_;
234 0           return $st->error($context, "Wrong number of arguments for %s", $name);
235             }
236              
237 1     1   8 no Mouse;
  1         1  
  1         5  
238             __PACKAGE__->meta->make_immutable;
239             1;
240             __END__