--- /dev/null
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+memory_app.pl - Test memory usage and benchmark speed comparison with CGI::Application
+
+=cut
+
+use Benchmark qw(cmpthese timethese);
+use strict;
+
+my $swap = {
+ one => "ONE",
+ two => "TWO",
+ three => "THREE",
+ a_var => "a",
+ hash => {a => 1, b => 2},
+ code => sub {"($_[0])"},
+};
+
+my $form = q{([% has_errors %])(<TMPL_VAR has_errors>)<form name=foo><input type=text name="bar" value=""><input type=text name="baz"></form>};
+my $str_ht = $form . (q{Well hello there (<TMPL_VAR script_name>)} x 20) ."\n";
+my $str_tt = $form . (q{Well hello there ([% script_name %])} x 20) ."\n";
+
+my $template_ht = \$str_ht;
+my $template_tt = \$str_tt;
+
+###----------------------------------------------------------------###
+use Scalar::Util;
+use Time::HiRes;
+use CGI;
+use CGI::Ex::Dump qw(debug);
+use Template::Alloy load => 'Parse', 'Play', 'HTML::Template', 'Template';
+$Template::VERSION = 2.18;
+#use HTML::Template;
+
+my $tests = {
+ 'C::A - bare' => sub {
+ package FooBare;
+ require CGI::Application;
+ @FooBare::ISA = qw(CGI::Application);
+
+ sub setup {
+ my $self = shift;
+ $self->start_mode('main');
+ $self->mode_param(path_info => 1);
+ $self->run_modes(main => sub { "Simple test" });
+ }
+
+ FooBare->new->run;
+ },
+ 'C::E::A - bare' => sub {
+ package FooBare;
+ require CGI::Ex::App;
+ @FooBare::ISA = qw(CGI::Ex::App);
+
+ sub main_run_step {
+ my $self = shift;
+ print "Content-Type: text/html\r\n\r\n";
+ #$self->cgix->print_content_type;
+ print "Simple test";
+ 1;
+ }
+
+ FooBare->navigate({form => {}});
+ },
+ 'Handwritten - bare' => sub {
+ package FooBare2;
+
+ sub new { bless {}, __PACKAGE__ }
+
+ sub main {
+ my $self = shift;
+ print "Content-Type: text/html\r\n\r\n";
+ print "Simple test";
+ }
+
+ FooBare2->new->main;
+ },
+ #'CGI::Prototype - bare' => sub {
+ # package FooBare;
+ # require CGI::Prototype;
+ #},
+
+ ###----------------------------------------------------------------###
+
+ #'C::A - simple htonly' => sub {
+ # require CGI::Application;
+ # my $t = CGI::Application->new->load_tmpl($template_ht, die_on_bad_params => 0);
+ # $t->param(script_name => 2);
+ # print $t->output;
+ #},
+ #'C::E::A - simple htonly' => sub {
+ # require CGI::Ex::App;
+ # my $out = '';
+ # CGI::Ex::App->new->template_obj({SYNTAX => 'hte'})->process($template_ht, {script_name=>2}, \$out);
+ # print $out;
+ #},
+
+ 'C::A - simple ht' => sub {
+ package FooHT;
+ require CGI::Application;
+ @FooHT::ISA = qw(CGI::Application);
+
+ sub setup {
+ my $self = shift;
+ $self->start_mode('main');
+ $self->mode_param(path_info => 1);
+ $self->run_modes(main => sub {
+ my $self = shift;
+ my $t = $self->load_tmpl($template_ht, die_on_bad_params => 0);
+ $t->param('script_name', $0);
+ return $t->output();
+ });
+ }
+
+ FooHT->new->run;
+ },
+ 'C::E::A - simple ht' => sub {
+ package FooHT;
+ require CGI::Ex::App;
+ @FooHT::ISA = qw(CGI::Ex::App);
+
+ sub main_file_print { $template_ht }
+ sub template_args { {SYNTAX => 'hte'} } # , GLOBAL_CACHE => 1, COMPILE_PERL => 2} }
+ sub fill_template {}
+ sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
+
+ FooHT->navigate({no_history => 1, form => {}});
+ },
+ 'C::A - simple tt' => sub {
+ package FooTT;
+ require CGI::Application;
+ @FooTT::ISA = qw(CGI::Application);
+ require CGI::Application::Plugin::TT;
+ CGI::Application::Plugin::TT->import;
+
+ sub setup {
+ my $self = shift;
+ $self->start_mode('main');
+
+ $self->run_modes(main => sub {
+ my $self = shift;
+ return $self->tt_process($template_tt, {script_name => $0});
+ });
+ }
+
+ FooTT->new->run;
+ },
+ 'C::E::A - simple tt' => sub {
+ package FooTT;
+ require CGI::Ex::App;
+ @FooTT::ISA = qw(CGI::Ex::App);
+ sub main_file_print { $template_tt }
+ sub fill_template {}
+ sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
+ FooTT->navigate({no_history => 1, form => {}});
+ },
+
+ ###----------------------------------------------------------------###
+
+ 'C::A - complex ht' => sub {
+ package FooComplexHT;
+ require CGI::Application;
+ @FooComplexHT::ISA = qw(CGI::Application);
+ require CGI::Application::Plugin::ValidateRM;
+ CGI::Application::Plugin::ValidateRM->import('check_rm');
+ require CGI::Application::Plugin::FillInForm;
+ CGI::Application::Plugin::FillInForm->import('fill_form');
+
+ sub setup {
+ my $self = shift;
+ $self->start_mode('main');
+ $self->mode_param(path_info => 1);
+ $self->run_modes(main => sub {
+ my $self = shift;
+ my ($results, $err_page) = $self->check_rm('error_page','_profile');
+ return $err_page if $err_page;
+ die "Got here";
+ });
+ }
+
+ sub error_page {
+ my $self = shift;
+ my $errs = shift;
+ my $t = $self->load_tmpl($template_ht, die_on_bad_params => 0);
+ $t->param('script_name', $0);
+ $t->param($errs) if $errs;
+ $t->param(has_errors => 1) if $errs;
+ my $q = $self->query;
+ $q->param(bar => 'BAROOSELVELT');
+ return $self->fill_form(\$t->output, $q);
+ }
+
+ sub _profile { return {required => [qw(bar baz)], msgs => {prefix => 'err_'}} };
+
+ FooComplexHT->new->run;
+ },
+ 'C::E::A - complex ht' => sub {
+ package FooComplexHT;
+ require CGI::Ex::App;
+ @FooComplexHT::ISA = qw(CGI::Ex::App);
+
+ sub main_file_print { $template_ht }
+ sub main_hash_fill { {bar => 'BAROOSELVELT'} }
+ sub main_hash_validation { {bar => {required => 1}, baz => {required => 1}} }
+ sub main_finalize { die "Got here" }
+ sub template_args { {SYNTAX => 'hte'} } # , GLOBAL_CACHE => 1, COMPILE_PERL => 2} }
+ sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
+
+ local $ENV{'REQUEST_METHOD'} = 'POST';
+ FooComplexHT->navigate({no_history => 1, form => {}});
+ },
+ 'C::A - complex tt' => sub {
+ package FooComplexTT;
+ require CGI::Application;
+ @FooComplexTT::ISA = qw(CGI::Application);
+ require CGI::Application::Plugin::TT;
+ CGI::Application::Plugin::TT->import;
+ require CGI::Application::Plugin::ValidateRM;
+ CGI::Application::Plugin::ValidateRM->import('check_rm');
+ require CGI::Application::Plugin::FillInForm;
+ CGI::Application::Plugin::FillInForm->import('fill_form');
+
+ sub setup {
+ my $self = shift;
+ $self->start_mode('main');
+
+ $self->run_modes(main => sub {
+ my $self = shift;
+ my ($results, $err_page) = $self->check_rm('error_page','_profile');
+ return $err_page if $err_page;
+ die "Got here";
+ });
+ }
+
+ sub error_page {
+ my $self = shift;
+ my $errs = shift;
+ my $out = $self->tt_process($template_tt, {script_name => $0, %{$errs || {}}, has_errors => ($errs ? 1 : 0)});
+ my $q = $self->query;
+ $q->param(bar => 'BAROOSELVELT');
+ return $self->fill_form(\$out, $q);
+ }
+
+ sub _profile { return {required => [qw(bar baz)], msgs => {prefix => 'err_'}} };
+
+ FooComplexTT->new->run;
+ },
+ 'C::E::A - complex tt' => sub {
+ package FooComplexTT;
+ require CGI::Ex::App;
+ @FooComplexTT::ISA = qw(CGI::Ex::App);
+ sub main_file_print { $template_tt }
+ sub main_hash_fill { {bar => 'BAROOSELVELT'} }
+ sub main_hash_validation { {bar => {required => 1}, baz => {required => 1}} }
+ sub main_finalize { die "Got here" }
+ sub print_out { my ($self, $step, $out) = @_; print "Content-Type: text/html\r\n\r\n$$out" }
+
+ local $ENV{'REQUEST_METHOD'} = 'POST';
+ FooComplexTT->navigate({no_history => 1, form => {}});
+ },
+
+ #'Template::Alloy - bare ht' => sub { require Template::Alloy; Template::Alloy->import('HTE') },
+ #'Template::Alloy - bare tt' => sub { require Template::Alloy; Template::Alloy->import('TT') },
+};
+
+#perl -d:DProf samples/devel/memory_app.pl ; dprofpp tmon.out
+#select($_) if open($_, ">>/dev/null");
+$tests->{'C::E::A - complex tt'}->()
+# for 1 .. 1000
+ ;
+#exit;
+
+###----------------------------------------------------------------###
+
+my %_INC = %INC;
+my @pids;
+foreach my $name (sort keys %$tests) {
+ my $pid = fork;
+ if (! $pid) {
+ $0 = "$0 - $name";
+ my $fh;
+ select($fh) if open($fh, ">>/dev/null");
+ $tests->{$name}->() for 1 .. 1;
+ sleep 1;
+ select STDOUT;
+ print "$name times: (@{[times]})\n";
+ print "$name $_\n" foreach sort grep {! $_INC{$_}} keys %INC;
+ sleep 15;
+ exit;
+ }
+ push @pids, $pid;
+}
+
+sleep 2;
+# print "Parent - $_\n" foreach sort keys %INC;
+print grep {/\Q$0\E/} `ps fauwx`;
+kill 15, @pids;
+
+###----------------------------------------------------------------###
+
+exit if grep {/no_?bench/i} @ARGV;
+
+
+foreach my $type (qw(bare simple complex)) {
+ my $hash = {};
+ open(my $fh, ">>/dev/null") || die "Can't access /dev/null: $!";
+ foreach my $name (keys %$tests) {
+ next if $name !~ /\b$type\b/;
+ (my $copy = $name) =~ s/\s*\b$type\b//;
+ $hash->{$copy} = sub {
+ select $fh;
+ $tests->{$name}->();
+ select STDOUT;
+ };
+ }
+ print "-------------------------------------------------\n";
+ print "--- Testing $type\n";
+ cmpthese timethese -2, $hash;
+}
+
+=head1 NOTES
+
+Abbreviations:
+
+ C::E::A - CGI::Ex::App
+ C::A - CGI::Application
+
+The tests are currently run with the following code:
+
+ use Template::Alloy load => 'Parse', 'Play', 'HTML::Template', 'Template';
+
+This assures that CGI::Application will use the same templating system
+as CGI::Ex::App so that template system issues don't affect overall
+performance. With the line commented out and CGI::Application using
+HTML::Template (ht), C::A has a slight speed benefit, though it still
+uses more memory. With the line commented out and CGI::Application
+using Template (tt), C::E::A is 2 to 3 times faster and uses a lot
+less memory.
+
+=head1 SAMPLE OUTPUT
+
+ paul 23927 4.3 0.5 8536 6016 pts/1 S+ 11:36 0:00 | \_ perl samples/devel/memory_app.pl
+ paul 23928 1.0 0.5 8988 5992 pts/1 S+ 11:36 0:00 | \_ samples/devel/memory_app.pl - C::A - bare
+ paul 23929 2.0 0.6 9988 7152 pts/1 S+ 11:36 0:00 | \_ samples/devel/memory_app.pl - C::A - complex ht
+ paul 23930 2.5 0.7 10172 7336 pts/1 S+ 11:36 0:00 | \_ samples/devel/memory_app.pl - C::A - complex tt
+ paul 23931 1.0 0.5 8988 6024 pts/1 S+ 11:36 0:00 | \_ samples/devel/memory_app.pl - C::A - simple ht
+ paul 23932 1.5 0.6 9308 6276 pts/1 S+ 11:36 0:00 | \_ samples/devel/memory_app.pl - C::A - simple tt
+ paul 23933 0.0 0.5 8536 5200 pts/1 S+ 11:36 0:00 | \_ samples/devel/memory_app.pl - C::E::A - bare
+ 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
+ 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
+ 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
+ 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
+ paul 23938 0.0 0.4 8536 5076 pts/1 S+ 11:36 0:00 | \_ samples/devel/memory_app.pl - Handwritten - bare
+ -------------------------------------------------
+ --- Testing bare
+ Benchmark: running C::A -, C::E::A -, Handwritten - for at least 2 CPU seconds...
+ C::A -: 3 wallclock secs ( 2.08 usr + 0.01 sys = 2.09 CPU) @ 3196.17/s (n=6680)
+ C::E::A -: 3 wallclock secs ( 1.99 usr + 0.19 sys = 2.18 CPU) @ 6164.68/s (n=13439)
+ Handwritten -: 1 wallclock secs ( 2.15 usr + 0.00 sys = 2.15 CPU) @ 266711.16/s (n=573429)
+ Rate C::A - C::E::A - Handwritten -
+ C::A - 3196/s -- -48% -99%
+ C::E::A - 6165/s 93% -- -98%
+ Handwritten - 266711/s 8245% 4226% --
+ -------------------------------------------------
+ --- Testing simple
+ Benchmark: running C::A - ht, C::A - tt, C::E::A - ht, C::E::A - tt for at least 2 CPU seconds...
+ C::A - ht: 2 wallclock secs ( 2.04 usr + 0.00 sys = 2.04 CPU) @ 709.80/s (n=1448)
+ C::A - tt: 2 wallclock secs ( 2.12 usr + 0.01 sys = 2.13 CPU) @ 600.47/s (n=1279)
+ C::E::A - ht: 2 wallclock secs ( 2.14 usr + 0.01 sys = 2.15 CPU) @ 663.26/s (n=1426)
+ C::E::A - tt: 3 wallclock secs ( 2.16 usr + 0.01 sys = 2.17 CPU) @ 589.40/s (n=1279)
+ Rate C::E::A - tt C::A - tt C::E::A - ht C::A - ht
+ C::E::A - tt 589/s -- -2% -11% -17%
+ C::A - tt 600/s 2% -- -9% -15%
+ C::E::A - ht 663/s 13% 10% -- -7%
+ C::A - ht 710/s 20% 18% 7% --
+ -------------------------------------------------
+ --- Testing complex
+ Benchmark: running C::A - ht, C::A - tt, C::E::A - ht, C::E::A - tt for at least 2 CPU seconds...
+ C::A - ht: 2 wallclock secs ( 2.00 usr + 0.00 sys = 2.00 CPU) @ 438.50/s (n=877)
+ C::A - tt: 3 wallclock secs ( 2.16 usr + 0.00 sys = 2.16 CPU) @ 383.80/s (n=829)
+ C::E::A - ht: 2 wallclock secs ( 2.14 usr + 0.01 sys = 2.15 CPU) @ 457.21/s (n=983)
+ C::E::A - tt: 2 wallclock secs ( 2.13 usr + 0.00 sys = 2.13 CPU) @ 417.37/s (n=889)
+ Rate C::A - tt C::E::A - tt C::A - ht C::E::A - ht
+ C::A - tt 384/s -- -8% -12% -16%
+ C::E::A - tt 417/s 9% -- -5% -9%
+ C::A - ht 438/s 14% 5% -- -4%
+ C::E::A - ht 457/s 19% 10% 4% --
+
+=cut
projects / chaz / p5-CGI-Ex / blobdiff