r4062 - in
/packages/libemail-simple-perl/branches/upstream/current: Changes
MANIFEST META.yml lib/Email/Simple.pm t/header-many.t t/header-prepend.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Fri Oct 6 20:13:13 UTC 2006
Author: gregoa-guest
Date: Fri Oct 6 20:13:12 2006
New Revision: 4062
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4062
Log:
Load /tmp/tmp.jkmpIu2240/libemail-simple-perl-1.992 into
packages/libemail-simple-perl/branches/upstream/current.
Added:
packages/libemail-simple-perl/branches/upstream/current/t/header-many.t
packages/libemail-simple-perl/branches/upstream/current/t/header-prepend.t
Modified:
packages/libemail-simple-perl/branches/upstream/current/Changes
packages/libemail-simple-perl/branches/upstream/current/MANIFEST
packages/libemail-simple-perl/branches/upstream/current/META.yml
packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm
Modified: packages/libemail-simple-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/Changes?rev=4062&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/Changes (original)
+++ packages/libemail-simple-perl/branches/upstream/current/Changes Fri Oct 6 20:13:12 2006
@@ -1,4 +1,12 @@
Revision history for Perl extension Email::Simple.
+
+1.992 2006-10-05
+
+ - fix a number of bugs when setting multiple headers, which would often
+ refuse to set more values than were currently present
+ - added a test for prepending (rather than appending) headers; while E::S
+ does not yet support this, the header behavior will be easier to replace in
+ future versions, and this is a forward-looking test
1.990 2006-09-05
Modified: packages/libemail-simple-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/MANIFEST?rev=4062&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libemail-simple-perl/branches/upstream/current/MANIFEST Fri Oct 6 20:13:12 2006
@@ -1,16 +1,18 @@
Changes
+lib/Email/Simple.pm
+lib/Email/Simple/Headers.pm
Makefile.PL
MANIFEST
README
-lib/Email/Simple.pm
-lib/Email/Simple/Headers.pm
t/badly-folded.t
t/basic.t
t/folding.t
t/header-case.t
t/header-junk.t
+t/header-many.t
t/header-names.t
t/header-pairs.t
+t/header-prepend.t
t/long-msgid.t
t/many-repeats.t
t/no-body.t
Modified: packages/libemail-simple-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/META.yml?rev=4062&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/META.yml (original)
+++ packages/libemail-simple-perl/branches/upstream/current/META.yml Fri Oct 6 20:13:12 2006
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Email-Simple
-version: 1.990
+version: 1.992
version_from: lib/Email/Simple.pm
installdirs: site
requires:
Modified: packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm?rev=4062&op=diff
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm (original)
+++ packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple.pm Fri Oct 6 20:13:12 2006
@@ -5,7 +5,7 @@
use Carp;
use vars qw($VERSION $GROUCHY);
-$VERSION = '1.990';
+$VERSION = '1.992';
my $crlf = qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; # We are liberal in what we accept.
@@ -158,6 +158,16 @@
$field = $self->{header_names}->{lc $field};
}
+ my @loci = grep { lc $self->{order}[$_] eq lc $field }
+ 0 .. $#{$self->{order}};
+
+ if (@loci > @data) {
+ my $overage = @loci - @data;
+ splice @{$self->{order}}, $_, 1 for reverse @loci[ -$overage, $#loci ];
+ } elsif (@data > @loci) {
+ push @{$self->{order}}, ($field) x (@data - @loci);
+ }
+
$self->{head}->{$field} = [ @data ];
return wantarray ? @data : $data[0];
}
@@ -301,7 +311,7 @@
This module is maintained by the Perl Email Project
- L<http://emailproject.perl.org/wiki/Email::Simple>
+L<http://emailproject.perl.org/wiki/Email::Simple>
=head1 COPYRIGHT AND LICENSE
Added: packages/libemail-simple-perl/branches/upstream/current/t/header-many.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/t/header-many.t?rev=4062&op=file
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/t/header-many.t (added)
+++ packages/libemail-simple-perl/branches/upstream/current/t/header-many.t Fri Oct 6 20:13:12 2006
@@ -1,0 +1,111 @@
+#!perl
+use strict;
+use Test::More tests => 12;
+
+use_ok('Email::Simple');
+
+my $email_text = <<END_MESSAGE;
+Alpha: this header comes first
+Bravo: this header comes second
+Alpha: this header comes third
+
+The body is irrelevant.
+END_MESSAGE
+
+my $email = Email::Simple->new($email_text);
+isa_ok($email, "Email::Simple");
+
+is_deeply(
+ [ $email->header('alpha') ],
+ [ 'this header comes first', 'this header comes third' ],
+ "we get both values, in order, for a multi-entry header",
+);
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'this header comes first',
+ Bravo => 'this header comes second',
+ Alpha => 'this header comes third',
+ ],
+ "and we get everything in order for header_pairs",
+);
+
+$email->header_set(alpha => ('header one', 'header three'));
+
+is_deeply(
+ [ $email->header('alpha') ],
+ [ 'header one', 'header three' ],
+ "headers are replaced in order",
+);
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'header one',
+ Bravo => 'this header comes second',
+ Alpha => 'header three',
+ ],
+ "and we still get everything in order for header_pairs",
+);
+
+$email->header_set(alpha => qw(h1 h3 h4));
+
+is_deeply(
+ [ $email->header('alpha') ],
+ [ qw(h1 h3 h4) ],
+ "headers are replaced in order, extras appended",
+);
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'h1',
+ Bravo => 'this header comes second',
+ Alpha => 'h3',
+ Alpha => 'h4',
+ ],
+ "and we still get everything in order for header_pairs",
+);
+
+$email->header_set(alpha => 'one is the loneliest header');
+
+is_deeply(
+ [ $email->header('alpha') ],
+ [ 'one is the loneliest header' ],
+ "and we drop down to one value for alpha header ok",
+);
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'one is the loneliest header',
+ Bravo => 'this header comes second',
+ ],
+ "and we still get everything in order for header_pairs",
+);
+
+$email->header_set(Gamma => 'gammalon');
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'one is the loneliest header',
+ Bravo => 'this header comes second',
+ Gamma => 'gammalon',
+ ],
+ "a third header goes in at the end",
+);
+
+$email->header_set(alpha => ('header one', 'header omega'));
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'header one',
+ Bravo => 'this header comes second',
+ Gamma => 'gammalon',
+ Alpha => 'header omega',
+ ],
+ "and re-adding to the previously third header puts it fourth",
+);
Added: packages/libemail-simple-perl/branches/upstream/current/t/header-prepend.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/branches/upstream/current/t/header-prepend.t?rev=4062&op=file
==============================================================================
--- packages/libemail-simple-perl/branches/upstream/current/t/header-prepend.t (added)
+++ packages/libemail-simple-perl/branches/upstream/current/t/header-prepend.t Fri Oct 6 20:13:12 2006
@@ -1,0 +1,55 @@
+#!perl
+use strict;
+use Test::More tests => 4;
+
+# This test is not here to encourage you to muck about in the object guts, but
+# to provide a test for when Email::Simple has a way to provide optional
+# extended header munging.
+
+use_ok('Email::Simple');
+
+my $email_text = <<END_MESSAGE;
+Alpha: this header comes first
+Bravo: this header comes second
+Alpha: this header comes third
+
+The body is irrelevant.
+END_MESSAGE
+
+my $email = Email::Simple->new($email_text);
+isa_ok($email, "Email::Simple");
+
+sub Email::Simple::header_prepend {
+ my ($self, $field, @values) = @_;
+
+ unshift @{ $self->{order} }, ($field) x @values;
+ unshift @{ $self->{head}->{$field} }, @values;
+}
+
+$email->header_prepend(Alpha => 'this header comes firstest');
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'this header comes firstest',
+ Alpha => 'this header comes first',
+ Bravo => 'this header comes second',
+ Alpha => 'this header comes third',
+ ],
+ "we can prepend an existing header",
+);
+
+$email->header_prepend('Zero' => 'this header comes zeroeth', 'and 0+1th');
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Zero => 'this header comes zeroeth',
+ Zero => 'and 0+1th',
+ Alpha => 'this header comes firstest',
+ Alpha => 'this header comes first',
+ Bravo => 'this header comes second',
+ Alpha => 'this header comes third',
+ ],
+ "we can prepend mutiply, too, and to a new header",
+);
More information about the Pkg-perl-cvs-commits
mailing list