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
|
#!/usr/bin/perl
#
# tests for body_string()
#
# body_string() calls fetch() internally. rather than refactor
# body_string() just for testing, we subclass M::IC and use the
# overidden fetch() to feed it test data.
use strict;
use warnings;
use IO::Socket qw(:crlf);
use Test::More tests => 3;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my @tests = (
[
"simple fetch",
[
'12 FETCH 1 BODY[TEXT]',
'* 1 FETCH (FLAGS (\\Seen \\Recent) BODY[TEXT]',
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
")$CRLF",
"12 OK Fetch completed.$CRLF",
],
[ 1 ],
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
],
# 2010-05-27: test for bug reported by Heiko Schlittermann
[
"uwimap IMAP4rev1 2007b.404 fetch unseen",
[
'4 FETCH 1 BODY[TEXT]',
'* 1 FETCH (BODY[TEXT]',
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
")$CRLF",
"* 1 FETCH (FLAGS (\\Recent \\Seen)$CRLF",
"4 OK Fetch completed$CRLF",
],
[ 1 ],
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
],
);
package Test::Mail::IMAPClient;
use base qw(Mail::IMAPClient);
sub new {
my ( $class, %args ) = @_;
my %me = %args;
return bless \%me, $class;
}
sub fetch {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
package main;
sub run_tests {
my ( $imap, $tests ) = @_;
for my $test (@$tests) {
my ( $comment, $fetch, $request, $response ) = @$test;
$imap->{_next_fetch_response} = $fetch;
my $r = $imap->body_string(@$request);
is_deeply( $r, $response, $comment );
}
}
my $imap = Test::Mail::IMAPClient->new( Uid => 0, Debug => 0 );
run_tests( $imap, \@tests );
|
