File Coverage

blib/lib/Net/Tomcat/Connector/Scoreboard.pm

Criterion	Covered	Total	%
statement	15	49	30.6
branch			n/a
condition			n/a
subroutine	5	13	38.4
pod	6	6	100.0
total	26	68	38.2

package Net::Tomcat::Connector::Scoreboard;

use strict;
use warnings;

use overload ( '""' => \&pretty_print );

use  Net::Tomcat::Connector::Scoreboard::Entry;

our %STATES     = (
                        R => 'ready',
                        P => 'parse',
                        S => 'service',
                        F => 'finish',
                        K  => 'keepalive'
                );

foreach my $state ( keys %STATES ) {{
        no strict 'refs';
        *{ __PACKAGE__ . '::threads_' . $STATES{ $state } } = sub {
                my $self = shift;
                return grep { $_->{stage} eq $state } @{ $self->{__threads} }
        }
}}

sub new {
        my ( $class, @args ) = @_;
        my $self = bless {}, $class;
        $self->{__timestamp} = time;
        my @h = @{ shift @args };

        for ( @args ) {
                my %a;
                @a{ @h } = @{ $_ };
                push @{ $self->{__threads} }, Net::Tomcat::Connector::Scoreboard::Entry->new( %a );
        }

        return $self;
}

sub threads             { return @{ $_[0]->{__threads } }       }

sub thread_count        { return scalar @{ $_[0]->{__threads} } }

sub threads_for_client {
        my ( $self, $client ) = @_;
        return grep { $_->{client} eq $client } @{ $self->{__threads} };
}

sub threads_for_vhost {
        my ( $self, $vhost ) = @_;
        return grep { $_->{vhost} eq $vhost } @{ $self->{__threads} };
}

sub __timestamp         { return $_[0]->{__timestamp}           }

sub pretty_print {
        my $self = shift;
        print <
+----------+----------+----------+----------+--------------------+--------------------+----------------------------------------+
|  Stage   |   Time   |  B Sent  |  B Recv  |       Client       |        VHost       |                Request                 |
+----------+----------+----------+----------+--------------------+--------------------+----------------------------------------+
PP
        map {
                printf( "|%9s |%9s |%9s |%9s |%19s |%19s |%39s |\n",
                        $_->stage,
                        $_->time,
                        $_->bytes_sent,
                        $_->bytes_received,
                        $_->client,
                        $_->vhost,
                        $_->request
                )
        } $self->threads;

print "+----------+----------+----------+----------+--------------------+--------------------+----------------------------------------+\n";
}

1;

__END__