view release on metacpan or  search on metacpan

pperl.h.header  view on Meta::CPAN

            # we are bad people
            $cwd =~ /^(.*)$/
              or barf("cwd '$cwd' unclean");
            $cwd = $1;
            chdir $cwd or barf("couldn't chdir '$cwd':  '$!'");
            next;
        }
        if ($_ eq '[ENV]') {
            log_error("$$ setting env\n");
            chomp( my $env = <$sd> );
            for (1..$env) {
                local $_ = <$sd>;
                chomp;
                my ($key, $value) = split(/\s*=\s*/, $_, 2);
                $ENV{$key} = $value;
            }
            next;
        }
        if ($_ eq '[ARGV]') {
            chomp( my $args = <$sd> );
            log_error("$$ setting $args args\n");
            for (1..$args) {
                chomp( $_ = <$sd> );
                log_error("$$ Read arg: $_\n");
                push @ARGV, $_;
            }
            next;
        }
        if ($_ eq '[DONE]') {
            return;
        }
        log_error("got unexpected '$_'\n");
        barf("what's this then? '$_'");
    }
}

use vars qw($cycles);

while (!$DONE) {
    while ($CHILD_COUNT < $PPERL::MAX_SERVERS) {
        my $child = launch_child(\&cleanup_child);
        if ($child) {  # child > 0, so we are the parent
            log_error("$$ launched child $child\n");
            $CHILD_COUNT++;
        }
        else {
            $cycles = $PPERL::MAX_REQUESTS;
            while ($cycles-- && !$should_exit) {
                log_error("$$ waiting for $cycles more new jobs\n");
                $____self = $socket->accept;
                unless ($____self) {
                    log_error("$$ accept failed: $!\n");
                    last;
                }

                %ENV  = ();
                @ARGV = ();

                setup_chunk($____self);

                local *ARGV if !@ARGV; # mumble, grumble, scoping
                if (!@ARGV) { # magic for <ARGV>
                    log_error("$$ Set argv magic\n");
                    open(ARGV, "<&STDIN");
                }

                log_error("$$ sending OK message\n");
                POSIX::write($____self->fileno, "OK\n", 3);
                log_error("$$ sent\n");

                # reset bogus '<STDIN>, line 99' count
                $. = 0;
                $? = $! = $^E = 0;
                select STDOUT;
                '' =~ m/^$/; # should reset match variables
		srand (time ^ $$);

                goto ____PPerlCode;
              ____PPerlBackAgain:

                if ($@) {
                    print STDERR $@;
                    $exit_code = 255;
                }

              __PPerl_exit:

                log_error("$$ disabling alarms\n");
                alarm 0;

                log_error("$$ closing everything\n");

                $closed = $count = 0;
                close_over(\%::);
                log_error("$$ considered $count things, closed $closed\n");

                open(STDIN,"</dev/null");
                open(STDOUT,">/dev/null");
                open(STDERR, '>&STDOUT');

                if ( fileno main::DATA && $data_at ) {
                    my $ret = seek(main::DATA, $data_at, 0);
                    log_error("seek returned $ret\n");
                }
                log_error("$$ run done - exit code $exit_code\n");

                print $____self $exit_code;
                log_error("$$ closing down socket\n");
                close($____self);
            }
            log_error("$$ child is done (should_exit: $should_exit, cycles: $cycles)\n");
            exit 0;                 # child is done
        }
    }
    sleep;         # wait for a signal
}

PPerl::kill_children();
log_error("normal termination\n");
exit 0;