File: 21reply.t

package info (click to toggle)
libmail-box-perl 2.068-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 3,576 kB
  • ctags: 1,493
  • sloc: perl: 22,358; makefile: 49
file content (140 lines) | stat: -rw-r--r-- 3,021 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
#!/usr/bin/perl -T
#
# Test the creation of reply messages
#

use strict;
use warnings;

use lib qw(. .. tests);
use Tools;

use Test::More tests => 23;
use Mail::Address;

use Mail::Message;
use Mail::Message::Head;
use Mail::Message::Body::Lines;
use Mail::Message::Construct::Reply;

#
# First produce a message to reply to.
#

my $head = Mail::Message::Head->build
 ( To   => 'me@example.com (Me the receiver)'
 , From => 'him@somewhere.else.nl (Original Sender)'
 , Cc   => 'the.rest@world.net'
 , Subject => 'Test of Reply'
 , Skip => 'Do not take this line'
 , Date => 'Wed, 9 Feb 2000 15:44:05 -0500'
 , 'Content-Something' => 'something'
 );

my ($text, $sig) = (<<'TEXT', <<'SIG');
First line of orig message.
Another line of message.
TEXT
--
And this is the signature
which
has
a
few lines
too
SIG

my @lines = split /^/, $text.$sig;
my $body = Mail::Message::Body::Lines->new
  ( mime_type => 'text/plain'
  , checked   => 1
  , data      => \@lines
  );

ok(defined $body);

my $msg  = Mail::Message->new(head => $head);
$msg->body($body);

ok(defined $msg);

#
# Create a simple reply
#

my $reply = $msg->reply
  ( strip_signature => undef
  , prelude         => undef
  , quote           => undef
  );

ok(defined $reply);
isa_ok($reply, 'Mail::Message');

my $equal = $reply->body==$msg->body;
ok($equal);

is(  $reply->head->get('to'), $msg->head->get('from'));
is($reply->head->get('from'), $msg->head->get('to'));
ok(!defined $reply->head->get('cc'));
ok(!defined $reply->head->get('skip'));
ok(!defined $reply->head->get('content-something'));
#$reply->head->print(\*STDERR);

#warn $reply->body->string;
is($reply->body->string, $text.$sig);

#
# Create a complicated reply
#

my $postlude = Mail::Message::Body::Lines->new
  ( data => [ "added to the end\n", "two lines\n" ]
  );

$reply = $msg->reply
  ( group_reply => 1
  , quote       => '] '
  , postlude    => $postlude
  );

ok($reply->body!=$msg->body);
is(  $reply->head->get('to'), $msg->head->get('from'));
is($reply->head->get('from'), $msg->head->get('to'));
is(  $reply->head->get('cc'), $msg->head->get('cc'));
ok(!defined $reply->head->get('skip'));

#$reply->body->print;
is($reply->body->string, <<'EXPECT');
On Wed Feb  9 20:44:05 2000, Original Sender wrote:
] First line of orig message.
] Another line of message.
added to the end
two lines
EXPECT

#
# Another complicated reply
#

$reply = $msg->reply
  ( group_reply => 0
  , quote       => sub {chomp; "> ".reverse."\n"}
  , postlude    => $postlude
  , Bcc         => Mail::Address->new('username', 'user@example.com')
  );

is(  $reply->head->get('to'), $msg->head->get('from'));
is($reply->head->get('from'), $msg->head->get('to'));
ok(!defined $reply->head->get('cc'));
ok(!defined $reply->head->get('skip'));
is($reply->head->get('bcc'), 'username <user@example.com>');

#$reply->print;
is($reply->body->string, <<'EXPECT');
On Wed Feb  9 20:44:05 2000, Original Sender wrote:
> .egassem giro fo enil tsriF
> .egassem fo enil rehtonA
added to the end
two lines
EXPECT