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 (76 lines) | stat: -rw-r--r-- 1,502 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
#!/usr/bin/perl -T

#
# Test writing of mbox folders.
#

use strict;
use warnings;

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

use Test::More tests => 5;
use File::Compare;
use File::Copy;

use Mail::Box::Mbox;

#
# We will work with a copy of the original to avoid that we write
# over our test file.
#

unlink $cpy;
copy $src, $cpy
    or die "Cannot create test folder: $!\n";

my $folder = new Mail::Box::Mbox
  ( folder       => "=$cpyfn"
  , folderdir    => 'folders'
  , lock_type    => 'NONE'
  , extract      => 'ALWAYS'
  , access       => 'rw'
  );

die "Couldn't read $cpy: $!\n"
     unless $folder;

#
# None of the messages should be modified.
#

my $modified = 0;
$modified ||= $_->modified foreach $folder->messages;
ok(!$modified);

#
# Write unmodified folder to different file.
# Because file-to-file copy of unmodified messages, the result must be
# the same.
#

$folder->modified(1);  # force write
ok($folder->write(policy => 'REPLACE'));

# Try to read it back

my $copy = new Mail::Box::Mbox
  ( folder    => "=$cpyfn"
  , folderdir => 'folders'
  , lock_type => 'NONE'
  , extract   => 'ALWAYS'
  );

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

# Check also if the subjects are the same.

my @folder_subjects = sort map {$_->head->get('subject')||''} $folder->messages;
my @copy_subjects   = sort map {$_->head->get('subject')||''} $copy->messages;

while(@folder_subjects)
{   last unless shift(@folder_subjects) eq shift(@copy_subjects);
}
ok(!@folder_subjects);