view release on metacpan or  search on metacpan

lib/Apache2/WebApp/Plugin/Validate.pm  view on Meta::CPAN

    }
}

#----------------------------------------------------------------------------+
# currency($total)
#
# Check the currency format (0.00)

sub currency {
    my ( $self, $total )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    if ($total =~ /\A [0-9]{0,8}[\.][0-9]{1,2} \z/xs && length($total) < 10) {
        return 1;
    }
    else {
        return 0;
    }
}

#----------------------------------------------------------------------------+
# date($date)
#
# Check the date format (YYYY-MM-DD)

sub date {
    my ( $self, $date )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    if ($date =~ /\A [0-9]{4}[\/|-][0-9]{1,2}[\/|-][0-9]{1,2} \z/xs ) {
        return 1;
    }
    else {
        return 0;
    }
}

#----------------------------------------------------------------------------+
# date_is_future($date)
#
# Is the date in the future? (YYYY-MM-DD)

sub date_is_future {
    my ( $self, $date )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    my ( $year1, $month1, $day1 ) = split( /\-/, $date );
    my ( $year2, $month2, $day2 ) = Today();

    if (Date_to_Days( $year1, $month1, $day1 ) >=
        Date_to_Days( $year2, $month2, $day2 ))
    {

lib/Apache2/WebApp/Plugin/Validate.pm  view on Meta::CPAN

    return 0;
}

#----------------------------------------------------------------------------+
# date_is_past($date)
#
# Is the date in the past? (YYYY-MM-DD)

sub date_is_past {
    my ( $self, $date )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    my ( $year1, $month1, $day1 ) = split( /\-/, $date );
    my ( $year2, $month2, $day2 ) = Today();

    if (Date_to_Days( $year1, $month1, $day1 ) <=
        Date_to_Days( $year2, $month2, $day2 ))
    {

lib/Apache2/WebApp/Plugin/Validate.pm  view on Meta::CPAN

    return 0;
}

#----------------------------------------------------------------------------+
# domain($name)
#
# Check the domain name format; verify the domain status using a DNS query.

sub domain {
    my ( $self, $name )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    my $dns = new Net::DNS::Check(
        domain => $name,
      );

    return ($dns->check_status() ? 1 : 0);
}

#----------------------------------------------------------------------------+
# email($address)
#
# Check the e-mail address format; verify the domain status using a DNS query.

sub email {
    my ( $self, $address, $mx )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR },
          { type => SCALAR, optional => 1 }
          );

    my $valid = Email::Valid->address(
        -address => $address,
        -mxcheck => ($mx) ? 1 : 0
      ) ? 1 : 0;

    return $valid;
}

#----------------------------------------------------------------------------+
# integer($value)
#
# Check for a integer.

sub integer {
    my ( $self, $value )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    if ($value =~ /^[\d]*$/) {
        return 1;
    }
    else {
        return 0;
    }
}

#----------------------------------------------------------------------------+
# html($markup)
#
# Check for HTML markup.

sub html {
    my ( $self, $markup )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    if ($markup =~ /<\/?\w+((\s+\w+(\s*=\s*(?:"(.|\n)*?"|'(.|\n)*?'|[^'">\s]+))?)+\s*|\s*)\/?>/) {
        return 1;
    }
    else {
        return 0;
    }
}

#----------------------------------------------------------------------------+
# url($string)
#
# Check the URL.

sub url {
    my ( $self, $string )
      = validate_pos( @_,
          { type => OBJECT },
          { type => SCALAR }
          );

    my $v = Data::Validate::URI->new();

    if ( $v->is_web_uri($string) ) {
        return 1;
    }
    else {