r11643 - in /trunk/libemail-folder-perl: Changes MANIFEST META.yml debian/changelog lib/Email/Folder.pm lib/Email/Folder/Mbox.pm t/01mbox.t t/mboxcl2 t/mboxcl2.lies t/mboxes/ t/testmbox t/testmbox.dos t/testmbox.empty t/testmbox.mac

gregoa-guest at users.alioth.debian.org gregoa-guest at users.alioth.debian.org
Tue Dec 25 23:38:04 UTC 2007


Author: gregoa-guest
Date: Tue Dec 25 23:38:04 2007
New Revision: 11643

URL: http://svn.debian.org/wsvn/?sc=1&rev=11643
Log:
New upstream release.

Added:
    trunk/libemail-folder-perl/t/mboxes/
      - copied from r11642, branches/upstream/libemail-folder-perl/current/t/mboxes/
Removed:
    trunk/libemail-folder-perl/t/mboxcl2
    trunk/libemail-folder-perl/t/mboxcl2.lies
    trunk/libemail-folder-perl/t/testmbox
    trunk/libemail-folder-perl/t/testmbox.dos
    trunk/libemail-folder-perl/t/testmbox.empty
    trunk/libemail-folder-perl/t/testmbox.mac
Modified:
    trunk/libemail-folder-perl/Changes
    trunk/libemail-folder-perl/MANIFEST
    trunk/libemail-folder-perl/META.yml
    trunk/libemail-folder-perl/debian/changelog
    trunk/libemail-folder-perl/lib/Email/Folder.pm
    trunk/libemail-folder-perl/lib/Email/Folder/Mbox.pm
    trunk/libemail-folder-perl/t/01mbox.t

Modified: trunk/libemail-folder-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libemail-folder-perl/Changes?rev=11643&op=diff
==============================================================================
--- trunk/libemail-folder-perl/Changes (original)
+++ trunk/libemail-folder-perl/Changes Tue Dec 25 23:38:04 2007
@@ -1,3 +1,6 @@
+0.854     2007-12-23
+          fix a bug in which the last header of a mbox message could be lost
+
 0.853     2007-03-23
           packaging improvements
 

Modified: trunk/libemail-folder-perl/MANIFEST
URL: http://svn.debian.org/wsvn/trunk/libemail-folder-perl/MANIFEST?rev=11643&op=diff
==============================================================================
--- trunk/libemail-folder-perl/MANIFEST (original)
+++ trunk/libemail-folder-perl/MANIFEST Tue Dec 25 23:38:04 2007
@@ -19,12 +19,13 @@
 t/testmh/2
 t/testmh/3
 t/testmh/4
-t/mboxcl2
-t/mboxcl2.lies
-t/testmbox
-t/testmbox.mac
-t/testmbox.dos
-t/testmbox.empty
+t/mboxes/mboxcl2
+t/mboxes/mboxcl2.lies
+t/mboxes/mboxcl3
+t/mboxes/testmbox
+t/mboxes/testmbox.mac
+t/mboxes/testmbox.dos
+t/mboxes/testmbox.empty
 t/testmaildir/new/1050314226.9981_1.penfold
 t/testmaildir/tmp/1050314226.9981_8.penfold
 t/testmaildir/cur/1050314226.9981_11.penfold

Modified: trunk/libemail-folder-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libemail-folder-perl/META.yml?rev=11643&op=diff
==============================================================================
--- trunk/libemail-folder-perl/META.yml (original)
+++ trunk/libemail-folder-perl/META.yml Tue Dec 25 23:38:04 2007
@@ -1,14 +1,15 @@
 --- #YAML:1.0
 name:                Email-Folder
-version:             0.853
+version:             0.854
 abstract:            ~
 license:             perl
-generated_by:        ExtUtils::MakeMaker version 6.32
+author:              ~
+generated_by:        ExtUtils::MakeMaker version 6.42
 distribution_type:   module
 requires:     
     Email::FolderType:             0.6
     Email::Simple:                 0
     Test::More:                    0.47
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.2.html
-    version: 1.2
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3

Modified: trunk/libemail-folder-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libemail-folder-perl/debian/changelog?rev=11643&op=diff
==============================================================================
--- trunk/libemail-folder-perl/debian/changelog (original)
+++ trunk/libemail-folder-perl/debian/changelog Tue Dec 25 23:38:04 2007
@@ -1,5 +1,6 @@
-libemail-folder-perl (0.853-2) UNRELEASED; urgency=low
+libemail-folder-perl (0.854-1) UNRELEASED; urgency=low
 
+  * New upstream release.
   * debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
     field (source stanza); Homepage field (source stanza). Removed: XS-
     Vcs-Svn fields.

Modified: trunk/libemail-folder-perl/lib/Email/Folder.pm
URL: http://svn.debian.org/wsvn/trunk/libemail-folder-perl/lib/Email/Folder.pm?rev=11643&op=diff
==============================================================================
--- trunk/libemail-folder-perl/lib/Email/Folder.pm (original)
+++ trunk/libemail-folder-perl/lib/Email/Folder.pm Tue Dec 25 23:38:04 2007
@@ -5,7 +5,7 @@
 use Email::FolderType qw/folder_type/;
 
 use vars qw($VERSION);
-$VERSION = "0.853";
+$VERSION = "0.854";
 
 =head1 NAME
 

Modified: trunk/libemail-folder-perl/lib/Email/Folder/Mbox.pm
URL: http://svn.debian.org/wsvn/trunk/libemail-folder-perl/lib/Email/Folder/Mbox.pm?rev=11643&op=diff
==============================================================================
--- trunk/libemail-folder-perl/lib/Email/Folder/Mbox.pm (original)
+++ trunk/libemail-folder-perl/lib/Email/Folder/Mbox.pm Tue Dec 25 23:38:04 2007
@@ -136,20 +136,22 @@
     my $inheaders = 1;
     ++$count;
     print "$count starting scanning at line $.\n" if debug;
-    local $_;
-    while (<$fh>) {
-        if ($_ eq $/ && $inheaders) { # end of headers
+
+    while (my $line = <$fh>) {
+        if ($line eq $/ && $inheaders) { # end of headers
             print "$count end of headers at line $.\n" if debug;
             $inheaders = 0; # stop looking for the end of headers
             my $pos = tell $fh; # where to go back to if it goes wrong
+
             # look for a content length header, and try to use that
             if ($mail =~ m/^Content-Length: (\d+)$/mi) {
+                $mail .= $prev;
                 my $length = $1;
                 print " Content-Length: $length\n" if debug;
                 my $read = '';
-                while (<$fh>) {
+                while (my $bodyline = <$fh>) {
                     last if length $read >= $length;
-                    $read .= $_;
+                    $read .= $bodyline;
                 }
                 # grab the next line (should be /^From / or undef)
                 my $next = <$fh>;
@@ -160,12 +162,14 @@
                 print " Content-Length assertion failed '$next'\n" if debug;
                 seek $fh, $pos, 0;
             }
+
             # much the same, but with Lines:
             if ($mail =~ m/^Lines: (\d+)$/mi) {
+                $mail .= $prev;
                 my $lines = $1;
                 print " Lines: $lines\n" if debug;
                 my $read = '';
-                for (1..$lines) { $read .= <$fh> }
+                for (1 .. $lines) { $read .= <$fh> }
                 <$fh>; # trailing newline
                 my $next = <$fh>;
                 return "$mail$/$read"
@@ -176,27 +180,34 @@
                 seek $fh, $pos, 0;
             }
         }
-        if (!$self->{jwz_From_}) {
-            # according to mutt:
-            #   A valid message separator looks like:
-            #   From [ <return-path> ] <weekday> <month> <day> <time> [ <timezone> ] <year>
-            last if $prev eq $/ && (
-                /^From \S+\s+(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun)/ ||
-                /^From (?:Mon|Tue|Wed|Thu|Fri|Sat|Sun)/
-                    );
-        }
-        else {
-            # though, as jwz rants, only this is reliable and portable
-            last if $prev eq $/ && /^From /;
-        }
+
+        last if $prev eq $/ && ($line =~ $self->_from_line_re);
+
         $mail .= $prev;
-        $prev = $_;
+        $prev = $line;
     }
     print "$count end of message line $.\n" if debug;
     return unless $mail;
     return $mail;
 }
 
+my @FROM_RE;
+BEGIN {
+  @FROM_RE = (
+    # according to mutt:
+    #   A valid message separator looks like:
+    #   From [ <return-path> ] <weekday> <month> <day> <time> [ <tz> ] <year>
+    qr/^From (?:\S+\s+)?(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun)/,
+
+    # though, as jwz rants, only this is reliable and portable
+    qr/^From /,
+  );
+}
+
+sub _from_line_re {
+  return $FROM_RE[ $_[0]->{jwz_From_} ? 1 : 0 ];
+}
+
 sub tell {
     my $self = shift;
     return tell $self->{_fh};

Modified: trunk/libemail-folder-perl/t/01mbox.t
URL: http://svn.debian.org/wsvn/trunk/libemail-folder-perl/t/01mbox.t?rev=11643&op=diff
==============================================================================
--- trunk/libemail-folder-perl/t/01mbox.t (original)
+++ trunk/libemail-folder-perl/t/01mbox.t Tue Dec 25 23:38:04 2007
@@ -1,44 +1,52 @@
 #!perl -w
+use strict;
 my %boxes;
-BEGIN { %boxes = ( 't/testmbox'      => "\x0a",
-                   't/testmbox.mac'  => "\x0d",
-                   't/testmbox.dos'  => "\x0d\x0a" ) }
-use Test::More tests => 12 + 3 * keys %boxes;
-use strict;
+BEGIN {
+  %boxes = (
+    'testmbox'      => "\x0a",
+    'testmbox.mac'  => "\x0d",
+    'testmbox.dos'  => "\x0d\x0a"
+  )
+}
+
+use Test::More tests => 17 + 3 * keys %boxes;
 
 use_ok("Email::Folder");
 
 for my $box (keys %boxes) {
-    my $folder;
-    ok($folder = Email::Folder->new($box, eol => $boxes{$box}), "opened $box");
+  my $folder;
+  ok(
+    $folder = Email::Folder->new("t/mboxes/$box", eol => $boxes{$box}),
+    "opened $box"
+  );
 
-    my @messages = $folder->messages;
-    is(@messages, 10, "grabbed 10 messages");
+  my @messages = $folder->messages;
+  is(@messages, 10, "grabbed 10 messages");
 
-    my @subjects = sort map { $_->header('Subject') }  @messages;
+  my @subjects = sort map { $_->header('Subject') }  @messages;
 
-    my @known = (
-                 'R: [p5ml] karie kahimi binge...help needed',
-                 'RE: [p5ml] Re: karie kahimi binge...help needed',
-                 'Re: January\'s meeting',
-                 'Re: January\'s meeting',
-                 'Re: January\'s meeting',
-                 'Re: [p5ml] karie kahimi binge...help needed',
-                 'Re: [p5ml] karie kahimi binge...help needed',
-                 'Re: [rt-users] Configuration Problem',
-                 '[p5ml] Re: karie kahimi binge...help needed',
-                 '[rt-users] Configuration Problem',
-                );
+  my @known = (
+    'R: [p5ml] karie kahimi binge...help needed',
+    'RE: [p5ml] Re: karie kahimi binge...help needed',
+    'Re: January\'s meeting',
+    'Re: January\'s meeting',
+    'Re: January\'s meeting',
+    'Re: [p5ml] karie kahimi binge...help needed',
+    'Re: [p5ml] karie kahimi binge...help needed',
+    'Re: [rt-users] Configuration Problem',
+    '[p5ml] Re: karie kahimi binge...help needed',
+    '[rt-users] Configuration Problem',
+  );
 
-    is_deeply(\@subjects, \@known, "they're the messages we expected");
+  is_deeply(\@subjects, \@known, "they're the messages we expected");
 }
 
 
 my $folder;
-ok($folder = Email::Folder->new('t/testmbox.empty'), "opened testmbox.empty");
+ok($folder = Email::Folder->new('t/mboxes/testmbox.empty'), "opened testmbox.empty");
 is($folder->messages, 0);
 
-ok($folder = Email::Folder->new('t/mboxcl2'), "opened mboxcl2");
+ok($folder = Email::Folder->new('t/mboxes/mboxcl2'), "opened mboxcl2");
 my @messages = $folder->messages;
 
 is(@messages, 3);
@@ -50,7 +58,7 @@
            "they're the messages we expected");
 
 # mboxcl2 with a lying Content-Length header
-ok($folder = Email::Folder->new('t/mboxcl2.lies'), "opened mboxcl2.lies");
+ok($folder = Email::Folder->new('t/mboxes/mboxcl2.lies'), "opened mboxcl2.lies");
 @messages = $folder->messages;
 
 is(@messages, 3);
@@ -61,7 +69,7 @@
             ],
            "they're the messages we expected");
 
-my $r = Email::Folder->new('t/mboxcl2');
+my $r = Email::Folder->new('t/mboxes/mboxcl2');
 is( $r->next_message->header('Subject'), 'Fifteenth anniversary of Perl.',
     'iterate first message' );
 
@@ -69,7 +77,31 @@
 my $offset = $r->reader->tell;
 undef $r;
 
-ok( $r = Email::Folder->new('t/mboxcl2', seek_to => $offset), "reopened");
+ok( $r = Email::Folder->new('t/mboxes/mboxcl2', seek_to => $offset), "reopened");
 is( $r->next_message->header('Subject'), 'Re: Fifteenth anniversary of Perl.',
     'second message' );
 
+undef $r;
+
+$r = Email::Folder->new('t/mboxes/mboxcl3');
+my @m = $r->messages;
+is @m, 2, 'there are two messages in the mbox mboxcl2';
+
+is(
+  $m[0]->header('X-Test'),
+  'Just a bwahaha',
+ 'one more line after Content-Length'
+);
+
+is(
+  $m[0]->header_names(),
+  11,
+  'with Content-Length all headers are in place'
+);
+
+is(
+  $m[1]->header('X-Test'),
+  'Just another bwahaha',
+  'one more line after Lines'
+);
+is( $m[1]->header_names(), 11, 'with Lines all headers are in place' );




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