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

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 bench_template.pl - Test relative performance of CGI::Ex::Template to Template::Toolkit
   6
   7 =cut
   8
   9 use strict;
  10 use Benchmark qw(cmpthese timethese);
  11 use POSIX qw(tmpnam);
  12 use File::Path qw(rmtree);
  13 use CGI::Ex::Template;
  14 use CGI::Ex::Dump qw(debug);
  15 use Template;
  16 use constant test_taint => 0 && eval { require Taint::Runtime }; # s/0/1/ to check tainting
  17
  18 Taint::Runtime::taint_start() if test_taint;
  19
  20 my $tt_cache_dir = tmpnam;
  21 END { rmtree $tt_cache_dir };
  22 mkdir $tt_cache_dir, 0755;
  23
  24 my $swap = {
  25     one   => "ONE",
  26     a_var => "a",
  27     foo   => '[% bar %]',
  28     bar   => "baz",
  29     hash  => {a => 1, b => 2, c => { d => [{hee => ["hmm"]}] }},
  30     array => [qw(A B C D E a A)],
  31     code  => sub {"(@_)"},
  32     filt  => sub {sub {$_[0]x2}},
  33 };
  34
  35 use Template::Stash;;
  36 my $s = Template::Stash->new($swap);
  37 #use Template::Stash::XS;
  38 #$s = Template::Stash::XS->new($swap);
  39
  40 ###----------------------------------------------------------------###
  41 ### get objects ready
  42
  43 my @config1 = (STASH => $s, ABSOLUTE => 1, CONSTANTS => {simple => 'var'}, EVAL_PERL => 1, INCLUDE_PATH => $tt_cache_dir);
  44 #push @config1, (INTERPOLATE => 1);
  45 my @config2 = (@config1, COMPILE_EXT => '.ttc');
  46
  47 #use CGI::Ex::Template::XS;
  48 #my $tt1 = CGI::Ex::Template::XS->new(@config1);
  49 #my $tt2 = CGI::Ex::Template::XS->new(@config2);
  50 my $tt1 = Template->new(@config1);
  51 my $tt2 = Template->new(@config2);
  52
  53 my $cet = CGI::Ex::Template->new(@config1);
  54 my $cetc = CGI::Ex::Template->new(@config2);
  55
  56 #$swap->{$_} = $_ for (1 .. 1000); # swap size affects benchmark speed
  57
  58 ###----------------------------------------------------------------###
  59 ### write out some file to be used later
  60
  61 my $fh;
  62 my $bar_template = "$tt_cache_dir/bar.tt";
  63 END { unlink $bar_template };
  64 open($fh, ">$bar_template") || die "Couldn't open $bar_template: $!";
  65 print $fh "BAR";
  66 close $fh;
  67
  68 my $baz_template = "$tt_cache_dir/baz.tt";
  69 END { unlink $baz_template };
  70 open($fh, ">$baz_template") || die "Couldn't open $baz_template: $!";
  71 print $fh "[% SET baz = 42 %][% baz %][% bing %]";
  72 close $fh;
  73
  74 my $longer_template = "[% INCLUDE bar.tt %]"
  75     ."[% array.join('|') %]"
  76     .("123"x200)
  77     ."[% FOREACH a IN array %]foobar[% IF a == 'A' %][% INCLUDE baz.tt %][% END %]bazbing[% END %]"
  78     .("456"x200)
  79     ."[% IF foo ; bar ; ELSIF baz ; bing ; ELSE ; bong ; END %]"
  80     .("789"x200)
  81     ."[% IF foo ; bar ; ELSIF baz ; bing ; ELSE ; bong ; END %]"
  82     .("012"x200)
  83     ."[% IF foo ; bar ; ELSIF baz ; bing ; ELSE ; bong ; END %]"
  84     ."[% array.join('|') %]"
  85     ."[% PROCESS bar.tt %]";
  86
  87 my $hello2000 = "<html><head><title>[% title %]</title></head><body>
  88 [% array = [ \"Hello\", \"World\", \"2000\", \"Hello\", \"World\", \"2000\" ] %]
  89 [% sorted = array.sort %]
  90 [% multi = [ sorted, sorted, sorted, sorted, sorted ] %]
  91 <table>
  92 [% FOREACH row = multi %]
  93   <tr bgcolor=\"[% loop.count % 2 ? 'gray' : 'white' %]\">
  94   [% FOREACH col = row %]
  95     <td align=\"center\"><font size=\"+1\">[% col %]</font></td>
  96   [% END %]
  97   </tr>
  98 [% END %]
  99 </table>
 100 [% param = integer %]
 101 [% FOREACH i = [ 1 .. 10 ] %]
 102   [% var = i + param %]"
 103   .("\n  [%var%] Hello World Hello World Hello World Hello World Hello World Hello World Hello World Hello World Hello World Hello World <br/>"x20)."
 104 [% END %]
 105 </body></html>
 106 ";
 107
 108 ###----------------------------------------------------------------###
 109 ### set a few globals that will be available in our subs
 110 my $show_list = grep {$_ eq '--list'} @ARGV;
 111 my $run_all   = grep {$_ eq '--all'}  @ARGV;
 112 my @run = $run_all ? () : @ARGV;
 113 my $str_ref;
 114 my $filename;
 115
 116 ### uncomment to run a specific test - otherwise all tests run
 117 #@run = qw(07);
 118
 119 #                                                                         ### All percents are CGI::Ex::Template vs TT2
 120 #                                                                         ### (The percent that CET is faster than TT)
 121 #                                                                               Existing object by string ref #
 122 #                                                                      New object with CACHE_EXT set #        #
 123 #                                                   New object each time (undef CACHE_SIZE) #        #        #
 124 #                              This percent is compiled in memory (repeated calls) #        #        #        #
 125 my $tests = {                                                             #        #        #        #        #
 126     '01_empty'     => "",                                                 #  231%  #  571%  #  310%  #  431%  # 20798.0/s #
 127     '02_var_sma'   => "[% one %]",                                        #  162%  #  531%  #  409%  #  436%  # 14964.9/s #
 128     '03_var_lar'   => "[% one %]"x100,                                    #   22%  #  338%  #   63%  #  331%  # 948.8/s #
 129     '04_set_sma'   => "[% SET one = 2 %]",                                #  160%  #  478%  #  391%  #  370%  # 14835.7/s #
 130     '05_set_lar'   => "[% SET one = 2 %]"x100,                            #   12%  #  280%  #   28%  #  272%  # 919.7/s #
 131     '06_set_range' => "[% SET one = [0..30] %]",                          #   42%  #  289%  #  230%  #  192%  # 7909.3/s #
 132     '07_chain_sm'  => "[% hash.a %]",                                     #  163%  #  551%  #  397%  #  450%  # 13791.3/s #
 133     '08_mixed_sma' => "".((" "x100)."[% one %]\n")x10,                    #   72%  #  467%  #  234%  #  440%  # 5941.1/s #
 134     '09_mixed_med' => "".((" "x10)."[% one %]\n")x100,                    #   17%  #  416%  #   99%  #  394%  # 879.7/s #
 135     '10_str_sma'   => "".("[% \"".(" "x100)."\$one\" %]\n")x10,           #  -12%  #  1391%  #   96%  #  1448%  # 2939.5/s #
 136     '11_str_lar'   => "".("[% \"".(" "x10)."\$one\" %]\n")x100,           #  -50%  #  303%  #   -1%  #  303%  # 365.3/s #
 137     '12_num_lterl' => "[% 2 %]",                                          #  170%  #  534%  #  430%  #  422%  # 16592.1/s #
 138     '13_plus'      => "[% 1 + 2 %]",                                      #  116%  #  426%  #  351%  #  311%  # 13151.4/s #
 139     '14_chained'   => "[% c.d.0.hee.0 %]",                                #  168%  #  567%  #  390%  #  486%  # 14451.2/s #
 140     '15_chain_set' => "[% SET c.d.0.hee.0 = 2 %]",                        #  153%  #  465%  #  337%  #  389%  # 11123.9/s #
 141     '16_chain_lar' => "[% c.d.0.hee.0 %]"x100,                            #   58%  #  468%  #   74%  #  465%  # 828.2/s #
 142     '17_chain_sl'  => "[% SET c.d.0.hee.0 = 2 %]"x100,                    #  111%  #  343%  #   85%  #  346%  # 367.4/s #
 143     '18_cplx_comp' => "[% t = 1 || 0 ? 0 : 1 || 2 ? 2 : 3 %][% t %]",     #   81%  #  254%  #  253%  #  188%  # 9677.4/s #
 144     '19_if_sim_t'  => "[% a=1 %][% IF a %]Two[% END %]",                  #  119%  #  428%  #  316%  #  352%  # 11600.5/s #
 145     '20_if_sim_f'  => "         [% IF a %]Two[% END %]",                  #  163%  #  536%  #  398%  #  459%  # 14693.3/s #
 146     '21_if_else'   => "[% IF a %]A[% ELSE %]B[% END %]",                  #  139%  #  483%  #  363%  #  393%  # 13480.3/s #
 147     '22_if_elsif'  => "[% IF a %]A[% ELSIF b %]B[% ELSE %]C[% END %]",    #  133%  #  453%  #  334%  #  379%  # 12151.0/s #
 148     '23_for_i_sml' => "[% FOREACH i = [0..10]   ; i ; END %]",            #   12%  #  197%  #  131%  #  140%  # 2497.6/s #
 149     '24_for_i_med' => "[% FOREACH i = [0..100]  ; i ; END %]",            #  -23%  #   21%  #    0%  #    5%  # 357.3/s #
 150     '25_for_sml'   => "[% FOREACH [0..10]       ; i ; END %]",            #   23%  #  220%  #  151%  #  160%  # 2670.6/s #
 151     '26_for_med'   => "[% FOREACH [0..100]      ; i ; END %]",            #   -5%  #   41%  #   19%  #   24%  # 404.5/s #
 152     '27_while'     => "[% f = 10 %][%WHILE f%][%f=f- 1%][%f%][% END %]",  #    0%  #  161%  #   65%  #  120%  # 1604.2/s #
 153     '28_whl_set_l' => "[% f = 10; WHILE (g=f) ; f = f - 1 ; f ; END %]",  #   -3%  #  128%  #   50%  #   91%  # 1285.6/s #
 154     '29_whl_set_s' => "[% f = 1;  WHILE (g=f) ; f = f - 1 ; f ; END %]",  #   51%  #  287%  #  196%  #  227%  # 5914.2/s #
 155     '30_file_proc' => "[% PROCESS bar.tt %]",                             #  231%  #  492%  #  370%  #  468%  # 10900.5/s #
 156     '31_file_incl' => "[% INCLUDE baz.tt %]",                             #  150%  #  403%  #  278%  #  335%  # 6915.6/s #
 157     '32_process'   => "[% BLOCK foo %]Hi[% END %][% PROCESS foo %]",      #  159%  #  519%  #  396%  #  463%  # 10647.0/s #
 158     '33_include'   => "[% BLOCK foo %]Hi[% END %][% INCLUDE foo %]",      #  137%  #  491%  #  367%  #  424%  # 9087.9/s #
 159     '34_macro'     => "[% MACRO foo BLOCK %]Hi[% END %][% foo %]",        #   76%  #  364%  #  276%  #  285%  # 7838.4/s #
 160     '35_macro_arg' => "[% MACRO foo(n) BLOCK %]Hi[%n%][%END%][%foo(2)%]", #   64%  #  263%  #  251%  #  200%  # 6532.9/s #
 161     '36_macro_pro' => "[% MACRO foo PROCESS bar;BLOCK bar%]7[%END;foo%]", #   95%  #  393%  #  300%  #  333%  # 6369.2/s #
 162     '37_filter2'   => "[% n = 1 %][% n | repeat(2) %]",                   #  129%  #  394%  #  342%  #  313%  # 10703.2/s #
 163     '38_filter'    => "[% n = 1 %][% n FILTER repeat(2) %]",              #   90%  #  322%  #  286%  #  245%  # 8865.2/s #
 164     '39_fltr_name' => "[% n=1; n FILTER echo=repeat(2); n FILTER echo%]", #   36%  #  284%  #  211%  #  229%  # 5824.9/s #
 165     '40_constant'  => "[% constants.simple %]",                           #  174%  #  515%  #  435%  #  425%  # 16588.0/s #
 166     '41_perl'      => "[%one='ONE'%][% PERL %]print \"[%one%]\"[%END%]",  #   62%  #  403%  #  278%  #  332%  # 6885.4/s #
 167     '42_filtervar' => "[% 'hi' | \$filt %]",                              #   95%  #  454%  #  328%  #  370%  # 10167.3/s #
 168     '43_filteruri' => "[% ' ' | uri %]",                                  #  132%  #  550%  #  379%  #  471%  # 12524.4/s #
 169     '44_filterevl' => "[% foo | eval %]",                                 #  303%  #  530%  #  434%  #  478%  # 5475.5/s #
 170     '45_capture'   => "[% foo = BLOCK %]Hi[% END %][% foo %]",            #  102%  #  386%  #  291%  #  304%  # 10606.5/s #
 171     '46_complex'   => "$longer_template",                                 #   60%  #  290%  #  160%  #  270%  # 1054.3/s #
 172     '47_hello2000' => "$hello2000",                                       #    2%  #  136%  #   39%  #  115%  # 184.8/s #
 173     # overall                                                             #   95%  #  406%  #  251%  #  346%  #
 174
 175
 176     # With Stash::XS
 177     #'46_complex'   => "$longer_template",                                 #   -4%  #  274%  #   93%  #  228%  # 1201.9/s #
 178     ## overall                                                             #   30%  #  377%  #  211%  #  317%  #
 179 };
 180
 181 ### load the code representation
 182 my $text = {};
 183 seek DATA, 0, 0;
 184 my $data = do { local $/ = undef; <DATA> };
 185 foreach my $key (keys %$tests) {
 186     $data =~ m/(.*\Q$key\E.*)/ || next;
 187     $text->{$key} = $1;
 188 }
 189
 190 if ($show_list) {
 191     foreach my $text (sort values %$text) {
 192         print "$text\n";
 193     }
 194     exit;
 195 }
 196
 197 my $run = join("|", @run);
 198 @run = grep {/$run/} sort keys %$tests;
 199
 200 ###----------------------------------------------------------------###
 201
 202 sub file_TT_new {
 203     my $out = '';
 204     my $t = Template->new(@config1);
 205     $t->process($filename, $swap, \$out);
 206     return $out;
 207 }
 208
 209 sub str_TT_new {
 210     my $out = '';
 211     my $t = Template->new(@config1);
 212     $t->process($str_ref, $swap, \$out);
 213     return $out;
 214 }
 215
 216 sub file_TT {
 217     my $out = '';
 218     $tt1->process($filename, $swap, \$out);
 219     return $out;
 220 }
 221
 222 sub str_TT {
 223     my $out = '';
 224     $tt1->process($str_ref, $swap, \$out) || debug $tt1->error;
 225     return $out;
 226 }
 227
 228 sub file_TT_cache_new {
 229     my $out = '';
 230     my $t = Template->new(@config2);
 231     $t->process($filename, $swap, \$out);
 232     return $out;
 233 }
 234
 235 ###----------------------------------------------------------------###
 236
 237 sub file_CET_new {
 238     my $out = '';
 239     my $t = CGI::Ex::Template->new(@config1);
 240     $t->process($filename, $swap, \$out);
 241     return $out;
 242 }
 243
 244 sub str_CET_new {
 245     my $out = '';
 246     my $t = CGI::Ex::Template->new(@config1);
 247     $t->process($str_ref, $swap, \$out);
 248     return $out;
 249 }
 250
 251 sub file_CET {
 252     my $out = '';
 253     $cet->process($filename, $swap, \$out);
 254     return $out;
 255 }
 256
 257 sub str_CET {
 258     my $out = '';
 259     $cet->process($str_ref, $swap, \$out);
 260     return $out;
 261 }
 262
 263 sub str_CET_swap {
 264     my $txt = $cet->swap($str_ref, $swap);
 265     return $txt;
 266 }
 267
 268 sub file_CET_cache_new {
 269     my $out = '';
 270     my $t = CGI::Ex::Template->new(@config2);
 271     $t->process($filename, $swap, \$out);
 272     return $out;
 273 }
 274
 275 ###----------------------------------------------------------------###
 276
 277 @run = sort(keys %$tests) if $#run == -1;
 278
 279 my $output = '';
 280 my %cumulative;
 281 foreach my $test_name (@run) {
 282     die "Invalid test $test_name" if ! exists $tests->{$test_name};
 283     my $txt = $tests->{$test_name};
 284     my $sample =$text->{$test_name};
 285     $sample =~ s/^.+=>//;
 286     $sample =~ s/\#.+$//;
 287     print "-------------------------------------------------------------\n";
 288     print "Running test $test_name\n";
 289     print "Test text: $sample\n";
 290
 291     ### set the global file types
 292     $str_ref = \$txt;
 293     $filename = $tt_cache_dir ."/$test_name.tt";
 294     open(my $fh, ">$filename") || die "Couldn't open $filename: $!";
 295     print $fh $txt;
 296     close $fh;
 297
 298     #debug file_CET(), str_TT();
 299     #debug $cet->parse_tree($file);
 300
 301     ### check out put - and also allow for caching
 302     for (1..2) {
 303         if (file_CET() ne str_TT()) {
 304             debug $cet->parse_tree($str_ref);
 305             debug file_CET(), str_TT();
 306             die "file_CET didn't match";
 307         }
 308         die "file_TT didn't match "            if file_TT()      ne str_TT();
 309         die "str_CET didn't match "            if str_CET()      ne str_TT();
 310 #        die "str_CET_swap didn't match "       if str_CET_swap() ne str_TT();
 311         die "file_CET_cache_new didn't match " if file_CET_cache_new() ne str_TT();
 312         die "file_TT_cache_new didn't match " if file_TT_cache_new() ne str_TT();
 313     }
 314
 315     next if test_taint;
 316
 317 ###----------------------------------------------------------------###
 318
 319     my $r = eval { timethese (-2, {
 320         file_TT_n   => \&file_TT_new,
 321 #        str_TT_n    => \&str_TT_new,
 322         file_TT     => \&file_TT,
 323         str_TT      => \&str_TT,
 324         file_TT_c_n => \&file_TT_cache_new,
 325
 326         file_CT_n   => \&file_CET_new,
 327 #        str_CT_n    => \&str_CET_new,
 328         file_CT     => \&file_CET,
 329         str_CT      => \&str_CET,
 330 #        str_CT_sw   => \&str_CET_swap,
 331         file_CT_c_n => \&file_CET_cache_new,
 332     }) };
 333     if (! $r) {
 334         debug "$@";
 335         next;
 336     }
 337     eval { cmpthese $r };
 338
 339     my $copy = $text->{$test_name};
 340     $copy =~ s/\#.+//;
 341     $output .= $copy;
 342
 343     eval {
 344         my $hash = {
 345             '1 cached_in_memory           ' => ['file_CT',     'file_TT'],
 346             '2 new_object                 ' => ['file_CT_n',   'file_TT_n'],
 347             '3 cached_on_file (new_object)' => ['file_CT_c_n', 'file_TT_c_n'],
 348             '4 string reference           ' => ['str_CT',      'str_TT'],
 349             '5 CT new vs TT in mem        ' => ['file_CT_n',   'file_TT'],
 350             '6 CT in mem vs TT new        ' => ['file_CT',     'file_TT_n'],
 351             '7 CT in mem vs CT new        ' => ['file_CT',     'file_CT_n'],
 352             '8 TT in mem vs TT new        ' => ['file_TT',     'file_TT_n'],
 353         };
 354         foreach my $type (sort keys %$hash) {
 355             my ($key1, $key2) = @{ $hash->{$type} };
 356             my $ct = $r->{$key1};
 357             my $tt = $r->{$key2};
 358             my $ct_s = $ct->iters / ($ct->cpu_a || 1);
 359             my $tt_s = $tt->iters / ($tt->cpu_a || 1);
 360             my $p = int(100 * ($ct_s - $tt_s) / ($tt_s || 1));
 361             print "$type - CT is $p% faster than TT\n";
 362
 363             $output .= sprintf('#  %3s%%  ', $p) if $type =~ /^[1234]/;
 364
 365             ### store cumulatives
 366             if (abs($p) < 10000) {
 367                 $cumulative{$type} ||= [0, 0];
 368                 $cumulative{$type}->[0] += $p;
 369                 $cumulative{$type}->[1] ++;
 370             }
 371         }
 372     };
 373     debug "$@"
 374         if $@;
 375
 376     $output .= "# ".sprintf("%.1f", $r->{'file_CT'}->iters / ($r->{'file_CT'}->cpu_a || 1))."/s #\n";
 377 #    $output .= "#\n";
 378
 379     foreach my $row (values %cumulative) {
 380         $row->[2] = sprintf('%.1f', $row->[0] / ($row->[1]||1));
 381     }
 382
 383     if ($#run > 0) {
 384         foreach (sort keys %cumulative) {
 385             printf "Cumulative $_: %6.1f\n", $cumulative{$_}->[2];
 386         }
 387     }
 388
 389 }
 390
 391 ### add the final total row
 392 if ($#run > 0) {
 393     $output .= "    # overall" . (" "x61);
 394     foreach my $type (sort keys %cumulative) {
 395         $output .= sprintf('#  %3s%%  ', int $cumulative{$type}->[2]) if $type =~ /^[1234]/;
 396     }
 397     $output .= "#\n";
 398
 399     print $output;
 400 }
 401
 402
 403
 404 #print `ls -lR $tt_cache_dir`;
 405 __DATA__