# # Check if a email is valid # Tests aplied: there must not be space chars on the mail, there must be only one @ char, there must be a mail user # there must be a mail domain and a domain prefix # optionally it can also restrict a email into a given list of domain prefixes (com,pt,org,etc) # Will Return 0 ; 1 # 0 email is valid ; 1 email is not valid sub check_email { my $email = $_[0]; # email to test my $global_config_p = $_[1]; # configuration pointer print "Running the check_email() function\n" if ( defined $$global_config_p{debug_level} and ($$global_config_p{debug_level} eq "half" or $$global_config_p{debug_level} eq "full") ); # print message if the debug level requires it my $alllowed_domain_prefixes = $_[2]; # optional value where you can say what email prefixes (.pt .com .org etc) are allowed # the list should be passed without the . char and separated by the , char example (pt,com,org,es) my $error_flag = 1; # by default the email is invalid $email =~ s/^\s+//; # Delete leading whitespace ^ is the first caracter \s is space then // replace with nothing if there was /a/ then replace with a $email =~ s/\s+$//; # Delete trailing whitespace same thing kind of but $ represents end of line. if ( length($email) >= 5 and ($email =~ tr/@//) == 1 and ($email =~ tr/ //) == 0 ) { # email must have at least 5 chars ( a@a.c) and one @ char and no SPACE CHARS my ( $mail_user, $mail_domain ) = split (/@/, $email ); # find the last occurence of . my $mail_domain_pref_pos = rindex($mail_domain,"."); my $mail_domain_prefix = ""; # .pt .org etc if ( $mail_domain_pref_pos >= 0 ) { $mail_domain_prefix = substr($mail_domain,$mail_domain_pref_pos+1,length($mail_domain)); # get the domain prefix } # if mail user exists (exanmple miguel) and if the mail domain exists (mail.pt) and if the mail domain prefix exists (pt) if ( defined $mail_user and defined $mail_domain and defined $mail_domain_prefix and length($mail_user) > 0 and length($mail_domain) > 0 and length($mail_domain_prefix) > 0 ) { my $allowed_prefix = ""; if ( defined $alllowed_domain_prefixes and length($alllowed_domain_prefixes) > 0 ) { # check the allowed prefixed if required (pt com org etc) my @alllowed_domain_prefixes = split(/,/, $alllowed_domain_prefixes); $allowed_prefix = "no"; foreach my $allowed_prefix_record (@alllowed_domain_prefixes) { if ( $mail_domain_prefix eq $allowed_prefix_record ) { $allowed_prefix = "yes"; last; } } } if ( $allowed_prefix ne "no" ) { # check if the prefix is not allowed $error_flag = 0; # mail is valid } } } print "Function check_email() exit value is [ $error_flag ]\n" if ( defined $$global_config_p{debug_level} and $$global_config_p{debug_level} eq "full" ); # print message if the debug level requires it return $error_flag; }