r6278 - in /branches/upstream/libmail-verp-perl/current: Changes META.yml README Verp.pm t/1.t
tincho-guest at users.alioth.debian.org
tincho-guest at users.alioth.debian.org
Sun Aug 5 21:23:09 UTC 2007
Author: tincho-guest
Date: Sun Aug 5 21:23:09 2007
New Revision: 6278
URL: http://svn.debian.org/wsvn/?sc=1&rev=6278
Log:
[svn-upgrade] Integrating new upstream version, libmail-verp-perl (0.06)
Modified:
branches/upstream/libmail-verp-perl/current/Changes
branches/upstream/libmail-verp-perl/current/META.yml
branches/upstream/libmail-verp-perl/current/README
branches/upstream/libmail-verp-perl/current/Verp.pm
branches/upstream/libmail-verp-perl/current/t/1.t
Modified: branches/upstream/libmail-verp-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libmail-verp-perl/current/Changes?rev=6278&op=diff
==============================================================================
--- branches/upstream/libmail-verp-perl/current/Changes (original)
+++ branches/upstream/libmail-verp-perl/current/Changes Sun Aug 5 21:23:09 2007
@@ -1,4 +1,11 @@
Revision history for Perl extension Mail::Verp.
+0.06 Fri Jun 19, 2007
+ - Make class methods use default separator as advertised.
+ Thanks to Peter Leonard <pete -at- peteleonard.com>
+ - Allow correct decoding of addresses with embedded equals sign (=).
+ Thanks to Joe Edmonds <joe -at- thisnext.com>
+ - Added more and better tests!
+
0.05 Wed Aug 17, 2005
- Add accessor and parameter setting for separator.
Thanks to Daniel Senie <dts -at- senie.com>
Modified: branches/upstream/libmail-verp-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libmail-verp-perl/current/META.yml?rev=6278&op=diff
==============================================================================
--- branches/upstream/libmail-verp-perl/current/META.yml (original)
+++ branches/upstream/libmail-verp-perl/current/META.yml Sun Aug 5 21:23:09 2007
@@ -1,10 +1,10 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Mail-Verp
-version: 0.05
+version: 0.06
version_from: Verp.pm
installdirs: site
requires:
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30_01
Modified: branches/upstream/libmail-verp-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libmail-verp-perl/current/README?rev=6278&op=diff
==============================================================================
--- branches/upstream/libmail-verp-perl/current/README (original)
+++ branches/upstream/libmail-verp-perl/current/README Sun Aug 5 21:23:09 2007
@@ -1,4 +1,4 @@
-Email/Verp version 0.01
+Email/Verp version 0.06
=======================
This is the README file for Mail::Verp, which
@@ -25,7 +25,7 @@
COPYRIGHT AND LICENCE
-Copyright (C) 2003 Gyepi Sam <gyepi at cpan.org>
+Copyright (C) 2007 Gyepi Sam <gyepi at cpan.org>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
Modified: branches/upstream/libmail-verp-perl/current/Verp.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libmail-verp-perl/current/Verp.pm?rev=6278&op=diff
==============================================================================
--- branches/upstream/libmail-verp-perl/current/Verp.pm (original)
+++ branches/upstream/libmail-verp-perl/current/Verp.pm Sun Aug 5 21:23:09 2007
@@ -5,28 +5,37 @@
use Carp;
-use vars qw($VERSION @ENCODE_MAP @DECODE_MAP $SEPARATOR);
-$VERSION = '0.05';
+use vars qw($VERSION @ENCODE_MAP @DECODE_MAP $DEFAULT_SEPARATOR $SEPARATOR);
+$VERSION = '0.06';
my @chars = qw(@ : % ! - [ ]);
@ENCODE_MAP = map { quotemeta($_), sprintf '%.2X', ord($_) } ('+', @chars);
@DECODE_MAP = map { sprintf('%.2X', ord($_)), $_ } (@chars, '+');
+
+
+$DEFAULT_SEPARATOR = '-'; #used as a constant
+$SEPARATOR = $DEFAULT_SEPARATOR; #used by class methods. Can be changed.
sub separator {
my $self = shift;
+ #called as class or instance object?
+ my $var = ref($self) ? \$self->{separator} : \$SEPARATOR;
+
+ my $value = $$var;
+
if (@_){
- $SEPARATOR = shift;
+ $$var = shift;
}
- return $SEPARATOR;
+ return $value;
}
sub new
{
my $self = shift;
- $self = bless { separator => '-', @_ }, ref($self) || $self;
+ $self = bless { separator => $DEFAULT_SEPARATOR, @_ }, ref($self) || $self;
$self->separator($self->{separator});
return $self;
}
@@ -67,7 +76,7 @@
}
}
- return join('', $slocal, $SEPARATOR, $rlocal, '=', $rdomain, '@', $sdomain);
+ return join('', $slocal, $self->separator, $rlocal, '=', $rdomain, '@', $sdomain);
}
sub decode
@@ -80,8 +89,10 @@
return;
}
+ my $separator = $self->separator;
+
if (my ($slocal, $rlocal, $rdomain, $sdomain) =
- $address =~ m/^(.+?)\Q${SEPARATOR}\E([^=]+)=([^\@]+)\@(.+)/){
+ $address =~ m/^(.+?)\Q${separator}\E(.+)=([^=\@]+)\@(.+)/){
# warn "$address $slocal $rlocal $rdomain $sdomain\n";
@@ -131,11 +142,9 @@
#Create a VERP envelope sender of an email to recipient at example.net.
my $verp_email = $verp->encode('sender at example.com', 'recipient at example.net');
- #Change separator back to default.
- $verp->separator('-');
-
#Decode a bounce
my ($sender, $recipient) = $verp->decode($verp_email);
+
=head1 ABSTRACT
@@ -146,7 +155,7 @@
Mail::Verp encodes the address of an email recipient into the envelope
sender address so that a bounce can be more easily handled even if the original recipient
is forwarding their mail to another address and the remote Mail Transport Agents send back
-unhelpful bounce messages. The module must also be used to decode bounce recipient addresses.
+unhelpful bounce messages. The module can also be used to decode bounce recipient addresses.
=head1 FUNCTIONS
@@ -157,17 +166,18 @@
Primarily useful to save typing. So instead of typing C<Mail::Verp> you can say
S<< my $x = Mail::Verp->new; >> then use C<$x> whereever C<Mail::Verp> is usually required.
-Accepts an optional C<separator> argument for changing the separator.
+Accepts an optional C<separator> argument for changing the separator, which defaults
+to hyphen '-'. The value can also be changed using the C<separator> accessor.
+
S<< my $x = Mail::Verp->new(separator => '+'); >>
=item encode(LOCAL-ADDRESS, REMOTE-ADDRESS)
Encodes LOCAL-ADDRESS, REMOTE-ADDRESS into a verped address suitable for use
-as an envelope, return, address. It may also be useful to use the same address in
+as an envelope return address. It may also be useful to use the same address in
Errors-To and Reply-To headers to compensate for broken Mail Transport Agents.
-Uses current separator value, which defaults to hyphen '-', but can be changed
-using the C<separator> accessor.
+Uses current separator value.
=item decode(VERPED-ADDRESS)
@@ -177,6 +187,14 @@
Uses current separator value.
+=item separator
+
+Returns current value of the VERP C<separator>
+
+=item separator(SEPARATOR)
+
+Sets new value for VERP C<separator> and returns the previous value.
+
=back
=head2 EXPORT
@@ -187,7 +205,7 @@
DJ Bernstein details verps here: http://cr.yp.to/proto/verp.txt.
-Sam Varshavchik proposes an encoding here: http://www.courier-mta.org/draft-varshavchik-verp-smtpext.txt.
+Sam Varshavchik proposes an encoding here: http://www.courier-mta.org/draft-varshavchik-verp-smtpext.txt.
=head1 AUTHOR
@@ -195,7 +213,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright 2003 by Gyepi Sam
+Copyright 2007 by Gyepi Sam
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
Modified: branches/upstream/libmail-verp-perl/current/t/1.t
URL: http://svn.debian.org/wsvn/branches/upstream/libmail-verp-perl/current/t/1.t?rev=6278&op=diff
==============================================================================
--- branches/upstream/libmail-verp-perl/current/t/1.t (original)
+++ branches/upstream/libmail-verp-perl/current/t/1.t Sun Aug 5 21:23:09 2007
@@ -5,7 +5,7 @@
use Test;
-BEGIN { plan tests => 15 };
+BEGIN { plan tests => 122 };
use Mail::Verp;
ok(1); # If we made it this far, we're ok.
@@ -17,10 +17,13 @@
my $sender = 'local at source.com';
-my %remote = (
- 'remote+foo at example.com', [qw(local remote+2Bfoo=example.com at source.com)],
- 'node42!ann at old.example.com', [qw(local node42+21ann=old.example.com at source.com)]
- );
+my @recipients = (
+ 'standard at example.com', [qw(local standard=example.com at source.com)],
+ 'remote+foo at example.com', [qw(local remote+2Bfoo=example.com at source.com)],
+ 'node42!ann at old.example.com', [qw(local node42+21ann=old.example.com at source.com)],
+ '=@example.com', [qw(local ==example.com at source.com)],
+);
+
=pod
print STDERR "$s $r1 encodes -> ", $x->encode($s, $r1), "\n";
@@ -28,35 +31,42 @@
=cut
+#Test various address types
+for (my $i = 0; $i < @recipients; $i += 2) {
+ my ($recipient, $verp) = @recipients[$i, $i+1];
-while (my ($k, $r) = each %remote){
- for my $sep (qw(- +)){
- my $v = join($sep, @$r);
+ #test various separators, including default separator
+ for my $sep (undef, qw(- +)) {
+
+ #test use of object method and class method calls.
+ my @refs = ('object' => $x, 'class' => 'Mail::Verp');
+
+ for (my $j = 0; $j < @refs; $j += 2) {
+ my ($encoder_name, $encoder) = @refs[$j, $j+1];
+
+ my $expected = join(defined($sep) ? $sep : $encoder->separator, @$verp);
+ $encoder->separator($sep) if defined $sep;
- $x->separator($sep);
-
- my $encoded = $x->encode($sender, $k);
+ my $sep_str = $sep || '';
- print "Checking if $k encodes to $encoded\n";
- ok($encoded eq $v);
+ my $encoded = $encoder->encode($sender, $recipient);
- my ($decoded_sender, $decoded_remote) = $x->decode($encoded);
+ ok($encoded, $expected,
+ "encoded address using $encoder_name instance with separator [$sep_str]");
- print "Checking if sender decodes to $sender\n";
-
- ok($decoded_sender eq $sender);
+ #decode each encoding with both an object and class method call.
+ for (my $k = 0; $k < @refs; $k += 2) {
+ my ($decoder_name, $decoder) = @refs[$k, $k+1];
- print "Recipient $decoded_remote decodes to $k\n";
+ $decoder->separator($sep) if defined $sep;
+ my ($decoded_sender, $decoded_recipient) = $decoder->decode($encoded);
- ok($decoded_remote eq $k);
+ ok($decoded_sender, $sender,
+ "encoded with $encoder_name and separator [$sep_str], decoded sender with $decoder_name");
+
+ ok($decoded_recipient, $recipient,
+ "encoded with $encoder_name and separator [$sep_str], decoded recipient with $decoder_name");
+ }
}
+ }
}
-
-$x->separator('-');
-
-my $v1 = 'local-remote+2bfoo=example.com at source.com';
-
-my ($loc1, $rem1) = $x->decode($v1);
-ok($rem1 eq 'remote+foo at example.com');
-
-
More information about the Pkg-perl-cvs-commits
mailing list