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

   1 #!/usr/bin/perl -w
   2
   3 use Benchmark qw(timethese cmpthese countit timestr);
   4 use CGI::Ex::Dump qw(debug);
   5 use CGI::Ex::Validate;
   6 use Data::FormValidator;
   7
   8 my $form = {
   9   username  => "++foobar++",
  10   password  => "123",
  11   password2 => "1234",
  12 };
  13
  14 my $val_hash_ce = {
  15     username => {
  16         required => 1,
  17         match    => 'm/^\w+$/',
  18         match_error => '$name may only contain letters and numbers',
  19         untaint  => 1,
  20     },
  21     password => {
  22         required => 1,
  23         match    => 'm/^[ -~]{6,30}$/',
  24 #        min_len  => 6,
  25 #        max_len  => 30,
  26 #        match    => 'm/^[ -~]+$/',
  27         untaint  => 1,
  28     },
  29     password2 => {
  30         validate_if => 'password was_valid',
  31         equals      => 'password',
  32     },
  33     email => {
  34         required => 1,
  35         match    => 'm/^[\w\.\-]+\@[\w\.\-]+$/',
  36         untaint  => 1,
  37     },
  38 };
  39
  40 my $val_hash_df = {
  41     required => [qw(username password email)],
  42     dependencies => {
  43         password => [qw(password2)],
  44     },
  45     constraints => {
  46         email    => qr/^[\w\.\-]+\@[\w\.\-]+$/,
  47         password => qr/^[ -~]{6,30}$/,
  48         username => qr/^\w+$/,
  49     },
  50     untaint_all_constraints => 1,
  51     msgs => {
  52         format => '%s',
  53         prefix => 'error_',
  54     },
  55 };
  56
  57 sub check_form {
  58   my $form = shift;
  59   my $hash = {};
  60   if (! exists $form->{'username'}) {
  61     push @{ $hash->{'username_error'} }, 'Username required';
  62   } elsif ($form->{'username'} !~ m/^(\w+)$/) {
  63     push @{ $hash->{'username_error'} }, 'Username may only contain letters and numbers';
  64   } else {
  65     $form->{'username'} = $1;
  66   }
  67   if (! exists $form->{'password'}) {
  68     push @{ $hash->{'password_error'} }, 'Password required';
  69   } else {
  70     if ($form->{'password'} !~ m/^([ -~]+)$/) {
  71       push @{ $hash->{'password_error'} }, 'Password contained bad characters';
  72     } else {
  73       $form->{'password'} = $1;
  74     }
  75     if (length($form->{'password'}) < 6) {
  76       push @{ $hash->{'password_error'} }, 'Password must be more than 6 characters';
  77     } elsif (length($form->{'password'}) > 30) {
  78       push @{ $hash->{'password_error'} }, 'Password must be less than 30 characters';
  79     }
  80
  81     if (exists($form->{'password'})
  82         && ! $hash->{'password_error'}
  83         && (! defined($form->{'password2'})
  84             || $form->{'password2'} ne $form->{'password'})) {
  85       push @{ $hash->{'password2_error'} }, 'Password2 and password must be the same';
  86     }
  87   }
  88
  89   if (! exists $form->{'email'}) {
  90     push @{ $hash->{'email_error'} }, 'Email required';
  91   } elsif ($form->{'email'} !~ m/^[\w\.\-]+\@[\w\.\-]+$/) {
  92     push @{ $hash->{'email_error'} }, 'Please type a valid email address';
  93   }
  94
  95   return $hash;
  96 }
  97
  98 debug(CGI::Ex::Validate->validate($form, $val_hash_ce)->as_hash);
  99 debug(Data::FormValidator->check($form, $val_hash_df)->msgs);
 100 debug(check_form($form));
 101
 102 cmpthese (-2,{
 103   cgi_ex    => sub { my $t = CGI::Ex::Validate->validate($form, $val_hash_ce) },
 104   data_val  => sub { my $t = Data::FormValidator->check($form, $val_hash_df) },
 105   homegrown => sub { my $t = check_form($form) },
 106 },'auto');
 107
 108 cmpthese (-2,{
 109   cgi_ex    => sub { my $t = CGI::Ex::Validate->validate($form, $val_hash_ce)->as_hash },
 110   data_val  => sub { my $t = Data::FormValidator->check($form, $val_hash_df)->msgs },
 111   homegrown => sub { my $t = scalar keys %{ check_form($form) } },
 112 },'auto');
 113
 114 ### Home grown solution blows the others away - but lacks features
 115 #
 116 # Benchmark: running cgi_ex, data_val, homegrown for at least 2 CPU seconds...
 117 #   cgi_ex:  3 wallclock secs ( 2.04 usr +  0.00 sys =  2.04 CPU) @ 2845.10/s (n=5804)
 118 #   data_val:  3 wallclock secs ( 2.17 usr +  0.00 sys =  2.17 CPU) @ 1884.79/s (n=4090)
 119 #   homegrown:  3 wallclock secs ( 2.13 usr +  0.00 sys =  2.13 CPU) @ 77093.43/s (n=164209)
 120 #              Rate  data_val    cgi_ex homegrown
 121 # data_val   1885/s        --      -34%      -98%
 122 # cgi_ex     2845/s       51%        --      -96%
 123 # homegrown 77093/s     3990%     2610%        --
 124 # Benchmark: running cgi_ex, data_val, homegrown for at least 2 CPU seconds...
 125 #   cgi_ex:  2 wallclock secs ( 2.21 usr +  0.01 sys =  2.22 CPU) @ 2421.17/s (n=5375)
 126 #   data_val:  2 wallclock secs ( 2.27 usr +  0.03 sys =  2.30 CPU) @ 1665.22/s (n=3830)
 127 #   homegrown:  2 wallclock secs ( 2.04 usr +  0.01 sys =  2.05 CPU) @ 72820.00/s (n=149281)
 128 #              Rate  data_val    cgi_ex homegrown
 129 # data_val   1665/s        --      -31%      -98%
 130 # cgi_ex     2421/s       45%        --      -97%
 131 # homegrown 72820/s     4273%     2908%        --