view release on metacpan or  search on metacpan

lib/IPC/LockTicket.pm  view on Meta::CPAN

		$strErrors	.= qq{"$objSelf->{_uriPath}": No write permission.\n};
		}

	# What if permissions differ??
	if ( -e $objSelf->{_uriPath} ) {
		my %mxdFileStat		= ();
		my @strParts		= qw(o g u ts);
		my %intFilePerms	= ();	# user:users 0600
		my @intFileGrpsMbrs	= ();
		my %intObjPerms		= ();	# root:root 0600
		my $strEUName		= (getpwuid($EUID))[0];
		my @intObjGrps		= ( (getpwuid($EUID))[3] );
		my $cntPosition		= 0;
		@mxdFileStat{qw(dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks)} =
			stat($objSelf->{_uriPath});
		%intFilePerms		=
			map { $strParts[$cntPosition++] => $_ } #( $_ % 2 ) ? $_ - 1 : $_ }		# Execution bit is not required
			reverse(split('', sprintf(q{%04o}, $mxdFileStat{mode} & 07777)));
		$cntPosition		= 0;
		%intObjPerms		=
			map { $strParts[$cntPosition++] => $_ } #( $_ % 2 ) ? $_ - 1 : $_ }		# Execution bit is not required
			reverse(split('', sprintf(q{%04o}, $objSelf->{_octPermission})));