Mailing-List: contact cygwin-help AT cygwin DOT com; run by ezmlm
List-Subscribe: <mailto:cygwin-subscribe AT cygwin DOT com>
List-Archive: <http://sourceware.org/ml/cygwin/>
List-Post: <mailto:cygwin AT cygwin DOT com>
List-Help: <mailto:cygwin-help AT cygwin DOT com>, <http://sourceware.org/ml/#faqs>
Sender: cygwin-owner AT cygwin DOT com
Mail-Followup-To: cygwin AT cygwin DOT com
Delivered-To: mailing list cygwin AT cygwin DOT com
Message-ID: <42CA7281.5040103@iopan.gda.pl>
Date: Tue, 05 Jul 2005 13:44:01 +0200
From: Jacek Piskozub <piskozub AT iopan DOT gda DOT pl>
User-Agent: Mozilla/5.0 (Windows; U; Win 9x 4.90; en-US; rv:1.7.9) Gecko/20050622
MIME-Version: 1.0
To: cygwin AT cygwin DOT com
Subject: Re: Freeze in perl script after cygwin upgrade 1.5.17 -> 1.5.18 (mozLock)
Content-Type: multipart/mixed;  boundary="------------000406010102000700030805"

--------------000406010102000700030805
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit

Dave,

> Can't locate mozLock.pm in @INC (@INC contains: /usr/lib/perl5/5.8/cygwin

Find it attached.

Chris will probably kill me when he wakes up :-(

J.





--------------000406010102000700030805
Content-Type: text/plain;
 name="mozLock.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename="mozLock.pm"

#
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is mozilla.org code.
#
# The Initial Developer of the Original Code is
# Netscape Communications Corporation.
# Portions created by the Initial Developer are Copyright (C) 2001
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
#   Christopher Seawood <cls AT seawood DOT org>
#
# Alternatively, the contents of this file may be used under the terms of
# either of the GNU General Public License Version 2 or later (the "GPL"),
# or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
#
# ***** END LICENSE BLOCK *****

package mozLock;

use strict;
use IO::File;
use Cwd;

BEGIN {
    use Exporter ();
    use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

    $VERSION = 1.00;
    @ISA = qw(Exporter);
    @EXPORT = qw(&mozLock &mozUnlock);
    %EXPORT_TAGS = ( );
    @EXPORT_OK = qw();
}

my $lockcounter = 0;
my $locklimit = 100;
my $locksleep = 0.1;
my %lockhash;

# File::Spec->rel2abs appears to be broken in ActiveState Perl 5.22
# so roll our own
sub priv_abspath($) {
    my ($file) = @_;
    my ($dir, $out);
    my (@inlist, @outlist);

    # Force files to have unix paths.
    $file =~ s/\\/\//g;

    # Check if file is already absolute
    if ($file =~ m/^\// || substr($file, 1, 1) eq ':') {
	return $file;
    }
    $out = cwd . "/$file";

    # Do what File::Spec->canonpath should do
    @inlist = split(/\//, $out);
    foreach $dir (@inlist) {
	if ($dir eq '..') {
	    pop @outlist;
	} else {
	    push @outlist, $dir;
	}
    }
    $out = join '/',@outlist;
    return $out;
}

sub mozLock($) {
    my ($inlockfile) = @_;
    my ($lockhandle, $lockfile);
    $lockfile = priv_abspath($inlockfile);
    #print "LOCK: $lockfile\n";
    $lockcounter = 0;
    $lockhandle = new IO::File || die "Could not create filehandle for $lockfile: $!\n";    
    while ($lockcounter < $locklimit) {
	if (! -e $lockfile) {
	    open($lockhandle, ">$lockfile") || die "$lockfile: $!\n";
	    $lockhash{$lockfile} = $lockhandle;
	    last;
	}
	$lockcounter++;
	select(undef,undef,undef, $locksleep);
    }
    if ($lockcounter >= $locklimit) {
	undef $lockhandle;
	die "$0: Could not get lockfile $lockfile.\nRemove $lockfile to clear up\n";
    }
}

sub mozUnlock($) {
    my ($inlockfile) = @_;
    my ($lockhandle, $lockfile);
    #$lockfile = File::Spec->rel2abs($inlockfile);
    $lockfile = priv_abspath($inlockfile);
    #print "UNLOCK: $lockfile\n";
    $lockhandle = $lockhash{$lockfile};
    if (defined($lockhandle)) {
	close($lockhandle);
	$lockhash{$lockfile} = undef;
	unlink($lockfile);
    } else {
	print "WARNING: $0: lockhandle for $lockfile not defined.  Lock may not be removed.\n";
    }
}

END {};

1;


--------------000406010102000700030805
Content-Type: text/plain; charset=us-ascii

--
Unsubscribe info:      http://cygwin.com/ml/#unsubscribe-simple
Problem reports:       http://cygwin.com/problems.html
Documentation:         http://cygwin.com/docs.html
FAQ:                   http://cygwin.com/faq/
--------------000406010102000700030805--