view release on metacpan or  search on metacpan

lib/IPC/Locker/Server.pm  view on Meta::CPAN

    $send .= "owner $clientvar->{owner}\n";
    $send .= "locked $clientvar->{locked}\n";
    $send .= "lockname $clientvar->{locks}[0]\n" if $clientvar->{locked};
    $send .= "error $clientvar->{error}\n" if $clientvar->{error};
    $send .= "\n\n";  # End of group.  Some day we may not always send EOF immediately
    return client_send ($clientvar, $send);
}

sub client_lock_list {
    my $clientvar = shift || die;
    _timelog("c$clientvar->{client_num}: Locklist!\n") if $Debug;
    while (my ($lockname, $lock) = each %Locks) {
	if (!$lock->{locked}) {
	    _timelog("c$clientvar->{client_num}: Note unlocked lock $lockname\n") if $Debug;
	    next;
	}
	client_send ($clientvar, "lock $lockname $lock->{owner}\n");
    }
    return client_send ($clientvar, "\n\n");
}

sub client_lock {
    # Client wants this lock, return true if delayed transaction
    my $clientvar = shift || die;

    # Fast case, see if there are any non-allocated locks
    foreach my $lockname (@{$clientvar->{locks}}) {
	_timelog("c$clientvar->{client_num}: check $lockname\n") if $Debug;
	my $locki = locki_find ($lockname);
	if ($locki && $locki->{owner} ne $clientvar->{user}) {
	    # See if the user's machine can clear it
	    if ($locki->{autounlock} && $clientvar->{autounlock}) {
		# The 2 is for supports DEAD_PID added in version 1.480
		# Older clients will ignore it.
		client_send ($clientvar, "autounlock_check $locki->{lock} $locki->{hostname} $locki->{pid} 2\n");
	    }
	    # Try to have timer/exister clear up existing lock
	    locki_recheck($locki,undef); # locki maybe deleted
	} else {
	    if (!$clientvar->{locked}) {  # Unlikely - some async path established the lock
		# Know there's a free lock; for speed, munge request to point to only it
		$clientvar->{locks} = [$lockname];
		last;
	    }
	}
    }

    # Create lock requests
    my $first_locki = undef;
    foreach my $lockname (@{$clientvar->{locks}}) {
	_timelog("c$clientvar->{client_num}: new $lockname\n") if $Debug;
	# Create new request.  If it can be serviced, this will
	# establish the lock and send status back.
	my $locki = locki_new_request($lockname, $clientvar);
	$first_locki ||= $locki;
	# Done if found free lock
	last if $clientvar->{locked};
    }

    # All locks busy?
    if ($clientvar->{locked}) {
	# Done, and we already sent client_status when the lock was made
	return 0;
    } elsif (!$clientvar->{block}) {
	# All busy, and user wants non-blocking, just send status
	client_status($clientvar);
	return 0;
    } else {
	# All busy, we need to block the user's request and tell the user
	if (!$clientvar->{told_locked} && $first_locki) {
	    $clientvar->{told_locked} = 1;
	    client_send ($clientvar, "print_waiting $first_locki->{owner}\n");
	}
	# Either need to wait for timeout, or someone else to return key
	return 1;	# Exit loop and check if can lock later
    }
}

sub client_break {
    my $clientvar = shift || die;
    # The locki may be deleted by this call
    foreach my $lockname (@{$clientvar->{locks}}) {
	if (my $locki = locki_find ($lockname)) {
	    if ($locki->{locked}) {
		_timelog("c$clientvar->{client_num}: broke lock   $locki->{locks} User $clientvar->{user}\n") if $Debug;
		client_send ($clientvar, "print_broke $locki->{owner}\n");
		locki_unlock ($locki);  # locki may be deleted
	    }
	}
    }
    client_status ($clientvar);
}

sub client_unlock {
    my $clientvar = shift || die;
    # Client request to unlock the given lock
    # The locki may be deleted by this call
    $clientvar->{locked} = 0;
    foreach my $lockname (@{$clientvar->{locks}}) {
	if (my $locki = locki_find ($lockname)) {
	    if ($locki->{owner} eq $clientvar->{user}) {
		_timelog("c$clientvar->{client_num}: Unlocked   $locki->{lock} User $clientvar->{user}\n") if $Debug;
		locki_unlock ($locki); # locki may be deleted
	    } else {
		# Doesn't hold lock but might be waiting for it.
		_timelog("c$clientvar->{client_num}: Waiter count: ".$#{$locki->{waiters}}."\n") if $Debug;
		for (my $n=0; $n <= $#{$locki->{waiters}}; $n++) {
		    if ($locki->{waiters}[$n]{user} eq $clientvar->{user}) {
			_timelog("c$clientvar->{client_num}: Dewait     $locki->{lock} User $clientvar->{user}\n") if $Debug;
			splice @{$locki->{waiters}}, $n, 1;
		    }
		}
	    }
	}
    }
    client_status ($clientvar);
}

sub client_send {
    # Send a string to the client, return 1 if success
    my $clientvar = shift || die;
    my $msg = shift;

    my $clientfh = $clientvar->{socket};
    return 0 if (!$clientfh);
    _timelog_split("c$clientvar->{client_num}: RESP $clientfh",
		   (' 'x24)."c$clientvar->{client_num}: RES  ", $msg) if $Debug;

    $SIG{PIPE} = 'IGNORE';