byterazor/qpsmtpd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

100% test coverage of Qpsmtpd::Address

Browse Source 
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@265 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Ask Bjørn Hansen 2004-07-16 02:51:39 +00:00
parent 7889fa6990
commit f31e4b1b6b
2 changed files with 31 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lib/Qpsmtpd/Address.pm
View File

@ -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;
} }

29
t/qpsmtpd-address.t
View File

@ -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)');