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


line stmt bran cond sub pod time code
1             package Net::Tomcat::Connector::Scoreboard;
2              
3 1     1   6 use strict;
  1         1  
  1         35  
4 1     1   6 use warnings;
  1         1  
  1         36  
5              
6 1     1   5 use overload ( '""' => \&pretty_print );
  1         1  
  1         7  
7              
8 1     1   503 use Net::Tomcat::Connector::Scoreboard::Entry;
  1         3  
  1         79  
9              
10             our $VERSION = '0.01';
11             our %STATES = (
12             R => 'ready',
13             P => 'parse',
14             S => 'service',
15             F => 'finish',
16             K => 'keepalive'
17             );
18              
19 1         456 foreach my $state ( keys %STATES ) {{
20 1     1   7 no strict 'refs';
  1         4  
21             *{ __PACKAGE__ . '::threads_' . $STATES{ $state } } = sub {
22 0     0     my $self = shift;
23 0           return grep { $_->{stage} eq $state } @{ $self->{__threads} }
  0            
  0            
24             }
25             }}
26              
27             sub new {
28 0     0 1   my ( $class, @args ) = @_;
29 0           my $self = bless {}, $class;
30 0           $self->{__timestamp} = time;
31 0           my @h = @{ shift @args };
  0            
32              
33 0           for ( @args ) {
34 0           my %a;
35 0           @a{ @h } = @{ $_ };
  0            
36 0           push @{ $self->{__threads} }, Net::Tomcat::Connector::Scoreboard::Entry->new( %a );
  0            
37             }
38              
39 0           return $self;
40             }
41              
42 0     0 1   sub threads { return @{ $_[0]->{__threads } } }
  0            
43              
44 0     0 1   sub thread_count { return scalar @{ $_[0]->{__threads} } }
  0            
45              
46             sub threads_for_client {
47 0     0 1   my ( $self, $client ) = @_;
48 0           return grep { $_->{client} eq $client } @{ $self->{__threads} };
  0            
  0            
49             }
50              
51             sub threads_for_vhost {
52 0     0 1   my ( $self, $vhost ) = @_;
53 0           return grep { $_->{vhost} eq $vhost } @{ $self->{__threads} };
  0            
  0            
54             }
55              
56 0     0     sub __timestamp { return $_[0]->{__timestamp} }
57              
58             sub pretty_print {
59 0     0 1   my $self = shift;
60 0           print <
61             +----------+----------+----------+----------+--------------------+--------------------+----------------------------------------+
62             | Stage | Time | B Sent | B Recv | Client | VHost | Request |
63             +----------+----------+----------+----------+--------------------+--------------------+----------------------------------------+
64             PP
65 0           map {
66 0           printf( "|%9s |%9s |%9s |%9s |%19s |%19s |%39s |\n",
67             $_->stage,
68             $_->time,
69             $_->bytes_sent,
70             $_->bytes_received,
71             $_->client,
72             $_->vhost,
73             $_->request
74             )
75             } $self->threads;
76              
77 0           print "+----------+----------+----------+----------+--------------------+--------------------+----------------------------------------+\n";
78             }
79              
80             1;
81              
82             __END__