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

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 memory_app.pl - Test memory usage and benchmark speed comparison with CGI::Application
   6
   7 =cut
   8
   9 use Benchmark qw(cmpthese timethese);
  10 use strict;
  11
  12 my $swap = {
  13     one   => "ONE",
  14     two   => "TWO",
  15     three => "THREE",
  16     a_var => "a",
  17     hash  => {a => 1, b => 2},
  18     code  => sub {"($_[0])"},
  19 };
  20
  21 my $form = q{([% has_errors %])(<TMPL_VAR has_errors>)<form name=foo><input type=text name="bar" value=""><input type=text name="baz"></form>};
  22 my $str_ht = $form . (q{Well hello there (<TMPL_VAR script_name>)} x 20) ."\n";
  23 my $str_tt = $form . (q{Well hello there ([% script_name %])}      x 20) ."\n";
  24
  25 my $template_ht = \$str_ht;
  26 my $template_tt = \$str_tt;
  27
  28 ###----------------------------------------------------------------###
  29 use Scalar::Util;
  30 use Time::HiRes;
  31 use CGI;
  32 use CGI::Ex::Dump qw(debug);
  33 use Template::Alloy load => 'Parse', 'Play', 'HTML::Template', 'Template';
  34 $Template::VERSION = 2.18;
  35 #use HTML::Template;
  36
  37 my $tests = {
  38     'C::A - bare' => sub {
  39         package FooBare;
  40         require CGI::Application;
  41         @FooBare::ISA = qw(CGI::Application);
  42
  43         sub setup {
  44             my $self = shift;
  45             $self->start_mode('main');
  46             $self->mode_param(path_info => 1);
  47             $self->run_modes(main => sub { "Simple test" });
  48         }
  49
  50         FooBare->new->run;
  51     },
  52     'C::E::A - bare' => sub {
  53         package FooBare;
  54         require CGI::Ex::App;
  55         @FooBare::ISA = qw(CGI::Ex::App);
  56
  57         sub main_run_step {
  58             my $self = shift;
  59             print "Content-Type: text/html\r\n\r\n";
  60             #$self->cgix->print_content_type;
  61             print "Simple test";
  62             1;
  63         }
  64
  65         FooBare->navigate({form => {}});
  66     },
  67     'Handwritten - bare' => sub {
  68         package FooBare2;
  69
  70         sub new { bless {}, __PACKAGE__ }
  71
  72         sub main {
  73             my $self = shift;
  74             print "Content-Type: text/html\r\n\r\n";
  75             print "Simple test";
  76         }
  77
  78         FooBare2->new->main;
  79     },
  80     #'CGI::Prototype - bare' => sub {
  81     #    package FooBare;
  82     #    require CGI::Prototype;
  83     #},
  84
  85     ###----------------------------------------------------------------###
  86
  87     #'C::A - simple htonly' => sub {
  88     #    require CGI::Application;
  89     #    my $t = CGI::Application->new->load_tmpl($template_ht, die_on_bad_params => 0);
  90     #    $t->param(script_name => 2);
  91     #    print $t->output;
  92     #},
  93     #'C::E::A - simple htonly' => sub {
  94     #    require CGI::Ex::App;
  95     #    my $out = '';
  96     #    CGI::Ex::App->new->template_obj({SYNTAX => 'hte'})->process($template_ht, {script_name=>2}, \$out);
  97     #    print $out;
  98     #},
  99
 100     'C::A - simple ht' => sub {
 101         package FooHT;
 102         require CGI::Application;
 103         @FooHT::ISA = qw(CGI::Application);
 104
 105         sub setup {
 106             my $self = shift;
 107             $self->start_mode('main');
 108             $self->mode_param(path_info => 1);
 109             $self->run_modes(main => sub {
 110                 my $self = shift;
 111                 my $t = $self->load_tmpl($template_ht, die_on_bad_params => 0);
 112                 $t->param('script_name', $0);
 113                 return $t->output();
 114             });
 115         }
 116
 117         FooHT->new->run;
 118     },
 119     'C::E::A - simple ht' => sub {
 120         package FooHT;
 121         require CGI::Ex::App;
 122         @FooHT::ISA = qw(CGI::Ex::App);
 123
 124         sub main_file_print { $template_ht }
 125         sub template_args { {SYNTAX => 'hte'} } # , GLOBAL_CACHE => 1, COMPILE_PERL => 2} }
 126         sub fill_template {}
 127         sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
 128
 129         FooHT->navigate({no_history => 1, form => {}});
 130     },
 131     'C::A - simple tt' => sub {
 132         package FooTT;
 133         require CGI::Application;
 134         @FooTT::ISA = qw(CGI::Application);
 135         require CGI::Application::Plugin::TT;
 136         CGI::Application::Plugin::TT->import;
 137
 138         sub setup {
 139             my $self = shift;
 140             $self->start_mode('main');
 141
 142             $self->run_modes(main => sub {
 143                 my $self = shift;
 144                 return $self->tt_process($template_tt, {script_name => $0});
 145             });
 146         }
 147
 148         FooTT->new->run;
 149     },
 150     'C::E::A - simple tt' => sub {
 151         package FooTT;
 152         require CGI::Ex::App;
 153         @FooTT::ISA = qw(CGI::Ex::App);
 154         sub main_file_print { $template_tt }
 155         sub fill_template {}
 156         sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
 157         FooTT->navigate({no_history => 1, form => {}});
 158     },
 159
 160     ###----------------------------------------------------------------###
 161
 162     'C::A - complex ht' => sub {
 163         package FooComplexHT;
 164         require CGI::Application;
 165         @FooComplexHT::ISA = qw(CGI::Application);
 166         require CGI::Application::Plugin::ValidateRM;
 167         CGI::Application::Plugin::ValidateRM->import('check_rm');
 168         require CGI::Application::Plugin::FillInForm;
 169         CGI::Application::Plugin::FillInForm->import('fill_form');
 170
 171         sub setup {
 172             my $self = shift;
 173             $self->start_mode('main');
 174             $self->mode_param(path_info => 1);
 175             $self->run_modes(main => sub {
 176                 my $self = shift;
 177                 my ($results, $err_page) = $self->check_rm('error_page','_profile');
 178                 return $err_page if $err_page;
 179                 die "Got here";
 180             });
 181         }
 182
 183         sub error_page {
 184             my $self = shift;
 185             my $errs = shift;
 186             my $t = $self->load_tmpl($template_ht, die_on_bad_params => 0);
 187             $t->param('script_name', $0);
 188             $t->param($errs) if $errs;
 189             $t->param(has_errors => 1) if $errs;
 190             my $q = $self->query;
 191             $q->param(bar => 'BAROOSELVELT');
 192             return $self->fill_form(\$t->output, $q);
 193         }
 194
 195         sub _profile { return {required => [qw(bar baz)], msgs => {prefix => 'err_'}} };
 196
 197         FooComplexHT->new->run;
 198     },
 199     'C::E::A - complex ht' => sub {
 200         package FooComplexHT;
 201         require CGI::Ex::App;
 202         @FooComplexHT::ISA = qw(CGI::Ex::App);
 203
 204         sub main_file_print { $template_ht }
 205         sub main_hash_fill  { {bar => 'BAROOSELVELT'} }
 206         sub main_hash_validation { {bar => {required => 1}, baz => {required => 1}} }
 207         sub main_finalize { die "Got here" }
 208         sub template_args { {SYNTAX => 'hte'} } # , GLOBAL_CACHE => 1, COMPILE_PERL => 2} }
 209         sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
 210
 211         local $ENV{'REQUEST_METHOD'} = 'POST';
 212         FooComplexHT->navigate({no_history => 1, form => {}});
 213     },
 214     'C::A - complex tt' => sub {
 215         package FooComplexTT;
 216         require CGI::Application;
 217         @FooComplexTT::ISA = qw(CGI::Application);
 218         require CGI::Application::Plugin::TT;
 219         CGI::Application::Plugin::TT->import;
 220         require CGI::Application::Plugin::ValidateRM;
 221         CGI::Application::Plugin::ValidateRM->import('check_rm');
 222         require CGI::Application::Plugin::FillInForm;
 223         CGI::Application::Plugin::FillInForm->import('fill_form');
 224
 225         sub setup {
 226             my $self = shift;
 227             $self->start_mode('main');
 228
 229             $self->run_modes(main => sub {
 230                 my $self = shift;
 231                 my ($results, $err_page) = $self->check_rm('error_page','_profile');
 232                 return $err_page if $err_page;
 233                 die "Got here";
 234             });
 235         }
 236
 237         sub error_page {
 238             my $self = shift;
 239             my $errs = shift;
 240             my $out = $self->tt_process($template_tt, {script_name => $0, %{$errs || {}}, has_errors => ($errs ? 1 : 0)});
 241             my $q = $self->query;
 242             $q->param(bar => 'BAROOSELVELT');
 243             return $self->fill_form(\$out, $q);
 244         }
 245
 246         sub _profile { return {required => [qw(bar baz)], msgs => {prefix => 'err_'}} };
 247
 248         FooComplexTT->new->run;
 249     },
 250     'C::E::A - complex tt' => sub {
 251         package FooComplexTT;
 252         require CGI::Ex::App;
 253         @FooComplexTT::ISA = qw(CGI::Ex::App);
 254         sub main_file_print { $template_tt }
 255         sub main_hash_fill  { {bar => 'BAROOSELVELT'} }
 256         sub main_hash_validation { {bar => {required => 1}, baz => {required => 1}} }
 257         sub main_finalize { die "Got here" }
 258         sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
 259
 260         local $ENV{'REQUEST_METHOD'} = 'POST';
 261         FooComplexTT->navigate({no_history => 1, form => {}});
 262     },
 263
 264     #'Template::Alloy - bare ht' => sub { require Template::Alloy; Template::Alloy->import('HTE') },
 265     #'Template::Alloy - bare tt' => sub { require Template::Alloy; Template::Alloy->import('TT') },
 266 };
 267
 268 #perl -d:DProf samples/devel/memory_app.pl ; dprofpp tmon.out
 269 #select($_) if open($_, ">>/dev/null");
 270 $tests->{'C::E::A - complex tt'}->()
 271 #    for 1 .. 1000
 272     ;
 273 #exit;
 274
 275 ###----------------------------------------------------------------###
 276
 277 my %_INC = %INC;
 278 my @pids;
 279 foreach my $name (sort keys %$tests) {
 280     my $pid = fork;
 281     if (! $pid) {
 282         $0 = "$0 - $name";
 283         my $fh;
 284         select($fh) if open($fh, ">>/dev/null");
 285         $tests->{$name}->() for 1 .. 1;
 286         sleep 1;
 287         select STDOUT;
 288         print "$name times: (@{[times]})\n";
 289         print "$name $_\n" foreach sort grep {! $_INC{$_}} keys %INC;
 290         sleep 15;
 291         exit;
 292     }
 293     push @pids, $pid;
 294 }
 295
 296 sleep 2;
 297 #    print "Parent - $_\n" foreach sort keys %INC;
 298 print grep {/\Q$0\E/} `ps fauwx`;
 299 kill 15, @pids;
 300
 301 ###----------------------------------------------------------------###
 302
 303 exit if grep {/no_?bench/i} @ARGV;
 304
 305
 306 foreach my $type (qw(bare simple complex)) {
 307     my $hash = {};
 308     open(my $fh, ">>/dev/null") || die "Can't access /dev/null: $!";
 309     foreach my $name (keys %$tests) {
 310         next if $name !~ /\b$type\b/;
 311         (my $copy = $name) =~ s/\s*\b$type\b//;
 312         $hash->{$copy} = sub {
 313             select $fh;
 314             $tests->{$name}->();
 315             select STDOUT;
 316         };
 317     }
 318     print "-------------------------------------------------\n";
 319     print "--- Testing $type\n";
 320     cmpthese timethese -2, $hash;
 321 }
 322
 323 =head1 NOTES
 324
 325 Abbreviations:
 326
 327   C::E::A - CGI::Ex::App
 328   C::A    - CGI::Application
 329
 330 The tests are currently run with the following code:
 331
 332   use Template::Alloy load => 'Parse', 'Play', 'HTML::Template', 'Template';
 333
 334 This assures that CGI::Application will use the same templating system
 335 as CGI::Ex::App so that template system issues don't affect overall
 336 performance.  With the line commented out and CGI::Application using
 337 HTML::Template (ht), C::A has a slight speed benefit, though it still
 338 uses more memory.  With the line commented out and CGI::Application
 339 using Template (tt), C::E::A is 2 to 3 times faster and uses a lot
 340 less memory.
 341
 342 =head1 SAMPLE OUTPUT
 343
 344   paul     23927  4.3  0.5   8536  6016 pts/1    S+   11:36   0:00  |       \_ perl samples/devel/memory_app.pl
 345   paul     23928  1.0  0.5   8988  5992 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::A - bare
 346   paul     23929  2.0  0.6   9988  7152 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::A - complex ht
 347   paul     23930  2.5  0.7  10172  7336 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::A - complex tt
 348   paul     23931  1.0  0.5   8988  6024 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::A - simple ht
 349   paul     23932  1.5  0.6   9308  6276 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::A - simple tt
 350   paul     23933  0.0  0.5   8536  5200 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::E::A - bare
 351   paul     23934  1.0  0.6   9328  6384 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::E::A - complex ht
 352   paul     23935  1.0  0.6   9328  6392 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::E::A - complex tt
 353   paul     23936  0.0  0.5   8536  5272 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::E::A - simple ht
 354   paul     23937  0.0  0.5   8668  5344 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - C::E::A - simple tt
 355   paul     23938  0.0  0.4   8536  5076 pts/1    S+   11:36   0:00  |           \_ samples/devel/memory_app.pl - Handwritten - bare
 356   -------------------------------------------------
 357   --- Testing bare
 358   Benchmark: running C::A -, C::E::A -, Handwritten - for at least 2 CPU seconds...
 359       C::A -:  3 wallclock secs ( 2.08 usr +  0.01 sys =  2.09 CPU) @ 3196.17/s (n=6680)
 360    C::E::A -:  3 wallclock secs ( 1.99 usr +  0.19 sys =  2.18 CPU) @ 6164.68/s (n=13439)
 361   Handwritten -:  1 wallclock secs ( 2.15 usr +  0.00 sys =  2.15 CPU) @ 266711.16/s (n=573429)
 362                     Rate        C::A -     C::E::A - Handwritten -
 363   C::A -          3196/s            --          -48%          -99%
 364   C::E::A -       6165/s           93%            --          -98%
 365   Handwritten - 266711/s         8245%         4226%            --
 366   -------------------------------------------------
 367   --- Testing simple
 368   Benchmark: running C::A - ht, C::A - tt, C::E::A - ht, C::E::A - tt for at least 2 CPU seconds...
 369    C::A - ht:  2 wallclock secs ( 2.04 usr +  0.00 sys =  2.04 CPU) @ 709.80/s (n=1448)
 370    C::A - tt:  2 wallclock secs ( 2.12 usr +  0.01 sys =  2.13 CPU) @ 600.47/s (n=1279)
 371   C::E::A - ht:  2 wallclock secs ( 2.14 usr +  0.01 sys =  2.15 CPU) @ 663.26/s (n=1426)
 372   C::E::A - tt:  3 wallclock secs ( 2.16 usr +  0.01 sys =  2.17 CPU) @ 589.40/s (n=1279)
 373                 Rate C::E::A - tt    C::A - tt C::E::A - ht    C::A - ht
 374   C::E::A - tt 589/s           --          -2%         -11%         -17%
 375   C::A - tt    600/s           2%           --          -9%         -15%
 376   C::E::A - ht 663/s          13%          10%           --          -7%
 377   C::A - ht    710/s          20%          18%           7%           --
 378   -------------------------------------------------
 379   --- Testing complex
 380   Benchmark: running C::A - ht, C::A - tt, C::E::A - ht, C::E::A - tt for at least 2 CPU seconds...
 381    C::A - ht:  2 wallclock secs ( 2.00 usr +  0.00 sys =  2.00 CPU) @ 438.50/s (n=877)
 382    C::A - tt:  3 wallclock secs ( 2.16 usr +  0.00 sys =  2.16 CPU) @ 383.80/s (n=829)
 383   C::E::A - ht:  2 wallclock secs ( 2.14 usr +  0.01 sys =  2.15 CPU) @ 457.21/s (n=983)
 384   C::E::A - tt:  2 wallclock secs ( 2.13 usr +  0.00 sys =  2.13 CPU) @ 417.37/s (n=889)
 385                 Rate    C::A - tt C::E::A - tt    C::A - ht C::E::A - ht
 386   C::A - tt    384/s           --          -8%         -12%         -16%
 387   C::E::A - tt 417/s           9%           --          -5%          -9%
 388   C::A - ht    438/s          14%           5%           --          -4%
 389   C::E::A - ht 457/s          19%          10%           4%           --
 390
 391 =cut