Apache-Voodoo
view release on metacpan or search on metacpan
lib/Apache/Voodoo.pm view on Meta::CPAN
if ($ed < $sd) {
return 0;
}
}
}
# If we got here we were sucessful
return 1;
}
# Function: validate_date
# Purpose: Check to make sure a date follows the MM/DD/YYYY format and checks the sanity of the numbers passed in
sub validate_date {
my $self = shift;
my $date = shift;
my $check_future = shift;
#Number of days in each month
my %md = (1 => 31,
2 => 29,
3 => 31,
4 => 30,
5 => 31,
lib/Apache/Voodoo/Session/File.pm view on Meta::CPAN
my $dbh = shift;
my %opts = @_;
my %session;
my $obj;
$opts{'Directory'} = $self->{'session_dir'};
$opts{'LockDirectory'} = $self->{'session_dir'};
# Apache::Session probably validates this internally, making this check pointless.
# But why take that for granted?
if (defined($id) && $id !~ /^([0-9a-z]+)$/) {
$id = undef;
}
eval {
$obj = tie(%session,'Apache::Session::File',$id, \%opts) || die "Tieing to session failed: $!";
};
if ($@) {
undef $id;
lib/Apache/Voodoo/Table.pm view on Meta::CPAN
push(@{$self->{'update_callbacks'}},$sub_ref);
}
sub list_param_parser {
my $self = shift;
my $sub_ref = shift;
$self->{'list_param_parser'} = $sub_ref;
}
sub validate_add {
my $self = shift;
my $p = shift;
my $dbh = $p->{'dbh'};
my $params = $p->{'params'};
my $errors = {};
# call each of the insert callbacks
foreach (@{$self->{'insert_callbacks'}}) {
my $callback_errors = $_->($dbh,$params);
@{$errors}{keys %{$callback_errors}} = values %{$callback_errors};
}
# do all the normal parameter checking
my ($values,$e) = $self->{valid}->validate($params);
# copy the errors from the process_params
$errors = { %{$errors}, %{$e} } if ref($e) eq "HASH";
# check to see if the user supplied primary key (optional) is unique
if ($self->{'pkey_user_supplied'}) {
if ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) {
my $res = $dbh->selectall_arrayref("
SELECT 1
FROM $self->{'table'}
lib/Apache/Voodoo/Table.pm view on Meta::CPAN
undef,
$values->{$_});
if ($res->[0]->[0] == 1) {
$errors->{"DUP_$_"} = 1;
}
}
return ($values,$errors);
}
sub validate_edit {
my $self = shift;
my $p = shift;
my $dbh = $p->{'dbh'};
my $params = $p->{'params'};
unless ($params->{$self->{'pkey'}} =~ /$self->{'pkey_regexp'}/) {
return $self->display_error("Invalid ID");
}
my $errors = {};
# call each of the update callbacks
foreach (@{$self->{'update_callbacks'}}) {
# call back should return a list of error strings
my $callback_errors = $_->($dbh,$params);
@{$errors}{keys %{$callback_errors}} = values %{$callback_errors};
}
# run the standard error checks
my ($values,$e) = $self->{valid}->validate($params);
# copy the errors from the process_params
$errors = { %{$errors}, %{$e} } if ref($e) eq "HASH";
# check all the unique columns
foreach (@{$self->{'unique'}}) {
my $res = $dbh->selectall_arrayref("
SELECT 1
FROM $self->{'table'}
WHERE $_ = ? AND $self->{'pkey'} != ?",
lib/Apache/Voodoo/Table.pm view on Meta::CPAN
my $dbh = $p->{'dbh'};
my $params = $p->{'params'};
my $errors = {};
$self->{'success'} = 0;
$self->{'add_details'} = [];
if ($params->{'cm'} eq "add") {
my ($values,$errors) = $self->validate_add($p);
if (scalar keys %{$errors}) {
$errors->{'HAS_ERRORS'} = 1;
# copy values back into form
foreach (keys(%{$values})) {
$errors->{$_} = $values->{$_};
}
}
else {
lib/Apache/Voodoo/Table.pm view on Meta::CPAN
return $self->display_error("No record with that ID found");
}
my %original_values;
for (my $i=0; $i <= $#{$self->{'columns'}}; $i++) {
$original_values{$self->{'columns'}->[$i]} = $res->[0]->[$i];
}
my $errors = {};
if ($params->{'cm'} eq "update") {
my ($values,$errors) = $self->validate_edit($p);
if (scalar keys %{$errors}) {
$errors->{'has_errors'} = 1;
# copy values into template
$errors->{$self->{'pkey'}} = $params->{$self->{'pkey'}};
foreach (keys(%{$values})) {
$errors->{$_} = $values->{$_};
}
}
lib/Apache/Voodoo/Validate.pm view on Meta::CPAN
my $type = shift;
if ($type) {
return grep { $_->type eq $type } @{$self->{fields}};
}
else {
return @{$self->{fields}};
}
}
sub validate {
my $self = shift;
my $p = shift;
my $values = {};
my $errors = {};
foreach my $field ($self->fields) {
my $good;
my $missing = 1;
my $bad = 0;
lib/Apache/Voodoo/Validate/time.pm view on Meta::CPAN
}
}
elsif ($pm eq '0' && $h == 12) {
$h = 0;
}
}
else {
($h,$m,$s) = split(/:/,$time);
}
# our regexp above validated the minutes and seconds, so
# all we need to check that the hours are valid.
if ($h < 0 || $h > 23) { return undef; }
$s = 0 unless (defined($s));
return sprintf("%02d:%02d:%02d",$h,$m,$s);
}
1;
################################################################################
t/Validate.t view on Meta::CPAN
return undef;
});
};
if ($@) {
fail("Adding a validation callback failed when it shouldn't have\n$@");
BAIL_OUT("something is terribly wrong");
}
else {
pass("Adding Callback");
}
my ($v,$e) = $V->validate({});
# Catches missing required params
ok(defined $e->{MISSING_u_int_old_r},'unsigned int required 1');
ok(defined $e->{MISSING_u_int_new_r},'unsigned int required 2');
ok(defined $e->{MISSING_url_req}, 'url required');
ok(defined $e->{MISSING_varchar_req},'varchar required');
ok(defined $e->{MISSING_email_req}, 'email required');
ok(defined $e->{MISSING_regexp_req}, 'regexp required');
# Doesn't yell about missing optional params
t/Validate.t view on Meta::CPAN
url_req => 'abc',
url_opt => 'http://127.0.0.0.1/foo', # too many dots.
regexp_req => 'c',
regexp_opt => 'aba',
valid => 'notok',
varchar_req => 'docheck',
varchar_opt => 'bogus',
datetime => '2009-01-01 asdfasdf'
};
($v,$e) = $V->validate($params);
ok(scalar keys %{$v} == 0,'$values is empty');
ok(defined $e->{BAD_u_int_new_r},'bad unsigned int 1');
ok(defined $e->{BAD_u_int_new_o},'bad unsigned int 2');
ok(defined $e->{BAD_u_int_old_r},'bad unsigned int 3');
ok(defined $e->{BAD_u_int_old_o},'bad unsigned int 4');
ok(defined $e->{BAD_email_req}, 'bad email (format)');
ok(defined $e->{BAD_email_opt}, 'bad email (no such domain)') || diag("using this email address: ".$params->{email_opt});
ok(defined $e->{BAD_url_req}, 'bad url 1');
ok(defined $e->{BAD_url_opt}, 'bad url 2');
t/Validate.t view on Meta::CPAN
ok(defined $e->{BAD_regexp_opt}, 'bad regexp 2');
ok(defined $e->{BAD_valid}, 'bad valid sub');
ok(defined $e->{BAD_datetime}, 'bad datetime');
ok(defined $e->{BOGUS_varchar_req}, 'bad valid sub');
ok(defined $e->{BOGUS_varchar_opt}, 'bad valid sub');
# valid values
($v,$e) = $V->validate({
varchar_req => ' abc ', # also sneek in trim test
varchar_opt => 'abcdef ', # also sneek in trim test
u_int_new_r => '1234',
u_int_new_o => '1234',
u_int_old_r => '1234',
u_int_old_o => '1234',
email_req => 'abc@mailinator.com',
email_opt => 'abc@yahoo.com',
url_req => 'http://www.google.com',
url_opt => 'http://yahoo.com/foo',
t/Validate.t view on Meta::CPAN
ok($v->{email_req} eq 'abc@mailinator.com', 'good email 1');
ok($v->{email_opt} eq 'abc@yahoo.com', 'good email 2');
ok($v->{url_req} eq 'http://www.google.com','good url 1');
ok($v->{url_opt} eq 'http://yahoo.com/foo', 'good url 2');
ok($v->{regexp_req} eq 'aabbbba', 'good regexp 1');
ok($v->{regexp_opt} eq 'aaba', 'good regexp 2');
ok($v->{valid} eq 'ok', 'good valid sub');
ok($v->{datetime} eq '2009-01-01 00:00:00', 'good datetime');
# fence post values
($v,$e) = $V->validate({
text => 'a' x 500, # should not yell about length
varchar_req => 'a' x 64,
varchar_opt => ' '.('a' x 64).' ', # also sneek in trim test
u_int_new_r => 4294967295,
u_int_new_o => 4294967295,
u_int_old_r => 4294967295,
u_int_old_o => 4294967295,
email_req => 'a' x 54 . '@yahoo.com',
email_opt => 'a' x 54 . '@yahoo.com ',
url_req => 'http://www.google.com/'. ('a' x (64-22)),
regexp_req => 'aa'. ('b'x 61) . 'a'
});
ok(scalar keys %{$e} == 0,'$errors is empty');
# and over the line values
($v,$e) = $V->validate({
varchar_req => 'a' x 65,
varchar_opt => ' '.('a' x 100).' ', # also sneek in trim test
u_int_new_r => 4294967296,
u_int_new_o => 4294967296,
u_int_old_r => 4294967296,
u_int_old_o => 4294967296,
email_req => 'a' x 100 . '@yahoo.com',
email_opt => 'a' x 100 . '@yahoo.com ',
url_req => 'http://www.google.com/'. ('a' x 100),
url_opt => 'http://www.google.com/'. ('a' x 100),
t/Validate.t view on Meta::CPAN
ok(defined $e->{MAX_u_int_old_o},'big unsigned int 4');
ok(defined $e->{BIG_email_req}, 'big email 1');
ok(defined $e->{BIG_email_opt}, 'big email 2');
ok(defined $e->{BIG_url_req}, 'big url 1');
ok(defined $e->{BIG_url_opt}, 'big url 2');
ok(defined $e->{BIG_regexp_req}, 'big regexp 1');
ok(defined $e->{BIG_regexp_opt}, 'big regexp 2');
ok(defined $e->{BIG_valid}, 'big valid sub');
# de-array-ification of non-multiple values
($v,$e) = $V->validate({
varchar_req => [' abc ','def','ghi']
});
ok($v->{varchar_req} eq 'abc','de-array-ification');
my $M = Apache::Voodoo::Validate->new({
'mult' => {
'type' => 'varchar',
'multiple' => 1,
'required' => 1,
}
});
($v,$e) = $M->validate({ mult => 'abc'});
is_deeply($v->{mult},['abc'],'array-ification of scalar');
($v,$e) = $M->validate({ mult => ['abc ',' def ',' ghi']});
is_deeply($v->{mult},['abc','def','ghi'],'array passthrough');
my $P = Apache::Voodoo::Validate->new({
'prime' => {
%u_int_new,
multiple => 1,
valid => sub {
my $v = shift;
return 1 if ($v eq 1 or $v eq 2);
for (my $i=2; $i < $v; $i++) {
unless ($v % $i) {
return 0;
}
}
return 1;
}
}
});
($v,$e) = $P->validate({ prime => 4});
ok($e->{'BAD_prime'},'valid sub 1');
($v,$e) = $P->validate({ prime => [13,14]});
ok(scalar keys %{$v} == 0,'$values is empty');
ok($e->{'BAD_prime'},'valid sub 2');
($v,$e) = $P->validate({ prime => [1, 13]});
is_deeply($v->{'prime'},[1,13],'valid sub 2');
my $D = Apache::Voodoo::Validate->new({
'date_past' => {
type => 'date',
valid => 'past'
},
'date_future' => {
type => 'date',
t/Validate.t view on Meta::CPAN
valid => 'past',
now => sub { return '2000-01-01' }
},
'date_future_now' => {
type => 'date',
valid => 'future',
now => sub { return '2000-01-01' }
}
});
($v,$e) = $D->validate({
date_past => '1/1/1900',
date_future => '12/31/9999', # December 31, 9999 should be far enough in the future
date_past_now => '1/1/1900 ',
date_future_now => '1/1/2009',
});
ok(scalar keys %{$e} == 0,'$errors is empty');
is($v->{date_past}, '1900-01-01','date past 1');
is($v->{date_past_now}, '1900-01-01','date past 2');
is($v->{date_future}, '9999-12-31','date future 1');
is($v->{date_future_now},'2009-01-01','date future 2');
($v,$e) = $D->validate({
date_past => 'a/1/1900', # bogus
date_future => '13/31/9999', # bogus
date_past_now => '1/2/2000', # fence post
date_future_now => '1/1/2000', # fence post
});
ok(scalar keys %{$v} == 0,'$values is empty');
ok(defined($e->{BAD_date_past}) ,'bad date past 1');
ok(defined($e->{PAST_date_past_now}),'bad date past 2');
ok(defined($e->{BAD_date_future}), 'bad date future 1');
ok(defined($e->{FUTURE_date_future_now}),'bad date future 2');
($v,$e) = $D->validate({
date_past_now => '1/1/2000', # fence post again
date_future_now => '1/2/2000', # fence post again
});
ok(scalar keys %{$e} == 0,'$errors is empty');
is($v->{date_past_now}, '2000-01-01','fence post date 1');
is($v->{date_future_now}, '2000-01-02','fence post date 2');
$D = Apache::Voodoo::Validate->new({
t/Validate.t view on Meta::CPAN
type => 'time',
min => '9:00',
max => '17:00'
},
'time_valid' => {
type => 'time',
valid => sub { return $_[0] eq "13:14:15" }
}
});
($v,$e) = $D->validate({
time => ' 9:15:04 pm',
time_min => '9:00',
time_max => '17:00',
time_range => '12:00',
time_valid => '1:14:15 pm'
});
ok(scalar keys %{$e} == 0,'$errors is empty');
is($v->{time}, '21:15:04','good time 1');
is($v->{time_min}, '09:00:00','good time 2');
is($v->{time_max}, '17:00:00','good time 3');
is($v->{time_range},'12:00:00','good time 4');
is($v->{time_valid},'13:14:15','good time 5');
($v,$e) = $D->validate({
time => ' 19:15:04 pm',
time_min => '8:59:59',
time_max => '17:00:01',
time_range => '23:00',
time_valid => '12:14:15'
});
ok(scalar keys %{$v} == 0,'$values is empty');
ok(defined($e->{BAD_time}), 'bad time 1');
ok(defined($e->{MIN_time_min}), 'bad time 2');
t/Validate.t view on Meta::CPAN
ok(defined($e->{MAX_time_range}), 'bad time 4');
ok(defined($e->{BAD_time_valid}), 'bad time 5');
my $B = Apache::Voodoo::Validate->new({
bit => {
type => 'bit',
required => 1
}
});
($v,$e) = $B->validate({ bit => ' 1' }); is($v->{bit},1,'good bit 1');
($v,$e) = $B->validate({ bit => '11' }); is($v->{bit},1,'good bit 2');
($v,$e) = $B->validate({ bit => 'y' }); is($v->{bit},1,'good bit 3');
($v,$e) = $B->validate({ bit => 'yEs' }); is($v->{bit},1,'good bit 4');
($v,$e) = $B->validate({ bit => 't' }); is($v->{bit},1,'good bit 5');
($v,$e) = $B->validate({ bit => 'tRuE'}); is($v->{bit},1,'good bit 6');
($v,$e) = $B->validate({ bit => ' 0' }); is($v->{bit},0,'good bit 7');
($v,$e) = $B->validate({ bit => '00' }); is($v->{bit},0,'good bit 8');
($v,$e) = $B->validate({ bit => 'n' }); is($v->{bit},0,'good bit 9');
($v,$e) = $B->validate({ bit => 'nO' }); is($v->{bit},0,'good bit a');
($v,$e) = $B->validate({ bit => 'f' }); is($v->{bit},0,'good bit b');
($v,$e) = $B->validate({ bit => 'fAlSe'}); is($v->{bit},0,'good bit c');
($v,$e) = $B->validate({bit => ''}); ok($e->{MISSING_bit},'bad bit 1');
($v,$e) = $B->validate({bit => undef}); ok($e->{MISSING_bit},'bad bit 2');
($v,$e) = $B->validate({bit => -1}); ok($e->{MISSING_bit},'bad bit 3');
($v,$e) = $B->validate({bit => 'a'}); ok($e->{MISSING_bit},'bad bit 4');
my $E;
eval {
$E = Apache::Voodoo::Validate->new({});
};
ok(ref($@) eq "Apache::Voodoo::Exception::RunTime::BadConfig",'Empty configuration throws exception 1 ');
eval {
$E = Apache::Voodoo::Validate->new();
};
( run in 0.708 second using v1.01-cache-2.11-cpan-a5abf4f5562 )