"Fossies" - the Fresh Open Source Software Archive

Member "Mail-Box-3.007/t/503parser-bodyl.t" (15 Feb 2019, 5607 Bytes) of package /linux/privat/Mail-Box-3.007.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/env perl
    2 #
    3 # Test the reading from file of message bodies which have their content
    4 # stored in a an array of lines.
    5 
    6 use strict;
    7 use warnings;
    8 
    9 use Mail::Box::Test;
   10 use Mail::Box::Parser::Perl;
   11 use Mail::Message::Body::Lines;
   12 use Mail::Message::Head;
   13 
   14 use Test::More tests => 945;
   15 
   16 ###
   17 ### First carefully read the first message
   18 ###
   19 
   20 my $parser = Mail::Box::Parser::Perl->new(filename  => $src);
   21 ok(defined $parser,                "creation of parser");
   22 
   23 $parser->pushSeparator('From ');
   24 my ($where, $sep) = $parser->readSeparator;
   25 cmp_ok($where, "==", 0,            "begin at file-start");
   26 ok(defined $sep,                   "reading first separator");
   27 
   28 like($sep, qr/^From /,             "correctness first separator")
   29     if defined $sep;
   30 
   31 my $head = Mail::Message::Head->new;
   32 ok(defined $head);
   33 
   34 $head->read($parser);
   35 ok(defined $head);
   36 ok($head,                         "overloaded boolean");
   37 
   38 my $hard_coded_lines_msg0  = 33;
   39 my $hard_coded_length_msg0 = 1280;
   40 
   41 my $binary_size = $hard_coded_length_msg0
   42       + ($crlf_platform ? $hard_coded_lines_msg0 : 0);
   43 
   44 my $length = int $head->get('Content-Length');
   45 cmp_ok($length, "==", $binary_size,            "first message size");
   46 
   47 my $lines  = int $head->get('Lines');
   48 cmp_ok($lines, "==", $hard_coded_lines_msg0,   "first message lines");
   49 
   50 my $body = Mail::Message::Body::Lines->new;
   51 $body->read($parser, $head, undef, $length, $lines);
   52 ok(defined $body,                  "reading of first body");
   53 
   54 my @lines = $body->lines;
   55 $length -= @lines if $crlf_platform;
   56 
   57 cmp_ok($body->size, "==", $length, "size of body");
   58 cmp_ok(@lines, "==", $lines,       "lines of body");
   59 
   60 #
   61 # Try to read the rest of the folder, with specified content-length
   62 # and lines if available.
   63 #
   64 
   65 my @msgs;
   66 
   67 push @msgs,  # first message already read.
   68  { fields => scalar $head->names
   69  , lines  => $hard_coded_lines_msg0
   70  , size   => $hard_coded_length_msg0
   71  , sep    => $sep
   72  , subject=> $head->get('subject')
   73  };
   74 
   75 while(1)
   76 {   my ($where, $sep) = $parser->readSeparator;
   77     last unless $sep;
   78 
   79     my $count = @msgs;
   80     like($sep, qr/^From /,                     "1 from $count");
   81 
   82     $head = Mail::Message::Head->new;
   83     ok(defined $head,                          "1 head count");
   84 
   85     $head->read($parser);
   86 
   87     my $cl    = int $head->get('Content-Length');
   88     my $li    = int $head->get('Lines');
   89     my $su    = $head->get('Subject');
   90 
   91     $body = Mail::Message::Body::Lines->new
   92         ->read($parser, $head, undef, $cl, $li);
   93     ok(defined $body,                          "1 body $count");
   94 
   95     my $size  = $body->size;
   96     my $lines = $body->nrLines;
   97 
   98     cmp_ok($li , "==",  $lines,                "1 lines $count")
   99         if defined $li;
  100 
  101     $cl -= $li if $crlf_platform;
  102     cmp_ok($cl , "==",  $size,                 "1 size $count")
  103         if defined $cl;
  104 
  105     my $msg = 
  106      { size   => $size
  107      , lines  => $lines
  108      , fields => scalar $head->names
  109      , sep    => $sep
  110      , subject=> $su
  111      };
  112 
  113     push @msgs, $msg;
  114 }
  115 
  116 cmp_ok(@msgs, "==", 45);
  117 $parser->stop;
  118 
  119 ###
  120 ### Now read the whole folder again, but without help of content-length
  121 ### and nor lines.
  122 ###
  123 
  124 undef $parser;
  125 
  126 $parser = Mail::Box::Parser::Perl->new(filename => $src);
  127 $parser->pushSeparator('From ');
  128 
  129 my $count = 0;
  130 while($sep = $parser->readSeparator)
  131 {   my $msg = $msgs[$count];
  132 
  133     like($sep, qr/^From /,                      "2 from $count");
  134 
  135     $head     = Mail::Message::Head->new->read($parser);
  136     ok(defined $head,                           "2 head $count");
  137 
  138     $body = Mail::Message::Body::Lines->new->read($parser, $head, undef);
  139     ok(defined $body,                           "2 body $count");
  140 
  141     my $su    = $head->get('Subject');
  142     my $size  = $body->size;
  143     my $lines = $body->nrLines;
  144 
  145     cmp_ok($size, "==",  $msg->{size},           "2 size $count");
  146     cmp_ok($lines, "==",  $msg->{lines},         "2 lines $count");
  147 
  148     is($su, $msg->{subject},                     "2 subject $count")
  149         if defined $su && defined $msg->{subject};
  150 
  151     cmp_ok($head->names , "==",  $msg->{fields}, "2 names $count");
  152     is($sep, $msg->{sep},                        "2 sep $count");
  153 
  154     $count++;
  155 }
  156 
  157 $parser->stop;
  158 
  159 ###
  160 ### Now read the whole folder again, but with deceiving values for
  161 ### content-length and lines
  162 ###
  163 
  164 undef $parser;
  165 
  166 $parser = Mail::Box::Parser::Perl->new(filename => $src);
  167 $parser->pushSeparator('From ');
  168 
  169 $count = 0;
  170 while(1)
  171 {   my ($where, $sep) = $parser->readSeparator;
  172     last unless $sep;
  173 
  174     my $msg = $msgs[$count];
  175 
  176     like($sep, qr/^From /,                       "3 From $count");
  177 
  178     $head     = Mail::Message::Head->new->read($parser);
  179     ok(defined $head,                            "3 Head $count");
  180 
  181     $body = Mail::Message::Body::Lines->new;
  182     $body->read($parser, $head, undef, $msg->{size}-15, $msg->{lines}-3);
  183     ok(defined $body,                            "3 Body $count");
  184 
  185     my $su    = $head->get('Subject');
  186     my $size  = $body->size;
  187     my $lines = $body->nrLines;
  188 
  189     # two messages contain one trailing blank, which is removed because
  190     # of the wrong number of lines.  The will have an extra OK.
  191     my $wrong = $count==14 || $count==18;
  192 
  193     cmp_ok($size, '==', $msg->{size},            "3 size $count")
  194         unless $wrong;
  195 
  196     cmp_ok($lines, '==', $msg->{lines},          "3 lines $count")
  197         unless $wrong;
  198 
  199     is($su, $msg->{subject}, "3 subject $count")
  200         if defined $su && defined $msg->{subject};
  201 
  202     cmp_ok($head->names, '==', $msg->{fields},   "3 name $count");
  203     is($sep, $msg->{sep},                        "3 sep $count");
  204 
  205     $count++;
  206 }