]> Dogcows Code - chaz/p5-CGI-Ex/blob - samples/benchmark/bench_validation.pl
CGI::Ex 2.10
[chaz/p5-CGI-Ex] / 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 = 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 = scalar keys %{ 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.08 usr + 0.01 sys = 2.09 CPU) @ 2045.93/s (n=4276)
113 # data_val: 2 wallclock secs ( 2.15 usr + 0.00 sys = 2.15 CPU) @ 3496.28/s (n=7517)
114 # homegrown: 2 wallclock secs ( 2.09 usr + 0.01 sys = 2.10 CPU) @ 81919.52/s (n=172031)
115 # Rate cgi_ex data_val homegrown
116 # cgi_ex 2046/s -- -41% -98%
117 # data_val 3496/s 71% -- -96%
118 # homegrown 81920/s 3904% 2243% --
119 # Benchmark: running cgi_ex, data_val, homegrown for at least 2 CPU seconds...
120 # cgi_ex: 2 wallclock secs ( 2.11 usr + 0.00 sys = 2.11 CPU) @ 1696.68/s (n=3580)
121 # data_val: 2 wallclock secs ( 2.04 usr + 0.00 sys = 2.04 CPU) @ 2845.10/s (n=5804)
122 # homegrown: 2 wallclock secs ( 2.01 usr + 0.00 sys = 2.01 CPU) @ 83674.13/s (n=168185)
123 # Rate cgi_ex data_val homegrown
124 # cgi_ex 1697/s -- -40% -98%
125 # data_val 2845/s 68% -- -97%
126 # homegrown 83674/s 4832% 2841% --
This page took 0.038159 seconds and 4 git commands to generate.