File Coverage

blib/lib/Text/Xslate/PP.pm
Criterion Covered Total %
statement 141 315 44.7
branch 32 150 21.3
condition 3 38 7.8
subroutine 22 46 47.8
pod 4 25 16.0
total 202 574 35.1


line stmt bran cond sub pod time code
1             package Text::Xslate::PP;
2             # Text::Xslate in pure Perl
3 1     1   23535 use 5.008_001;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         88  
5              
6             our $VERSION = '3.3.8';
7              
8             BEGIN{
9 1   50 1   37 $ENV{XSLATE} = ($ENV{XSLATE} || '') . '[pp]';
10             }
11              
12 1         149 use Text::Xslate::Util qw(
13             $DEBUG
14             p
15 1     1   659 );
  1         3  
16              
17 1     1   7 use constant _PP_ERROR_VERBOSE => scalar($DEBUG =~ /\b pp=verbose \b/xms);
  1         3  
  1         112  
18              
19 1     1   6 use constant _DUMP_LOAD => scalar($DEBUG =~ /\b dump=load \b/xms);
  1         1202  
  1         60  
20              
21 1     1   664 use Text::Xslate::PP::Const qw(:all);
  1         3  
  1         317  
22 1     1   648 use Text::Xslate::PP::State;
  1         3  
  1         35  
23 1     1   805 use Text::Xslate::PP::Type::Raw;
  1         2  
  1         27  
24 1     1   653 use Text::Xslate::PP::Opcode;
  1         78  
  1         31  
25 1     1   6 use Text::Xslate::PP::Method;
  1         1  
  1         18  
26              
27 1     1   6 use Scalar::Util ();
  1         2  
  1         15  
28 1     1   6 use overload ();
  1         1  
  1         16  
29 1     1   6 use Carp ();
  1         2  
  1         3241  
30              
31             # it must be loaded dynamically
32             require Text::Xslate;
33              
34             my $state_class = 'Text::Xslate::PP::Opcode';
35              
36             $VERSION =~ s/_//; # for developers versions
37              
38             if(_PP_ERROR_VERBOSE) {
39             Carp->import('verbose');
40             }
41              
42             # fix up @ISA
43             {
44             package
45             Text::Xslate;
46             if(!our %OPS) {
47             # the compiler use %Text::Xslate::OPS in order to optimize the code
48             *OPS = \%Text::Xslate::PP::OPS;
49             }
50             our @ISA = qw(Text::Xslate::PP);
51             package
52             Text::Xslate::PP;
53             our @ISA = qw(Text::Xslate::Engine);
54             }
55              
56             our $_depth = 0;
57             our $_current_st;
58              
59             our($_orig_die_handler, $_orig_warn_handler);
60              
61             our %html_escape = (
62             '&' => '&',
63             '<' => '<',
64             '>' => '>',
65             '"' => '"',
66             "'" => ''', # IE8 doesn't support ' in title
67             );
68             our $html_metachars = sprintf '[%s]', join '', map { quotemeta } keys %html_escape;
69              
70             sub _register_builtin_methods {
71 1     1   3 my($self, $funcs) = @_;
72 1         6 Text::Xslate::PP::Method::tx_register_builtin_methods($funcs);
73             }
74              
75             #
76             # public APIs
77             #
78              
79             sub render_string {
80 1     1 0 8 my($self, $string, $vars) = @_;
81 1         11 $self->load_string($string);
82 1         4 return $self->render('', $vars);
83             }
84              
85             sub render {
86 1     1 0 3 my ( $self, $name, $vars ) = @_;
87              
88 1 50 33     8 Carp::croak("Usage: Text::Xslate::render(self, name, vars)")
89             if !( @_ == 2 or @_ == 3 );
90 1 50       4 unless ( ref $self ) {
91 0         0 Carp::croak( "Invalid xslate instance" );
92             }
93              
94 1 50       3 if(!defined $vars) {
95 0         0 $vars = {};
96             }
97              
98 1 50       3 if ( !defined $name ) {
99 0         0 Carp::croak("Xslate: Template name is not given");
100             }
101              
102 1 50       4 unless ( ref $vars eq 'HASH' ) {
103 0         0 Carp::croak( sprintf("Xslate: Template variables must be a HASH reference, not %s", $vars ) );
104             }
105              
106 1         7 my $st = $self->tx_load_template( $name, 0 );
107              
108 1         4 local $_orig_die_handler = $SIG{__DIE__};
109 1         3 local $_orig_warn_handler = $SIG{__WARN__};
110 1         6 local $SIG{__DIE__} = \&_die;
111 1         4 local $SIG{__WARN__} = \&_warn;
112              
113 1         4 return tx_execute( $st, $vars );
114             }
115              
116             sub validate {
117 0     0 0 0 my ( $self, $name ) = @_;
118              
119 0 0       0 Carp::croak("Usage: Text::Xslate::render(self, name)")
120             if !( @_ == 2 );
121 0 0       0 unless ( ref $self ) {
122 0         0 Carp::croak( "Invalid xslate instance" );
123             }
124              
125 0 0       0 if ( !defined $name ) {
126 0         0 Carp::croak("Xslate: Template name is not given");
127             }
128              
129 0         0 local $self->{cache} = 0; # do not touch the cache
130 0         0 $self->tx_load_template( $name, 0 );
131 0         0 return;
132             }
133              
134             sub current_engine {
135 0 0   0 0 0 return defined($_current_st) ? $_current_st->engine : undef;
136             }
137              
138             sub current_vars {
139 0 0   0 0 0 return defined($_current_st) ? $_current_st->vars : undef;
140             }
141              
142             sub current_file {
143             return defined($_current_st)
144             ? $_current_st->code->[ $_current_st->{ pc } ]->{file}
145 0 0   0 0 0 : undef;
146             }
147              
148             sub current_line {
149             return defined($_current_st)
150             ? $_current_st->code->[ $_current_st->{ pc } ]->{line}
151 0 0   0 0 0 : undef;
152             }
153              
154             sub print {
155 0     0 0 0 shift;
156 0 0       0 if(defined $_current_st) {
157 0         0 foreach my $s(@_) {
158 0         0 $_current_st->print($s);
159             }
160             }
161             else {
162 0         0 Carp::croak('You cannot call print() method outside render()');
163             }
164 0         0 return '';
165             }
166              
167             # >> copied and modified from Text::Xslate
168              
169             sub _assemble {
170 1     1   3 my ( $self, $asm, $name, $fullpath, $cachepath, $mtime ) = @_;
171              
172 1 50       3 unless ( defined $name ) { # $name ... filename
173 0         0 $name = '';
174 0         0 $fullpath = $cachepath = undef;
175 0         0 $mtime = time();
176             }
177              
178 1         14 my $st = $state_class->new();
179              
180 1         109 $st->symbol({ %{$self->{ function }} });
  1         21  
181              
182 1         4 my $tmpl = [];
183              
184 1         5 $self->{ template }->{ $name } = $tmpl;
185 1         3 $self->{ tmpl_st }->{ $name } = $st;
186              
187 1         3 $tmpl->[ Text::Xslate::PP::TXo_MTIME ] = $mtime;
188 1         2 $tmpl->[ Text::Xslate::PP::TXo_CACHEPATH ] = $cachepath;
189 1         2 $tmpl->[ Text::Xslate::PP::TXo_FULLPATH ] = $fullpath;
190              
191 1         7 $st->tmpl( $tmpl );
192 1         12 $st->engine( $self ); # weak_ref!
193              
194 1         8 $st->{sa} = undef;
195 1         3 $st->{sb} = undef;
196              
197             # stack frame
198 1         7 $st->frame( [] );
199 1         6 $st->current_frame( -1 );
200              
201 1         3 my $len = scalar( @$asm );
202              
203 1         8 $st->push_frame('main', $len);
204              
205 1         7 $st->code_len( $len );
206              
207 1         5 my $code = $st->code([]);
208 1         2 my $macro;
209              
210 1         2 my $oi_line = -1;
211 1         1 my $oi_file = $name;
212 1         5 for ( my $i = 0; $i < $len; $i++ ) {
213 6         10 my $c = $asm->[ $i ];
214              
215 6 50       15 if ( ref $c ne 'ARRAY' ) {
216 0         0 Carp::croak( sprintf( "Oops: Broken code found on [%d]", $i ) );
217             }
218              
219 6         8 my ( $opname, $arg, $line, $file ) = @{$c};
  6         13  
220 6         15 my $opnum = $OPS{ $opname };
221              
222 6 50       21 unless ( defined $opnum ) {
223 0         0 Carp::croak( sprintf( "Oops: Unknown opcode '%s' on [%d]", $opname, $i ) );
224             }
225              
226 6 100       18 if(defined $line) {
227 5         8 $oi_line = $line;
228             }
229 6 100       16 if(defined $file) {
230 1         3 $oi_file = $file;
231             }
232              
233 6         19 $code->[$i] = {
234             # opcode
235             opname => $opname,
236              
237             # opinfo
238             line => $oi_line,
239             file => $oi_file,
240             };
241              
242 6         12 $code->[ $i ]->{ exec_code } = $OPCODE[ $opnum ];
243              
244 6         10 my $oparg = $OPARGS[ $opnum ];
245              
246 6 100       13 if ( $oparg & TXARGf_SV ) {
247              
248             # This line croak at 'concat'!
249             # Carp::croak( sprintf( "Oops: Opcode %s must have an argument on [%d]", $opname, $i ) )
250             # unless ( defined $arg );
251              
252 3 100       14 if( $oparg & TXARGf_KEY ) {
    50          
253 1         3 $code->[ $i ]->{ arg } = $arg;
254             }
255             elsif ( $oparg & TXARGf_INT ) {
256 0         0 $code->[ $i ]->{ arg } = int($arg);
257              
258 0 0       0 if( $oparg & TXARGf_PC ) {
259 0         0 my $abs_addr = $i + $arg;
260              
261 0 0       0 if( $abs_addr >= $len ) {
262 0         0 Carp::croak(
263             sprintf( "Oops: goto address %d is out of range (must be 0 <= addr <= %d)", $arg, $len )
264             );
265             }
266              
267 0         0 $code->[ $i ]->{ arg } = $abs_addr;
268             }
269              
270             }
271             else {
272 2         5 $code->[ $i ]->{ arg } = $arg;
273             }
274              
275             }
276             else {
277 3 50       5 if( defined $arg ) {
278 0         0 Carp::croak( sprintf( "Oops: Opcode %s has an extra argument on [%d]", $opname, $i ) );
279             }
280 3         7 $code->[ $i ]->{ arg } = undef;
281             }
282              
283             # special cases
284 6 50       39 if( $opnum == $OPS{ macro_begin } ) {
    50          
    50          
    50          
285 0         0 my $name = $code->[ $i ]->{ arg };
286 0 0       0 if(!exists $st->symbol->{$name}) {
287 0         0 require Text::Xslate::PP::Type::Macro;
288 0         0 $macro = Text::Xslate::PP::Type::Macro->new(
289             name => $name,
290             addr => $i,
291             state => $st,
292             );
293 0         0 $st->symbol->{ $name } = $macro;
294             }
295             else {
296 0         0 $macro = undef;
297             }
298             }
299             elsif( $opnum == $OPS{ macro_nargs } ) {
300 0 0       0 if($macro) {
301 0         0 $macro->nargs($code->[$i]->{arg});
302             }
303             }
304             elsif( $opnum == $OPS{ macro_outer } ) {
305 0 0       0 if($macro) {
306 0         0 $macro->outer($code->[$i]->{arg});
307             }
308             }
309             elsif( $opnum == $OPS{ depend } ) {
310 0         0 push @{ $tmpl }, $code->[ $i ]->{ arg };
  0         0  
311             }
312              
313             }
314              
315 1         5 push @{$code}, {
316 1         1 exec_code => $OPCODE[ $OPS{end} ],
317             file => $oi_file,
318             line => $oi_line,
319             opname => 'end',
320             }; # for threshold
321 1         4 return;
322             }
323              
324             {
325             package
326             Text::Xslate::Util;
327              
328             sub escaped_string; *escaped_string = \&mark_raw;
329             sub mark_raw {
330 1     1 1 7 my($str) = @_;
331 1 50       8 if(defined $str) {
332 1 50       15 return ref($str) eq Text::Xslate::PP::TXt_RAW()
333             ? $str
334             : bless \$str, Text::Xslate::PP::TXt_RAW();
335             }
336 0         0 return $str; # undef
337             }
338             sub unmark_raw {
339 0     0 1 0 my($str) = @_;
340             return ref($str) eq Text::Xslate::PP::TXt_RAW()
341 0 0       0 ? ${$str}
  0         0  
342             : $str;
343             }
344              
345             sub html_escape {
346 0     0 1 0 my($s) = @_;
347 0 0 0     0 return $s if
348             ref($s) eq Text::Xslate::PP::TXt_RAW()
349             or !defined($s);
350              
351 0         0 $s =~ s/($html_metachars)/$html_escape{$1}/xmsgeo;
  0         0  
352 0         0 return bless \$s, Text::Xslate::PP::TXt_RAW();
353             }
354              
355             my $uri_unsafe_rfc3986 = qr/[^A-Za-z0-9\-\._~]/;
356             sub uri_escape {
357 0     0 1 0 my($s) = @_;
358 0 0       0 return $s if not defined $s;
359             # XXX: This must be the same as uri_escape() in XS.
360             # See also tx_uri_escape() in xs/Text-Xslate.xs.
361 0 0       0 utf8::encode($s) if utf8::is_utf8($s);
362 0         0 $s =~ s/($uri_unsafe_rfc3986)/sprintf '%%' . '%02X', ord $1/xmsgeo;
  0         0  
363 0         0 return $s;
364             }
365              
366 0     0 0 0 sub is_array_ref { ref($_[0]) eq 'ARRAY' }
367 0     0 0 0 sub is_hash_ref { ref($_[0]) eq 'HASH' }
368 0     0 0 0 sub is_code_ref { ref($_[0]) eq 'CODE' }
369              
370 0     0 0 0 sub merge_hash { +{ %{ $_[0] }, %{ $_[1] } } }
  0         0  
  0         0  
371             }
372              
373             #
374             # INTERNAL
375             #
376              
377             sub tx_check_itr_ar {
378 0     0 0 0 my ( $st, $ar, $frame, $line ) = @_;
379 0 0       0 return $ar if ref($ar) eq 'ARRAY';
380              
381 0 0       0 if ( defined $ar ) {
382 0 0       0 if(my $x = Text::Xslate::PP::sv_is_ref($ar, 'ARRAY', '@{}')) {
383 0         0 return $x;
384             }
385              
386 0         0 $st->error( [$frame, $line],
387             "Iterator variables must be an ARRAY reference, not %s",
388             Text::Xslate::Util::neat( $ar ) );
389             }
390 0         0 return [];
391             }
392              
393             sub sv_is_ref {
394 0     0 0 0 my($sv, $t, $ov) = @_;
395 0 0       0 return $sv if ref($sv) eq $t;
396              
397 0 0 0     0 if(Scalar::Util::blessed($sv)
398             && (my $m = overload::Method($sv, $ov))) {
399 0         0 $sv = $sv->$m(undef, undef);
400 0 0       0 return $sv if ref($sv) eq $t;
401             }
402 0         0 return undef;
403             }
404              
405             sub tx_sv_eq {
406 0     0 0 0 my($x, $y) = @_;
407 0 0       0 if ( defined $x ) {
408 0   0     0 return defined $y && $x eq $y;
409             }
410             else {
411 0         0 return !defined $y;
412             }
413             }
414              
415             sub tx_match { # simple smart matching
416 0     0 0 0 my($x, $y) = @_;
417              
418 0 0       0 if(ref($y) eq 'ARRAY') {
    0          
    0          
419 0         0 foreach my $item(@{$y}) {
  0         0  
420 0 0       0 if(defined($item)) {
421 0 0 0     0 if(defined($x) && $x eq $item) {
422 0         0 return 1;
423             }
424             }
425             else {
426 0 0       0 if(not defined($x)) {
427 0         0 return 1;
428             }
429             }
430             }
431 0         0 return '';
432             }
433             elsif(ref($y) eq 'HASH') {
434 0   0     0 return defined($x) && exists $y->{$x};
435             }
436             elsif(defined($y)) {
437 0   0     0 return defined($x) && $x eq $y;
438             }
439             else {
440 0         0 return !defined($x);
441             }
442             }
443              
444             sub tx_concat {
445 0     0 0 0 my($lhs, $rhs) = @_;
446 0 0       0 if(ref($lhs) eq TXt_RAW) {
447 0 0       0 if(ref($rhs) eq TXt_RAW) {
448 0         0 return Text::Xslate::Util::mark_raw(${ $lhs } . ${ $rhs });
  0         0  
  0         0  
449             }
450             else {
451 0         0 return Text::Xslate::Util::mark_raw(${ $lhs } . Text::Xslate::Util::html_escape($rhs));
  0         0  
452             }
453             }
454             else {
455 0 0       0 if(ref($rhs) eq TXt_RAW) {
456 0         0 return Text::Xslate::Util::mark_raw(Text::Xslate::Util::html_escape($lhs) . ${ $rhs });
  0         0  
457             }
458             else {
459 0         0 return $lhs . $rhs;
460             }
461             }
462             }
463              
464             sub tx_repeat {
465 0     0 0 0 my($lhs, $rhs) = @_;
466 0 0       0 if(!defined($lhs)) {
    0          
467 0         0 $_current_st->warn(undef, "Use of nil for repeat operator");
468             }
469             elsif(!Scalar::Util::looks_like_number($rhs)) {
470 0         0 $_current_st->error(undef, "Repeat count must be a number, not %s",
471             Text::Xslate::Util::neat($rhs));
472             }
473             else {
474 0 0       0 if( ref( $lhs ) eq TXt_RAW ) {
475 0         0 return Text::Xslate::Util::mark_raw( Text::Xslate::Util::unmark_raw($lhs) x $rhs );
476             }
477             else {
478 0         0 return $lhs x $rhs;
479             }
480             }
481 0         0 return '';
482             }
483              
484              
485             sub tx_load_template {
486 1     1 0 3 my ( $self, $name, $from_include ) = @_;
487              
488 1 50       3 unless ( ref $self ) {
489 0         0 Carp::croak( "Invalid xslate instance" );
490             }
491              
492 1         3 my $ttable = $self->{ template };
493 1         2 my $retried = 0;
494              
495 1 50       3 if(ref $ttable ne 'HASH' ) {
496 0         0 Carp::croak(
497             sprintf( "Xslate: Cannot load template '%s': %s", $name, "template table is not a HASH reference" )
498             );
499             }
500              
501             RETRY:
502 1 50       4 if( $retried > 1 ) {
503 0         0 Carp::croak(
504             sprintf( "Xslate: Cannot load template '%s': %s", $name, "retried reloading, but failed" )
505             );
506             }
507              
508 1 50       8 if ( not exists $ttable->{ $name } ) {
509 0         0 $self->load_file( $name, undef, $from_include );
510 0         0 $retried++;
511 0         0 goto RETRY;
512             }
513              
514 1         2 my $tmpl = $ttable->{ $name };
515              
516 1 50 33     13 if(ref($tmpl) ne 'ARRAY' or not exists $self->{tmpl_st}{$name}) {
517 0         0 Carp::croak(
518             sprintf( "Xslate: Cannot load template '%s': template entry is invalid", $name ),
519             );
520             }
521              
522 1         3 my $cache_mtime = $tmpl->[ TXo_MTIME ];
523              
524 1 50       3 if(not defined $cache_mtime) { # cache => 2 (release mode)
525 1         3 return $self->{ tmpl_st }->{ $name };
526             }
527              
528 0 0 0     0 if( $retried > 0 or tx_all_deps_are_fresh( $tmpl, $cache_mtime ) ) {
529 0         0 return $self->{ tmpl_st }->{ $name };
530             }
531             else{
532 0         0 $self->load_file( $name, $cache_mtime, $from_include );
533 0         0 $retried++;
534 0         0 goto RETRY;
535             }
536              
537 0         0 Carp::croak("Oops: Not reached");
538             }
539              
540              
541             sub tx_all_deps_are_fresh {
542 0     0 0 0 my ( $tmpl, $cache_mtime ) = @_;
543 0         0 my $len = scalar @{$tmpl};
  0         0  
544              
545 0         0 for ( my $i = TXo_FULLPATH; $i < $len; $i++ ) {
546 0         0 my $deppath = $tmpl->[ $i ];
547              
548 0 0       0 next if ref $deppath;
549              
550 0         0 my $mtime = ( stat( $deppath ) )[9];
551 0 0 0     0 if ( defined($mtime) and $mtime > $cache_mtime ) {
552 0         0 my $main_cache = $tmpl->[ TXo_CACHEPATH ];
553 0 0 0     0 if ( $i != TXo_FULLPATH and $main_cache ) {
554 0 0       0 unlink $main_cache or warn $!;
555             }
556 0         0 if(_DUMP_LOAD) {
557             printf STDERR " tx_all_depth_are_fresh: %s is too old (%d > %d)\n",
558             $deppath, $mtime, $cache_mtime;
559             }
560 0         0 return 0;
561             }
562              
563             }
564              
565 0         0 return 1;
566             }
567              
568             sub tx_execute {
569 1     1 0 2 my ( $st, $vars ) = @_;
570 1     1   7 no warnings 'recursion';
  1         1  
  1         664  
571              
572 1 50       4 if ( $_depth > 100 ) {
573 0         0 Carp::croak("Execution is too deep (> 100)");
574             }
575 1         2 if(_PP_ERROR_VERBOSE and ref $st->{code}->[0]->{ exec_code } ne 'CODE') {
576             Carp::croak("Oops: Not a CODE reference: "
577             . Text::Xslate::Util::neat($st->{code}->[0]->{ exec_code }));
578             }
579              
580 1         3 local $st->{pc} = 0;
581 1         2 local $st->{vars} = $vars;
582              
583 1         2 local $_depth = $_depth + 1;
584 1         3 local $_current_st = $st;
585              
586 1         2 local $st->{local_stack};
587 1         2 local $st->{SP} = [];
588              
589 1         3 local $st->{sa};
590 1         9 local $st->{sb};
591 1         3 local $st->{output} = '';
592              
593 1         3 local $st->{current_frame} = $st->{current_frame};
594              
595 1         2 eval {
596 1         6 $st->{code}->[0]->{ exec_code }->( $st );
597             };
598              
599 1         2 @{$st->{frame}->[-1]} = Text::Xslate::PP::TXframe_START_LVAR - 1;
  1         3  
600              
601 1 50       4 if ($@) {
602 0         0 my $e = $@;
603 0         0 die $e;
604             }
605 1         14 return $st->{output};
606             }
607              
608              
609             sub _error_handler {
610 0     0     my ( $str, $die ) = @_;
611 0           my $st = $_current_st;
612              
613 0           local $SIG{__WARN__} = $_orig_warn_handler;
614 0           local $SIG{__DIE__} = $_orig_die_handler;
615              
616 0 0         if(!_PP_ERROR_VERBOSE && $str =~ s/at .+Text.Xslate.PP.+ line \d+\.\n$//) {
617 0           $str = Carp::shortmess($str);
618             }
619              
620 0 0         Carp::croak( $str ) unless defined $st;
621              
622 0           my $engine = $st->engine;
623              
624 0           my $cframe = $st->frame->[ $st->current_frame ];
625 0           my $name = $cframe->[ Text::Xslate::PP::TXframe_NAME ];
626              
627 0           my $opcode = $st->code->[ $st->{ pc } ];
628 0           my $file = $opcode->{file};
629 0 0 0       if($file eq '' && exists $engine->{string_buffer}) {
630 0           $file = \$engine->{string_buffer};
631             }
632              
633             my $mess = Text::Xslate::Util::make_error($engine, $str, $file, $opcode->{line},
634 0           sprintf( "&%s[%d]", $name, $st->{pc} ));
635              
636 0 0         if ( !$die ) {
637             # $h can ignore warnings
638 0 0         if ( my $h = $engine->{ warn_handler } ) {
639 0           $h->( $mess );
640             }
641             else {
642 0           warn $mess;
643             }
644             }
645             else {
646             # $h cannot ignore errors
647 0 0         if(my $h = $engine->{ die_handler } ) {
648 0           $h->( $mess );
649             }
650 0           die $mess; # MUST DIE!
651             }
652 0           return;
653             }
654              
655             sub _warn {
656 0     0     _error_handler( $_[0], 0 );
657             }
658              
659             sub _die {
660 0     0     _error_handler( $_[0], 1 );
661             }
662              
663             {
664             package
665             Text::Xslate::PP::Guard;
666              
667 0     0     sub DESTROY { $_[0]->() }
668             }
669              
670             1;
671             __END__