#!/usr/bin/perl
# ----------------------------------------------------------------------------
# This software is Copyright (C) 2007, All Rights Reserved
# ----------------------------------------------------------------------------
# This program is protected by local and international copyright laws. Any
# use of this program is subject to the the terms of the license agreement
# included as part of this distribution archive. Any other uses are strictly
# prohibited without the written permission of the Vendor and all
# other rights are reserved.
# -----------------------------------------------------------------------------
# Warning : Modifying this program violates your license agreement!
# -----------------------------------------------------------------------------

package IT::Validation;

use strict;

use IT::Globals;

# library globals
use vars qw($VALID_EMAIL_REGEXP);

# use m/\A$VALID_EMAIL_REGEXP\z/ to see if string is a valid email
$VALID_EMAIL_REGEXP = '(?:[\w\-]+[\w\-.])*[\w\-]+@(?:[\w\-]+[\w\-.])*[\w\-]+\.[A-Za-z]{2,8}';



# ------------------------------------------------------------------------
# Function    : Valid Email
# Description : Check for valid email field.
# Usage       : if (&IT::Validation::isValidEmail('user@example.com')) { ... }
#             : returns 0=invalid 1=valid
# ------------------------------------------------------------------------

sub isValidEmail {
  my $email = shift;

  if ($email =~ m/\A$VALID_EMAIL_REGEXP\z/) { return 1; }

  return 0;
}

# ----------------------------------------------------------------------------
# Function    : isValidHostnameOrIP
# Description : check if hostname or IP has a valid format.  Does not check if hostname
#               resolves.  Use getHostByName for that.
# Usage       : my $isValid = &IT::Validation::isValidHostnameOrIP($hostname);
# ----------------------------------------------------------------------------

sub isValidHostnameOrIP {
  my $hostname = shift;

  # valid IP address checking
  if ($hostname =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})\z/i) {
    my($part1,$part2,$part3,$part4) = ($1,$2,$3,$4);
    if ($part1 < 0 || $part1 > 255) { return 0; }
    if ($part2 < 0 || $part2 > 255) { return 0; }
    if ($part3 < 0 || $part3 > 255) { return 0; }
    if ($part4 < 0 || $part4 > 255) { return 0; }
    return 1;
  }

  # valid hostname checking
  if ($hostname =~ /^localhost\z/i)      { return 1; }
  if (!$hostname)                        { return 0; }               # no email specified
  if ($hostname =~ /[^A-Za-z0-9\-\.]/)   { return 0; }               # contains invalid chars
  if ($hostname !~ /^([\w\-]+[\w\-.])*[\w\-]+\.[A-Za-z]{2,8}$/) { return 0; } # Invalid format
  return 1;

}

# ------------------------------------------------------------------------------
# Function    : isValidUrl
# Description :
# Usage       : my $isValidUrl = &IT::Validation::isValidUrl($url);
# ------------------------------------------------------------------------------

sub isValidUrl {
  my $url = shift;

  if ($url =~ m{
    ^                 # start of string
    (\w+://)          # get protocol        (e.g. "http://")
    ((([\w\-]+[\w\-.])*[\w\-]+\.[A-Za-z]{2,8})|(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})) # get host or ip         (e.g. "www.website.com", "127.0.0.1")
    ([^?\#]*?)        # get directory       (e.g. "/some/arbitrary/path/")
    ([^/?\#]*)        # get file            (e.g. "index.html")
    (?:(\?[^\#]*))?   # get query string    (e.g. "?action=sampleList&perpage=10")
    (?:(\#.*))?       # get anchor          (e.g. "#top")
    $                 # end of string
  }x) { return 1; };

  return 0;
}

# ------------------------------------------------------------------------
# Function    : validationError
# Description : Check a var against some validation rule and return the first error only.
# Usage       : $errors = &validationError($fieldLabel, $value, $rules);
# Usage       : $errors = &validationError($fieldLabel, $value, 'notref minLength(123) maxLength(323)');
# ------------------------------------------------------------------------

sub validationError {
  my($fieldLabel, $value, $rules) = @_;

  if ($rules eq '') { return; } # return undef

  # test rules
  my $errors = '';
  while (1) {

    if ($errors) { last; }

    # See m// under 'perldoc perlop' for details on \G and /c
    if    ($rules =~ /\G\s*notBlank/gcsi) { # same as minLength(1)
      if ($value eq '') { $errors .= "$fieldLabel cannot be blank!\n"; }
    }

    elsif ($rules =~ /\G\s*allowBlank/gcsi) { # this rule is used in addition to other rules (which may not allow blank be default)
      if ($value eq '') { last; }
    }

    elsif ($rules =~ /\G\s*allowUndef/gcsi) { # this rule is used in addition to other rules (which may not allow undef be default)
      if (!defined $value) { last; }
    }

    elsif ($rules =~ /\G\s*oneOf\((.+?)\)(?=\s|\z)/gcsi) {
      my $possibleOptions = $1;
      my %possibleOptions = map { $_ => 1 } split(/\s*,\s*/, $possibleOptions);
      unless ($possibleOptions{$value}) { $errors .= "$fieldLabel must be one of the following ($possibleOptions)!\n"; }
    }

    elsif ($rules =~ /\G\s*notRelativePath/gcsi) {
      if ($value !~ m/^([a-z]:)?[\\\/]/i) { $errors .= "$fieldLabel must be an absolute path (starting with / or C:/)!\n"; }
    }

    elsif ($rules =~ /\G\s*fileMustExist/gcsi) {
      if    (!-e $value) { $errors .= "$fieldLabel doesn't exist!\n"; }
      elsif (!-f $value) { $errors .= "$fieldLabel isn't a file!\n"; }
    }
    elsif ($rules =~ /\G\s*dirMustExist/gcsi) {
      if    (!-e $value) { $errors .= "$fieldLabel doesn't exist!\n"; }
      elsif (!-d $value) { $errors .= "$fieldLabel isn't a directory!\n"; }
    }

    elsif ($rules =~ /\G\s*trailingSlashRequired/gcsi) {
      unless ($value =~ m|[\\/]\z|) { $errors .= "$fieldLabel must end with a slash!\n"; }
    }

    elsif ($rules =~ /\G\s*validEmail/gcsi) {
      unless (&isValidEmail($value)) { $errors .= "$fieldLabel isn't a valid email address (example user\@example.com)\!\n"; }
    }

    elsif ($rules =~ /\G\s*validHostnameOrIP/gcsi) {
      unless (&isValidHostnameOrIP($value)) { $errors .= "$fieldLabel isn't a valid hostname or IP (example: server.example.com or 127.0.0.1)!\n"; }
    }

    elsif ($rules =~ /\G\s*positiveInt/gcsi) {
      if ($value =~ /[^0-9]/ || $value eq '') { $errors .= "$fieldLabel must be a number (only 0-9 are allowed)!\n"; }
    }

    elsif ($rules =~ /\G\s*int/gcsi) {
      if ($value =~ /[^0-9\-]/ || $value eq '') { $errors .= "$fieldLabel must be a number (only 0-9 and - are allowed)!\n"; }
    }

    elsif ($rules =~ /\G\s*minLength\((\d+)\)/gcsi) {
      my $minLength = $1;
      if (length $value < $minLength) { $errors .= "$fieldLabel must be longer than $minLength characters!\n"; }
    }

    elsif ($rules =~ /\G\s*maxLength\((\d+)\)/gcsi) {
      my $maxLength = $1;
      if (length $value > $maxLength) { $errors .= "$fieldLabel must be shorter than $maxLength characters!\n"; }
    }

    elsif ($rules =~ /\G\s*minNumber\(([\d\.\-]+)\)/gcsi) {
      my $minValue = $1;
      unless ($value >= $minValue) { $errors .= "$fieldLabel must be equal or greater than $minValue!\n"; }
    }

    elsif ($rules =~ /\G\s*maxNumber\(([\d\.\-]+)\)/gcsi) {
      my $maxValue = $1;
      unless ($value <= $maxValue) { $errors .= "$fieldLabel must be equal or less than $maxValue!\n"; }
    }

    elsif ($rules =~ /\G\s*hashKeysRequired\((.*?)\)(?=\s|\z)/gcsi) {
      my $requiredKeysString = $1;
      my @requiredKeys = split(/\s*,\s*/, $requiredKeysString);

      my @missingKeys;
      foreach my $keyName (@requiredKeys) {
        unless (exists $value->{$keyName}) { push @missingKeys, $keyName; }
      }

      if (@missingKeys) {
        my $missingKeys = join(', ', @missingKeys);
        $errors .= "The following required hash keys weren't found: $missingKeys\n";
      }
    }

    elsif ($rules =~ /\G\s*hashKeysAllowed\((.*?)\)(?=\s|\z)/gcsi) {
      my $allowedKeysString = $1;
      my %allowedKeys = map { $_ => 1 } split(/\s*,\s*/, $allowedKeysString);

      my @unknownKeys;
      foreach my $keyName (sort keys %$value) {
        unless ($allowedKeys{$keyName}) { push @unknownKeys, $keyName; }
      }

      if (@unknownKeys) {
        my $unknownKeys = join(', ', @unknownKeys);
        $errors .= "The following hash keys are not allowed: $unknownKeys\n";
      }
    }

    elsif ($rules =~ /\G\s*defined/gcsi) {
      unless (defined $value) { $errors .= "$fieldLabel is undefined!\n"; }
    }

    elsif ($rules =~ /\G\s*notref/gcsi) {
      if (ref $value) { $errors .= "$fieldLabel can't be a reference!\n"; }
    }

    elsif ($rules =~ /\G\s*ref/gcsi) {
      unless (ref $value) { $errors .= "$fieldLabel must be a reference!\n"; }
    }

    elsif ($rules =~ /\G\s*(scalar|array|hash|code)Ref/gcsi) {
      my $refType = uc $1;
      if (ref $value ne $refType) { $errors .= "$fieldLabel must be a $refType reference!\n"; }
    }

    elsif ($rules =~ /\G\s*maxElements\((\d+)\)/gcsi) {
      my $maxElements  = $1;
      my $elementCount = @$value;
      if ($elementCount > $maxElements) { $errors .= "$fieldLabel can't have more than $maxElements elements!\n"; }
    }

    elsif ($rules =~ /\G\s*noArgsLeft/gcsi) {
      if (ref($value) ne 'ARRAY') { die "noArgsLeft value must be a reference (for: $fieldLabel)"; }
      my $elementCount = @$value;
      my $extraElements = join ", ", map "'$_'", @$value;
      if ($elementCount > 0) { $errors .= "$fieldLabel shouldn't have any args left.  Unexpected elements: $extraElements!\n"; }
    }

    elsif ($rules =~ /\G\s*\z/gcs)                  { last; }              # end of string
    else {
      my $nextRule = $1 if $rules =~ /\G\s*(\S+)/gcs;
      return "error parsing validation rule '$nextRule' in rules '$rules' for '$fieldLabel'\n";
    }
  }

  if ($errors) { return $errors; }
  else         { return; }  # return undef

}

# ----------------------------------------------------------------------------
# end of file
1;

