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
|
use strict;
package Mail::Box::Locker;
use vars '$VERSION';
$VERSION = '2.068';
use base 'Mail::Reporter';
use Carp;
use Scalar::Util 'weaken';
#-------------------------------------------
my %lockers =
( DOTLOCK => __PACKAGE__ .'::DotLock'
, FLOCK => __PACKAGE__ .'::Flock'
, MULTI => __PACKAGE__ .'::Multi'
, MUTT => __PACKAGE__ .'::Mutt'
, NFS => __PACKAGE__ .'::NFS'
, NONE => __PACKAGE__
, POSIX => __PACKAGE__ .'::POSIX'
);
sub new(@)
{ my $class = shift;
return $class->SUPER::new(@_)
unless $class eq __PACKAGE__;
# Try to figure out which locking method we really want (bootstrap)
my %args = @_;
my $method = !defined $args{method} ? 'DOTLOCK'
: ref $args{method} eq 'ARRAY' ? 'MULTI'
: uc $args{method};
my $create = $lockers{$method} || $args{$method};
local $" = ' or ';
confess "No locking method $method defined: use @{[ keys %lockers ]}"
unless $create;
# compile the locking module (if needed)
eval "require $create";
confess $@ if $@;
$args{use} = $args{method} if ref $args{method} eq 'ARRAY';
$create->SUPER::new(%args);
}
sub init($)
{ my ($self, $args) = @_;
$self->SUPER::init($args);
$self->{MBL_folder} = $args->{folder}
or croak "No folder specified to be locked.\n";
weaken($self->{MBL_folder});
$self->{MBL_expires} = $args->{expires} || 3600; # one hour
$self->{MBL_timeout} = $args->{timeout} || 10; # ten secs
$self->{MBL_filename} = $args->{file} || $args->{folder}->name;
$self->{MBL_has_lock} = 0;
$self;
}
#-------------------------------------------
sub name {shift->notImplemented}
#-------------------------------------------
sub lockMethod($$$$)
{ confess "Method removed: use inheritance to implement own method."
}
#-------------------------------------------
sub folder() {shift->{MBL_folder}}
#-------------------------------------------
sub filename(;$)
{ my $self = shift;
$self->{MBL_filename} = shift if @_;
$self->{MBL_filename};
}
#-------------------------------------------
sub lock($) { shift->{MBL_has_lock} = 1 }
#-------------------------------------------
sub isLocked($) {0}
#-------------------------------------------
sub hasLock() {shift->{MBL_has_lock}}
#-------------------------------------------
# implementation hazard: the unlock must be self-reliant, without
# help by the folder, because it may be called at global destruction
# after the folder has been removed.
sub unlock() { shift->{MBL_has_lock} = 0 }
#-------------------------------------------
sub DESTROY()
{ my $self = shift;
$self->unlock if $self->hasLock;
$self->SUPER::DESTROY;
$self;
}
1;
|
