Scoreboard.pm

package Plack::Middleware::Parallel::Scoreboard;
use strict;
use warnings;
use parent qw(Plack::Middleware);
use Plack::Util::Accessor qw(board base_dir path);
use Parallel::Scoreboard;
our $VERSION = '0.01';

sub prepare_app {
    my $self = shift;

    if ( $self->base_dir ) {
        $self->board(
            Parallel::Scoreboard->new( base_dir => $self->base_dir ) );
    }
    else {
        die "Parallel::Scoreboard require base_dir option";
    }
}

sub call {
    my ( $self, $env ) = @_;

    $self->set_state( $env->{HTTP_KEEP_ALIVE} ? 'K' : 'A', $env );

    my $res;
    if ( $self->path && $env->{PATH_INFO} eq $self->path ) {
        $res = $self->_handle_server_status($env);
    }
    else {
        $res = $self->app->($env);
    }

    $self->set_state("_");

    return $res;
}

sub set_state {
    my $self   = shift;
    my $status = shift || '_';
    my $env    = shift;
    my $prev   = '';
    if ($env) {
        $prev = join( " ",
            $env->{REMOTE_ADDR},    $env->{HTTP_HOST},
            $env->{REQUEST_METHOD}, $env->{REQUEST_URI},
            $env->{SERVER_PROTOCOL} );
    }
    $self->board->update( sprintf( "[%s] %s %s", getppid, $status, $prev ) );
}

sub _handle_server_status {
    my ( $self, $env ) = @_;

    my @body;
    my $stats = $self->board->read_all();
    for my $pid ( sort { $a <=> $b } keys %$stats ) {
        push @body, "$stats->{$pid}\n";
    }

    return [ 200, [ 'Cotnent-Type' => 'text/plain; charset=utf-8' ], \@body ];
}
1;