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

* lib/Qpsmtpd/Address.pm

Browse Source 
Convert objects to hash.  Neuter parse() to wrapper around new().
    Add overload stringify to $obj->format().

* t/qpsmtpd-address.t
    Remove tests specific to parse().  Add test for overloaded "".

git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.31@552 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
John Peacock 2005-10-10 15:49:50 +00:00
parent 111afb91db
commit e6efda626f
2 changed files with 38 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
lib/Qpsmtpd/Address.pm
View File

@ -1,16 +1,23 @@
package Qpsmtpd::Address; package Qpsmtpd::Address;
use strict; use strict;
use overload (
'""' => \&format,
);
sub new { sub new {
my ($class, $address) = @_; my ($class, $user, $host) = @_;
my $self = [ ]; my $self = {};
if ($address =~ /^<(.*)>$/) { if ($user =~ /^<(.*)>$/ ) {
$self->[0] = $1; ($user, $host) = $class->canonify($user)
} else {
$self->[0] = $address;
} }
bless ($self, $class); elsif ( not defined $host ) {
return $self; my $address = $user;
($user, $host) = $address =~ m/(.*)(?:\@(.*))/;
}
$self->{_user} = $user;
$self->{_host} = $host;
return bless $self, $class;
} }
# Definition of an address ("path") from RFC 2821: # Definition of an address ("path") from RFC 2821:
@ -133,58 +140,55 @@ sub canonify {
# #
my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/); my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/);
return undef unless defined $localpart; 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 ($localpart, $domainpart);
} }
if ($localpart =~ /^"(($qtext|\\$text)*)"$/) { if ($localpart =~ /^"(($qtext|\\$text)*)"$/) {
$localpart = $1; $localpart = $1;
$localpart =~ s/\\($text)/$1/g; $localpart =~ s/\\($text)/$1/g;
return "$localpart\@$domainpart"; return ($localpart, $domainpart);
} }
return undef; return (undef);
} }
sub parse { # retain for compatibility only
return shift->new(shift);
sub parse {
my ($class, $line) = @_;
my $a = $class->canonify($line);
return ($class->new($a)) if (defined $a);
return undef;
} }
sub address { sub address {
my ($self, $val) = @_; my ($self, $val) = @_;
my $oldval = $self->[0]; if ( defined($val) ) {
return $self->[0] = $val if (defined($val)); $val = "<$val>" unless $val =~ /^<.+>$/;
return $oldval; my ($user, $host) = $self->canonify($val);
$self->{_user} = $user;
$self->{_host} = $host;
}
return ( defined $self->{_user} ? $self->{_user} : '' )
. ( defined $self->{_host} ? '@'.$self->{_host} : '' );
} }
sub format { sub format {
my ($self) = @_; my ($self) = @_;
my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]'; my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]';
my $s = $self->[0]; return '<>' unless defined $self->{_user};
return '<>' unless $s; if ( ( my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) {
my ($user, $host) = $s =~ m/(.*)\@(.*)/; return qq(<"$user")
if ($user =~ s/($qchar)/\\$1/g) { . ( defined $self->{_host} ? '@'.$self->{_host} : '' ). ">";
return qq{<"$user"\@$host>};
} }
return "<$s>"; return "<".$self->address().">";
} }
sub user { sub user {
my ($self) = @_; my ($self) = @_;
my ($user, $host) = $self->[0] =~ m/(.*)\@(.*)/; return $self->{_user};
return $user;
} }
sub host { sub host {
my ($self) = @_; my ($self) = @_;
my ($user, $host) = $self->[0] =~ m/(.*)\@(.*)/; return $self->{_host};
return $host;
} }
1; 1;

19
t/qpsmtpd-address.t
View File

@ -2,7 +2,7 @@
use strict; use strict;
$^W = 1; $^W = 1;
use Test::More tests => 28; use Test::More tests => 25;
BEGIN { BEGIN {
use_ok('Qpsmtpd::Address'); use_ok('Qpsmtpd::Address');
@ -38,21 +38,6 @@ $ao = Qpsmtpd::Address->parse($as);
ok ($ao, "parse $as"); 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, "new $as"); ok ($ao, "new $as");
@ -79,10 +64,10 @@ $as = '<foo@foo.x.example.com>';
$ao = Qpsmtpd::Address->new($as); $ao = Qpsmtpd::Address->new($as);
ok ($ao, "new $as"); ok ($ao, "new $as");
is ($ao->format, $as, "format $as"); is ($ao->format, $as, "format $as");
is ("$ao", $as, "overloaded stringify $as");
$as = 'foo@foo.x.example.com'; $as = 'foo@foo.x.example.com';
ok ($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>"); ok ($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
is ($ao && $ao->address, $as, "address $as"); is ($ao && $ao->address, $as, "address $as");