view release on metacpan or  search on metacpan

lib/POE/Component/PreforkDispatch.pm  view on Meta::CPAN

## RPC methods

sub process_queue {
    my ($kernel, $heap) = @_[KERNEL, HEAP];

    # Do nothing if queue is empty
    return if $#{ $heap->{request_queue} } < 0;

    # Find a fork to use

    # Check for available, not busy existing forks.
    # Choose the fork that's been waiting the longest
    my @avail_forks = 
        sort { $a->{finished_request} <=> $b->{finished_request} }
        grep { $_->{status} eq 'idle' }
        @{ $heap->{forks} };

    my $use_fork = $avail_forks[0] ? $avail_forks[0] : undef;

    # If no fork found, create a new one if possible.  Otherwise, wait.
    if (! $use_fork) {
        if (int @{ $heap->{forks} } == $heap->{max_forks}) {
            # Already forked the max number; have to wait for one to return
            $heap->{talkback}("All forks are busy; will wait to handle request after a fork returns") if $heap->{verbose};
            return;
        }

        # Don't forkbomb; delay before spawning another fork
        if ($heap->{last_fork_created} && time - $heap->{last_fork_created} < 5) {
            $heap->{talkback}("Delaying 2 sec on creating another fork") if $heap->{verbose};
            $kernel->delay('process_queue', 2);
            return;
        }
        $use_fork = fork_new($heap);