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

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 bench_auth.pl - Test relative performance of CGI::Ex::Auth
   6
   7 =head1 SAMPLE OUTPUT
   8
   9   Benchmark: running cookie_bad, cookie_good, cookie_good2, form_bad, form_good, form_good2, form_good3, form_good4 for at least 2 CPU seconds...
  10   cookie_bad:  3 wallclock secs ( 2.15 usr +  0.00 sys =  2.15 CPU) @ 6819.07/s (n=14661)
  11   cookie_good:  3 wallclock secs ( 2.01 usr +  0.08 sys =  2.09 CPU) @ 6047.85/s (n=12640)
  12   cookie_good2:  2 wallclock secs ( 1.95 usr +  0.10 sys =  2.05 CPU) @ 5087.80/s (n=10430)
  13     form_bad:  3 wallclock secs ( 2.19 usr +  0.00 sys =  2.19 CPU) @ 6542.92/s (n=14329)
  14    form_good:  3 wallclock secs ( 2.08 usr +  0.05 sys =  2.13 CPU) @ 6108.45/s (n=13011)
  15   form_good2:  3 wallclock secs ( 2.05 usr +  0.09 sys =  2.14 CPU) @ 5023.36/s (n=10750)
  16   form_good3:  3 wallclock secs ( 2.17 usr +  0.01 sys =  2.18 CPU) @ 7040.83/s (n=15349)
  17   form_good4:  3 wallclock secs ( 2.12 usr +  0.00 sys =  2.12 CPU) @ 1947.64/s (n=4129)
  18                  Rate form_good4 form_good2 cookie_good2 cookie_good form_good form_bad cookie_bad form_good3
  19   form_good4   1948/s         --       -61%         -62%        -68%      -68%     -70%       -71%       -72%
  20   form_good2   5023/s       158%         --          -1%        -17%      -18%     -23%       -26%       -29%
  21   cookie_good2 5088/s       161%         1%           --        -16%      -17%     -22%       -25%       -28%
  22   cookie_good  6048/s       211%        20%          19%          --       -1%      -8%       -11%       -14%
  23   form_good    6108/s       214%        22%          20%          1%        --      -7%       -10%       -13%
  24   form_bad     6543/s       236%        30%          29%          8%        7%       --        -4%        -7%
  25   cookie_bad   6819/s       250%        36%          34%         13%       12%       4%         --        -3%
  26   form_good3   7041/s       262%        40%          38%         16%       15%       8%         3%         --
  27
  28 =cut
  29
  30 use strict;
  31 use Benchmark qw(cmpthese timethese);
  32 use CGI::Ex::Auth;
  33 use CGI::Ex::Dump qw(debug);
  34
  35 {
  36     package Auth;
  37     use base qw(CGI::Ex::Auth);
  38     use strict;
  39     use vars qw($printed $set_cookie $deleted_cookie);
  40
  41     sub login_print      { $printed = 1 }
  42     sub set_cookie       { $set_cookie = 1 }
  43     sub delete_cookie    { $deleted_cookie = 1 }
  44     sub get_pass_by_user { '123qwe' }
  45     sub script_name      { $0 }
  46     sub no_cookie_verify { 1 }
  47     sub secure_hash_keys { ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa', 'bbbbbbbbbbbbbbbbbbbbbbbbbbb', 'ccc'] }
  48 }
  49
  50 {
  51     package Aut2;
  52     use base qw(Auth);
  53     use vars qw($crypt);
  54     BEGIN { $crypt = crypt('123qwe', 'SS') };
  55     sub use_crypt { 1 }
  56     sub get_pass_by_user { $crypt }
  57 }
  58
  59 {
  60     package Aut3;
  61     use base qw(Auth);
  62     sub use_blowfish  { "This_is_my_key" }
  63     sub use_base64    { 0 }
  64     sub use_plaintext { 1 }
  65 }
  66
  67 my $token  = Auth->new->generate_token({user => 'test', real_pass => '123qwe', use_base64 => 1});
  68 my $token2 = Aut3->new->generate_token({user => 'test', real_pass => '123qwe'});
  69
  70 my $form_bad     = { cea_user => 'test',   cea_pass => '123qw'  };
  71 my $form_good    = { cea_user => 'test',   cea_pass => '123qwe' };
  72 my $form_good2   = { cea_user => $token };
  73 my $form_good3   = { cea_user => 'test/123qwe' };
  74 my $form_good4   = { cea_user => $token2 };
  75 my $cookie_bad   = { cea_user => 'test/123qw'  };
  76 my $cookie_good  = { cea_user => 'test/123qwe' };
  77 my $cookie_good2 = { cea_user => $token };
  78
  79 sub form_good    { Auth->get_valid_auth({form => {%$form_good},  cookies => {}              }) }
  80 sub form_good2   { Auth->get_valid_auth({form => {%$form_good2}, cookies => {}              }) }
  81 sub form_good3   { Aut2->get_valid_auth({form => {%$form_good3}, cookies => {}              }) }
  82 sub form_good4   { Aut3->get_valid_auth({form => {%$form_good4}, cookies => {}              }) }
  83 sub form_bad     { Auth->get_valid_auth({form => {%$form_bad},   cookies => {}              }) }
  84 sub cookie_good  { Auth->get_valid_auth({form => {},             cookies => {%$cookie_good} }) }
  85 sub cookie_good2 { Auth->get_valid_auth({form => {},             cookies => {%$cookie_good2}}) }
  86 sub cookie_bad   { Auth->get_valid_auth({form => {},             cookies => {%$cookie_bad}  }) }
  87
  88 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
  89 die "Didn't get good auth"         if ! form_good();
  90 die "printed was set"              if $Auth::printed;
  91 die "set_cookie not called"        if ! $Auth::set_cookie;
  92 die "delete_cookie was called"     if $Auth::deleted_cookie;
  93
  94 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
  95 debug form_good2(), (my $e = $@);
  96 die "Didn't get good auth"         if ! form_good2();
  97 die "printed was set"              if $Auth::printed;
  98 die "set_cookie not called"        if ! $Auth::set_cookie;
  99 die "delete_cookie was called"     if $Auth::deleted_cookie;
 100
 101 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 102 die "Didn't get good auth"         if ! form_good3();
 103 die "printed was set"              if $Auth::printed;
 104 die "set_cookie not called"        if ! $Auth::set_cookie;
 105 die "delete_cookie was called"     if $Auth::deleted_cookie;
 106
 107 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 108 debug form_good4(), (my $e = $@);
 109 die "Didn't get good auth"         if ! form_good4();
 110 die "printed was set"              if $Auth::printed;
 111 die "set_cookie not called"        if ! $Auth::set_cookie;
 112 die "delete_cookie was called"     if $Auth::deleted_cookie;
 113
 114 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 115 die "Didn't get bad auth"          if form_bad();
 116 die "printed was not set"          if ! $Auth::printed;
 117 die "set_cookie called"            if $Auth::set_cookie;
 118 die "delete_cookie was called"     if $Auth::deleted_cookie;
 119
 120 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 121 die "Didn't get good auth"         if ! cookie_good();
 122 die "printed was set"              if $Auth::printed;
 123 die "set_cookie not called"        if ! $Auth::set_cookie;
 124 die "delete_cookie was called"     if $Auth::deleted_cookie;
 125
 126 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 127 die "Didn't get good auth"         if ! cookie_good2();
 128 die "printed was set"              if $Auth::printed;
 129 die "set_cookie not called"        if ! $Auth::set_cookie;
 130 die "delete_cookie was called"     if $Auth::deleted_cookie;
 131
 132 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 133 die "Didn't get bad auth"          if cookie_bad();
 134 die "printed was not set"          if ! $Auth::printed;
 135 die "set_cookie called"            if $Auth::set_cookie;
 136 die "delete_cookie was not called" if ! $Auth::deleted_cookie;
 137
 138 print "Ready\n";
 139
 140 my $r = eval { timethese (-2, {
 141     form_good    => \&form_good,
 142     form_good2   => \&form_good2,
 143     form_good3   => \&form_good3,
 144     form_good4   => \&form_good4,
 145     form_bad     => \&form_bad,
 146     cookie_good  => \&cookie_good,
 147     cookie_good2 => \&cookie_good2,
 148     cookie_bad   => \&cookie_bad,
 149 }) };
 150 if (! $r) {
 151     debug "$@";
 152     next;
 153 }
 154 eval { cmpthese $r };