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

19
t/qpsmtpd-address.t
View File

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