[svn:qpsmtpd] r552 - in branches/0.31: lib/Qpsmtpd t

Author: jpeacock
Date: Mon Oct 10 08:49:50 2005
New Revision: 552

Modified:
   branches/0.31/lib/Qpsmtpd/Address.pm
   branches/0.31/t/qpsmtpd-address.t
Log:
* lib/Qpsmtpd/Address.pm
    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 "".

Modified: branches/0.31/lib/Qpsmtpd/Address.pm
==============================================================================
--- branches/0.31/lib/Qpsmtpd/Address.pm	(original)
+++ branches/0.31/lib/Qpsmtpd/Address.pm	Mon Oct 10 08:49:50 2005
@@ -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)
+    }
+    elsif ( not defined $host ) {
+	my $address = $user;
+	($user, $host) = $address =~ m/(.*)(?:\@(.*))/;
     }
-    bless ($self, $class);
-    return $self;
+    $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;

Modified: branches/0.31/t/qpsmtpd-address.t
==============================================================================
--- branches/0.31/t/qpsmtpd-address.t	(original)
+++ branches/0.31/t/qpsmtpd-address.t	Mon Oct 10 08:49:50 2005
@@ -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 = '[email protected]';
-$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 = '[email protected]';
 $ao = Qpsmtpd::Address->new($as);
 ok ($ao, "new $as");
@@ -79,10 +64,10 @@ $as = '<[email protected]>';
 $ao = Qpsmtpd::Address->new($as);
 ok ($ao, "new $as");
 is ($ao->format, $as, "format $as");
+is ("$ao", $as, "overloaded stringify $as");
 
 $as = '[email protected]';
 ok ($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>");
 is ($ao && $ao->address, $as, "address $as");
 
 
-