r3394 - in /packages/libemail-simple-perl/trunk: ./ debian/ lib/Email/ t/ t/test-mails/

eloy at users.alioth.debian.org eloy at users.alioth.debian.org
Thu Aug 3 14:11:37 UTC 2006


Author: eloy
Date: Thu Aug  3 14:11:35 2006
New Revision: 3394

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3394
Log:
eloy: new upstream version

Added:
    packages/libemail-simple-perl/trunk/t/basic.t
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/basic.t
    packages/libemail-simple-perl/trunk/t/folding.t
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/folding.t
    packages/libemail-simple-perl/trunk/t/header-case.t
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/header-case.t
    packages/libemail-simple-perl/trunk/t/header-junk.t
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/header-junk.t
    packages/libemail-simple-perl/trunk/t/long-msgid.t
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/long-msgid.t
    packages/libemail-simple-perl/trunk/t/many-repeats.t
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/many-repeats.t
    packages/libemail-simple-perl/trunk/t/test-mails/badly-folded-noindent
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/test-mails/badly-folded-noindent
    packages/libemail-simple-perl/trunk/t/test-mails/josey-nobody-blank
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/test-mails/josey-nobody-blank
    packages/libemail-simple-perl/trunk/t/test-mails/junk-in-header
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/test-mails/junk-in-header
    packages/libemail-simple-perl/trunk/t/test-mails/many-repeats
      - copied unchanged from r3393, packages/libemail-simple-perl/branches/upstream/current/t/test-mails/many-repeats
Removed:
    packages/libemail-simple-perl/trunk/t/1.t
    packages/libemail-simple-perl/trunk/t/2.t
    packages/libemail-simple-perl/trunk/t/3.t
    packages/libemail-simple-perl/trunk/t/4.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/debian/changelog
    packages/libemail-simple-perl/trunk/lib/Email/Simple.pm
    packages/libemail-simple-perl/trunk/t/badly-folded.t
    packages/libemail-simple-perl/trunk/t/no-body.t

Modified: packages/libemail-simple-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/Changes?rev=3394&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/Changes (original)
+++ packages/libemail-simple-perl/trunk/Changes Thu Aug  3 14:11:35 2006
@@ -1,4 +1,10 @@
 Revision history for Perl extension Email::Simple.
+
+1.96    2006-07-28
+
+  - output headers in predictable order
+  - give tests more meaningful names
+  - improved test coverage
 
 1.95    2006-07-21
 

Modified: packages/libemail-simple-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/MANIFEST?rev=3394&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/MANIFEST (original)
+++ packages/libemail-simple-perl/trunk/MANIFEST Thu Aug  3 14:11:35 2006
@@ -3,18 +3,24 @@
 MANIFEST
 README
 lib/Email/Simple.pm
-t/1.t
-t/2.t
-t/3.t
-t/4.t
 t/badly-folded.t
+t/basic.t
+t/folding.t
+t/header-case.t
+t/header-junk.t
+t/long-msgid.t
+t/many-repeats.t
 t/no-body.t
+t/pod-coverage.t
 t/pod.t
-t/pod-coverage.t
 t/test-mails/badly-folded
+t/test-mails/badly-folded-noindent
 t/test-mails/josey-fold
 t/test-mails/josey-nobody
+t/test-mails/josey-nobody-blank
 t/test-mails/josey-nofold
+t/test-mails/junk-in-header
 t/test-mails/long-msgid
+t/test-mails/many-repeats
 t/unit.t
-META.yml                                Module meta-data (added by MakeMaker)
+META.yml                                 Module meta-data (added by MakeMaker)

Modified: packages/libemail-simple-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/META.yml?rev=3394&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/META.yml (original)
+++ packages/libemail-simple-perl/trunk/META.yml Thu Aug  3 14:11:35 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.95
+version:      1.96
 version_from: lib/Email/Simple.pm
 installdirs:  site
 requires:

Modified: packages/libemail-simple-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/debian/changelog?rev=3394&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/debian/changelog (original)
+++ packages/libemail-simple-perl/trunk/debian/changelog Thu Aug  3 14:11:35 2006
@@ -1,3 +1,9 @@
+libemail-simple-perl (1.96-1) unstable; urgency=low
+
+  * New upstream release
+
+ -- Krzysztof Krzyzaniak (eloy) <eloy at debian.org>  Thu,  3 Aug 2006 16:09:45 +0200
+
 libemail-simple-perl (1.95-1) unstable; urgency=low
 
   * New upstream release.
@@ -48,4 +54,3 @@
   * Initial Release. (Closes:Bug#194546)
 
  -- S. Zachariah Sprackett <zac at sprackett.com>  Thu, 15 Jul 2004 20:38:14 -0400
-

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=3394&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/lib/Email/Simple.pm (original)
+++ packages/libemail-simple-perl/trunk/lib/Email/Simple.pm Thu Aug  3 14:11:35 2006
@@ -5,7 +5,7 @@
 use Carp;
 
 use vars qw($VERSION $GROUCHY);
-$VERSION = '1.95';
+$VERSION = '1.96';
 
 my $crlf = qr/\x0a\x0d|\x0d\x0a|\x0a|\x0d/; # We are liberal in what we accept.
                                             # But then, so is a six dollar whore.
@@ -61,9 +61,9 @@
     my ($head, $body, $mycrlf) = _split_head_from_body($text);
     my ($head_hash, $order) = _read_headers($head);
     bless {
-        head => $head_hash,
-        body => $body,
-        order => $order,
+        head   => $head_hash,
+        body   => $body,
+        order  => $order,
         mycrlf => $mycrlf,
         header_names => { map { lc $_ => $_ } keys %$head_hash }
     }, $class;
@@ -125,7 +125,7 @@
 
 sub header {
     my ($self, $field) = @_;
-    $field = $self->{header_names}->{lc $field} || return "";
+    return '' unless $field = $self->{header_names}->{lc $field};
     return wantarray ? @{$self->{head}->{$field}}
                      :   $self->{head}->{$field}->[0];
 }
@@ -142,9 +142,9 @@
 sub header_set {
     my ($self, $field, @data) = @_;
     if ($GROUCHY) {
-        croak "I am not going to break RFC2822 and neither are you"
+        croak "field name contains illegal characters"
             unless $field =~ /^[\x21-\x39\x3b-\x7e]+$/;
-        carp "You're a miserable bastard but I'll let you off this time"
+        carp "field name is not limited to hyphens and alphanumerics"
             unless $field =~ /^[\w-]+$/;
     }
 
@@ -166,7 +166,10 @@
 
 =cut
 
-sub body { return $_[0]->{body}      } # We like this. This is simple.
+sub body {
+  my ($self) = @_;
+  return defined($self->{body}) ? $self->{body} : '';
+}
 
 =head2 body_set
 
@@ -174,25 +177,22 @@
 
 =cut
 
-sub body_set { $_[0]->{body} = $_[1] || '' }
+sub body_set { $_[0]->{body} = $_[1]; $_[0]->body }
 
 =head2 as_string
 
-Returns the mail as a string, reconstructing the headers. Please note
-that header fields are kept in order if they are unique, but, for,
-instance, multiple "Received" headers will be grouped together. (This is
-in accordance with RFC2822, honest.)
-
-Also, 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
-
-# However, 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.
+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
+
+# 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 = shift;
@@ -202,25 +202,30 @@
 sub _headers_as_string {
     my $self = shift;
     my @order = @{$self->{order}};
-    my %head = %{$self->{head}};
-    my $stuff = "";
-    while (keys %head) {
-        my $thing = shift @order;
-        next unless exists $head{$thing}; # We have already dealt with it
-        $stuff .= $self->_header_as_string($thing, $head{$thing});
-        delete $head{$thing};
-    }
-    return $stuff;
+
+    my $header_str = "";
+    my %seen;
+
+    for my $header (@{$self->{order}}) {
+        $header_str .= $self->_header_as_string(
+          $header,
+          $self->{head}{$header}[ $seen{$header}++ ]
+        );
+    }
+
+    return $header_str;
 }
 
 sub _header_as_string {
     my ($self, $field, $data) = @_;
-    my @stuff = @$data;
+
     # Ignore "empty" headers
-    return '' unless @stuff = grep { defined $_ } @stuff;
-    return join "", map { length > 78 ? $self->_fold($_) : "$_$self->{mycrlf}" }
-                    map { "$field: $_" } 
-                    @stuff;
+    return '' unless defined $data;
+
+    my $string = "$field: $data";
+
+    return (length $string > 78) ? $self->_fold($string)
+                                 : "$string$self->{mycrlf}";
 }
 
 sub _fold {

Modified: packages/libemail-simple-perl/trunk/t/badly-folded.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/badly-folded.t?rev=3394&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/badly-folded.t (original)
+++ packages/libemail-simple-perl/trunk/t/badly-folded.t Thu Aug  3 14:11:35 2006
@@ -1,19 +1,35 @@
 #!perl -w
 use strict;
-use Test::More tests => 2;
+use Test::More tests => 5;
 
 # This time, with folding!
 
 use_ok("Email::Simple");
 sub read_file { local $/; local *FH; open FH, shift or die $!; return <FH> }
 
-my $mail_text = read_file("t/test-mails/badly-folded");
+{
+  my $mail_text = read_file("t/test-mails/badly-folded");
 
-my $msg1 = Email::Simple->new($mail_text);
-my $msg2 = Email::Simple->new($msg1->as_string);
+  my $msg1 = Email::Simple->new($mail_text);
+  my $msg2 = Email::Simple->new($msg1->as_string);
 
-is(
-  $msg2->header('X-Sieve'),
-  'CMU Sieve 2.2',
-  "still have X-Sieve header after round trip",
-);
+  is(
+    $msg2->header('X-Sieve'),
+    'CMU Sieve 2.2',
+    "still have X-Sieve header after round trip",
+  );
+}
+
+{
+  my $mail_text = read_file("t/test-mails/badly-folded-noindent");
+
+  my $msg1 = Email::Simple->new($mail_text);
+
+  is($msg1->header('Bar'), 'Bar', "got first header ok");
+  is(
+    $msg1->header('Badly-Folded'),
+    'This header is badly folded because even though it goes onto the second line, it has no indent.',
+    "got badly folded, middle header OK",
+  );
+  is($msg1->header('Foo'), 'Foo', "got final header ok");
+}

Modified: packages/libemail-simple-perl/trunk/t/no-body.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-simple-perl/trunk/t/no-body.t?rev=3394&op=diff
==============================================================================
--- packages/libemail-simple-perl/trunk/t/no-body.t (original)
+++ packages/libemail-simple-perl/trunk/t/no-body.t Thu Aug  3 14:11:35 2006
@@ -1,25 +1,22 @@
 #!perl -w
 use strict;
-use Test::More tests => 4;
+use Test::More tests => 5;
 
 # This time, with folding!
 
 use_ok("Email::Simple");
 sub read_file { local $/; local *FH; open FH, shift or die $!; return <FH> }
 
-my $mail_text = read_file("t/test-mails/josey-nobody");
+for ('', '-blank') {
+  my $mail_text = read_file("t/test-mails/josey-nobody$_");
 
-my $mail = Email::Simple->new($mail_text);
-isa_ok($mail, "Email::Simple");
+  my $mail = Email::Simple->new($mail_text);
+  isa_ok($mail, "Email::Simple");
 
-is(
-  $mail->header('From'),
-  'Andrew Josey <ajosey at rdg.opengroup.org>',
-  'correct From header on bodyless message',
-);
+  is(
+    $mail->header('From'),
+    'Andrew Josey <ajosey at rdg.opengroup.org>',
+    'correct From header on bodyless message',
+  );
+}
 
-SKIP: {
-    skip "no alarm() on win32", 1 if $^O =~ /mswin32/i;
-    alarm 5;
-    ok($mail->as_string(), "doesn't hang");
-};




More information about the Pkg-perl-cvs-commits mailing list