File Coverage

blib/lib/Plack/App/Gearman/Status.pm
Criterion Covered Total %
statement 55 61 90.1
branch 6 8 75.0
condition 4 5 80.0
subroutine 15 18 83.3
pod 5 5 100.0
total 85 97 87.6


line stmt bran cond sub pod time code
1             package Plack::App::Gearman::Status;
2             {
3             $Plack::App::Gearman::Status::VERSION = '0.001001';
4             }
5 1     1   118890 use parent qw(Plack::Component);
  1         2  
  1         8  
6              
7             # ABSTRACT: Plack application to display the status of Gearman job servers
8              
9 1     1   4296 use strict;
  1         2  
  1         23  
10 1     1   3 use warnings;
  1         2  
  1         18  
11              
12 1     1   4 use Carp;
  1         1  
  1         51  
13 1     1   4 use MRO::Compat;
  1         2  
  1         27  
14 1     1   676 use Net::Telnet::Gearman;
  1         28177  
  1         43  
15 1     1   749 use Text::MicroTemplate;
  1         2827  
  1         49  
16 1     1   763 use Try::Tiny;
  1         1408  
  1         54  
17 1     1   655 use Plack::Util::Accessor qw(job_servers template connections);
  1         217  
  1         7  
18              
19              
20             chomp(my $template_string = <<'EOTPL');
21            
22            
23            
24            
25             Gearman Server Status
26            
27            
90            
91            
92            

Gearman Server Status
93             <% for my $job_server_status (@{$_[0]}) { %>
94            

Job server <%= $job_server_status->{job_server} %>
95             <% if ($job_server_status->{error}) { %>
96            

<%= $job_server_status->{error} %>
97             <% } else { %>
98            

Server Version: <%= $job_server_status->{version} %>
99              
100            

Workers
101            
102            
103             File Descriptor
104             IP Address
105             Client ID
106             Functions
107            
108             <% for my $worker (@{$job_server_status->{workers}}) { %>
109            
110             <%= $worker->file_descriptor() %>
111             <%= $worker->ip_address() %>
112             <%= $worker->client_id() %>
113             <%= join(', ', sort @{$worker->functions()}) %>
114            
115             <% } %>
116            
117              
118            

Status
119            
120            
121             Function
122             Total
123             Running
124             Available Workers
125             Queue
126            
127             <% for my $status (@{$job_server_status->{status}}) { %>
128            
129             <%= $status->name() %>
130             <%= $status->running() %>
131             <%= $status->busy() %>
132             <%= $status->free() %>
133             <%= $status->queue() %>
134            
135             <% } %>
136            
137             <% } %>
138             <% } %>
139            
140            
141             EOTPL
142              
143              
144              
145             sub new {
146 5     5 1 44545 my ($class, @arg) = @_;
147              
148 5         100 my $self = $class->next::method(@arg);
149              
150 5 100       355 unless (ref $self->job_servers() eq 'ARRAY') {
151 3         359 $self->job_servers(['127.0.0.1:4730']);
152             }
153              
154 5         163 $self->connections({});
155              
156 5         156 $self->template(Text::MicroTemplate->new(
157             template => $template_string,
158             tag_start => '<%',
159             tag_end => '%>',
160             line_start => '%',
161             )->build());
162              
163 5         48505 return $self;
164             }
165              
166              
167              
168             sub parse_job_server_address {
169 14     14 1 27733 my ($self, $address) = @_;
170              
171 14 50       57 unless (defined $address) {
172 0         0 croak("Required job server address parameter not passed");
173             }
174              
175 14 100       194 $address =~ m{^
176             # IPv6 address or hostname/IPv4 address
177             (?:\[([\d:]+)\]|([\w.-]+))
178             # Optional port
179             (?::(\d+))?
180             $}xms or croak("Unable to parse address '$address'");
181 10   66     65 my $host = $1 || $2;
182 10   100     38 my $port = $3 || 4730;
183              
184 10         38 return ($host, $port);
185             }
186              
187              
188              
189             sub connection {
190 2     2 1 30 my ($self, $address) = @_;
191              
192 2         19 my ($host, $port) = $self->parse_job_server_address($address);
193 2         3 my $connection;
194             try {
195 2     2   255 $connection = Net::Telnet::Gearman->new(
196             Host => $host,
197             Port => $port,
198             );
199             }
200             catch {
201 0     0   0 carp $_;
202 2         56 };
203 2         4841 return $connection;
204             }
205              
206              
207              
208             sub get_status {
209 1     1 1 53 my ($self) = @_;
210              
211 1         11 my @result;
212 1         17 for my $job_server (@{$self->job_servers()}) {
  1         17  
213 1 50       91 unless (defined $self->connections()->{$job_server}) {
214 1         24 $self->connections()->{$job_server} = $self->connection($job_server);
215             }
216             try {
217 1     1   40 push @result, {
218             job_server => $job_server,
219             workers => [ $self->connections()->{$job_server}->workers() ],
220             status => [ $self->connections()->{$job_server}->status() ],
221             version => $self->connections()->{$job_server}->version(),
222             };
223             }
224             catch {
225 0     0   0 delete $self->connections()->{$job_server};
226 0         0 push @result, {
227             job_server => $job_server,
228             error => 'Failed to fetch status information from '.$job_server,
229             }
230 1         30 };
231             }
232              
233 1         1384 return \@result;
234             }
235              
236              
237              
238             sub call {
239 0     0 1   my ($self, $env) = @_;
240              
241             return [
242 0           200,
243             [ 'Content-Type' => 'text/html; charset=utf-8' ],
244             [ $self->template()->($self->get_status()) ]
245             ];
246             }
247              
248              
249              
250             1;
251              
252              
253             __END__