2
# This Source Code Form is subject to the terms of the Mozilla Public
3
# License, v. 2.0. If a copy of the MPL was not distributed with this
4
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
14
use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
18
@EXPORT = qw(&mozLock &mozUnlock);
28
# File::Spec->rel2abs appears to be broken in ActiveState Perl 5.22
33
my (@inlist, @outlist);
35
# Force files to have unix paths.
38
# Check if file is already absolute
39
if ($file =~ m/^\// || substr($file, 1, 1) eq ':') {
42
$out = cwd . "/$file";
44
# Do what File::Spec->canonpath should do
45
@inlist = split(/\//, $out);
46
foreach $dir (@inlist) {
53
$out = join '/',@outlist;
58
my ($inlockfile) = @_;
59
my ($lockhandle, $lockfile);
60
$lockfile = priv_abspath($inlockfile);
61
#print "LOCK: $lockfile\n";
63
$lockhandle = new IO::File || die "Could not create filehandle for $lockfile: $!\n";
64
while ($lockcounter < $locklimit) {
66
open($lockhandle, ">$lockfile") || die "$lockfile: $!\n";
67
$lockhash{$lockfile} = $lockhandle;
71
select(undef,undef,undef, $locksleep);
73
if ($lockcounter >= $locklimit) {
75
die "$0: Could not get lockfile $lockfile.\nRemove $lockfile to clear up\n";
80
my ($inlockfile) = @_;
81
my ($lockhandle, $lockfile);
82
#$lockfile = File::Spec->rel2abs($inlockfile);
83
$lockfile = priv_abspath($inlockfile);
84
#print "UNLOCK: $lockfile\n";
85
$lockhandle = $lockhash{$lockfile};
86
if (defined($lockhandle)) {
88
$lockhash{$lockfile} = undef;
91
print "WARNING: $0: lockhandle for $lockfile not defined. Lock may not be removed.\n";