r5098 - in /packages/libemail-simple-perl/trunk: ./ debian/
lib/Email/ lib/Email/Simple/ t/ t/test-mails/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Fri Apr 13 22:57:41 UTC 2007
Author: gregoa-guest
Date: Fri Apr 13 22:57:41 2007
New Revision: 5098
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5098
Log:
* New upstream release.
Added:
packages/libemail-simple-perl/trunk/lib/Email/Simple/Header.pm
- copied unchanged from r5097, packages/libemail-simple-perl/branches/upstream/current/lib/Email/Simple/Header.pm
packages/libemail-simple-perl/trunk/t/header-new.t
- copied unchanged from r5097, packages/libemail-simple-perl/branches/upstream/current/t/header-new.t
packages/libemail-simple-perl/trunk/t/header-space.t
- copied unchanged from r5097, packages/libemail-simple-perl/branches/upstream/current/t/header-space.t
Modified:
packages/libemail-simple-perl/trunk/Changes
packages/libemail-simple-perl/trunk/MANIFEST
packages/libemail-simple-perl/trunk/META.yml
packages/libemail-simple-perl/trunk/Makefile.PL
packages/libemail-simple-perl/trunk/debian/changelog
packages/libemail-simple-perl/trunk/lib/Email/Simple.pm
packages/libemail-simple-perl/trunk/lib/Email/Simple/Headers.pm
packages/libemail-simple-perl/trunk/t/basic.t
packages/libemail-simple-perl/trunk/t/header-junk.t
packages/libemail-simple-perl/trunk/t/header-many.t
packages/libemail-simple-perl/trunk/t/header-names.t
packages/libemail-simple-perl/trunk/t/header-prepend.t
packages/libemail-simple-perl/trunk/t/test-mails/junk-in-header
packages/libemail-simple-perl/trunk/t/unit.t
Modified: packages/libemail-simple-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/Changes?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/Changes (original)
+++ packages/libemail-simple-perl/trunk/Changes Fri Apr 13 22:57:41 2007
@@ -1,4 +1,22 @@
Revision history for Perl extension Email::Simple.
+
+1.999 2007-03-20
+ fix bug 25496: deletion of headers affected the wrong range,
+ sometimes deleting too many headers -- thanks, Nicholas Oxhoej!
+ fix bug 24922: errant space in last header of CRLF-delim email
+ thanks, Barry Downes and Alex Vandiver
+
+1.998 2007-02-07
+ MAJOR REFACTORING OF GUTS
+ If you run Email::MIME, you MUST be running Email::MIME 1.857 or
+ better.
+ require Email::MIME 1.857 in Makefile.PL only if an older
+ version is already installed
+ boldly moving forward with refactored headers and
+ Email::Simple:::Header
+ greatly reduce memory footprint
+ add crlf method to allow other modules to avoid ->{mycrlf}
+ fix broken header-junk test
1.996 2006-11-27
- do not wrap Content-Type field; it can cause Outlook to go nuts
@@ -84,4 +102,3 @@
- original version; created by h2xs 1.22 with options
-b 5.5.3 -AX -n Email::Simple
-Full details are available at http://cvs.simon-cozens.org/
Modified: packages/libemail-simple-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/MANIFEST?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/MANIFEST (original)
+++ packages/libemail-simple-perl/trunk/MANIFEST Fri Apr 13 22:57:41 2007
@@ -1,5 +1,6 @@
Changes
lib/Email/Simple.pm
+lib/Email/Simple/Header.pm
lib/Email/Simple/Headers.pm
Makefile.PL
MANIFEST
@@ -12,8 +13,10 @@
t/header-junk.t
t/header-many.t
t/header-names.t
+t/header-new.t
t/header-pairs.t
t/header-prepend.t
+t/header-space.t
t/long-msgid.t
t/many-repeats.t
t/no-body.t
Modified: packages/libemail-simple-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/META.yml?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/META.yml (original)
+++ packages/libemail-simple-perl/trunk/META.yml Fri Apr 13 22:57:41 2007
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Email-Simple
-version: 1.996
+version: 1.999
abstract: ~
license: perl
generated_by: ExtUtils::MakeMaker version 6.31
Modified: packages/libemail-simple-perl/trunk/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/Makefile.PL?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/Makefile.PL (original)
+++ packages/libemail-simple-perl/trunk/Makefile.PL Fri Apr 13 22:57:41 2007
@@ -1,11 +1,27 @@
use strict;
use ExtUtils::MakeMaker;
+
+# This is so stupid! We need to make sure that Email::MIME, a downstream
+# module, is running a version that doesn't screw around with the guts of
+# Email::Simple.
+my @prereq;
+if (eval { require Email::MIME }) {
+ unless (eval { Email::MIME->VERSION(1.857) }) {
+ warn <<END_ACHTUNG;
+### ACHTUNG! You need to update Email::MIME to a later version, as versions
+### before 1.857 meddled in the guts of Email::Simple, which have been changed.
+### If you are using an automated installer, this should happen automatically.
+END_ACHTUNG
+ push @prereq, 'Email::MIME' => 1.857;
+ }
+}
WriteMakefile(
NAME => 'Email::Simple',
VERSION_FROM => 'lib/Email/Simple.pm',
(eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
PREREQ_PM => {
+ @prereq,
'Test::More' => '0.47',
},
);
Modified: packages/libemail-simple-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/debian/changelog?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/debian/changelog (original)
+++ packages/libemail-simple-perl/trunk/debian/changelog Fri Apr 13 22:57:41 2007
@@ -1,3 +1,9 @@
+libemail-simple-perl (1.999-1) unstable; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregor+debian at comodo.priv.at> Sat, 14 Apr 2007 00:56:15 +0200
+
libemail-simple-perl (1.996-1) unstable; urgency=low
* New upstream release
Modified: packages/libemail-simple-perl/trunk/lib/Email/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/lib/Email/Simple.pm?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/lib/Email/Simple.pm (original)
+++ packages/libemail-simple-perl/trunk/lib/Email/Simple.pm Fri Apr 13 22:57:41 2007
@@ -4,7 +4,9 @@
use strict;
use Carp ();
-$Email::Simple::VERSION = '1.996';
+use Email::Simple::Header;
+
+$Email::Simple::VERSION = '1.999';
$Email::Simple::GROUCHY = 0;
my $crlf = qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; # We are liberal in what we accept.
@@ -15,31 +17,27 @@
=head1 SYNOPSIS
- my $email = Email::Simple->new($text);
-
- my $from_header = $email->header("From");
- my @received = $email->header("Received");
-
- $email->header_set("From", 'Simon Cozens <simon at cpan.org>');
-
- my $old_body = $email->body;
- $email->body_set("Hello world\nSimon");
-
- print $email->as_string;
+ my $email = Email::Simple->new($text);
+
+ my $from_header = $email->header("From");
+ my @received = $email->header("Received");
+
+ $email->header_set("From", 'Simon Cozens <simon at cpan.org>');
+
+ my $old_body = $email->body;
+ $email->body_set("Hello world\nSimon");
+
+ print $email->as_string;
=head1 DESCRIPTION
C<Email::Simple> is the first deliverable of the "Perl Email Project." The
-Email:: namespace is a reaction against the complexity and increasing bugginess
-of the C<Mail::*> modules. In contrast, C<Email::*> modules are meant to be
-simple to use and to maintain, pared to the bone, fast, minimal in their
+Email:: namespace was begun as a reaction against the increasing complexity and
+bugginess of Perl's existing email modules. C<Email::*> modules are meant to
+be simple to use and to maintain, pared to the bone, fast, minimal in their
external dependencies, and correct.
=head1 METHODS
-
-Methods are deliberately kept to a minimum. This is meant to be simple.
-No, I will not add method X. This is meant to be simple. Why doesn't it
-have feature Y? Because it's meant to be simple.
=head2 new
@@ -53,28 +51,54 @@
Carp::croak 'Unable to parse undefined message' if !defined $text;
- my ($head, $body, $mycrlf) = _split_head_from_body($text);
-
- my $self = bless { body => $body, mycrlf => $mycrlf } => $class;
-
- $self->__read_header($head);
+ my $text_ref = ref $text ? $text : \$text;
+
+ my ($pos, $mycrlf) = $class->_split_head_from_body($text_ref);
+
+ my $self = bless { mycrlf => $mycrlf } => $class;
+
+ my $head;
+ if (defined $pos) {
+ $head = substr $$text_ref, 0, $pos, '';
+ substr($head, -(length $mycrlf)) = '';
+ } else {
+ $head = $$text_ref;
+ $text_ref = \'';
+ }
+
+ $self->{body} = $text_ref;
+
+ $self->header_obj_set(
+ Email::Simple::Header->new($head, { crlf => $self->crlf })
+ );
return $self;
}
+# Given the text of an email, return ($pos, $crlf) where $pos is the position
+# at which the body text begins and $crlf is the type of newline used in the
+# message.
sub _split_head_from_body {
- my $text = shift;
-
- # The body is simply a sequence of characters that
- # follows the header and is separated from the header by an empty
- # line (i.e., a line with nothing preceding the CRLF).
- # - RFC 2822, section 2.1
- if ($text =~ /(.*?($crlf))\2(.*)/sm) {
- return ($1, ($3 || ''), $2);
- } else { # The body is, of course, optional.
- return ($text, "", "\n");
+ my ($self, $text_ref) = @_;
+
+ # For body/header division, see RFC 2822, section 2.1
+ if ($$text_ref =~ /(.*?($crlf))\2/gsm) {
+ return (pos($$text_ref), $2);
+ } else {
+
+ # The body is, of course, optional.
+ return (undef, "\n");
}
}
+
+=head2 header_obj
+
+ my $header = $email->header_obj;
+
+This method returns the object representing the email's header, and at present
+exists primarily for internal consumption.
+
+=cut
# Header fields are lines composed of a field name, followed by a colon (":"),
# followed by a field body, and terminated by CRLF. A field name MUST be
@@ -85,55 +109,28 @@
# However, a field body may contain CRLF when used in header "folding" and
# "unfolding" as described in section 2.2.3.
-sub __headers_to_list {
- my ($self, $head) = @_;
-
- my @headers;
-
- for (split /$crlf/, $head) {
- if (s/^\s+// or not /^([^:]+):\s*(.*)/) {
- # This is a continuation line. We fold it onto the end of
- # the previous header.
- next if !@headers; # Well, that sucks. We're continuing nothing?
-
- $headers[-1][1] .= $headers[-1][1] ? " $_" : $_;
- } else {
- push @headers, [ $1, $2 ];
- }
- }
-
- return \@headers;
-}
-
-sub _read_headers {
- Carp::carp "Email::Simple::_read_headers is private and depricated";
- my ($head) = @_; # ARG! Why is this a function? -- rjbs
- my $dummy = bless {} => __PACKAGE__;
- $dummy->__read_header($head);
- my $h = $dummy->__head->{head};
- my $o = $dummy->__head->{order};
- return ($h, $o);
-}
-
-sub __read_header {
- my ($self, $head) = @_;
-
- my $headers = $self->__headers_to_list($head);
-
- $self->{_head}
- = Email::Simple::__Header->new($headers, { crlf => $self->{mycrlf} });
-}
-
-sub __head {
+sub header_obj {
my ($self) = @_;
- return $self->{_head} if $self->{_head};
-
- if ($self->{head} and $self->{order} and $self->{header_names}) {
- Carp::carp "Email::Simple subclass appears to have broken header behavior";
- my $head = bless {} => 'Email::Simple::__Header';
- $head->{$_} = $self->{$_} for qw(head order header_names mycrlf);
- return $self->{_head} = $head;
- }
+ return $self->{header};
+}
+
+# Probably needs to exist in perpetuity for modules released during the "__head
+# is tentative" phase, until we have a way to force modules below us on the
+# dependency tree to upgrade. i.e., never and/or in Perl 6 -- rjbs, 2006-11-28
+BEGIN { *__head = \&header_obj }
+
+=head2 header_obj_set
+
+ $email->header_obj_set($new_header_obj);
+
+This method substitutes the given new header object for the email's existing
+header object.
+
+=cut
+
+sub header_obj_set {
+ my ($self, $obj) = @_;
+ $self->{header} = $obj;
}
=head2 header
@@ -146,7 +143,7 @@
=cut
-sub header { $_[0]->__head->header($_[1]); }
+sub header { $_[0]->header_obj->header($_[1]); }
=head2 header_set
@@ -157,7 +154,7 @@
=cut
-sub header_set { (shift)->__head->header_set(@_); }
+sub header_set { (shift)->header_obj->header_set(@_); }
=head2 header_names
@@ -172,7 +169,7 @@
=cut
-sub header_names { $_[0]->__head->header_names }
+sub header_names { $_[0]->header_obj->header_names }
BEGIN { *headers = \&header_names; }
=head2 header_pairs
@@ -185,7 +182,7 @@
=cut
-sub header_pairs { $_[0]->__head->header_pairs }
+sub header_pairs { $_[0]->header_obj->header_pairs }
=head2 body
@@ -195,7 +192,7 @@
sub body {
my ($self) = @_;
- return defined($self->{body}) ? $self->{body} : '';
+ return (defined ${ $self->{body} }) ? ${ $self->{body} } : '';
}
=head2 body_set
@@ -204,154 +201,32 @@
=cut
-sub body_set { $_[0]->{body} = $_[1]; $_[0]->body }
+sub body_set {
+ my ($self, $text) = @_;
+ my $text_ref = ref $text ? $text : \$text;
+ $self->{body} = $text_ref;
+ $self->body;
+}
=head2 as_string
Returns the mail as a string, reconstructing the headers.
-
-If you've added new headers with C<header_set> that weren't in the original
-mail, they'll be added to the end.
=cut
sub as_string {
my $self = shift;
- return $self->__head->as_string . $self->{mycrlf} . $self->body;
-}
-
-package Email::Simple::__Header;
-
-sub new {
- my ($class, $headers, $arg) = @_;
-
- my $self = {};
- $self->{mycrlf} = $arg->{crlf} || "\n";
-
- for my $header (@$headers) {
- push @{ $self->{order} }, $header->[0];
- push @{ $self->{head}{ $header->[0] } }, $header->[1];
- }
-
- $self->{header_names} = { map { lc $_ => $_ } keys %{ $self->{head} } };
-
- bless $self => $class;
-}
-
-# RFC 2822, 3.6:
-# ...for the purposes of this standard, header fields SHOULD NOT be reordered
-# when a message is transported or transformed. More importantly, the trace
-# header fields and resent header fields MUST NOT be reordered, and SHOULD be
-# kept in blocks prepended to the message.
-
-sub as_string {
- my ($self) = @_;
-
- my $header_str = '';
- my @pairs = $self->header_pairs;
-
- while (my ($name, $value) = splice @pairs, 0, 2) {
- $header_str .= $self->_header_as_string($name, $value);
- }
-
- return $header_str;
-}
-
-sub _header_as_string {
- my ($self, $field, $data) = @_;
-
- # Ignore "empty" headers
- return '' unless defined $data;
-
- my $string = "$field: $data";
-
- return ((length $string > 78) and (lc $field ne 'content-type'))
- ? $self->_fold($string)
- : ($string . $self->{mycrlf});
-}
-
-sub _fold {
- my $self = shift;
- my $line = shift;
-
- # We know it will not contain any new lines at present
- my $folded = "";
- while ($line) {
- $line =~ s/^\s+//;
- if ($line =~ s/^(.{0,77})(\s|\z)//) {
- $folded .= $1 . $self->{mycrlf};
- $folded .= " " if $line;
- } else {
-
- # Basically nothing we can do. :(
- $folded .= $line . $self->{mycrlf};
- last;
- }
- }
- return $folded;
-}
-
-sub header_names {
- values %{ $_[0]->{header_names} };
-}
-
-sub header_pairs {
- my ($self) = @_;
-
- my @headers;
- my %seen;
-
- for my $header (@{ $self->{order} }) {
- push @headers, ($header, $self->{head}{$header}[ $seen{$header}++ ]);
- }
-
- return @headers;
-}
-
-sub header {
- my ($self, $field) = @_;
- return
- unless (exists $self->{header_names}->{ lc $field })
- and $field = $self->{header_names}->{ lc $field };
-
- return wantarray
- ? @{ $self->{head}->{$field} }
- : $self->{head}->{$field}->[0];
-}
-
-sub header_set {
- my ($self, $field, @data) = @_;
-
- # I hate this block. -- rjbs, 2006-10-06
- if ($Email::Simple::GROUCHY) {
- Carp::croak "field name contains illegal characters"
- unless $field =~ /^[\x21-\x39\x3b-\x7e]+$/;
- Carp::carp "field name is not limited to hyphens and alphanumerics"
- unless $field =~ /^[\w-]+$/;
- }
-
- if (!exists $self->{header_names}->{ lc $field }) {
- $self->{header_names}->{ lc $field } = $field;
-
- # New fields are added to the end.
- push @{ $self->{order} }, $field;
- } else {
- $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];
-}
+ return $self->header_obj->as_string . $self->crlf . $self->body;
+}
+
+=head2 crlf
+
+This method returns the type of newline used in the email. It is an accessor
+only.
+
+=cut
+
+sub crlf { $_[0]->{mycrlf} }
1;
@@ -364,13 +239,18 @@
outside world, say for example when writing a mail filter for
invocation from a .forward file (for this we recommend you use
L<Email::Filter> anyway). For more information on this issue please
-consult RT issue 2478, http://rt.cpan.org/NoAuth/Bug.html?id=2478 .
+consult RT issue 2478, L<http://rt.cpan.org/NoAuth/Bug.html?id=2478>.
=head1 PERL EMAIL PROJECT
This module is maintained by the Perl Email Project
L<http://emailproject.perl.org/wiki/Email::Simple>
+
+=head1 AUTHORS
+
+Simon Cozens originally wrote Email::Simple in 2003. Casey West took over
+maintenance in 2004, and Ricardo SIGNES took over maintenance in 2006.
=head1 COPYRIGHT AND LICENSE
Modified: packages/libemail-simple-perl/trunk/lib/Email/Simple/Headers.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/lib/Email/Simple/Headers.pm?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/lib/Email/Simple/Headers.pm (original)
+++ packages/libemail-simple-perl/trunk/lib/Email/Simple/Headers.pm Fri Apr 13 22:57:41 2007
@@ -4,8 +4,9 @@
use vars qw[$VERSION];
$VERSION = '1.970';
-# XXX: In the future, this should throw a "stop using me!" warning.
-# -- rjbs, 2006-08-01
+use Carp ();
+Carp::carp 'Email::Simple::Headers is deprecated; using it does nothing'
+ unless $ENV{HARNESS_ACTIVE};
1;
Modified: packages/libemail-simple-perl/trunk/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/basic.t?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/basic.t (original)
+++ packages/libemail-simple-perl/trunk/t/basic.t Fri Apr 13 22:57:41 2007
@@ -1,78 +1,99 @@
#!/usr/bin/perl -w
use strict;
-use Test::More tests => 17;
+use Test::More tests => 37;
sub read_file { local $/; local *FH; open FH, shift or die $!; return <FH> }
use_ok("Email::Simple");
# Very basic functionality test
-my $mail_text = read_file("t/test-mails/josey-nofold");
-my $mail = Email::Simple->new($mail_text);
-isa_ok($mail, "Email::Simple");
+my $file_contents = read_file("t/test-mails/josey-nofold");
-my $old_from;
-is($old_from = $mail->header("From"),
- 'Andrew Josey <ajosey at rdg.opengroup.org>',
- "We can get a header");
-my $sc = 'Simon Cozens <simon at cpan.org>';
-is($mail->header_set("From", $sc), $sc, "Setting returns new value");
-is($mail->header("From"), $sc, "Which is consistently returned");
+for my $mail_text ($file_contents, \$file_contents) {
+ my $mail_text_string = ref $mail_text ? $$mail_text : $mail_text;
-is(
- $mail->header("Bogus"),
- undef,
- "missing header returns undef"
-);
+ my $mail = Email::Simple->new($mail_text);
+ isa_ok($mail, "Email::Simple");
-# Put andrew back:
-$mail->header_set("From", $old_from);
+ my $old_from;
+ is($old_from = $mail->header("From"),
+ 'Andrew Josey <ajosey at rdg.opengroup.org>',
+ "We can get a header");
+ my $sc = 'Simon Cozens <simon at cpan.org>';
+ is($mail->header_set("From", $sc), $sc, "Setting returns new value");
+ is($mail->header("From"), $sc, "Which is consistently returned");
-my $body;
-like($body = $mail->body, qr/Austin Group Chair/, "Body has sane stuff in it");
-my $old_body;
-
-my $hi = "Hi there!\n";
-$mail->body_set($hi);
-is($mail->body, $hi, "Body can be set properly");
-
-$mail->body_set($body);
-is($mail->as_string, $mail_text, "Good grief, it's round-trippable");
-is(Email::Simple->new($mail->as_string)->as_string, $mail_text, "Good grief, it's still round-trippable");
-
-{
- my $email = Email::Simple->new($mail->as_string);
-
- $email->body_set(undef);
is(
- $email->body,
- '',
- "setting body to undef makes ->body return ''",
+ $mail->header("Bogus"),
+ undef,
+ "missing header returns undef"
);
- $email->body_set(0);
+ # Put andrew back:
+ $mail->header_set("From", $old_from);
+
+ my $body;
+ like($body = $mail->body, qr/Austin Group Chair/, "Body has sane stuff in it");
+ my $old_body;
+
+ my $hi = "Hi there!\n";
+ $mail->body_set($hi);
+ is($mail->body, $hi, "Body can be set properly");
+
+ my $bye = "Goodbye!\n";
+ $mail->body_set(\$bye);
+ is($mail->body, $bye, "Body can be set with a ref to a string, too");
+
+ $mail->body_set($body);
is(
- $email->body,
- '0',
- "setting body to false string makes ->body return that",
+ $mail->as_string,
+ $mail_text_string,
+ "Good grief, it's round-trippable"
);
- $email->header_set('Previously-Unknown' => 'wonderful species');
is(
- $email->header('Previously-Unknown'),
- 'wonderful species',
- "we can add headers that were previously not in the message",
+ Email::Simple->new($mail->as_string)->as_string,
+ $mail_text_string,
+ "Good grief, it's still round-trippable"
);
- like(
- $email->as_string,
- qr/Previously-Unknown: wonderful species/,
- "...and the show up in the stringification",
- );
+
+ {
+ my $email = Email::Simple->new($mail->as_string);
+
+ $email->body_set(undef);
+ is(
+ $email->body,
+ '',
+ "setting body to undef makes ->body return ''",
+ );
+
+ $email->body_set(0);
+ is(
+ $email->body,
+ '0',
+ "setting body to false string makes ->body return that",
+ );
+
+ $email->header_set('Previously-Unknown' => 'wonderful species');
+ is(
+ $email->header('Previously-Unknown'),
+ 'wonderful species',
+ "we can add headers that were previously not in the message",
+ );
+ like(
+ $email->as_string,
+ qr/Previously-Unknown: wonderful species/,
+ "...and the show up in the stringification",
+ );
+ }
+
+ {
+ # With nasty newlines
+ my $nasty = "Subject: test\n\rTo: foo\n\r\n\rfoo\n\r";
+ my $mail = Email::Simple->new($nasty);
+ my ($pos, $mycrlf) = Email::Simple->_split_head_from_body(\$nasty);
+ is($pos, 26, "got proper header-end offset");
+ is($mycrlf, "\n\r", "got proper line terminator");
+ my $test = $mail->as_string;
+ is($test, $nasty, "Round trip that too");
+ is(Email::Simple->new($mail->as_string)->as_string, $nasty, "... twice");
+ }
}
-
-# With nasty newlines
-my $nasty = "Subject: test\n\rTo: foo\n\r\n\rfoo\n\r";
-$mail = Email::Simple->new($nasty);
-my ($x,$y) = Email::Simple::_split_head_from_body($nasty);
-is ($x, "Subject: test\n\rTo: foo\n\r", "Can split head OK");
-my $test = $mail->as_string;
-is($test, $nasty, "Round trip that too");
-is(Email::Simple->new($mail->as_string)->as_string, $nasty, "... twice");
Modified: packages/libemail-simple-perl/trunk/t/header-junk.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/header-junk.t?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/header-junk.t (original)
+++ packages/libemail-simple-perl/trunk/t/header-junk.t Fri Apr 13 22:57:41 2007
@@ -11,4 +11,4 @@
my $mail = Email::Simple->new($mail_text);
isa_ok($mail, "Email::Simple");
-unlike($mail->body, qr/linden/, "junk droped from header");
+unlike($mail->as_string, qr/linden/, "junk droped from header");
Modified: packages/libemail-simple-perl/trunk/t/header-many.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/header-many.t?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/header-many.t (original)
+++ packages/libemail-simple-perl/trunk/t/header-many.t Fri Apr 13 22:57:41 2007
@@ -1,6 +1,6 @@
#!perl
use strict;
-use Test::More tests => 12;
+use Test::More tests => 16;
use_ok('Email::Simple');
@@ -31,7 +31,13 @@
"and we get everything in order for header_pairs",
);
-$email->header_set(alpha => ('header one', 'header three'));
+my @rv = $email->header_set(alpha => ('header one', 'header three'));
+
+is_deeply(
+ \@rv,
+ [ 'header one', 'header three' ],
+ "header_set in list context returns all set values",
+);
is_deeply(
[ $email->header('alpha') ],
@@ -49,7 +55,8 @@
"and we still get everything in order for header_pairs",
);
-$email->header_set(alpha => qw(h1 h3 h4));
+my $rv = $email->header_set(alpha => qw(h1 h3 h4));
+is($rv, 'h1', "header_set in scalar context returns first set header");
is_deeply(
[ $email->header('alpha') ],
@@ -63,7 +70,7 @@
Alpha => 'h1',
Bravo => 'this header comes second',
Alpha => 'h3',
- Alpha => 'h4',
+ alpha => 'h4',
],
"and we still get everything in order for header_pairs",
);
@@ -105,7 +112,31 @@
Alpha => 'header one',
Bravo => 'this header comes second',
Gamma => 'gammalon',
- Alpha => 'header omega',
+ alpha => 'header omega',
],
"and re-adding to the previously third header puts it fourth",
);
+
+$email->header_set('Bravo');
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'header one',
+ Gamma => 'gammalon',
+ alpha => 'header omega',
+ ],
+ "Bravo header gets completely removed",
+);
+
+$email->header_set('Omega');
+
+is_deeply(
+ [ $email->header_pairs ],
+ [
+ Alpha => 'header one',
+ Gamma => 'gammalon',
+ alpha => 'header omega',
+ ],
+ "nothing weird happens when deleting absent headers",
+);
Modified: packages/libemail-simple-perl/trunk/t/header-names.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/header-names.t?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/header-names.t (original)
+++ packages/libemail-simple-perl/trunk/t/header-names.t Fri Apr 13 22:57:41 2007
@@ -16,6 +16,7 @@
From: casey at geeknest.com
To: drain at example.com
Subject: Message in a bottle
+subject: second subject!
HELP!
__MESSAGE__
@@ -23,12 +24,10 @@
for my $email (@emails) {
for my $method ('header_names', 'headers') {
can_ok($email, $method);
- ok(
- eq_set(
- [ qw(From To Subject) ],
- [ $email->$method ],
- ),
- 'have expected headers'
+ is_deeply(
+ [ qw(From To Subject) ],
+ [ $email->$method ],
+ "have expected headers (via $method)"
);
}
}
Modified: packages/libemail-simple-perl/trunk/t/header-prepend.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/header-prepend.t?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/header-prepend.t (original)
+++ packages/libemail-simple-perl/trunk/t/header-prepend.t Fri Apr 13 22:57:41 2007
@@ -22,8 +22,9 @@
sub Email::Simple::header_prepend {
my ($self, $field, @values) = @_;
- unshift @{ $self->{_head}{order} }, ($field) x @values;
- unshift @{ $self->{_head}{head}->{$field} }, @values;
+ for my $value (reverse @values) {
+ unshift @{ $self->header_obj->{headers} }, $field, $value;
+ }
}
$email->header_prepend(Alpha => 'this header comes firstest');
Modified: packages/libemail-simple-perl/trunk/t/test-mails/junk-in-header
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/test-mails/junk-in-header?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/test-mails/junk-in-header (original)
+++ packages/libemail-simple-perl/trunk/t/test-mails/junk-in-header Fri Apr 13 22:57:41 2007
@@ -1,5 +1,5 @@
+linden boulevard represent, represent
Header-One: steve biko
-linden boulevard represent, represent
Header-Two: stir it up
ATCQ!
Modified: packages/libemail-simple-perl/trunk/t/unit.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/unit.t?rev=5098&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/unit.t (original)
+++ packages/libemail-simple-perl/trunk/t/unit.t Fri Apr 13 22:57:41 2007
@@ -10,27 +10,26 @@
# Simple "email", no body
my $text = "a\nb\nc\n";
-my ($h, $b) = _split_head_from_body($text);
-is($h, $text, "No body, everything's head");
-is($b, "", "No body!");
+my ($pos, $crlf) = Email::Simple->_split_head_from_body(\$text);
+is($pos, undef, "no body position!");
+is($crlf, "\n", 'and \n is the crlf');
# Simple "email", properly formed
$text = "a\n\nb\n";
-($h, $b) = _split_head_from_body($text);
-is($h, "a\n", "Simple mail, head OK");
-is($b, "b\n", "Simple mail, body OK");
+($pos, $crlf) = Email::Simple->_split_head_from_body(\$text);
+is($pos, 3, "body starts at pos 3");
+is($crlf, "\n", 'and \n is the crlf');
# Simple "email" with blank lines
$text = "a\n\nb\nc\n";
-($h, $b) = _split_head_from_body($text);
-is($h, "a\n", "Simple mail, head OK");
-is($b, "b\nc\n", "Simple mail, body OK");
+($pos, $crlf) = Email::Simple->_split_head_from_body(\$text);
+is($pos, 3, "body starts at pos 3");
+is($crlf, "\n", 'and \n is the crlf');
# Blank line as first line in email
$text = "a\n\n\nb\nc\n";
-($h, $b) = _split_head_from_body($text);
-is($h, "a\n", "Simple mail, head OK");
-is($b, "\nb\nc\n", "Simple mail, body OK");
-
+($pos, $crlf) = Email::Simple->_split_head_from_body(\$text);
+is($pos, 3, "body starts at pos 3");
+is($crlf, "\n", 'and \n is the crlf');
More information about the Pkg-perl-cvs-commits
mailing list