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::Validate;
   5 use Data::FormValidator;
   6
   7 my $form = {
   8   username  => "++foobar++",
   9   password  => "123",
  10   password2 => "1234",
  11 };
  12
  13 my $val_hash_ce = {
  14     username => {
  15         required => 1,
  16         match    => 'm/^\w+$/',
  17         match_error => '$name may only contain letters and numbers',
  18         untaint  => 1,
  19     },
  20     password => {
  21         required => 1,
  22         match    => 'm/^[ -~]{6,30}$/',
  23 #        min_len  => 6,
  24 #        max_len  => 30,
  25 #        match    => 'm/^[ -~]+$/',
  26         untaint  => 1,
  27     },
  28     password2 => {
  29         validate_if => 'password',
  30         equals      => 'password',
  31     },
  32     email => {
  33         required => 1,
  34         match    => 'm/^[\w\.\-]+\@[\w\.\-]+$/',
  35         untaint  => 1,
  36     },
  37 };
  38
  39 my $val_hash_df = {
  40     required => [qw(username password email)],
  41     dependencies => {
  42         password => [qw(password2)],
  43     },
  44     constraints => {
  45         email    => qr/^[\w\.\-]+\@[\w\.\-]+$/,
  46         password => qr/^[ -~]{6,30}$/,
  47         username => qr/^\w+$/,
  48     },
  49     untaint_all_constraints => 1,
  50     msgs => {
  51         format => '%s',
  52         prefix => 'error_',
  53     },
  54 };
  55
  56 sub check_form {
  57   my $form = shift;
  58   my $hash = {};
  59   if (! exists $form->{'username'}) {
  60     push @{ $hash->{'username_error'} }, 'Username required';
  61   } elsif ($form->{'username'} !~ m/^(\w+)$/) {
  62     push @{ $hash->{'username_error'} }, 'Username may only contain letters and numbers';
  63   } else {
  64     $form->{'username'} = $1;
  65   }
  66   if (! exists $form->{'password'}) {
  67     push @{ $hash->{'password_error'} }, 'Password required';
  68   } else {
  69     if ($form->{'password'} !~ m/^([ -~]+)$/) {
  70       push @{ $hash->{'password_error'} }, 'Password contained bad characters';
  71     } else {
  72       $form->{'password'} = $1;
  73     }
  74     if (length($form->{'password'}) < 6) {
  75       push @{ $hash->{'password_error'} }, 'Password must be more than 6 characters';
  76     } elsif (length($form->{'password'}) > 30) {
  77       push @{ $hash->{'password_error'} }, 'Password must be less than 30 characters';
  78     }
  79
  80     if (! defined($form->{'password2'})
  81         || $form->{'password2'} ne $form->{'password'}) {
  82       push @{ $hash->{'password2_error'} }, 'Password2 and password must be the same';
  83     }
  84   }
  85
  86   if (! exists $form->{'email'}) {
  87     push @{ $hash->{'email_error'} }, 'Email required';
  88   } elsif ($form->{'email'} !~ m/^[\w\.\-]+\@[\w\.\-]+$/) {
  89     push @{ $hash->{'email_error'} }, 'Please type a valid email address';
  90   }
  91
  92   return $hash;
  93 }
  94
  95
  96 cmpthese (-2,{
  97   cgi_ex    => sub { my $t = CGI::Ex::Validate->validate($form, $val_hash_ce) },
  98   data_val  => sub { my $t = Data::FormValidator->check($form, $val_hash_df) },
  99   homegrown => sub { my $t = scalar keys %{ check_form($form) } },
 100 },'auto');
 101
 102 cmpthese (-2,{
 103   cgi_ex    => sub { my $t = CGI::Ex::Validate->validate($form, $val_hash_ce)->as_hash },
 104   data_val  => sub { my $t = Data::FormValidator->check($form, $val_hash_df)->msgs },
 105   homegrown => sub { my $t = check_form($form) },
 106 },'auto');
 107
 108
 109 ### Home grown solution blows the others away - but lacks features
 110 #
 111 # Benchmark: running cgi_ex, data_val, homegrown for at least 2 CPU seconds...
 112 #     cgi_ex:  2 wallclock secs ( 2.12 usr +  0.00 sys =  2.12 CPU) @ 1430.66/s (n=3033)
 113 #   data_val:  2 wallclock secs ( 2.01 usr +  0.00 sys =  2.01 CPU) @ 2588.56/s (n=5203)
 114 #  homegrown:  2 wallclock secs ( 2.19 usr +  0.01 sys =  2.20 CPU) @ 54733.18/s (n=120413)
 115 #              Rate    cgi_ex  data_val homegrown
 116 # cgi_ex     1431/s        --      -45%      -97%
 117 # data_val   2589/s       81%        --      -95%
 118 # homegrown 54733/s     3726%     2014%        --
 119 # Benchmark: running cgi_ex, data_val, homegrown for at least 2 CPU seconds...
 120 #     cgi_ex:  2 wallclock secs ( 2.10 usr +  0.00 sys =  2.10 CPU) @ 1218.57/s (n=2559)
 121 #   data_val:  2 wallclock secs ( 2.14 usr +  0.00 sys =  2.14 CPU) @ 2092.99/s (n=4479)
 122 #  homegrown:  2 wallclock secs ( 2.14 usr +  0.00 sys =  2.14 CPU) @ 56267.76/s (n=120413)
 123 #              Rate    cgi_ex  data_val homegrown
 124 # cgi_ex     1219/s        --      -42%      -98%
 125 # data_val   2093/s       72%        --      -96%
 126 # homegrown 56268/s     4518%     2588%        --