-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathlockf.pm
191 lines (123 loc) · 4.38 KB
/
lockf.pm
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
#
# File-Lockf version 0.20
#
# Paul Henson <[email protected]>
#
# Copyright (c) 1997,1998 Paul Henson -- see COPYRIGHT file for details
#
package File::lockf;
use strict;
use vars qw($VERSION @ISA @EXPORT);
require Exporter;
require DynaLoader;
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw();
$VERSION = '0.20';
bootstrap File::lockf $VERSION;
sub new {
my ($class, $fh) = @_;
my $self = {};
$self->{fh} = $fh;
bless($self, "File::lockf::lock_obj");
return $self;
}
sub File::lockf::lock_obj::fh {
my ($self) = @_;
return $self->{fh};
}
sub File::lockf::lock_obj::lock {
my ($self, $size) = @_;
$size = 0 unless $size;
return File::lockf::lock($self->{fh}, $size);
}
sub File::lockf::lock_obj::tlock {
my ($self, $size) = @_;
$size = 0 unless $size;
return File::lockf::tlock($self->{fh}, $size);
}
sub File::lockf::lock_obj::ulock {
my ($self, $size) = @_;
$size = 0 unless $size;
return File::lockf::ulock($self->{fh}, $size);
}
sub File::lockf::lock_obj::test {
my ($self, $size) = @_;
$size = 0 unless $size;
return File::lockf::test($self->{fh}, $size);
}
sub File::lockf::lock_obj::slock {
my ($self, $count, $delay, $size) = @_;
$count = 5 unless $count;
$delay = 2 unless $delay;
$size = 0 unless $size;
my $status = -1;
my $index;
for ($index = 0; $index < $count; $index++) {
$status = File::lockf::tlock($self->{fh}, $size);
return 0 if ($status == 0);
sleep($delay);
}
return $status;
}
1;
__END__
=head1 NAME
File::lockf - Perl module interface to the lockf system call
=head1 SYNOPSIS
use File::lockf;
=head1 DESCRIPTION
File-Lockf is an interface to the lockf system call. Perl supports the
flock system call natively, but that does not acquire network locks. Perl
also supports the fcntl system call, but that is somewhat ugly to
use. There are other locking modules available for Perl, but none of them
provided what I wanted -- a simple, clean interface to the lockf system
call, without any bells or whistles getting in the way.
File-Lockf contains four functions which map directly to the four modes of
lockf, and an OO wrapper class that encapulates the basic locking
functionality along with an additional utility method that iteratively
attempts to acquire a lock.
=head1 Lock functions
The following functions return 0 (zero) on success, and the system error
number from errno on failure. They each take an open file handle as the
first argument, and optionally a size parameter. Please see your system
lockf man page for more details about lockf functionality on your system.
=over 4
=item $status = File::lockf::lock(FH, size = 0)
This function maps to the F_LOCK mode of lockf.
=item $status = File::lockf::tlock(FH, size = 0)
This function maps to the F_TLOCK mode of lockf.
=item $status = File::lockf::ulock(FH, size = 0)
This function maps to the F_ULOCK mode of lockf.
=item $status = File::lockf::test(FH, size = 0)
This function maps to the F_TEST mode of lockf.
=back
=head1 OO wrapper
File-Lockf also provides a simple OO wrapper class around the locking
functionality, which allows you to create a lock object for a file handle
and then perform lock operations with it. All of the methods return 0
(zero) on success, and the system error number from errno on failure.
=over 4
=item $lock = new File::lockf(\*FH)
This function returns a new lock object bound to the given file
handle. Note that you need to pass a reference to the file handle
to the constructor, not the file handle itself.
=item $fh = $lock->fh()
This method returns the file handle associated with the lock object.
=item $status = $lock->lock(size = 0)
This method calls File::lockf::lock on the bound file handle.
=item $status = $lock->tlock(size = 0)
This method calls File::lockf::tlock on the bound file handle.
=item $status = $lock->ulock(size = 0)
This method calls File::lockf::ulock on the bound file handle.
=item $status = $lock->test(size = 0)
This method calls File::lockf::test on the bound file handle.
=item $status = $lock->slock(count = 5, delay = 2, size = 0)
This method will attempt to lock the bound file handle <count> times,
sleeping <delay> seconds after each try. It will return 0 if the lock
succeeded, or the system error number from errno if all attempts fail.
=back
=head1 AUTHOR
Paul Henson <[email protected]>
=head1 SEE ALSO
perl(1).
=cut