* lib/Qpsmtpd/Address.pm

Add POD to describe how to use the objects.  Make the addr_cmp 
    method private (no need to expose it).

* t/qpsmtpd-address.t
    Include tests of overloaded comparison, including sorting.

git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.31@559 958fd67b-6ff1-0310-b445-bb7760255be9

lib/Qpsmtpd/Address.pm

@@ -1,11 +1,61 @@
+#!/usr/bin/perl -w
 package Qpsmtpd::Address;
 use strict;
 
+=head1 NAME
+
+Qpsmtpd::Address - Lightweight E-Mail address objects
+
+=head1 DESCRIPTION
+
+Based originally on cut and paste from Mail::Address and including 
+every jot and tittle from RFC-2821/2822 on what is a legal e-mail 
+address for use during the SMTP transaction.
+
+=head1 USAGE
+
+  my $rcpt = Qpsmtpd::Address->new('<email.address@example.com>');
+
+The objects created can be used as is, since they automatically 
+stringify to a standard form, and they have an overloaded comparison 
+for easy testing of values.
+
+=head1 METHODS
+
+=cut
+
 use overload (
     '""'   => \&format,
-    'cmp'  => \&addr_cmp,
+    'cmp'  => \&_addr_cmp,
 );
 
+=head2 new()
+
+Can be called two ways:
+
+=over 4 
+
+=item * Qpsmtpd::Address->new('<full_address@example.com>')
+
+The normal mode of operation is to pass the entire contents of the 
+RCPT TO: command from the SMTP transaction.  The value will be fully 
+parsed via the L<canonify> method, using the full RFC 2821 rules.
+
+=item * Qpsmtpd::Address->new("user", "host")
+
+If the caller has already split the address from the domain/host,
+this mode will not L<canonify> the input values.  This is not 
+recommended in cases of user-generated input for that reason.  This 
+can be used to generate Qpsmtpd::Address objects for accounts like 
+"<postmaster>" or indeed for the bounce address "<>".
+
+=back
+
+The resulting objects can be stored in arrays or used in plugins to 
+test for equality (like in badmailfrom).
+
+=cut
+
 sub new {
     my ($class, $user, $host) = @_;
     my $self = {};
@@ -118,6 +168,15 @@ sub new {
 #
 # (We ignore all obs forms)
 
+=head2 canonify()
+
+Primarily an internal method, it is used only on the path portion of
+an e-mail message, as defined in RFC-2821 (this is the part inside the
+angle brackets and does not include the "human readable" portion of an
+address).  It returns a list of (local-part, domain).
+
+=cut
+
 sub canonify {
     my ($dummy, $path) = @_;
     my $atom = '[a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~]+';
@@ -155,10 +214,29 @@ sub canonify {
     return (undef);
 }
 
+=head2 parse()
+
+Retained as a compatibility method, it is completely equivalent
+to new() called with a single parameter.
+
+=cut
+
 sub parse { # retain for compatibility only
     return shift->new(shift);
 }
 
+=head2 address()
+
+Can be used to reset the value of an existing Q::A object, in which
+case it takes a parameter with or without the angle brackets.
+
+Returns the stringified representation of the address.  NOTE: does
+not escape any of the characters that need escaping, nor does it
+include the surrounding angle brackets.  For that purpose, see
+L<format>.
+
+=cut
+
 sub address {
     my ($self, $val) = @_;
     if ( defined($val) ) {
@@ -171,6 +249,18 @@ sub address {
          . ( defined $self->{_host} ? '@'.$self->{_host} : '' );
 }
 
+=head2 format()
+
+Returns the canonical stringified representation of the address.  It
+does escape any characters requiring it (per RFC-2821/2822) and it
+does include the surrounding angle brackets.  It is also the default
+stringification operator, so the following are equivalent:
+
+  print $rcpt->format();
+  print $rcpt;
+
+=cut
+
 sub format {
     my ($self) = @_;
     my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]';
@@ -182,17 +272,31 @@ sub format {
     return "<".$self->address().">";
 }
 
+=head2 user()
+
+Returns the "localpart" of the address, per RFC-2821, or the portion
+before the '@' sign.
+
+=cut
+
 sub user {
     my ($self) = @_;
     return $self->{_user};
 }
 
+=head2 host()
+
+Returns the "domain" part of the address, per RFC-2821, or the portion
+after the '@' sign.
+
+=cut
+
 sub host {
     my ($self) = @_;
     return $self->{_host};
 }
 
-sub addr_cmp {
+sub _addr_cmp {
     require UNIVERSAL;
     my ($left, $right, $swap) = @_;
     my $class = ref($left);
@@ -212,4 +316,11 @@ sub addr_cmp {
     return ($left cmp $right);
 }
 
+=head1 COPYRIGHT
+
+Copyright 2004-2005 Peter J. Holzer.  See the LICENSE file for more 
+information.
+
+=cut
+
 1;

t/qpsmtpd-address.t

@@ -2,7 +2,7 @@
 use strict;
 $^W = 1;
 
-use Test::More tests => 25;
+use Test::More tests => 27;
 
 BEGIN {
     use_ok('Qpsmtpd::Address');
@@ -69,5 +69,30 @@ 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");
+ok ($ao eq $as, "overloaded 'cmp' operator");
 
+my @unsorted_list = map { Qpsmtpd::Address->new($_) }
+	qw(
+	    "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
+	    foo@example.com
+	    ask@perl.org
+	    foo@foo.x.example.com
+	    jpeacock@cpan.org
+	    test@example.com
+	);
+
+# NOTE that this is sorted by _host_ not by _domain_
+my @sorted_list = map { Qpsmtpd::Address->new($_) }
+	qw(
+	    jpeacock@cpan.org
+	    foo@example.com
+	    test@example.com
+	    foo@foo.x.example.com
+	    ask@perl.org
+	    "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at
+	);
+
+my @test_list = sort @unsorted_list;
+
+is_deeply( \@test_list, \@sorted_list, "sort via overloaded 'cmp' operator");