view release on metacpan or  search on metacpan

Generic.pm  view on Meta::CPAN

689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
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

768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
            && 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

826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
    $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;