view release on metacpan or  search on metacpan

Generic.pm  view on Meta::CPAN

    my $n = "_do_preforked_adult($$)"; # for reporting status
    my $start_servers   = ( $self->start_servers()     or 5     );
    my $spare_servers   = ( $self->min_spare_servers() or 1     );
    my $max_servers     = ( $self->max_servers()       or 10    );
    my $scoreboard      = ( $self->scoreboard()        or {}    );
    $SIG{CHLD} = \&reap_child;
    my @buffer = ();
    my $buffer = "";
    $NetServer::Debug && print STDERR "$n: About to loop on scoreboard file\n";
    my $loopcnt = 0;
    my $busycnt = 0;
    my @busyvec = ();
    #while(@buffer = $self->_read_fifo()) {
    *READ_PIPE = $self->read_pipe();
    while($buffer = <READ_PIPE>) {
        $NetServer::Debug 
           && print STDERR "busyvec: [", join("][", @busyvec), "]\n";
        $loopcnt++;
        $NetServer::Debug 
            && print STDERR "$n: in pipe read loop $loopcnt\n";
        $buffer =~ tr/ //;
        chomp $buffer;
        $NetServer::Debug 
            && print STDERR "$n: buffer: $buffer\n";
        my ($child_pid, $status) = split(/:/, $buffer);
        # kids write $$:busy or $$:idle into the pipe whenever 
        # they change state.
        if ($status eq "exit") {
            # a child just exited on us
            $NetServer::Debug 
               && print STDERR "$n: child $child_pid just died\n";
            delete($scoreboard->{$child_pid});
        } elsif ($status eq "busy") {
            $scoreboard->{$child_pid} = "busy";
            push(@busyvec, $child_pid);
            $busycnt++;
        } elsif ($status eq "idle") {
            $scoreboard->{$child_pid} = "idle";
            @busyvec = grep(!/$child_pid/, @busyvec);
            $busycnt--;
        } elsif ($status eq "start") {
            $scoreboard->{$child_pid} = "idle";
        }
        $NetServer::Debug && print STDERR "$n: $child_pid has status [",
                             $scoreboard->{$child_pid}, "]\n",
                             "$n: got ", scalar(@busyvec), " busy kids\n";
        $busycnt = scalar(@busyvec);
        my $all_kids  = scalar keys %$scoreboard;
        $NetServer::Debug && 
            print STDERR "$n: $busycnt children busy of $all_kids total\n";
        # busy_kids is number of kids currently busy; all_kids is number of kids
        if ((($all_kids - $busycnt) < $spare_servers) and 
            ($all_kids <= $max_servers)) {
            my $kids_to_launch = ($spare_servers - ($all_kids - $busycnt)) +1;
            $NetServer::Debug && 
                 print STDERR "spare servers: $spare_servers, ",
                         "all kids: $all_kids, ",
                         "busycnt: $busycnt\n", 
                         "kids to launch = spares - (all - busy) +1 ",
                         " => $kids_to_launch\n";
                         
            # launch new children
            for (my ($i) = 0; $i < $kids_to_launch; $i++) {
                my $pid = fork();
                if ($pid == 0) {
                    # new child
                    $NetServer::Debug && 
                        print STDERR "spawned child\n";
                    $self->_do_preforked_child();

Generic.pm  view on Meta::CPAN

            && print STDERR "$n: scoreboard: \n", Dumper $scoreboard;
    } 
    print STDERR "exited getline loop\n";
}

sub _do_preforked_child {
    my $self = shift;
    # we are a preforked child process. We have an IO::Pipe called 
    # $self->writer() that we write strange things to. Each "strange thing" 
    # consists of a line containing our PID, a colon, and one of three strings:
    # busy, idle, or exit.  We run like a run_select server, except that we 
    # write a busy line whenever we accept a connection, an idle line whenever 
    # we finish handling a connection, and an exit line when our age exceeds 
    # $self->server_lifespan() and we suicide.
    #
    my $n = "_do_preforked_child($$)"; # for reporting status
    my $server_lifespan = ( $self->server_lifespan() or 1000  );
    my $my_age          = ( $self->my_age()          or 0     );
    my $main_sock       = $self->sock();
    my $LOCK_SH = 1;
    my $LOCK_EX = 2;
    my $LOCK_NB = 4;

Generic.pm  view on Meta::CPAN

                $new_sock->autoflush(1);
                $rh->add($new_sock);
                if (! $self->ok_to_serve($new_sock)) {
                    $rh->remove($sock);
                    close($sock);
                }
            } else {
                if (! eof($sock)) {
                    $my_age++;
                    $NetServer::Debug 
                       && print STDERR "$n: print WRITE_PIPE ($$:busy)\n";
                    print WRITE_PIPE "$$:busy\n";
                    $NetServer::Debug 
                       && print STDERR "$n: serving connection\n";
                    $sock->autoflush(1);
                    my ($in_port, $in_addr) = sockaddr_in($sock->sockname());
                    $self->servername([$in_port, $in_addr]);
                    my ($code) = $self->callback();
                    $self->sock($sock);
                    *OLD_STDIN = *STDIN;
                    *OLD_STDOUT = *STDOUT;
                    *STDIN = $sock;