config/mozLock.pm

   1 #
   2 # ***** BEGIN LICENSE BLOCK *****
   3 # Version: MPL 1.1/GPL 2.0/LGPL 2.1
   4 #
   5 # The contents of this file are subject to the Mozilla Public License Version
   6 # 1.1 (the "License"); you may not use this file except in compliance with
   7 # the License. You may obtain a copy of the License at
   8 # http://www.mozilla.org/MPL/
   9 #
  10 # Software distributed under the License is distributed on an "AS IS" basis,
  11 # WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12 # for the specific language governing rights and limitations under the
  13 # License.
  14 #
  15 # The Original Code is mozilla.org code.
  16 #
  17 # The Initial Developer of the Original Code is
  18 # Netscape Communications Corporation.
  19 # Portions created by the Initial Developer are Copyright (C) 2001
  20 # the Initial Developer. All Rights Reserved.
  21 #
  22 # Contributor(s):
  23 #   Christopher Seawood <cls@seawood.org>
  24 #
  25 # Alternatively, the contents of this file may be used under the terms of
  26 # either of the GNU General Public License Version 2 or later (the "GPL"),
  27 # or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  28 # in which case the provisions of the GPL or the LGPL are applicable instead
  29 # of those above. If you wish to allow use of your version of this file only
  30 # under the terms of either the GPL or the LGPL, and not to allow others to
  31 # use your version of this file under the terms of the MPL, indicate your
  32 # decision by deleting the provisions above and replace them with the notice
  33 # and other provisions required by the GPL or the LGPL. If you do not delete
  34 # the provisions above, a recipient may use your version of this file under
  35 # the terms of any one of the MPL, the GPL or the LGPL.
  36 #
  37 # ***** END LICENSE BLOCK *****
  38
  39 package mozLock;
  40
  41 use strict;
  42 use IO::File;
  43 use Cwd;
  44
  45 BEGIN {
  46     use Exporter ();
  47     use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  48
  49     $VERSION = 1.00;
  50     @ISA = qw(Exporter);
  51     @EXPORT = qw(&mozLock &mozUnlock);
  52     %EXPORT_TAGS = ( );
  53     @EXPORT_OK = qw();
  54 }
  55
  56 my $lockcounter = 0;
  57 my $locklimit = 100;
  58 my $locksleep = 0.1;
  59 my %lockhash;
  60
  61 # File::Spec->rel2abs appears to be broken in ActiveState Perl 5.22
  62 # so roll our own
  63 sub priv_abspath($) {
  64     my ($file) = @_;
  65     my ($dir, $out);
  66     my (@inlist, @outlist);
  67
  68     # Force files to have unix paths.
  69     $file =~ s/\\/\//g;
  70
  71     # Check if file is already absolute
  72     if ($file =~ m/^\// || substr($file, 1, 1) eq ':') {
  73         return $file;
  74     }
  75     $out = cwd . "/$file";
  76
  77     # Do what File::Spec->canonpath should do
  78     @inlist = split(/\//, $out);
  79     foreach $dir (@inlist) {
  80         if ($dir eq '..') {
  81             pop @outlist;
  82         } else {
  83             push @outlist, $dir;
  84         }
  85     }
  86     $out = join '/',@outlist;
  87     return $out;
  88 }
  89
  90 sub mozLock($) {
  91     my ($inlockfile) = @_;
  92     my ($lockhandle, $lockfile);
  93     $lockfile = priv_abspath($inlockfile);
  94     #print "LOCK: $lockfile\n";
  95     $lockcounter = 0;
  96     $lockhandle = new IO::File || die "Could not create filehandle for $lockfile: $!\n";
  97     while ($lockcounter < $locklimit) {
  98         if (! -e $lockfile) {
  99             open($lockhandle, ">$lockfile") || die "$lockfile: $!\n";
 100             $lockhash{$lockfile} = $lockhandle;
 101             last;
 102         }
 103         $lockcounter++;
 104         select(undef,undef,undef, $locksleep);
 105     }
 106     if ($lockcounter >= $locklimit) {
 107         undef $lockhandle;
 108         die "$0: Could not get lockfile $lockfile.\nRemove $lockfile to clear up\n";
 109     }
 110 }
 111
 112 sub mozUnlock($) {
 113     my ($inlockfile) = @_;
 114     my ($lockhandle, $lockfile);
 115     #$lockfile = File::Spec->rel2abs($inlockfile);
 116     $lockfile = priv_abspath($inlockfile);
 117     #print "UNLOCK: $lockfile\n";
 118     $lockhandle = $lockhash{$lockfile};
 119     if (defined($lockhandle)) {
 120         close($lockhandle);
 121         $lockhash{$lockfile} = undef;
 122         unlink($lockfile);
 123     } else {
 124         print "WARNING: $0: lockhandle for $lockfile not defined.  Lock may not be removed.\n";
 125     }
 126 }
 127
 128 END {};
 129
 130 1;