view release on metacpan or  search on metacpan

lib/HTTP/Proxy/Engine/ScoreBoard.pm  view on Meta::CPAN

    kill 'INT' => keys %$kids;

    # wait for remaining children
    while (%$kids) {
        my $pid = waitpid( -1, WNOHANG );
        next unless $pid;

        $proxy->{conn}++;  # WRONG for this engine!

        delete $kids->{$pid};
        $proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
            "Reaped child process $pid" );
        $proxy->log( HTTP::Proxy::PROCESS, "PROCESS",
            keys(%$kids) . " remaining kids: @{[ keys %$kids ]}" );
    }

    # remove the temporary file
    unlink $self->tempfile()->filename() or do {
        $proxy->log( HTTP::Proxy::ERROR, "ERROR",
            "Can't unlink @{[ $self->tempfile()->filename() ]}: $!" );
    };
}

sub _run_child {
    my $self = shift;
    my $proxy = $self->proxy();

    my $daemon       = $proxy->daemon();
    my $status_write = $self->status_write();

    open my $lockfh, $self->tempfile()->filename() or do {
        $proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot open lock file: $!" );
        exit;
    };

    my $did = 0;    # processed count

    while ( ++$did <= $self->max_requests_per_child() ) {

        flock $lockfh, LOCK_EX or do {
            $proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot get flock: $!" );
            exit;
        };

        last unless $proxy->loop();

        5 == syswrite $status_write, pack "NA", $$, "A"    # go accept
          or $proxy->log( HTTP::Proxy::ERROR, "ERROR", "status A: short write");

        my $slave = $daemon->accept() or do {
           $proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot accept: $!");
           exit;
        };

        flock $lockfh, LOCK_UN or do {
            $proxy->log( HTTP::Proxy::ERROR, "ERROR", "Cannot unflock: $!" );
            exit;
        };

        5 == syswrite $status_write, pack "NA", $$, "B"    # go busy
          or $proxy->log( HTTP::Proxy::ERROR, "ERROR", "status B: short write");
        $slave->autoflush(1);
        
        $proxy->serve_connections($slave);    # the real work is done here

        close $slave;
        5 == syswrite $status_write, pack "NA", $$, "I"    # go idle
          or $proxy->log( HTTP::Proxy::ERROR, "ERROR", "status I: short write");
    }
}

1;

__END__

=head1 NAME

HTTP::Proxy::Engine::ScoreBoard - A scoreboard-based HTTP::Proxy engine

=head1 SYNOPSIS

    my $proxy = HTTP::Proxy->new( engine => 'ScoreBoard' );

=head1 DESCRIPTION

This module provides a scoreboard-based engine to L<HTTP::Proxy>.

=head1 METHODS

The module defines the following methods, used by L<HTTP::Proxy> main loop:

=over 4

=item start()

Initialise the engine.

=item run()

Implements the forking logic: a new process is forked for each new
incoming TCP connection.

=item stop()

Reap remaining child processes.

=back

=head1 SEE ALSO

L<HTTP::Proxy>, L<HTTP::Proxy::Engine>.

=head1 AUTHOR

Philippe "BooK" Bruhat, C<< <book@cpan.org> >>.

Many thanks to Randal L. Schwartz for his help in implementing this module.

=head1 COPYRIGHT