File Coverage

blib/lib/Text/Xslate/PP.pm
Criterion Covered Total %
statement 141 318 44.3
branch 32 154 20.7
condition 3 38 7.8
subroutine 22 46 47.8
pod 4 25 16.0
total 202 581 34.7


line stmt bran cond sub pod time code
1             package Text::Xslate::PP;
2             # Text::Xslate in pure Perl
3 1     1   18138 use 5.008_001;
  1         5  
4 1     1   6 use strict;
  1         2  
  1         71  
5              
6             our $VERSION = '3.4.0';
7              
8             BEGIN{
9 1   50 1   30 $ENV{XSLATE} = ($ENV{XSLATE} || '') . '[pp]';
10             }
11              
12 1         1010 use Text::Xslate::Util qw(
13             $DEBUG
14             p
15 1     1   421 );
  1         2  
16              
17 1     1   7 use constant _PP_ERROR_VERBOSE => scalar($DEBUG =~ /\b pp=verbose \b/xms);
  1         1  
  1         87  
18              
19 1     1   4 use constant _DUMP_LOAD => scalar($DEBUG =~ /\b dump=load \b/xms);
  1         1  
  1         39  
20              
21 1     1   456 use Text::Xslate::PP::Const qw(:all);
  1         2  
  1         223  
22 1     1   340 use Text::Xslate::PP::State;
  1         3  
  1         49  
23 1     1   571 use Text::Xslate::PP::Type::Raw;
  1         2  
  1         28  
24 1     1   446 use Text::Xslate::PP::Opcode;
  1         77  
  1         29  
25 1     1   6 use Text::Xslate::PP::Method;
  1         1  
  1         17  
26              
27 1     1   3 use Scalar::Util ();
  1         1  
  1         11  
28 1     1   3 use overload ();
  1         2  
  1         9  
29 1     1   3 use Carp ();
  1         1  
  1         2500  
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         7 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 2 my($self, $string, $vars) = @_;
81 1         7 $self->load_string($string);
82 1         4 return $self->render('', $vars);
83             }
84              
85             sub render {
86 1     1 0 2 my ( $self, $name, $vars ) = @_;
87              
88 1 50 33     6 Carp::croak("Usage: Text::Xslate::render(self, name, vars)")
89             if !( @_ == 2 or @_ == 3 );
90 1 50       3 unless ( ref $self ) {
91 0         0 Carp::croak( "Invalid xslate instance" );
92             }
93              
94 1 50       6 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       3 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         6 my $st = $self->tx_load_template( $name, 0 );
107              
108 1         3 local $_orig_die_handler = $SIG{__DIE__};
109 1         2 local $_orig_warn_handler = $SIG{__WARN__};
110 1         4 local $SIG{__DIE__} = \&_die;
111 1         3 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   2 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         24 my $st = $state_class->new();
179              
180 1         82 $st->symbol({ %{$self->{ function }} });
  1         16  
181              
182 1         2 my $tmpl = [];
183              
184 1         2 $self->{ template }->{ $name } = $tmpl;
185 1         3 $self->{ tmpl_st }->{ $name } = $st;
186              
187 1         1 $tmpl->[ Text::Xslate::PP::TXo_MTIME ] = $mtime;
188 1         1 $tmpl->[ Text::Xslate::PP::TXo_CACHEPATH ] = $cachepath;
189 1         2 $tmpl->[ Text::Xslate::PP::TXo_FULLPATH ] = $fullpath;
190              
191 1         3 $st->tmpl( $tmpl );
192 1         4 $st->engine( $self ); # weak_ref!
193              
194 1         5 $st->{sa} = undef;
195 1         1 $st->{sb} = undef;
196              
197             # stack frame
198 1         3 $st->frame( [] );
199 1         3 $st->current_frame( -1 );
200              
201 1         2 my $len = scalar( @$asm );
202              
203 1         5 $st->push_frame('main', $len);
204              
205 1         5 $st->code_len( $len );
206              
207 1         3 my $code = $st->code([]);
208 1         1 my $macro;
209              
210 1         2 my $oi_line = -1;
211 1         1 my $oi_file = $name;
212 1         3 for ( my $i = 0; $i < $len; $i++ ) {
213 6         3 my $c = $asm->[ $i ];
214              
215 6 50       13 if ( ref $c ne 'ARRAY' ) {
216 0         0 Carp::croak( sprintf( "Oops: Broken code found on [%d]", $i ) );
217             }
218              
219 6         4 my ( $opname, $arg, $line, $file ) = @{$c};
  6         7  
220 6         7 my $opnum = $OPS{ $opname };
221              
222 6 50       15 unless ( defined $opnum ) {
223 0         0 Carp::croak( sprintf( "Oops: Unknown opcode '%s' on [%d]", $opname, $i ) );
224             }
225              
226 6 100       10 if(defined $line) {
227 5         6 $oi_line = $line;
228             }
229 6 100       7 if(defined $file) {
230 1         1 $oi_file = $file;
231             }
232              
233 6         9 $code->[$i] = {
234             # opcode
235             opname => $opname,
236              
237             # opinfo
238             line => $oi_line,
239             file => $oi_file,
240             };
241              
242 6         8 $code->[ $i ]->{ exec_code } = $OPCODE[ $opnum ];
243              
244 6         5 my $oparg = $OPARGS[ $opnum ];
245              
246 6 100       8 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       7 if( $oparg & TXARGf_KEY ) {
    50          
253 1         2 $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         2 $code->[ $i ]->{ arg } = $arg;
273             }
274              
275             }
276             else {
277 3 50       4 if( defined $arg ) {
278 0         0 Carp::croak( sprintf( "Oops: Opcode %s has an extra argument on [%d]", $opname, $i ) );
279             }
280 3         3 $code->[ $i ]->{ arg } = undef;
281             }
282              
283             # special cases
284 6 50       23 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         4 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         2 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 6 my($str) = @_;
331 1 50       7 if(defined $str) {
332 1 50       13 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 (!defined $lhs){
    0          
447 0         0 return $rhs;
448             }elsif(!defined $rhs){
449 0         0 return $lhs;
450             }
451 0 0       0 if(ref($lhs) eq TXt_RAW) {
452 0 0       0 if(ref($rhs) eq TXt_RAW) {
453 0         0 return Text::Xslate::Util::mark_raw(${ $lhs } . ${ $rhs });
  0         0  
  0         0  
454             }
455             else {
456 0         0 return Text::Xslate::Util::mark_raw(${ $lhs } . Text::Xslate::Util::html_escape($rhs));
  0         0  
457             }
458             }
459             else {
460 0 0       0 if(ref($rhs) eq TXt_RAW) {
461 0         0 return Text::Xslate::Util::mark_raw(Text::Xslate::Util::html_escape($lhs) . ${ $rhs });
  0         0  
462             }
463             else {
464 0         0 return $lhs . $rhs;
465             }
466             }
467             }
468              
469             sub tx_repeat {
470 0     0 0 0 my($lhs, $rhs) = @_;
471 0 0       0 if(!defined($lhs)) {
    0          
472 0         0 $_current_st->warn(undef, "Use of nil for repeat operator");
473             }
474             elsif(!Scalar::Util::looks_like_number($rhs)) {
475 0         0 $_current_st->error(undef, "Repeat count must be a number, not %s",
476             Text::Xslate::Util::neat($rhs));
477             }
478             else {
479 0 0       0 if( ref( $lhs ) eq TXt_RAW ) {
480 0         0 return Text::Xslate::Util::mark_raw( Text::Xslate::Util::unmark_raw($lhs) x $rhs );
481             }
482             else {
483 0         0 return $lhs x $rhs;
484             }
485             }
486 0         0 return '';
487             }
488              
489              
490             sub tx_load_template {
491 1     1 0 1 my ( $self, $name, $from_include ) = @_;
492              
493 1 50       2 unless ( ref $self ) {
494 0         0 Carp::croak( "Invalid xslate instance" );
495             }
496              
497 1         2 my $ttable = $self->{ template };
498 1         1 my $retried = 0;
499              
500 1 50       5 if(ref $ttable ne 'HASH' ) {
501 0         0 Carp::croak(
502             sprintf( "Xslate: Cannot load template '%s': %s", $name, "template table is not a HASH reference" )
503             );
504             }
505              
506             RETRY:
507 1 50       3 if( $retried > 1 ) {
508 0         0 Carp::croak(
509             sprintf( "Xslate: Cannot load template '%s': %s", $name, "retried reloading, but failed" )
510             );
511             }
512              
513 1 50       3 if ( not exists $ttable->{ $name } ) {
514 0         0 $self->load_file( $name, undef, $from_include );
515 0         0 $retried++;
516 0         0 goto RETRY;
517             }
518              
519 1         1 my $tmpl = $ttable->{ $name };
520              
521 1 50 33     7 if(ref($tmpl) ne 'ARRAY' or not exists $self->{tmpl_st}{$name}) {
522 0         0 Carp::croak(
523             sprintf( "Xslate: Cannot load template '%s': template entry is invalid", $name ),
524             );
525             }
526              
527 1         2 my $cache_mtime = $tmpl->[ TXo_MTIME ];
528              
529 1 50       2 if(not defined $cache_mtime) { # cache => 2 (release mode)
530 1         2 return $self->{ tmpl_st }->{ $name };
531             }
532              
533 0 0 0     0 if( $retried > 0 or tx_all_deps_are_fresh( $tmpl, $cache_mtime ) ) {
534 0         0 return $self->{ tmpl_st }->{ $name };
535             }
536             else{
537 0         0 $self->load_file( $name, $cache_mtime, $from_include );
538 0         0 $retried++;
539 0         0 goto RETRY;
540             }
541              
542 0         0 Carp::croak("Oops: Not reached");
543             }
544              
545              
546             sub tx_all_deps_are_fresh {
547 0     0 0 0 my ( $tmpl, $cache_mtime ) = @_;
548 0         0 my $len = scalar @{$tmpl};
  0         0  
549              
550 0         0 for ( my $i = TXo_FULLPATH; $i < $len; $i++ ) {
551 0         0 my $deppath = $tmpl->[ $i ];
552              
553 0 0       0 next if ref $deppath;
554              
555 0         0 my $mtime = ( stat( $deppath ) )[9];
556 0 0 0     0 if ( defined($mtime) and $mtime > $cache_mtime ) {
557 0         0 my $main_cache = $tmpl->[ TXo_CACHEPATH ];
558 0 0 0     0 if ( $i != TXo_FULLPATH and $main_cache ) {
559 0 0       0 unlink $main_cache or warn $!;
560             }
561 0         0 if(_DUMP_LOAD) {
562             printf STDERR " tx_all_depth_are_fresh: %s is too old (%d > %d)\n",
563             $deppath, $mtime, $cache_mtime;
564             }
565 0         0 return 0;
566             }
567              
568             }
569              
570 0         0 return 1;
571             }
572              
573             sub tx_execute {
574 1     1 0 1 my ( $st, $vars ) = @_;
575 1     1   6 no warnings 'recursion';
  1         2  
  1         579  
576              
577 1 50       3 if ( $_depth > 100 ) {
578 0         0 Carp::croak("Execution is too deep (> 100)");
579             }
580 1         3 if(_PP_ERROR_VERBOSE and ref $st->{code}->[0]->{ exec_code } ne 'CODE') {
581             Carp::croak("Oops: Not a CODE reference: "
582             . Text::Xslate::Util::neat($st->{code}->[0]->{ exec_code }));
583             }
584              
585 1         3 local $st->{pc} = 0;
586 1         1 local $st->{vars} = $vars;
587              
588 1         2 local $_depth = $_depth + 1;
589 1         1 local $_current_st = $st;
590              
591 1         1 local $st->{local_stack};
592 1         4 local $st->{SP} = [];
593              
594 1         2 local $st->{sa};
595 1         2 local $st->{sb};
596 1         2 local $st->{output} = '';
597              
598 1         1 local $st->{current_frame} = $st->{current_frame};
599              
600 1         2 eval {
601 1         5 $st->{code}->[0]->{ exec_code }->( $st );
602             };
603              
604 1         2 @{$st->{frame}->[-1]} = Text::Xslate::PP::TXframe_START_LVAR - 1;
  1         3  
605              
606 1 50       4 if ($@) {
607 0         0 my $e = $@;
608 0         0 die $e;
609             }
610 1         10 return $st->{output};
611             }
612              
613              
614             sub _error_handler {
615 0     0     my ( $str, $die ) = @_;
616 0           my $st = $_current_st;
617              
618 0           local $SIG{__WARN__} = $_orig_warn_handler;
619 0           local $SIG{__DIE__} = $_orig_die_handler;
620              
621 0 0         if(!_PP_ERROR_VERBOSE && $str =~ s/at .+Text.Xslate.PP.+ line \d+\.\n$//) {
622 0           $str = Carp::shortmess($str);
623             }
624              
625 0 0         Carp::croak( $str ) unless defined $st;
626              
627 0           my $engine = $st->engine;
628              
629 0           my $cframe = $st->frame->[ $st->current_frame ];
630 0           my $name = $cframe->[ Text::Xslate::PP::TXframe_NAME ];
631              
632 0           my $opcode = $st->code->[ $st->{ pc } ];
633 0           my $file = $opcode->{file};
634 0 0 0       if($file eq '' && exists $engine->{string_buffer}) {
635 0           $file = \$engine->{string_buffer};
636             }
637              
638             my $mess = Text::Xslate::Util::make_error($engine, $str, $file, $opcode->{line},
639 0           sprintf( "&%s[%d]", $name, $st->{pc} ));
640              
641 0 0         if ( !$die ) {
642             # $h can ignore warnings
643 0 0         if ( my $h = $engine->{ warn_handler } ) {
644 0           $h->( $mess );
645             }
646             else {
647 0           warn $mess;
648             }
649             }
650             else {
651             # $h cannot ignore errors
652 0 0         if(my $h = $engine->{ die_handler } ) {
653 0           $h->( $mess );
654             }
655 0           die $mess; # MUST DIE!
656             }
657 0           return;
658             }
659              
660             sub _warn {
661 0     0     _error_handler( $_[0], 0 );
662             }
663              
664             sub _die {
665 0     0     _error_handler( $_[0], 1 );
666             }
667              
668             {
669             package
670             Text::Xslate::PP::Guard;
671              
672 0     0     sub DESTROY { $_[0]->() }
673             }
674              
675             1;
676             __END__