view release on metacpan or  search on metacpan

lib/HTML/FormValidator.pm  view on Meta::CPAN

time that the disk copy is modified.

Here is an example of a valid input profiles specification :

    {
	customer_infos => {
	    optional     =>
		[ qw( company fax country ) ],
	    required     =>
		[ qw( fullname phone email address city state zipcode ) ],
	    constraints  =>
		{
		    email	=> "email",
		    fax		=> "american_phone",
		    phone	=> "american_phone",
		    zipcode	=> '/^\s*\d{5}(?:[-]\d{4})?\s*$/',
		    state	=> "state",
		},
	    defaults => {
		country => "USA",
	    },
	},
	customer_billing_infos => {
	     optional	    => [ "cc_no" ],
	     dependencies   => {
		"cc_no" => [ qw( cc_type cc_exp ) ],
	     },
	     constraints => {
		cc_no      => {  constraint  => "cc_number",
				 params	     => [ qw( cc_no cc_type ) ],
				},
		cc_type	=> "cc_type",
		cc_exp	=> "cc_exp",
	      }
	    filters       => [ "trim" ],
	    field_filters => { cc_no => "digit" },
	},
    }

The following are the valid fields for an input specification :

=over

=item required

This is an array reference which contains the name of the fields which
are required. Any fields in this list which are not present in the
user input will be reported as missing.

=item optional

This is an array reference which contains the name of optional fields.
These are fields which MAY be present and if they are, they will be
check for valid input. Any fields not in optional or required list
will be reported as unknown.

=item dependencies

This is an hash reference which contains dependencies information.
This is for the case where one optional fields has other requirements.
For example, if you enter your credit card number, the field cc_exp
and cc_type should also be present. Any fields in the dependencies
list that is missing when the target is present will be reported as
missing.

=item defaults

This is an hash reference which contains defaults which should be
substituted if the user hasn't filled the fields. Key is field name
and value is default value which will be returned in the list of valid
fields.

=item filters

This is a reference to an array of filters that will be applied to ALL
optional or required fields. This can be the name of a builting filter
(trim,digit,etc) or an anonymous subroutine which should take one parameter, the field value and return the (possibly) modified value.

=item field_filters

This is a reference to an hash which contains reference to array of
filters which will be apply to specific input fields. The key of the
hash is the name of the input field and the valud is a reference to an
array of filters like for the filters parameter.

=item constraints

This is a reference to an hash which contains the constraints that
will be used to check wheter or not the field contains valid data.
Constraint can be either the name of a builtin constraint function
(see below), a perl regexp or an anonymous subroutine which will check
the input and return true or false depending on the input's validity.

The constraint function takes one parameter, the input to be validated
and returns true or false. It is possible to specify the parameters
that will be passed to the subroutine. For that use an hash reference
which contains in the I<constraint> element, the anonymous subroutine
or the name of the builtin and in the I<params> element the name of
the fields to pass a parameter to the function. (Don't forget to
include the name of the field to check in that list!) For an example,
look at the I<cc_no> constraint example.

=back

=cut

sub load_profiles {
    my $self = shift;

    my $file = $self->{profile_file};
    return unless $file;

    die "No such file: $file\n" unless -f $file;
    die "Can't read $file\n"	unless -r _;

    my $mtime = (stat _)[9];
    return if $self->{profiles} and $self->{profiles_mtime} <= $mtime;

    $self->{profiles} = do $file;
    die "Error in input profiles: $@\n" if $@;
    die "Input profiles didn't return an hash ref\n"

lib/HTML/FormValidator.pm  view on Meta::CPAN

=item postcode

This constraints checks if the input is a valid Canadian postal code.

=cut

sub valid_postcode {
    my $val = shift;
    $val =~ s/[_\W]+//g;
    return $val =~ /^[ABCEGHJKLMNPRSTVXYabceghjklmnprstvxy]\d[A-Za-z][- ]?\d[A-Za-z]\d$/;
}

=pod

=item zip

This input validator checks if the input is a valid american zipcode :
5 digits followed by an optional mailbox number.

=cut

sub valid_zip {
    my $val = shift;
    return $val =~ /^\s*\d{5}(?:[-]\d{4})?\s*$/;
}

=pod

=item phone

This one checks if the input looks like a phone number, (if it
contains at least 6 digits.)

=cut

sub valid_phone {
    my $val = shift;

    return $val =~ tr/0-9// >= 6;
}

=pod

=item american_phone

This constraints checks if the number is a possible North American style
of phone number : (XXX) XXX-XXXX. It has to contains more than 7 digits.

=cut

sub valid_american_phone {
    my $val = shift;
    return $val =~ tr/0-9// >= 7;
}

=pod

=item cc_number

This is takes two parameters, the credit card number and the credit cart
type. You should take the hash reference option for using that constraint.

The number is checked only for plausibility, it checks if the number could
be valid for a type of card by checking the checksum and looking at the number
of digits and the number of digits of the number.

This functions is only good at weeding typos and such. IT DOESN'T
CHECK IF THERE IS AN ACCOUNT ASSOCIATED WITH THE NUMBER.

=cut

# This one is taken from the contributed program to 
# MiniVend by Bruce Albrecht
sub valid_cc_number {
    my ( $the_card, $card_type ) = @_;

    my ($index, $digit, $product);
    my $multiplier = 2;        # multiplier is either 1 or 2
    my $the_sum = 0;

    return 0 if length($the_card) == 0;

    # check card type
    return 0 unless $card_type =~ /^[admv]/i;

    return 0 if ($card_type =~ /^v/i && substr($the_card, 0, 1) ne "4") ||
      ($card_type =~ /^m/i && substr($the_card, 0, 1) ne "5") ||
	($card_type =~ /^d/i && substr($the_card, 0, 4) ne "6011") ||
	  ($card_type =~ /^a/i && substr($the_card, 0, 2) ne "34" &&
	   substr($the_card, 0, 2) ne "37");

    # check for valid number of digits.
    $the_card =~ s/\s//g;    # strip out spaces
    return 0 if $the_card !~ /^\d+$/;

    $digit = substr($the_card, 0, 1);
    $index = length($the_card)-1;
    return 0 if ($digit == 3 && $index != 14) ||
        ($digit == 4 && $index != 12 && $index != 15) ||
            ($digit == 5 && $index != 15) ||
                ($digit == 6 && $index != 13 && $index != 15);


    # calculate checksum.
    for ($index--; $index >= 0; $index --)
    {
        $digit=substr($the_card, $index, 1);
        $product = $multiplier * $digit;
        $the_sum += $product > 9 ? $product - 9 : $product;
        $multiplier = 3 - $multiplier;
    }
    $the_sum %= 10;
    $the_sum = 10 - $the_sum if $the_sum;

    # return whether checksum matched.
    $the_sum == substr($the_card, -1);
}

=pod

=item cc_exp

This one checks if the input is in the format MM/YY or MM/YYYY and if
the MM part is a valid month (1-12) and if that date is not in the past.

=cut

sub valid_cc_exp {
    my $val = shift;

    my ($month, $year) = split('/', $val);
    return 0 if $month !~ /^\d+$/ || $year !~ /^\d+$/;
    return 0 if $month <1 || $month > 12;
    $year += ($year < 70) ? 2000 : 1900 if $year < 1900;
    my @now=localtime();
    $now[5] += 1900;
    return 0 if ($year < $now[5]) || ($year == $now[5] && $month <= $now[4]);

    return 1;
}

=pod

=item cc_type

This one checks if the input field starts by M(asterCard), V(isa),
A(merican express) or D(iscovery).

=cut

sub valid_cc_type {
    my $val = shift;

    return $val =~ /^[MVAD]/i;
}

1;

__END__

=pod

=back

=head1 CREDITS

Some of those input validation functions have been taken from MiniVend
by Michael J. Heins <mike@heins.net>

The credit card checksum validation was taken from contribution by
Bruce Albrecht <bruce.albrecht@seag.fingerhut.com> to the MiniVend
program.

=head1 AUTHOR

Copyright (c) 1999 Francis J. Lacoste and iNsu Innovations Inc.
All rights reserved.

Parts Copyright 1996-1999 by Michael J. Heins <mike@heins.net>
Parts Copyright 1996-1999 by Bruce Albrecht  <bruce.albrecht@seag.fingerhut.com>

This program is free software; you can redistribute it and/or modify
it under the terms as perl itself.

=cut