/usr/share/perl5/Perlbal/Plugin/Queues.pm is in libperlbal-perl 1.80-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | ###########################################################################
# simple queue length header inclusion plugin
###########################################################################
package Perlbal::Plugin::Queues;
use strict;
use warnings;
no warnings qw(deprecated);
# called when we're being added to a service
sub register {
my ($class, $svc) = @_;
# more complicated statistics
$svc->register_hook('Queues', 'backend_client_assigned', sub {
my Perlbal::BackendHTTP $obj = shift;
my Perlbal::HTTPHeaders $hds = $obj->{req_headers};
my Perlbal::Service $svc = $obj->{service};
return 0 unless defined $hds && defined $svc;
# determine age of oldest (first in line)
my $now = time;
my Perlbal::ClientProxy $cp = $svc->{waiting_clients}->[0];
my $age = defined $cp ? ($now - $cp->{last_request_time}) : 0;
# now do the age of the high priority queue
$cp = $svc->{waiting_clients_highpri}->[0];
my $hpage = defined $cp ? ($now - $cp->{last_request_time}) : 0;
# setup the queue length headers
$hds->header('X-Queue-Count', scalar(@{$svc->{waiting_clients}}));
$hds->header('X-Queue-Age', $age);
$hds->header('X-HP-Queue-Count', scalar(@{$svc->{waiting_clients_highpri}}));
$hds->header('X-HP-Queue-Age', $hpage);
return 0;
});
return 1;
}
# called when we're no longer active on a service
sub unregister {
my ($class, $svc) = @_;
# clean up time
$svc->unregister_hooks('Queues');
return 1;
}
# we don't do anything in here
sub load { return 1; }
sub unload { return 1; }
1;
|