File: 20write.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 (126 lines) | stat: -rw-r--r-- 3,014 bytes parent folder | download | duplicates (3)
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
#!/usr/bin/perl -T

#
# Test writing of maildir folders.
#

use strict;
use warnings;

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

use Test::More;
use File::Compare;
use File::Copy;

use Mail::Box::Maildir;

BEGIN {
   if($windows)
   {   plan skip_all => 'Filenames not compatible with Windows';
       exit 1;
   }
   plan tests => 45;
}

my $mdsrc = File::Spec->catfile('folders', 'maildir.src');

clean_dir $mdsrc;
unpack_mbox2maildir($src, $mdsrc);

my $folder = new Mail::Box::Maildir
  ( folder       => $mdsrc
  , extract      => 'LAZY'
  , access       => 'rw'
  );

ok(defined $folder);

ok($folder->message(40)->label('accepted'),        "40 accepted");
ok(!$folder->message(41)->label('accepted'),       "41 not accepted");

#
# Count files flagged for deletion  (T flag)
#

my $to_be_deleted =0;
$_->deleted && $to_be_deleted++  foreach $folder->messages;
cmp_ok($to_be_deleted, "==", 7);

$folder->close;

#
# Reopen the folder and see whether the messages flagged for deletion
# are away.
#

$folder = new Mail::Box::Maildir
  ( folder       => $mdsrc
  , extract      => 'LAZY'
  , access       => 'rw'
  );

cmp_ok($folder->messages, "==", 38);

my $msg6 = $folder->message(6);
like($msg6->filename , qr/:2,$/);
ok(!$msg6->label('draft'));
ok(!$msg6->label('flagged'));
ok(!$msg6->label('replied'));
ok(!$msg6->label('seen'));
ok(!$msg6->modified);

my $msg12 = $folder->message(12);
like($msg12->filename , qr/:2,DFRS$/);
ok($msg12->label('draft'));
ok($msg12->label('flagged'));
ok($msg12->label('replied'));
ok($msg12->label('seen'));

ok(!$msg12->label(flagged => 0));
ok(!$msg12->label('flagged'));
like($msg12->filename , qr/:2,DRS$/);

ok(!$msg12->label(draft => 0));
ok(!$msg12->label('draft'));
like($msg12->filename , qr/:2,RS$/);

ok(!$msg12->label(seen => 0));
ok(!$msg12->label('seen'));
like($msg12->filename , qr/:2,R$/);

ok($msg12->label(flagged => 1));
ok($msg12->label('flagged'));
like($msg12->filename , qr/:2,FR$/);

ok(!$msg12->label(flagged => 0, replied => 0));
ok(!$msg12->label('flagged'));
ok(!$msg12->label('replied'));
like($msg12->filename , qr/:2,$/);

ok(!$msg12->modified);

#
# Test accepting and unaccepting
#

# test are only run on unix, so we can simply use '/'s
is($msg12->filename, 'folders/maildir.src/cur/110000010.l.43:2,');
ok($msg12->label('accepted'),                      "12 accepted");
cmp_ok($msg12->label(accepted => 0), '==', 0,      'un-accept a message');
ok(! $msg12->label('accepted'));
is($msg12->filename, 'folders/maildir.src/new/110000010.l.43:2,');
ok(!$msg12->modified);   # message is not modified
ok($folder->modified);   # ... but the folder is modified
                         #     (which implies nothing)
cmp_ok($msg12->label(accepted => 1), '==', 1,      'accept the message');
ok($msg12->label('accepted'));
is($msg12->filename, 'folders/maildir.src/cur/110000010.l.43:2,');

ok(! $folder->message(-1)->label('accepted'));
$folder->message(-1)->accept;
ok($folder->message(-1)->label('accepted'));

$folder->close;
clean_dir $mdsrc;