100% test coverage of Qpsmtpd::Address
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@265 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
parent
7889fa6990
commit
f31e4b1b6b
@ -126,14 +126,15 @@ sub canonify {
|
|||||||
$path = $1;
|
$path = $1;
|
||||||
|
|
||||||
# strip source route
|
# strip source route
|
||||||
$path =~ s/[EMAIL PROTECTED](?:,[EMAIL PROTECTED])*://;
|
$path =~ s/^\@$domain(?:,\@$domain)*://;
|
||||||
|
|
||||||
# empty path is ok
|
# empty path is ok
|
||||||
return "" if $path eq "";
|
return "" if $path eq "";
|
||||||
|
|
||||||
#
|
#
|
||||||
my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/);
|
my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/);
|
||||||
return undef unless (defined $localpart && defined $domainpart);
|
return undef unless defined $localpart;
|
||||||
|
|
||||||
if ($localpart =~ /^$atom(\.$atom)*/) {
|
if ($localpart =~ /^$atom(\.$atom)*/) {
|
||||||
# simple case, we are done
|
# simple case, we are done
|
||||||
return $path;
|
return $path;
|
||||||
@ -158,7 +159,7 @@ sub parse {
|
|||||||
sub address {
|
sub address {
|
||||||
my ($self, $val) = @_;
|
my ($self, $val) = @_;
|
||||||
my $oldval = $self->[0];
|
my $oldval = $self->[0];
|
||||||
$self->[0] = $val if (defined($val));
|
return $self->[0] = $val if (defined($val));
|
||||||
return $oldval;
|
return $oldval;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2,7 +2,7 @@
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
use Test::More tests => 11;
|
use Test::More tests => 21;
|
||||||
|
|
||||||
BEGIN {
|
BEGIN {
|
||||||
use_ok('Qpsmtpd::Address');
|
use_ok('Qpsmtpd::Address');
|
||||||
@ -21,6 +21,9 @@ $ao = Qpsmtpd::Address->parse($as);
|
|||||||
ok ($ao, "parse $as");
|
ok ($ao, "parse $as");
|
||||||
is ($ao->format, $as, "format $as");
|
is ($ao->format, $as, "format $as");
|
||||||
|
|
||||||
|
is ($ao->user, 'foo', 'user');
|
||||||
|
is ($ao->host, 'example.com', 'host');
|
||||||
|
|
||||||
# the \ before the @ in the local part is not required, but
|
# the \ before the @ in the local part is not required, but
|
||||||
# allowed. For simplicity we add a backslash before all characters
|
# allowed. For simplicity we add a backslash before all characters
|
||||||
# which are not allowed in a dot-string.
|
# which are not allowed in a dot-string.
|
||||||
@ -36,9 +39,31 @@ ok ($ao, "parse $as");
|
|||||||
is ($ao->format, '<"foo\ bar"@example.com>', "format $as");
|
is ($ao->format, '<"foo\ bar"@example.com>', "format $as");
|
||||||
|
|
||||||
|
|
||||||
|
$as = 'foo@example.com';
|
||||||
|
$ao = Qpsmtpd::Address->parse($as);
|
||||||
|
is ($ao, undef, "can't parse $as");
|
||||||
|
|
||||||
|
$as = '<@example.com>';
|
||||||
|
is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
|
||||||
|
|
||||||
|
$as = '<@123>';
|
||||||
|
is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
|
||||||
|
|
||||||
|
$as = '<user>';
|
||||||
|
is (Qpsmtpd::Address->parse($as), undef, "can't parse $as");
|
||||||
|
|
||||||
|
|
||||||
$as = 'foo@example.com';
|
$as = 'foo@example.com';
|
||||||
$ao = Qpsmtpd::Address->new($as);
|
$ao = Qpsmtpd::Address->new($as);
|
||||||
ok ($ao, "parse $as");
|
ok ($ao, "new $as");
|
||||||
is ($ao->address, $as, "address $as");
|
is ($ao->address, $as, "address $as");
|
||||||
|
|
||||||
|
$as = '<foo@example.com>';
|
||||||
|
$ao = Qpsmtpd::Address->new($as);
|
||||||
|
ok ($ao, "new $as");
|
||||||
|
is ($ao->address, 'foo@example.com', "address $as");
|
||||||
|
|
||||||
|
# Not sure why we can change the address like this, but we can so test it ...
|
||||||
|
is ($ao->address('test@example.com'), 'test@example.com', 'address(test@example.com)');
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user