view release on metacpan or  search on metacpan

FormEngine/Checks.pm  view on Meta::CPAN

=head2 email

Returns I<invalid> if the format of the field value seems to be
incompatible to an email address. A simple regular expression is used
here , so far it matches the common email addresses. But it isn't
compatible to any standard. Use C<rfc822> if you want to check for RFC
compatible address format.

Here is the used regexp, please inform me if you discover any bugs:

C<^[A-Za-z0-9._-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,6}$>

=cut

######################################################################

sub _check_email {
  my ($value) = @_;
  return '' unless($value ne '');
  # better use rfc822!
  if(! ($value =~ m/^[A-Za-z0-9._-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,6}$/)) {
    return gettext('invalid').'!';
  }  
}

######################################################################

=head2 rfc822

Returns I<standard incompatible> if the given field value doesn't
match the RFC 822 specification. In RFC 822 the format of valid email
addresses is defined.  This check routine is somewhat better than
I<email>, the only disadvantage is, that some working email addresses
don't follow the RFC 822 standard. So if you have problems try using
the I<email> routine.

Thanks to  Richard Piacentini for fixing this method :)

It now simply uses the rfc822 method of Email::Valid (you have to
install Email::Valid to be able to use this method).

=cut

######################################################################

sub _check_rfc822 {
  my($value) = @_;
  return '' unless($value ne '');
  require Email::Valid;
  return gettext('standard incompatible') unless
    Email::Valid->rfc822($value);
  return '';
}

######################################################################

=head2 date

Returns I<invalid> if the field value seems to be incompatible to
common date formats or the date doesn't exist in the Gregorian
calendar.  The following formats are allowed:

dd.mm.yyyy dd-mm-yyyy dd/mm/yyyy yyyy-mm-dd yyyy/mm/dd yyyy.mm.dd

The C<check_date> method of the I<Date::Pcalc> package is used to
prove the dates existence.

=cut

######################################################################

sub _check_date {
  my ($value) = @_;
  return '' unless($value ne '');
  my ($d, $m, $y);
  my $msg = gettext('invalid').'!';

  #  dd.mm.yyyy dd-mm-yyyy dd/mm/yyyy
  if($value =~ m/^([0-9]{1,2})\.([0-9]{1,2})\.([0-9]{2,4})$/ || $value =~ m/^([0-9]{2})-([0-9]{2})-([0-9]{2,4})$/ || $value =~ m/^([0-9]{2})\/([0-9]{2})\/([0-9]{2,4})$/) {
    $d = $1;
    $m = $2;
    $y = $3;
  }
  #  yyyy-mm-dd yyyy/mm/dd yyyy.mm.dd
  elsif($value =~ m/^([0-9]{4})-([0-9]{2})-([0-9]{2})$/ || $value =~ m/^([0-9]{4})\/([0-9]{2})\/([0-9]{2})$/ || $value =~ m/^([0-9]{4}).([0-9]{2}).([0-9]{2})$/) {
    $d = $3;
    $m = $2;
    $y = $1;
  }
  else {
    return $msg;
  }

  if(! check_date($y, $m, $d)) {
    return $msg;
  }

  return '';
}

######################################################################

=head2 digitonly

... returns I<invalid> if the value doesn't match C<[0-9]*>.

=cut

######################################################################

sub _check_digitonly {
  ($_,$self,$caller,$min,$max) = @_;
  return '' unless($_ ne '');
  $regex = '^[0-9]{' . ($min||0) . ',' . ($max||'') . '}' . '$';
  return gettext('invalid').'!' unless(m/$regex/);
  return '';
}

######################################################################

=head2 match