Dogcows Code - chaz/p5-CGI-Ex/blob - samples/memory_template.pl

   1 #!/usr/bin/perl -w
   2
   3 my $swap = {
   4     one   => "ONE",
   5     two   => "TWO",
   6     three => "THREE",
   7     a_var => "a",
   8     hash  => {a => 1, b => 2},
   9     code  => sub {"($_[0])"},
  10 };
  11
  12 my $txt  = "[% one %][% two %][% three %][% hash.keys.join %] [% code(one).length %] [% hash.\$a_var %]\n";
  13 #$txt = hello2000();
  14
  15 ###----------------------------------------------------------------###
  16
  17 my $module;
  18 my $name;
  19 if (! fork) {
  20     $module = 'CGI::Ex::Template';
  21 } elsif (! fork) {
  22     $module = 'CGI::Ex::Template::XS';
  23 } elsif (! fork) {
  24     $module = 'Template';
  25 } elsif (! fork) {
  26     $module = 'Template';
  27     $name   = 'Template Stash::XS';
  28     require Template::Stash::XS;
  29 } elsif (! fork) {
  30     $module = 'HTML::Template';
  31 } elsif (! fork) {
  32     $module = 'HTML::Template::Expr';
  33 } elsif (! fork) {
  34     $module = 'HTML::Template::Compiled';
  35 } elsif (! fork) {
  36     $module = 'Text::Tmpl';
  37 } elsif (! fork) {
  38     $module = 'Template';
  39     $name   = 'Template::Parser::CET';
  40     require Template::Parser::CET;
  41     Template::Parser::CET->activate;
  42 }
  43
  44 if ($module) {
  45     $name ||= $module;
  46     $0 = "$0 - $name";
  47
  48     my $pm = "$module.pm";
  49     $pm =~ s|::|/|g;
  50     require $pm;
  51
  52     if ($module =~ /HTML::Template/) {
  53         my $t = eval { $module->new };
  54     } elsif ($module eq 'Text::Tmpl') {
  55         my $t = eval { $module->new->parse_string($txt) };
  56     } else {
  57
  58         my $t = $module->new(ABSOLUTE => 1);
  59         my $out = '';
  60         $t->process(\$txt, $swap, \$out);
  61         print "$name $out";
  62         for (1..30) { my $out; $t->process(\$txt, $swap, \$out); };
  63     }
  64
  65 #    print "$name $_\n" foreach sort keys %INC;
  66     print "$name times: (@{[times]})\n";
  67     sleep 15;
  68     exit;
  69 }
  70
  71 sleep 2;
  72 print grep {/\Q$0\E/} `ps fauwx`;
  73 #sleep 15; # go and check the 'ps fauwx|grep perl'
  74 exit;
  75
  76 ###----------------------------------------------------------------###
  77
  78 sub hello2000 {
  79     my $hello2000 = "<html><head><title>[% title %]</title></head><body>
  80 [% array = [ \"Hello\", \"World\", \"2000\", \"Hello\", \"World\", \"2000\" ] %]
  81 [% sorted = array.sort %]
  82 [% multi = [ sorted, sorted, sorted, sorted, sorted ] %]
  83 <table>
  84 [% FOREACH row = multi %]
  85   <tr bgcolor=\"[% loop.count % 2 ? 'gray' : 'white' %]\">
  86   [% FOREACH col = row %]
  87     <td align=\"center\"><font size=\"+1\">[% col %]</font></td>
  88   [% END %]
  89   </tr>
  90 [% END %]
  91 </table>
  92 [% param = integer %]
  93 [% FOREACH i = [ 1 .. 10 ] %]
  94   [% var = i + param %]"
  95   .("\n  [%var%] Hello World Hello World Hello World Hello World Hello World Hello World Hello World Hello World Hello World Hello World <br/>"x20)."
  96 [% END %]
  97 </body></html>
  98 ";
  99 }