Dogcows Code - chaz/p5-CGI-Ex/blob - t/7_template_03_html_template.t

   1 # -*- Mode: Perl; -*-
   2
   3 =head1 NAME
   4
   5 7_template_03_html_template.t - Test the ability to parse and play html template
   6
   7 =cut
   8
   9 use vars qw($module $is_ht $is_hte $is_cet);
  10 BEGIN {
  11     $module = 'CGI::Ex::Template';
  12 #    $module = 'HTML::Template';
  13 #    $module = 'HTML::Template::Expr';
  14     $is_hte = $module eq 'HTML::Template::Expr';
  15     $is_ht  = $module eq 'HTML::Template';
  16     $is_cet = $module eq 'CGI::Ex::Template';
  17 };
  18
  19 use strict;
  20 use Test::More tests => ($is_cet) ? 92 : ($is_ht) ? 60 : 64;
  21 use Data::Dumper qw(Dumper);
  22 use constant test_taint => 0 && eval { require Taint::Runtime };
  23
  24 use_ok($module);
  25
  26 Taint::Runtime::taint_start() if test_taint;
  27
  28 ### find a place to allow for testing
  29 my $test_dir = $0 .'.test_dir';
  30 END { rmdir $test_dir }
  31 mkdir $test_dir, 0755;
  32 ok(-d $test_dir, "Got a test dir up and running");
  33
  34
  35 sub process_ok { # process the value and say if it was ok
  36     my $str  = shift;
  37     my $test = shift;
  38     my $vars = shift || {};
  39     my $conf = local $vars->{'tt_config'} = $vars->{'tt_config'} || [];
  40     my $line = (caller)[2];
  41     delete $vars->{'tt_config'};
  42
  43     Taint::Runtime::taint(\$str) if test_taint;
  44
  45     my $obj;
  46     my $out;
  47     eval {
  48         $obj = shift || $module->new(scalarref => \$str, die_on_bad_params => 0, path => $test_dir, @$conf); # new object each time
  49         $obj->param($vars);
  50         $out = $obj->output;
  51     };
  52     my $err = $@;
  53     $out = '' if ! defined $out;
  54
  55     my $ok = ref($test) ? $out =~ $test : $out eq $test;
  56     if ($ok) {
  57         ok(1, "Line $line   \"$str\" => \"$out\"");
  58         return $obj;
  59     } else {
  60         ok(0, "Line $line   \"$str\"");
  61         warn "# Was:\n$out\n# Should've been:\n$test\n";
  62         print "$err\n";
  63         if ($obj && $obj->can('parse_tree')) {
  64             local $obj->{'SYNTAX'} = 'hte';
  65             print Dumper $obj->parse_tree(\$str);
  66         }
  67         exit;
  68     }
  69 }
  70
  71 ### create some files to include
  72 my $foo_template = "$test_dir/foo.ht";
  73 END { unlink $foo_template };
  74 open(my $fh, ">$foo_template") || die "Couldn't open $foo_template: $!";
  75 print $fh "Good Day!";
  76 close $fh;
  77
  78 ###----------------------------------------------------------------###
  79 print "### VAR ##############################################################\n";
  80
  81 process_ok("Foo" => "Foo");
  82
  83 process_ok("<TMPL_VAR foo>" => "FOO", {foo => "FOO"});
  84 process_ok("<TMPL_VAR foo>" => "FOO", {foo => "FOO"});
  85 process_ok("<TMPL_VAR name=foo>" => "FOO", {foo => "FOO"});
  86 process_ok("<TMPL_VAR NAME=foo>" => "FOO", {foo => "FOO"});
  87 process_ok("<TMPL_VAR NAME=\"foo\">" => "FOO", {foo => "FOO"});
  88 process_ok("<TMPL_VAR NAME='foo'>" => "FOO", {foo => "FOO"});
  89 process_ok("<TMPL_VAR NAME='foo' >" => "FOO", {foo => "FOO"});
  90 process_ok("<TMPL_VAR foo >" => "FOO", {foo => "FOO"});
  91
  92 process_ok("<TMPL_VAR                 foo>" => "<>",       {foo => "<>"});
  93 process_ok("<TMPL_VAR                 foo>" => "&lt;&gt;", {foo => "<>", tt_config => [default_escape => 'html']});
  94 process_ok("<TMPL_VAR ESCAPE=html     foo>" => "&lt;&gt;", {foo => "<>"});
  95 process_ok("<TMPL_VAR ESCAPE=HTML     foo>" => "&lt;&gt;", {foo => "<>"});
  96 process_ok("<TMPL_VAR ESCAPE=\"HTML\" foo>" => "&lt;&gt;", {foo => "<>"});
  97 process_ok("<TMPL_VAR ESCAPE='HTML'   foo>" => "&lt;&gt;", {foo => "<>"});
  98 process_ok("<TMPL_VAR ESCAPE=1        foo>" => "&lt;&gt;", {foo => "<>"});
  99 process_ok("<TMPL_VAR ESCAPE=0        foo>" => "<>", {foo => "<>"});
 100 process_ok("<TMPL_VAR ESCAPE=NONE     foo>" => "<>", {foo => "<>"});
 101 process_ok("<TMPL_VAR ESCAPE=URL      foo>" => "%3C%3E", {foo => "<>"});
 102 process_ok("<TMPL_VAR ESCAPE=JS       foo>" => "<>\\n\\r\t\\\"\\\'", {foo => "<>\n\r\t\"\'"});
 103
 104 process_ok("<TMPL_VAR foo ESCAPE=html>" => "&lt;&gt;", {foo => "<>"});
 105 process_ok("<TMPL_VAR NAME=foo ESCAPE=html>" => "&lt;&gt;", {foo => "<>"});
 106 process_ok("<TMPL_VAR ESCAPE=html NAME=foo>" => "&lt;&gt;", {foo => "<>"});
 107 process_ok("<TMPL_VAR ESCAPE=html NAME=foo ESCAPE=js>" => "&lt;&gt;", {foo => "<>"});
 108
 109 process_ok("<TMPL_VAR DEFAULT=bar NAME=foo>" => "FOO", {foo => "FOO", bar => "BAR"});
 110 process_ok("<TMPL_VAR DEFAULT=bar NAME=foo>d" => "bard", {foo => undef, bar => "BAR"});
 111 process_ok("<TMPL_VAR NAME=foo DEFAULT=bar>d" => "bard", {foo => undef, bar => "BAR"});
 112 process_ok("<TMPL_VAR DEFAULT=bar NAME=foo DEFAULT=bing>d" => "bard");
 113
 114 process_ok("<!--TMPL_VAR foo-->" => "FOO", {foo => "FOO"}) if $is_cet;
 115 process_ok("<!--TMPL_VAR NAME='foo'-->" => "FOO", {foo => "FOO"});
 116
 117 ###----------------------------------------------------------------###
 118 print "### IF / ELSE / UNLESS ###############################################\n";
 119
 120 process_ok("<TMPL_IF foo>bar</TMPL_IF>" => "", {foo => ""});
 121 process_ok("<TMPL_IF foo>bar</TMPL_IF>" => "bar", {foo => "1"});
 122 process_ok("<TMPL_IF foo>bar<TMPL_ELSE>bing</TMPL_IF>" => "bing", {foo => ''});
 123 process_ok("<TMPL_IF foo>bar<TMPL_ELSE>bing</TMPL_IF>" => "bar",  {foo => '1'});
 124 process_ok("<TMPL_UNLESS foo>bar</TMPL_UNLESS>" => "bar", {foo => ""});
 125 process_ok("<TMPL_UNLESS foo>bar</TMPL_UNLESS>" => "", {foo => "1"});
 126
 127 process_ok("<TMPL_IF ESCAPE=HTML foo>bar</TMPL_IF>baz" => "", {foo => "1"});
 128 process_ok("<TMPL_IF DEFAULT=bar foo>bar</TMPL_IF>baz" => "", {foo => "1"});
 129
 130 ###----------------------------------------------------------------###
 131 print "### INCLUDE ##########################################################\n";
 132
 133 process_ok("<TMPL_INCLUDE blah>" => "");
 134 process_ok("<TMPL_INCLUDE foo.ht>" => "Good Day!");
 135 process_ok("<TMPL_INCLUDE $test_dir/foo.ht>" => "Good Day!", {tt_config => [path => '']});
 136 process_ok("<TMPL_INCLUDE NAME=foo.ht>" => "Good Day!");
 137 process_ok("<TMPL_INCLUDE NAME='foo.ht'>" => "Good Day!");
 138 process_ok("<TMPL_INCLUDE NAME='foo.ht'>" => "", {tt_config => [no_includes => 1]});
 139
 140 process_ok("<TMPL_INCLUDE ESCAPE=HTML NAME='foo.ht'>" => "");
 141 process_ok("<TMPL_INCLUDE DEFAULT=bar NAME='foo.ht'>" => "");
 142
 143 process_ok("<TMPL_INCLUDE EXPR=\"'foo.ht'\">" => "Good Day!")                if $is_cet;
 144 process_ok("<TMPL_INCLUDE EXPR=\"foo\">" => "Good Day!", {foo => 'foo.ht'})  if $is_cet;
 145 process_ok("<TMPL_INCLUDE EXPR=\"sprintf('%s', 'foo.ht')\">" => "Good Day!") if $is_cet;
 146
 147 ###----------------------------------------------------------------###
 148 print "### EXPR #############################################################\n";
 149
 150 process_ok("<TMPL_VAR EXPR=\"sprintf('%d', foo)\">" => "777", {foo => "777"}) if ! $is_ht;
 151 process_ok("<TMPL_VAR EXPR=\"sprintf('%d', foo)\">" => "777", {foo => "777"}) if ! $is_ht;
 152 process_ok("<TMPL_VAR EXPR='sprintf(\"%d\", foo)'>" => "777", {foo => "777"}) if ! $is_ht && ! $is_hte; # odd that HTE can't parse this
 153 process_ok("<TMPL_VAR EXPR=\"sprintf(\"%d\", foo)\">" => "777", {foo => "777"}) if ! $is_ht;
 154 process_ok("<TMPL_VAR EXPR=sprintf(\"%d\", foo)>" => "777", {foo => "777"}) if ! $is_ht && ! $is_hte;
 155 process_ok("<TMPL_VAR EXPR=\"sprintf('%s', foo)\">" => "<>", {foo => "<>"}) if ! $is_ht;
 156 process_ok("<TMPL_VAR ESCAPE=HTML EXPR=\"sprintf('%s', foo)\">" => "", {foo => "<>"});
 157 process_ok("<TMPL_VAR DEFAULT=bar EXPR=foo>" => "", {foo => "FOO", bar => "BAR"});
 158
 159 process_ok("<!--TMPL_VAR EXPR=\"foo\"-->" => "FOO", {foo => "FOO"}) if ! $is_ht;;
 160
 161 ###----------------------------------------------------------------###
 162 print "### LOOP #############################################################\n";
 163
 164 process_ok("<TMPL_LOOP blah></TMPL_LOOP>foo" => "foo");
 165 process_ok("<TMPL_LOOP blah>Hi</TMPL_LOOP>foo" => "", {blah => 1});
 166 process_ok("<TMPL_LOOP blah>Hi</TMPL_LOOP>foo" => "Hifoo", {blah => {wow => 1}}) if $is_cet;
 167 process_ok("<TMPL_LOOP blah>Hi</TMPL_LOOP>foo" => "HiHifoo", {blah => [{}, {}]});
 168 process_ok("<TMPL_LOOP blah>(<TMPL_VAR i>)</TMPL_LOOP>foo" => "(1)(2)(3)foo", {blah => [{i=>1}, {i=>2}, {i=>3}]});
 169 process_ok("<TMPL_LOOP NAME=\"blah\">(<TMPL_VAR i>)</TMPL_LOOP>foo" => "(1)(2)(3)foo", {blah => [{i=>1}, {i=>2}, {i=>3}]});
 170 process_ok("<TMPL_LOOP EXPR=\"blah\">(<TMPL_VAR i>)</TMPL_LOOP>foo" => "(1)(2)(3)foo", {blah => [{i=>1}, {i=>2}, {i=>3}]}) if $is_cet;
 171 process_ok("<TMPL_LOOP blah>(<TMPL_VAR i>)(<TMPL_VAR blue>)</TMPL_LOOP>foo" => "(1)()(2)()(3)()foo", {blah => [{i=>1}, {i=>2}, {i=>3}], blue => 'B'}) if $is_ht;
 172 process_ok("<TMPL_LOOP blah>(<TMPL_VAR i>)(<TMPL_VAR blue>)</TMPL_LOOP>foo" => "(1)(B)(2)(B)(3)(B)foo", {blah => [{i=>1}, {i=>2}, {i=>3}], blue => 'B', tt_config => [GLOBAL_VARS => 1]});
 173
 174 process_ok("<TMPL_LOOP blah>(<TMPL_VAR i>)(<TMPL_VAR blue>)</TMPL_LOOP>foo" => "(1)()(2)()(3)()foo", {blah => [{i=>1}, {i=>2}, {i=>3}], blue => 'B', tt_config => [SYNTAX => 'ht']}) if $is_cet;
 175 process_ok("<TMPL_LOOP blah>(<TMPL_VAR i>)(<TMPL_VAR blue>)</TMPL_LOOP>foo" => "(1)(B)(2)(B)(3)(B)foo", {blah => [{i=>1}, {i=>2}, {i=>3}], blue => 'B', tt_config => [GLOBAL_VARS => 1, SYNTAX => 'ht']}) if $is_cet;
 176
 177 process_ok("<TMPL_LOOP blah>(<TMPL_VAR i>)</TMPL_LOOP>foo" => "(1)()(3)foo", {blah => [{i=>1}, undef, {i=>3}]});
 178
 179 process_ok("<TMPL_LOOP blah>\n(<TMPL_VAR __first__>|<TMPL_VAR __last__>|<TMPL_VAR __odd__>|<TMPL_VAR __inner__>|<TMPL_VAR __counter__>)</TMPL_LOOP>foo" => "
 180 (||||)
 181 (||||)
 182 (||||)foo", {blah => [undef, undef, undef]});
 183
 184 process_ok("<TMPL_LOOP blah>\n(<TMPL_VAR __first__>|<TMPL_VAR __last__>|<TMPL_VAR __odd__>|<TMPL_VAR __inner__>|<TMPL_VAR __counter__>)</TMPL_LOOP>foo" => "
 185 (1||1|0|1)
 186 (0|0||1|2)
 187 (0|1|1|0|3)foo", {blah => [undef, undef, undef], tt_config => [LOOP_CONTEXT_VARS => 1]}) if ! $is_cet;
 188
 189 process_ok("<TMPL_LOOP blah>\n(<TMPL_VAR __first__>|<TMPL_VAR __last__>|<TMPL_VAR __odd__>|<TMPL_VAR __inner__>|<TMPL_VAR __counter__>)</TMPL_LOOP>foo" => "
 190 (1|0|1|0|1)
 191 (0|0|0|1|2)
 192 (0|1|1|0|3)foo", {blah => [undef, undef, undef], tt_config => [LOOP_CONTEXT_VARS => 1]}) if $is_cet;
 193
 194
 195 process_ok("<TMPL_LOOP NAME=\"blah\"><TMPL_IF EXPR='i==2'><TMPL_NEXT></TMPL_IF>(<TMPL_VAR i>)</TMPL_LOOP>foo" => "(1)(3)foo", {blah => [{i=>1}, {i=>2}, {i=>3}]}) if $is_cet;
 196
 197 ###----------------------------------------------------------------###
 198 print "### TT3 DIRECTIVES ###################################################\n";
 199
 200 process_ok("<TMPL_GET foo>" => "FOO", {foo => "FOO"})    if $is_cet;
 201 process_ok("<TMPL_GET foo>" => "", {foo => "FOO", tt_config => [NO_TT => 1]}) if $is_cet;
 202 process_ok("<TMPL_GET foo>" => "", {foo => "FOO", tt_config => [SYNTAX => 'ht']}) if $is_cet;
 203 process_ok("<TMPL_GET 1+2+3+4>" => "10", {foo => "FOO"}) if $is_cet;
 204
 205 process_ok("<TMPL_IF foo>bar<TMPL_ELSIF wow>wee<TMPL_ELSE>bing</TMPL_IF>" => "bar", {foo => "1"}) if $is_cet;
 206
 207 process_ok("<TMPL_SET i = 'foo'>(<TMPL_VAR i>)" => "(foo)") if $is_cet;
 208 process_ok("<TMPL_SET i = 'foo'>(<TMPL_GET i>)" => "(foo)") if $is_cet;
 209 process_ok("<TMPL_FOR i IN [1..3]>(<TMPL_VAR i>)</TMPL_FOR>" => "(1)(2)(3)") if $is_cet;
 210
 211 process_ok("<TMPL_BLOCK foo>(<TMPL_VAR i>)</TMPL_BLOCK><TMPL_PROCESS foo i='bar'>" => "(bar)") if $is_cet;
 212 process_ok("<TMPL_BLOCK foo>(<TMPL_VAR i>)</TMPL_BLOCK><TMPL_SET wow = PROCESS foo i='bar'><TMPL_VAR wow>" => "(bar)") if $is_cet;
 213
 214 process_ok("<TMPL_GET template.foo><TMPL_META foo = 'bar'>" => "bar") if $is_cet;
 215
 216 process_ok('<TMPL_MACRO bar(n) BLOCK>You said <TMPL_VAR n></TMPL_MACRO><TMPL_GET bar("hello")>' => 'You said hello') if $is_cet;
 217
 218 ###----------------------------------------------------------------###
 219 print "### TT3 CHOMPING #####################################################\n";
 220
 221 process_ok("\n<TMPL_GET foo>" => "\nFOO", {foo => "FOO"}) if $is_cet;
 222 process_ok("<TMPL_GET foo->\n" => "FOO", {foo => "FOO"})  if $is_cet;
 223 process_ok("\n<-TMPL_GET foo>" => "FOO", {foo => "FOO"})  if $is_cet;
 224
 225 ###----------------------------------------------------------------###
 226 print "### TT3 INTERPOLATE ##################################################\n";
 227
 228 process_ok('$foo <TMPL_GET foo> ${ 1 + 2 }' => '$foo FOO ${ 1 + 2 }', {foo => "FOO"});
 229 process_ok('$foo <TMPL_GET foo> ${ 1 + 2 }' => 'FOO FOO 3', {foo => "FOO", tt_config => [INTERPOLATE => 1]}) if $is_cet;
 230 process_ok('<TMPL_CONFIG INTERPOLATE => 1>$foo <TMPL_GET foo> ${ 1 + 2 }' => 'FOO FOO 3', {foo => "FOO"}) if $is_cet;
 231
 232 ###----------------------------------------------------------------###
 233 print "### DONE #############################################################\n";