#!/usr/bin/perl -w #< regex-email.pl - 20121231 use strict; use warnings; my @examples = ( "pete\@freeflightsim.org", "flightgear\@sablonier.ch", "my.big-name.sucks-big-time\@mail.server-farm.long-domain.coop", "HB-GRAL " ); my ($email,$name,$dom,$ext); sub prt($) { print shift; } # **************************************************** # This seems the BEST for long,beatly email items ;=)) # ==================================================== sub is_email($$$$) { my ($txt,$rn,$rd,$re) = @_; if ($txt =~ /^(\w[\w\.\-]*\w)\@(\w[\w\.\-]*\w)(\.\w{2,4})$/) { ${$rn} = $1; ${$rd} = $2; ${$re} = $3; return 1; } return 0; } # ===================================================== # ***************************************************** sub is_email_address($$$$$) { my ($txt,$rb,$rn,$rd,$re) = @_; my $email = $txt; my $bgn = ''; if ($txt =~ /^\s*(.*)\s*<(.+)>.*$/) { $bgn = $1; $email = $2; $bgn = substr($bgn,0,length($bgn) - 1) while ($bgn =~ /\s$/g); # remove all TRAILING space } ${$rb} = $bgn; return is_email($email,$rn,$rd,$re); } sub is_email2($$$$) { my ($txt,$rn,$rd,$re) = @_; if ($txt =~ /^(\w+)\@([\da-zA-Z\-]{1,}\.){1,}([\da-zA-Z-]{2,6})$/ ) { ${$rn} = $1; ${$rd} = $2; ${$re} = $3; return 1; } return 0; } foreach my $test (@examples) { my $email = $test; if ($test =~ /^.*<(.+)>.*$/) { $email = $1; } my $cnt = 0; my $bgn = ''; # 1 2 3 if ($email =~ /^(\w+)\@(\w+)\.(\w{2,4})$/) { $name = $1; $dom = $2; $ext = $3; prt("Yeah! $name\@$dom.$ext\n"); $cnt++; } else { prt("FAILED\n"); } if (is_email($email,\$name,\$dom,\$ext)) { prt("Yes1! $name\@$dom"."$ext\n"); $cnt++; } else { prt("No!\n"); } if (is_email2($email,\$name,\$dom,\$ext)) { prt("Yes2! $name\@$dom"."$ext\n"); $cnt++; } else { prt("No2!\n"); } if (is_email_address($test,\$bgn,\$name,\$dom,\$ext)) { prt("Yes3! $name\@$dom"."$ext [$bgn]\n"); $cnt++; } else { prt("No3!\n"); } prt("email: $email passes $cnt\n\n"); } # eof