Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

r28471@knight: rjbs | 2006-11-25 10:22:25 -0500

 bug 22710, etc
  • Loading branch information...
commit 4a33929aa3a19b5742e3170e81061e3461fccf5b 1 parent 1cc8870
@rjbs authored
Showing with 53 additions and 7 deletions.
  1. +5 −0 Changes
  2. +1 −1  Makefile.PL
  3. +31 −5 lib/Email/Valid.pm
  4. +16 −1 t/valid.t
View
5 Changes
@@ -1,5 +1,10 @@
Revision history for Perl extension Email::Valid.
+0.177 Sat Nov 25 2006
+ resolve bug 22710: make fqdn rule more strict: domains must be multiple
+ valid domain labels, and domain labels must be [a-z0-9][-a-z0-9]*
+ replace UNIVERSAL:: with eval{}-wrapping
+
0.176 Thu Jul 27 2006
further improve DNS stuff: try to make Net::DNS a prereq if we think
we'll need it later
View
2  Makefile.PL
@@ -21,7 +21,7 @@ unless ($need_net_dns) {
WriteMakefile(
'NAME' => 'Email::Valid',
'VERSION_FROM' => 'lib/Email/Valid.pm',
- (eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl'), : ()),
+ (eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
'PREREQ_PM' => {
'Mail::Address' => 0,
($need_net_dns ? ('Net::DNS' => 0) : ()),
View
36 lib/Email/Valid.pm
@@ -9,7 +9,7 @@ use IO::File;
use Mail::Address;
use File::Spec;
-$VERSION = '0.176';
+$VERSION = '0.177';
%AUTOLOAD = (
fqdn => 1,
@@ -88,7 +88,7 @@ sub rfc822 {
my %args = $self->_rearrange([qw( address )], \@_);
my $addr = $args{address} or return $self->details('rfc822');
- $addr = $addr->address if UNIVERSAL::isa($addr, 'Mail::Address');
+ $addr = $addr->address if eval { $addr->isa('Mail::Address') };
return $self->details('rfc822') unless $addr =~ m/^$RFC822PAT$/o;
@@ -219,7 +219,7 @@ sub _host {
my $self = shift;
my $addr = shift;
- $addr = $addr->address if UNIVERSAL::isa($addr, 'Mail::Address');
+ $addr = $addr->address if eval { $addr->isa('Mail::Address') };
my $host = ($addr =~ /^.*@(.*)$/ ? $1 : $addr);
$host =~ s/\s+//g;
@@ -264,6 +264,31 @@ sub _local_rules {
1;
}
+sub _valid_domain_parts {
+ my ($self, $string) = @_;
+
+ return unless $string and length $string <= 255;
+ return if $string =~ /\.\./;
+ my @labels = split /\./, $string;
+
+ for my $label (@labels) {
+ return 0 unless $self->_is_domain_label($label);
+ }
+ return scalar @labels;
+}
+
+sub _is_domain_label {
+ my ($self, $string) = @_;
+ return unless $string =~ /\A
+ [A-Z0-9] # must start with an alnum
+ (?:
+ [-A-Z0-9]+ # then maybe a dash or alnum
+ [A-Z0-9] # finally ending with an alnum
+ )* # lather, rinse, repeat
+ \z/ix;
+ return 1;
+}
+
# Purpose: Put an address through a series of checks to determine
# whether it should be considered valid.
sub address {
@@ -272,7 +297,7 @@ sub address {
local_rules )], \@_);
my $addr = $args{address} or return $self->details('rfc822');
- $addr = $addr->address if UNIVERSAL::isa($addr, 'Mail::Address');
+ $addr = $addr->address if eval { $addr->isa('Mail::Address') };
$addr = $self->_fudge( $addr ) if $args{fudge};
$self->rfc822( -address => $addr ) or return undef;
@@ -287,7 +312,8 @@ sub address {
}
if ($args{fqdn}) {
- $addr->host =~ /^.+\..+$/ or return $self->details('fqdn');
+ $self->_valid_domain_parts($addr->host) > 1
+ or return $self->details('fqdn');
}
if ($args{mxcheck}) {
View
17 t/valid.t
@@ -1,7 +1,7 @@
#!perl
use strict;
-use Test::More tests => 16;
+use Test::More tests => 19;
BEGIN {
use_ok('Email::Valid');
@@ -59,6 +59,21 @@ ok(
'an email can start with a dash (alternate calling method)',
);
+ok(
+ ! $v->address(-address => 'dashy@-example.net', -fqdn => 1),
+ 'but a domain cannot',
+);
+
+ok(
+ ! $v->address(-address => 'dashy@example.net-', -fqdn => 1),
+ 'a domain cannot end with a dash either',
+);
+
+ok(
+ $v->address(-address => 'dashy@a--o.example.net', -fqdn => 1),
+ 'but a domain may contain two dashes in a row in the middle',
+);
+
SKIP: {
skip "your dns appears missing or failing to resolve", 2
unless $v->address(-address=> 'devnull@pobox.com', -mxcheck => 1);
Please sign in to comment.
Something went wrong with that request. Please try again.