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
|
#!/usr/bin/env perl
#### test run untainted! Otherwise we will not find a relative
#### mutt_dotlock program.
#
# Test the locking methods.
#
use strict;
use warnings;
use lib qw(. .. tests);
use Tools;
use Test::More;
use Mail::Box::Mbox;
use Mail::Box::Locker::Mutt;
BEGIN {
eval qq{use POSIX 'sys_wait_h';
close STDERR;
system('mutt_dotlock', '-u', '$0');
die "OK!" if WIFEXITED(\$?);
};
if($@ =~ m/OK!/)
{ plan tests => 7;
}
else
{ plan skip_all => "mutt_dotlock cannot be used";
exit 0;
}
}
my $foldername = $0;
my $fakefolder = bless {MB_foldername=> $foldername}, 'Mail::Box::Mbox';
my $lockfile = "$foldername.lock";
unlink $lockfile;
my $locker = Mail::Box::Locker->new
( method => 'MUTT'
, timeout => 1
, wait => 1
, folder => $fakefolder
);
ok($locker);
is($locker->name, 'MUTT', 'locker name');
ok($locker->lock, 'can lock');
ok(-f $lockfile, 'lockfile found');
ok($locker->hasLock, 'locked status');
# Already got lock, so should return immediately.
my $warn = '';
{ $SIG{__WARN__} = sub {$warn = "@_"};
$locker->lock;
}
ok($warn =~ m/already mutt-locked/, 'second attempt');
$locker->unlock;
ok(! $locker->hasLock, 'released lock');
|
