File Coverage

blib/lib/Text/TemplateLite/Standard.pm
Criterion Covered Total %
statement 219 237 92.4
branch 74 116 63.7
condition 36 50 72.0
subroutine 48 49 97.9
pod 45 45 100.0
total 422 497 84.9


line stmt bran cond sub pod time code
1             package Text::TemplateLite::Standard;
2              
3 10     10   363479 use 5.006;
  10         41  
  10         427  
4 10     10   65 use strict;
  10         24  
  10         340  
5 10     10   60 use warnings;
  10         29  
  10         327  
6 10     10   58 use Scalar::Util qw(looks_like_number);
  10         18  
  10         82324  
7              
8             =head1 NAME
9              
10             Text::TemplateLite::Standard - Standard function library for templates
11             using Text::TemplateLite
12              
13             =head1 VERSION
14              
15             Version 0.03
16              
17             =cut
18              
19             our $VERSION = '0.03';
20              
21             our %map = (
22              
23             # Conditional and logical
24              
25             '?' => \&fn_ifeach,
26             ifea => \&fn_ifeach,
27             '??' => \&fn_ifelse,
28             ifel => \&fn_ifelse,
29              
30             ':conditional' => [ qw/ ? ifea ?? ifel / ],
31              
32             '&&' => \&fn_log_and,
33             '||' => \&fn_log_or,
34             '!' => \&fn_log_not,
35              
36             ':logical' => [ qw/ && || ! / ],
37              
38             # Iteration
39              
40             '?*' => \&fn_test_rpt, # test/execute/repeat (like while)
41             wh => \&fn_test_rpt,
42             '*?' => \&fn_test_rpt, # execute/test/repeat (like do-while)
43             dowh => \&fn_test_rpt,
44              
45             ':iteration' => [ qw/ ?* wh *? dowh / ],
46              
47             # Character/string
48              
49             cr => sub { "\r"; },
50             gg => sub { ">>"; },
51             ht => sub { "\t"; },
52             lf => sub { "\n"; },
53             ll => sub { "<<"; },
54             nl => sub { "\n"; },
55             sp => sub { " "; },
56              
57             ':character' => [ qw/ cr gg ht lf ll nl sp / ],
58              
59             '$;' => \&fn_join,
60             join => \&fn_join,
61             '$;;' => \&fn_join4,
62             join4 => \&fn_join4,
63             len => \&fn_length,
64             '$/' => \&fn_split,
65             split => \&fn_split,
66             '$-' => \&fn_substr,
67             substr => \&fn_substr,
68             trim => \&fn_trim,
69              
70             x => \&fn_str_rpt,
71              
72             cmp => \&fn_scmp,
73             eq => \&fn_seq,
74             ge => \&fn_sge,
75             gt => \&fn_sgt,
76             le => \&fn_sle,
77             lt => \&fn_slt,
78             ne => \&fn_sne,
79              
80             ':string' => [ qw{ $; join $;; join4 len $/ split $- substr trim
81             cmp eq ge gt le lt ne } ],
82              
83             # Numeric
84              
85             '+' => \&fn_add,
86             '-' => \&fn_neg_sub,
87             '*' => \&fn_mul,
88             '/' => \&fn_div,
89             '%' => \&fn_mod,
90              
91             int => \&fn_int,
92             max => \&fn_max,
93             min => \&fn_min,
94              
95             '<=>' => \&fn_ncmp,
96             '=' => \&fn_neq,
97             '>=' => \&fn_nge,
98             '>' => \&fn_ngt,
99             '<=' => \&fn_nle,
100             '<' => \&fn_nlt,
101             '!=' => \&fn_nne,
102              
103             '&' => \&fn_bin_and,
104             '|' => \&fn_bin_or,
105             '^' => \&fn_bin_xor,
106             '~' => \&fn_complement,
107              
108             ':numeric' => [ qw{ + - * / % int max min <=> = >= > <= < != / } ],
109             ':bitwise' => [ qw/ & | ^ ~ / ],
110              
111             # Template function
112              
113             tpl => \&fn_set_template,
114             '<$>' => \&fn_ext_equal,
115              
116             ':template' => [ qw/ tpl <$> / ],
117              
118             # Miscellaneous
119              
120             '$=' => \&fn_var_equal,
121             void => \&fn_void,
122              
123             ':misc' => [ qw/ $= void / ],
124             ':miscellaneous' => ':misc',
125              
126             # More groups
127              
128             ':basic' => [ qw/ :conditional :logical :character :string
129             :numeric :bitwise :misc / ],
130              
131             ':all' => [ qw/ :basic :iteration x :template / ],
132              
133             );
134              
135             =head1 SYNOPSIS
136              
137             use Text::TemplateLite;
138             use Text::TemplateLite::Standard;
139              
140             my $ttl = Text::TemplateLite->new;
141              
142             # Register basic functions
143             Text::TemplateLite::Standard::register($ttl, ':basic');
144              
145             # Register all functions
146             Text::TemplateLite::Standard::register($ttl, ':all');
147              
148             # Register specific functions
149             Text::TemplateLite::Standard::register($ttl, @list);
150              
151             =head1 DESCRIPTION
152              
153             This module provides a library of standard functions for templates using
154             Text::TemplateLite.
155              
156             =head1 PERL FUNCTIONS
157              
158             The functions in this section can be called from Perl code. The other
159             sections describe functions that can be added to and called from
160             L template engines.
161              
162             =head2 register($template, @list)
163              
164             This registers the specified functions or function-group tags with the
165             specified template engine. It returns the template engine.
166              
167             The template engine must respond to the method
168             L<"register($name, $definition)">, where C<$definition> is a coderef
169             expecting three parameters: the name of the function as called from
170             the template, an arrayref of parameter code sequences, and an object
171             instance compatible with L.
172              
173             =cut
174              
175             sub register {
176 29     29 1 1252 my ($ttl, @list) = @_;
177 29         44 my ($mapping, $type);
178              
179 29         61 foreach (@list) {
180 141         1122 $type = ref($mapping = $map{$_});
181              
182 141 100       330 if ($type eq 'CODE') {
    50          
183 122         432 $ttl->register($_, $mapping);
184             } elsif ($type eq 'ARRAY') {
185 19         75 register($ttl, @$mapping);
186             }
187             }
188              
189 29         204 return $ttl;
190             }
191              
192             =head2 get_numbers($args, $renderer)
193              
194             This is a helper function to evaluate and return parameters as
195             numbers. (Non-numbers are returned as 0.)
196              
197             =cut
198              
199             sub get_numbers {
200 48     48 1 69 my ($args, $renderer) = @_;
201 48         137 my @args = $renderer->execute_each($args);
202              
203 48         3674 foreach (@args) {
204 81 50       381 $_ = 0 unless looks_like_number($_);
205             }
206              
207 48         141 return @args;
208             }
209              
210             =head1 FUNCTION GROUP TAGS
211              
212             Use these tags to conveniently register groups of related functions.
213              
214             =over
215              
216             =item :logical
217              
218             &&, !!, and !
219              
220             =item :conditional
221              
222             ?, ifea, ??, and ifel
223              
224             =item :iteration
225              
226             ?*, wh, *?, and dowh
227              
228             =item :character
229              
230             cr ("\r"), gg (">>"), ht ("\t"), lf ("\n"), ll ("<<"), nl ("\n"), and sp (" ")
231              
232             =item :string
233              
234             $;, join, $;;, join4, len, $-, substr,
235             cmp, eq, ge, gt, le, lt, and ne
236              
237             =item :numeric
238              
239             +, -, *, /, %, int, max, min,
240             <=>, =, >=, >, <=, <, and !=
241              
242             =item :bitwise
243              
244             &, |, and !
245              
246             =item :template
247              
248             tpl, <$>
249              
250             =item :misc or :miscellaneous
251              
252             $=, void
253              
254             =item :basic
255              
256             :conditional, :logical, :character, :string, :numeric,
257             :bitwise, and :misc
258              
259             =item :all
260              
261             :basic, x, :iteration, and :template
262              
263             =back
264              
265             =head1 LOGICAL FUNCTIONS
266              
267             =head2 &&(condition, ...)
268              
269             This function, "logical and", evaluates each condition in turn. If any
270             condition is empty or zero, evaluation stops and "0" is returned. If
271             all conditions are true, "1" is returned.
272              
273             =cut
274              
275             sub fn_log_and {
276 2     2 1 3599 my ($name, $args, $renderer) = @_;
277 2         3 my $value;
278              
279 2         5 foreach (@$args) {
280 5         19 $value = $renderer->execute_sequence($_);
281 5 100 66     170 return 0 unless length($value) && $value ne '0';
282             }
283              
284 1         6 return 1;
285             }
286              
287             =head2 ||(condition, ...)
288              
289             This function, "logical or", evaluates each condition in turn. If any
290             condition is non-empty and non-zero, evaluation stops and "1" is
291             returned. If all conditions are false, "0" is returned.
292              
293             =cut
294              
295             sub fn_log_or {
296 2     2 1 3726 my ($name, $args, $renderer) = @_;
297 2         4 my $value;
298              
299 2         6 foreach (@$args) {
300 5         15 $value = $renderer->execute_sequence($_);
301 5 100 100     141 return 1 if length($value) && $value ne '0';
302             }
303              
304 1         6 return 0;
305             }
306              
307             =head2 !(condition)
308              
309             This function, "logical not", evaluates the condition. If it is non-empty
310             and non-zero, the result is "0". Otherwise, the result is "1".
311              
312             =cut
313              
314             sub fn_log_not {
315 4     4 1 2853 my ($name, $args, $renderer) = @_;
316 4         15 my $value = $renderer->execute_sequence($args->[0]);
317              
318 4 50 66     151 return ((length($value) && $value ne '0')? 0: 1);
319             }
320              
321             =head1 CONDITIONAL FUNCTIONS
322              
323             =head2 ?(expression, ...)
324              
325             =head2 ifea(expression, ...)
326              
327             This function, "if each", returns each non-empty expression. Expressions
328             may be multi-valued.
329              
330             tpl('dear', 'Dear ' $;;(' and ', ', ', ', ', ', and ',
331             ?($1, $2, $3, $4, $5, $6, $7, $8, $9)) ',')
332             $dear('Dick', 'Jane') /* Dear Dick and Jane, */
333             $dear('Tom', 'Dick', 'Harry') /* Dear Tom, Dick, and Harry, */
334              
335             =cut
336              
337             sub fn_ifeach {
338 1     1 1 68 my ($name, $args, $renderer) = @_;
339              
340 1   66     4 return grep(defined && length, $renderer->execute_each($args));
341             }
342              
343             =head2 ??(condition, expression, ..., default?)
344              
345             =head2 ifel(condition, expression, ..., default?)
346              
347             This function, "if else", takes any number of (condition, expression) pairs,
348             optionally followed by a default. Each condition is evaluated in turn. The
349             (possibly multi-valued) expression corresponding to the first non-empty,
350             non-zero condition is evaluated and returned. If no conditions are satisifed,
351             the (possibly multi-valued) default expression is evaluated and returned
352             (if supplied).
353              
354             =cut
355              
356             sub fn_ifelse {
357 6     6 1 6966 my ($name, $args, $renderer) = @_;
358 6         18 my @args = @$args;
359 6         7 my ($cond, $ret);
360              
361 6         17 while (@args > 1) {
362 10         31 $cond = $renderer->execute_sequence(shift(@args));
363 10         436 $ret = shift(@args);
364              
365 10 100 100     142 return $renderer->execute_sequence($ret)
366             if length($cond) && $cond ne '0';
367             }
368              
369 3 50       14 return $renderer->execute_sequence($args[0]) if @args;
370 0 0       0 return wantarray? (): '';
371             }
372              
373             =head1 ITERATION FUNCTIONS
374              
375             =head2 ?*(condition, code)
376              
377             =head2 wh(condition, code)
378              
379             This function, "while", executes the specified code repeatedly as long as
380             the condition remains true (non-empty and non-zero). If the condition is
381             not initially true, the code will never be executed.
382              
383             It returns a list (in array context) or the concatenation of the results of
384             executing the code.
385              
386             =head2 *?(code, condition)
387              
388             =head2 dowh(code, condition)
389              
390             This function, "do-while", executes the specified code repeatedly as long
391             as the condition remains true (non-empty and non-zero). The code is
392             executed before the condition is evaluated and so will run at least once.
393              
394             It returns a list (in array context) or the concatenation of the results of
395             executing the code.
396              
397             =cut
398              
399             sub fn_test_rpt {
400 5     5 1 14150 my ($name, $args, $renderer) = @_;
401 5         12 my (@results, @temp, $code, $cond);
402 5         16 my $max_len = $renderer->{limits}{step_length};
403 5         7 my $value;
404              
405 5 100 66     44 if ($name ne '*?' && $name !~ /^do/) {
406             # test/exec/repeat (AKA "while") form (condition, code)
407 3         9 ($cond, $code) = @$args;
408 3         13 $value = $renderer->execute_sequence($cond);
409 3 50 66     165 return wantarray? (): '' unless length($value) && $value ne '0';
    100          
410             } else {
411             # exec/test/repeat (AKA "do while") form (code, condition)
412 2         7 ($code, $cond) = @$args;
413             }
414              
415 4   100     501 do {
      66        
416 10 50       516 if (defined($max_len)) {
417 0         0 push(@results, @temp = $renderer->execute_sequence($code));
418 0         0 $max_len -= length(join('', @temp));
419 0 0       0 $renderer->exceeded_limits('step_length') if $max_len < 0;
420             } else {
421 10         34 push(@results, $renderer->execute_sequence($code));
422             }
423 10         792 $value = $renderer->execute_sequence($cond);
424             } while (length($value) && $value ne '0' && !$renderer->exceeded_limits);
425              
426 4 50       180 return wantarray? @results: join('', @results);
427             }
428              
429             =head1 CHARACTERS
430              
431             cr ("\r"), gg (">>"), ht ("\t"), ll ("<<"), nl ("\n"), and sp (" ")
432              
433             =head1 STRING FUNCTIONS
434              
435             =head2 $;(separator, expression, ...)
436              
437             =head2 join(separator, expression, ...)
438              
439             This function returns the concatenation of all the values of all the
440             (possibly multi-valued) expression parameters, separated by separator.
441              
442             $;(',', 'a', 'b', 'c') /* a,b,c */
443             $;(',', 'a', ?('b', 'c')) /* a,b,c */
444             $;(',', 'a', ''?('b', 'c')) /* a,bc */
445              
446             =cut
447              
448             sub fn_join {
449 9     9 1 8149 my ($name, $args, $renderer) = @_;
450 9         34 my @args = $renderer->execute_each($args);
451 9         626 my $sep = shift(@args);
452              
453 9         61 return join($sep, @args);
454             }
455              
456             =head2 $;;(sep2, first_sep, middle_sep, last_sep, expression, ...)
457              
458             =head2 join4(sep2, first_sep, middle_sep, last_sep, expression, ...)
459              
460             This function returns the concatenation of all values of all expression
461             parameters, separated by separators. If there are exactly two values, only
462             the "sep2" separator is used. If there are three or more values, "first_sep"
463             is used first, "last_sep" is used last, and "middle_sep" is used between all
464             other values.
465              
466             The intent is to support "a and b" and "a, b, and c" styles of
467             context-dependent joins while working either left-to-right or right-to-left.
468              
469             =cut
470              
471             sub fn_join4 {
472 8     8 1 8125 my ($name, $args, $renderer) = @_;
473 8         25 my @args = $renderer->execute_each($args);
474 8         2087 my ($sep2, $sep1, $sep, $sepn) = splice(@args, 0, 4);
475              
476 8 50       28 return '' unless (@args);
477 8 100       31 return @args if (@args == 1);
478 6 100       27 return join($sep2, @args) if (@args == 2);
479              
480 4         7 my $first = shift(@args);
481 4         9 my $last = pop(@args);
482 4         27 return "$first$sep1" . join($sep, @args) . "$sepn$last";
483             }
484              
485             =head2 len(value)
486              
487             This function returns the length (in characters) of the specified value.
488              
489             =cut
490              
491             sub fn_length {
492 5     5 1 1480 my ($name, $args, $renderer) = @_;
493              
494 5         21 return length($renderer->execute_sequence($args->[0]));
495             }
496              
497             =head2 $/(separator, string, nth?)
498              
499             =head2 split(separator, string, nth?)
500              
501             This function splits the string into parts using the specified separator. If
502             nth is specified, that part (counting from 0) is returned. Otherwise, all
503             the parts are returned (as separate values).
504              
505             =cut
506              
507             sub fn_split {
508 3     3 1 1036 my ($name, $args, $renderer) = @_;
509 3         11 my $sep = $renderer->execute_sequence($args->[0]);
510 3         164 my $string = $renderer->execute_sequence($args->[1]);
511 3         170 my @parts = split(/\Q$sep/, $string);
512              
513 3 100       11 if (@$args > 2) {
514 1         4 my $nth = $renderer->execute_sequence($args->[2]);
515 1 50       59 return $parts[$nth] if looks_like_number($nth);
516             }
517              
518 2         14 return @parts;
519             }
520              
521             =head2 x(string, count)
522              
523             This function returns the concatenation of count copies of string. Extra
524             care is taken to avoid exceeding the step_length limit (see
525             L).
526              
527             x('-#',5)'-' /* -#-#-#-#-#- */
528              
529             =cut
530              
531             sub fn_str_rpt {
532 0     0 1 0 my ($name, $args, $renderer) = @_;
533 0         0 my @args = $renderer->execute_each([ @{$args}[0, 1] ]);
  0         0  
534              
535 0 0       0 $args[1] = 0 unless looks_like_number($args[1]);
536              
537 0 0 0     0 if ($args[1] && defined(my $max_len = $renderer->{limits}{step_length})) {
538 0         0 my $max_times = int($max_len / length($args[0]));
539              
540 0 0       0 if ($max_times < $args[1]) {
541 0         0 $renderer->exceeded_limits('step_length');
542 0 0       0 if (!$max_times) {
543 0         0 $args[0] = substr($args[0], 0, $max_len);
544 0         0 ++$max_times;
545             }
546 0         0 $args[1] = $max_times;
547             }
548             }
549              
550 0         0 return $args[0] x $args[1];
551             }
552              
553             =head2 $-(string, offset?, length?)
554              
555             =head2 substr(string, offset?, length?)
556              
557             This function returns the substring of length length beginning at offset
558             offset. It uses Perl's substr, so negative offsets and lengths work the
559             same way.
560              
561             =cut
562              
563             sub fn_substr {
564 7     7 1 385 my ($name, $args, $renderer) = @_;
565 7         15 my @args = $renderer->execute_each([ @{$args}[0..2] ]);
  7         31  
566 7 50 66     875 $args[1] = 0 if @args > 1 && !looks_like_number($args[1]);
567 7 50 66     60 $args[2] = 0 if @args > 2 && !looks_like_number($args[2]);
568              
569             # substr(@args)
570 7 50       22 return '' unless @args;
571 7 100       23 return $args[0] if @args == 1;
572 6 100       27 return substr($args[0], $args[1]) if @args == 2;
573 4         31 return substr($args[0], $args[1], $args[2]);
574             }
575              
576             =head2 trim(string, ...)
577              
578             This function returns each string parameter with leading and trailing
579             white space removed.
580              
581             =cut
582              
583             sub fn_trim {
584 1     1 1 91 my ($name, $args, $renderer) = @_;
585 1         6 my @args = $renderer->execute_each($args);
586              
587 1         176 $_ =~ s/^\s+|\s+$//g foreach @args;
588 1         8 return @args;
589             }
590              
591             =head2 cmp(string1, string2)
592              
593             This function returns -1, 0, or 1 depending on whether string1 is less than,
594             equal to, or greater than string2 (using the C operator in Perl).
595              
596             =cut
597              
598             sub fn_scmp {
599 21     21 1 1195 my ($name, $args, $renderer) = @_;
600 21         25 my @args = $renderer->execute_each([ @{$args}[0, 1] ]);
  21         89  
601              
602 21 50       1952 return ((defined($args[0])? $args[0]: '') cmp
    50          
603             (defined($args[1])? $args[1]: ''));
604             }
605              
606             =head2 eq(string1, string2)
607              
608             =head2 ge(string1, string2)
609              
610             =head2 gt(string1, string2)
611              
612             =head2 le(string1, string2)
613              
614             =head2 lt(string1, string2)
615              
616             =head2 ne(string1, string2)
617              
618             These functions return true if string1 is equal to (eq), greater than or
619             equal to (ge), greater than (gt), less than or equal to (le), less than
620             (le), or not equal to (ne) string2.
621              
622             =cut
623              
624 3     3 1 1201 sub fn_seq { fn_scmp(@_) == 0; }
625 3     3 1 1356 sub fn_sge { fn_scmp(@_) >= 0; }
626 3     3 1 1224 sub fn_sgt { fn_scmp(@_) > 0; }
627 3     3 1 1173 sub fn_sle { fn_scmp(@_) <= 0; }
628 3     3 1 1181 sub fn_slt { fn_scmp(@_) < 0; }
629 3     3 1 1120 sub fn_sne { fn_scmp(@_) != 0; }
630              
631             =head1 NUMERIC FUNCTIONS
632              
633             =head2 +(number, ...)
634              
635             This function returns the sum of its numeric parameters
636             (or 0 if there aren't any).
637              
638             =cut
639              
640             sub fn_add {
641 16     16 1 3076 my ($name, $args, $renderer) = @_;
642 16         29 my $sum = 0;
643 16         85 my $value;
644              
645 16         60 foreach (@$args) {
646 27         88 $value = $renderer->execute_sequence($_);
647 27 100       1253 $sum += $value if looks_like_number($value);
648             }
649              
650 16         83 return $sum;
651             }
652              
653             =head2 -(number)
654              
655             The "unary minus" form of this function returns the negative of the number.
656              
657             =head2 -(number1, number2)
658              
659             The "binary minus" form of this function returns the difference
660             C.
661              
662             =cut
663              
664             sub fn_neg_sub {
665 5     5 1 1720 my ($name, $args, $renderer) = @_;
666 5         9 my @args = get_numbers([ @{$args}[0, 1] ], $renderer);
  5         20  
667              
668 5 100       38 return 0 if !@args;
669 3 100       14 return -$args[0] if @args == 1;
670 2         15 return $args[0] - $args[1];
671             }
672              
673             =head2 *(number, ...)
674              
675             This function returns the product of its numeric parameters
676             (or 1 if there aren't any).
677              
678             =cut
679              
680             sub fn_mul {
681 11     11 1 1872 my ($name, $args, $renderer) = @_;
682 11         17 my $prod = 1;
683 11         15 my $value;
684              
685 11         26 foreach (@$args) {
686 18         54 $value = $renderer->execute_sequence($_);
687 18 50       1165 $prod *= $value if looks_like_number($value);
688             }
689              
690 11         57 return $prod;
691             }
692              
693             =head2 /(number1, number2)
694              
695             This function returns the quotient of number1 divided by number2. It returns
696             an empty string if number2 is zero.
697              
698             =cut
699              
700             sub fn_div {
701 10     10 1 1421 my ($name, $args, $renderer) = @_;
702 10         18 my @args = get_numbers([ @{$args}[0, 1] ], $renderer);
  10         40  
703              
704 10 100 66     146 return ((@args == 2 && $args[1])? ($args[0] / $args[1]): '');
705             }
706              
707             =head2 %(number1, number2)
708              
709             This function returns the remainder of number1 divided by number2. It returns
710             an empty string if number2 is zero.
711              
712             =cut
713              
714             sub fn_mod {
715 4     4 1 1075 my ($name, $args, $renderer) = @_;
716 4         6 my @args = get_numbers([ @{$args}[0, 1] ], $renderer);
  4         12  
717              
718 4 100 66     42 return ((@args == 2 && $args[1])? ($args[0] % $args[1]): '');
719             }
720              
721             =head2 &(number, ...)
722              
723             This function returns the binary "and" of its numeric parameters
724             (or ~0 if there aren't any).
725              
726             =cut
727              
728             sub fn_bin_and {
729 4     4 1 616 my ($name, $args, $renderer) = @_;
730 4         9 my $result = ~0;
731 4         6 my $value;
732              
733 4         9 foreach (@$args) {
734 3         14 $value = $renderer->execute_sequence($_);
735 3 50       186 $result &= 0+$value if looks_like_number($value);
736             }
737              
738 4         27 return $result;
739             }
740              
741             =head2 |(number, ...)
742              
743             This function returns the binary "or" of its parameters
744             (or 0 if there aren't any).
745              
746             =cut
747              
748             sub fn_bin_or {
749 4     4 1 1660 my ($name, $args, $renderer) = @_;
750 4         6 my $result = 0;
751 4         3 my $value;
752              
753 4         11 foreach (@$args) {
754 5         14 $value = $renderer->execute_sequence($_);
755 5 50       289 $result |= 0+$value if looks_like_number($value);
756             }
757              
758 4         21 return $result;
759             }
760              
761             =head2 ^(number, ...)
762              
763             This function returns the binary "exclusive-or" ("xor") of its parameters
764             (or 0 if there aren't any).
765              
766             =cut
767              
768             sub fn_bin_xor {
769 4     4 1 1109 my ($name, $args, $renderer) = @_;
770 4         4 my $result = 0;
771 4         5 my $value;
772              
773 4         8 foreach (@$args) {
774 5         13 $value = $renderer->execute_sequence($_);
775 5 50       303 $result ^= 0+$value if looks_like_number($value);
776             }
777              
778 4         19 return $result;
779             }
780              
781             =head2 ~(number)
782              
783             This function returns the one's complement of number.
784              
785             =cut
786              
787             sub fn_complement {
788 4     4 1 2062 my ($name, $args, $renderer) = @_;
789 4         16 my $value = $renderer->execute_sequence($args->[0]);
790              
791 4 100       179 return looks_like_number($value)? ~(0+$value): ~0;
792             }
793              
794             =head2 int(number)
795              
796             This function returns the integer portion of number.
797              
798             =cut
799              
800             sub fn_int {
801 6     6 1 1466 my ($name, $args, $renderer) = @_;
802 6         19 my $value = $renderer->execute_sequence($args->[0]);
803              
804 6 100       289 return looks_like_number($value)? int($value): 0;
805             }
806              
807             =head2 max(number, ...)
808              
809             This function returns the maximum of its numeric parameters
810             (or any empty string if there aren't any).
811              
812             =cut
813              
814             sub fn_max {
815 4     4 1 1622 my ($name, $args, $renderer) = @_;
816 4         5 my ($max, $value);
817              
818 4         11 foreach (@$args) {
819 6 50       16 if (looks_like_number($value = $renderer->execute_sequence($_))) {
820 6 100 100     322 $max = $value if !defined($max) || $value > $max;
821             }
822             }
823              
824 4 100       23 return defined($max)? $max: '';
825             }
826              
827             =head2 min(number, ...)
828              
829             This function returns the minimum of its numeric parameters
830             (or any empty string if there aren't any).
831              
832             =cut
833              
834             sub fn_min {
835 4     4 1 1316 my ($name, $args, $renderer) = @_;
836 4         6 my ($min, $value);
837              
838 4         11 foreach (@$args) {
839 6 50       18 if (looks_like_number($value = $renderer->execute_sequence($_))) {
840 6 100 100     347 $min = $value if !defined($min) || $value < $min;
841             }
842             }
843              
844 4 100       23 return defined($min)? $min: '';
845             }
846              
847             =head2 <=>(number1, number2)
848              
849             This function returns -1, 0, or 1 depending on whether number1 is less than,
850             equal to, or greater than number2 (using the C<< <=> >> operator in Perl).
851              
852             =cut
853              
854             sub fn_ncmp {
855 29     29 1 2230 my ($name, $args, $renderer) = @_;
856 29         42 my @args = get_numbers([ @{$args}[0, 1] ], $renderer);
  29         96  
857              
858 29         194 return $args[0] <=> $args[1];
859             }
860              
861             =head2 =(number1, number2)
862              
863             =head2 >=(number1, number2)
864              
865             =head2 >(number1, number2)
866              
867             =head2 <=(number1, number2)
868              
869             =head2 <(number1, number2)
870              
871             =head2 !=(number1, number2)
872              
873             These functions return true if number1 is equal to (=), greater than or
874             equal to (>=), greater than (>), less than or equal to (<=), less than
875             (<), or not equal to (!=) number2.
876              
877             =cut
878              
879 3     3 1 1180 sub fn_neq { fn_ncmp(@_) == 0; }
880 3     3 1 1078 sub fn_nge { fn_ncmp(@_) >= 0; }
881 3     3 1 1088 sub fn_ngt { fn_ncmp(@_) > 0; }
882 3     3 1 1252 sub fn_nle { fn_ncmp(@_) <= 0; }
883 8     8 1 1715 sub fn_nlt { fn_ncmp(@_) < 0; }
884 3     3 1 1167 sub fn_nne { fn_ncmp(@_) != 0; }
885              
886             =head1 TEMPLATE FUNCTIONS
887              
888             =head2 tpl(name, code)
889              
890             This function creates a template within the template. The code is stored in
891             the variable with the specified name and can be called later within the
892             main template as C<$name> or C<$name(parameters)>. The parameters will appear
893             as variables C<$1>, C<$2>, etc. Parameter C<$0> will be set to the number of
894             parameters supplied.
895              
896             It returns no value.
897              
898             =cut
899              
900             sub fn_set_template {
901 3     3 1 5190 my ($name, $args, $renderer) = @_;
902              
903 3 50       12 if (@$args) {
904 3         14 my $vname = $renderer->execute_sequence($args->[0]);
905 3   50     219 $renderer->vars->{$vname} = [ '<>', $args->[1] || [] ];
906             }
907              
908 3         30 return ();
909             }
910              
911             =head2 <$>(int_name1, ext_name1, ..., ext_name?)
912              
913             This function allows you to retrieve variable values from the most recent
914             external template call.
915              
916             Parameters are interpreted as as many pairs as possible. The first
917             parameter in each pair is a variable name in the current template; the
918             second is a variable name in the external template whose value will be
919             assigned to the variable in the current template.
920              
921             If there are an odd number of parameters, the value of the external
922             variable named last will be the return value of the function call. Otherwise,
923             no value is returned.
924              
925             <$>('my_a', 'a', 'my_b', 'b', 'c')
926             /* Copies the values of $a and $b in the last external template
927             into $my_a and $my_b in the current template. Returns the
928             value of $c from the external template. */
929              
930             If there has been no external template call, nothing happens and nothing
931             is returned.
932              
933             =cut
934              
935             sub fn_ext_equal {
936 1     1 1 93 my ($name, $args, $renderer) = @_;
937 1         7 my $ext_rend = $renderer->last_renderer;
938              
939 1 0       9 return wantarray? (): '' unless $ext_rend;
    50          
940              
941 1         4 my @args = @$args;
942 1         5 my $locvars = $renderer->vars;
943 1         11 my $extvars = $ext_rend->vars;
944 1         5 my ($locname, $extname);
945              
946 1         6 while (@args > 1) {
947 2         9 ($locname, $extname) = $renderer->execute_each([ splice(@args, 0, 2) ]);
948 2         204 $locvars->{$locname} = $extvars->{$extname};
949             }
950              
951 1 50       5 if (@args) {
952 1         5 $extname = $renderer->execute_sequence($args[0]);
953 1         60 my $value = $extvars->{$extname};
954 1 50       10 return defined($value)? $value: '';
955             }
956              
957 0 0       0 return wantarray? (): '';
958             }
959              
960             =head1 MISCELLANEOUS FUNCTIONS
961              
962             =head2 $=(name1, expr1, ..., ret_name?)
963              
964             This function takes any number of (possibly multi-valued) parameters. The
965             maximum even number of resulting values are interpreted as (name, value)
966             pairs, assigning each value to the variable with the preceding name.
967              
968             If there are an odd number of parameters, the value of the variable named
969             by the last parameter is returned. Otherwise, no value is returned.
970              
971             $=('prev', $var, 'var', +($var, 1))
972             /* sets $prev to the current value of $var,
973             adds 1 to $var, and returns nothing */
974              
975             $=('a', 2, 'b'$a, 3, 'b'$a)
976             /* sets $a to 2, sets $b2 to 3, and returns $b2 */
977              
978             =cut
979              
980             sub fn_var_equal {
981 30     30 1 13697 my ($name, $args, $renderer) = @_;
982 30         112 my @args = $renderer->execute_each($args);
983 30         2308 my ($key, $value);
984              
985 30         102 while (@args > 1) {
986 30         110 ($key, $value) = splice(@args, 0, 2);
987 30         100 $renderer->vars->{$key} = $value;
988             }
989              
990 30 100       251 if (@args) {
991 5         17 $value = $renderer->vars->{$args[0]};
992 5 100       59 return defined($value)? $value: '';
993             }
994              
995 25 50       181 return wantarray? (): '';
996             }
997              
998             =head2 void(expression, ...)
999              
1000             This function evaluates each expression but returns nothing.
1001              
1002             You probably won't need this unless you add functions with side effects
1003             that return something when they shouldn't.
1004              
1005             =cut
1006              
1007             sub fn_void {
1008 1     1 1 1310 my ($name, $args, $renderer) = @_;
1009              
1010 1         6 $renderer->execute_sequence($_) foreach (@$args);
1011 1 50       38 return wantarray? (): '';
1012             }
1013              
1014             =head1 AUTHOR
1015              
1016             Brian Katzung, C<< >>
1017              
1018             =head1 BUGS
1019              
1020             Please report any bugs or feature requests to
1021             C, or through the web interface at
1022             L. I
1023             will be notified, and then you'll automatically be notified of progress
1024             on your bug as I make changes.
1025              
1026             =head1 SUPPORT
1027              
1028             You can find documentation for this module with the perldoc command.
1029              
1030             perldoc Text::TemplateLite::Standard
1031              
1032             You can also look for information at:
1033              
1034             =over 4
1035              
1036             =item * RT: CPAN's request tracker (report bugs here)
1037              
1038             L
1039              
1040             =item * AnnoCPAN: Annotated CPAN documentation
1041              
1042             L
1043              
1044             =item * CPAN Ratings
1045              
1046             L
1047              
1048             =item * Search CPAN
1049              
1050             L
1051              
1052             =back
1053              
1054             =head1 LICENSE AND COPYRIGHT
1055              
1056             Copyright 2012 Brian Katzung.
1057              
1058             This program is free software; you can redistribute it and/or modify it
1059             under the terms of either: the GNU General Public License as published
1060             by the Free Software Foundation; or the Artistic License.
1061              
1062             See http://dev.perl.org/licenses/ for more information.
1063              
1064              
1065             =cut
1066              
1067             1; # End of Text::TemplateLite::Standard
1068              
1069             =begin pod_coverage
1070              
1071             =head2 fn_log_and
1072              
1073             =head2 fn_log_or
1074              
1075             =head2 fn_log_not
1076              
1077             =head2 fn_ifeach
1078              
1079             =head2 fn_ifelse
1080              
1081             =head2 fn_test_rpt
1082              
1083             =head2 fn_join
1084              
1085             =head2 fn_join4
1086              
1087             =head2 fn_length
1088              
1089             =head2 fn_split
1090              
1091             =head2 fn_trim
1092              
1093             =head2 fn_str_rpt
1094              
1095             =head2 fn_substr
1096              
1097             =head2 fn_scmp
1098              
1099             =head2 fn_seq
1100              
1101             =head2 fn_sge
1102              
1103             =head2 fn_sgt
1104              
1105             =head2 fn_sle
1106              
1107             =head2 fn_slt
1108              
1109             =head2 fn_sne
1110              
1111             =head2 fn_add
1112              
1113             =head2 fn_neg_sub
1114              
1115             =head2 fn_mul
1116              
1117             =head2 fn_div
1118              
1119             =head2 fn_mod
1120              
1121             =head2 fn_bin_and
1122              
1123             =head2 fn_bin_or
1124              
1125             =head2 fn_bin_xor
1126              
1127             =head2 fn_complement
1128              
1129             =head2 fn_int
1130              
1131             =head2 fn_max
1132              
1133             =head2 fn_min
1134              
1135             =head2 fn_ncmp
1136              
1137             =head2 fn_neq
1138              
1139             =head2 fn_nge
1140              
1141             =head2 fn_ngt
1142              
1143             =head2 fn_nle
1144              
1145             =head2 fn_nlt
1146              
1147             =head2 fn_nne
1148              
1149             =head2 fn_set_template
1150              
1151             =head2 fn_ext_equal
1152              
1153             =head2 fn_var_equal
1154              
1155             =head2 fn_void
1156              
1157             =end pod_coverage