File Coverage

blib/lib/Apache/BalancerManager.pm

Criterion	Covered	Total	%
statement	55	64	85.9
branch	1	2	50.0
condition			n/a
subroutine	14	15	93.3
pod	3	3	100.0
total	73	84	86.9

package Apache::BalancerManager;
$Apache::BalancerManager::VERSION = '0.002000';
# ABSTRACT: Interact with the Apache BalancerManager

use Moo;
use List::Util ();
use Web::Scraper;

has url => (
   is => 'ro',
   required => 1,
);

has name => (
   is => 'ro',
   lazy => 1,
   builder => '_build_name',
);

sub _build_name {
   my $ret = $_[0]->_scraped_content->{name_stuff};

   $ret =~ s(^balancer://)();

   return $ret
}

has nonce => (
   is => 'ro',
   init_arg => undef,
   lazy => 1,
   builder => '_build_nonce',
);

sub _build_nonce {
   my $self = shift;

   my $url  = $self->url;
   my $link = $self->_scraped_content->{data}[0]{link};

   require URI;
   require URI::QueryParam;
   my $uri = URI->new("$url$link");
   scalar $uri->query_param('nonce')
}

has _index_content => (
   is => 'ro',
   init_arg => undef,
   lazy => 1,
   builder => '_build_index_content',
);

sub _build_index_content {
   my $self = shift;

   my $response = $self->_get($self->url);
   if ($response->is_success) {
       return $response->decoded_content;
   }
   else {
       die $response->status_line;
   }
}

has _scraper => (
   is => 'ro',
   init_arg => undef,
   lazy => 1,
   builder => '_build_scraper',
   handles => {
      _scrape => 'scrape',
   },
);

sub _build_scraper {
   return scraper {
      process 'h3 > a', name_stuff => 'TEXT';
      process '//table[2]/tr' => 'data[]' => scraper {
         process '//td[1]/a/@href', 'link' => 'TEXT';
         process '//td[1]/a', 'location' => 'TEXT';
         process '//td[2]', 'route' => 'TEXT';
         process '//td[3]', 'route_redirect' => 'TEXT';
         process '//td[4]', 'load_factor' => 'TEXT';
         process '//td[5]', 'lb_set' => 'TEXT';
         process '//td[6]', status => 'TEXT';
         process '//td[7]', times_elected => 'TEXT';
         process '//td[8]', busy => 'TEXT';
         process '//td[9]', load => 'TEXT';
         process '//td[10]', to => 'TEXT';
         process '//td[11]', from => 'TEXT';
      };
   };
}

has _scraped_content => (
   is => 'ro',
   init_arg => undef,
   lazy => 1,
   builder => '_build_scraped_content',
);

sub _build_scraped_content {
   my $s = $_[0]->_scrape( $_[0]->_index_content );
   $s->{data} = [grep %$_, @{$s->{data}}];
   $s
}

has _user_agent => (
   is => 'ro',
   lazy => 1,
   init_arg => 'user_agent',
   builder => '_build_user_agent',
   handles => {
      _get => 'get',
      _post => 'post',
   },
);

sub _build_user_agent {
   my $self = shift;
   require LWP::UserAgent;
   require URI;
   my $uri = URI->new($self->url);
   my $ua = LWP::UserAgent->new;
   # since httpd 2.4.41 referer is required for XSS protection
   $ua->default_header(Referer => $self->url);
   $ua->default_header(Host => $uri->host);
   $ua
}

has _members => (
   is => 'ro',
   # TODO: support passing memebers as either objects or strings that coerce
   init_arg => undef,
   lazy => 1,
   builder => '_build_members',
);

sub _build_members {
   require Apache::BalancerManager::Member;

   [
      map {;
         $_->{status} = $_->{status} =~ m/Ok/;
         $_->{manager} = $_[0];
         Apache::BalancerManager::Member->new($_),
      } @{$_[0]->_scraped_content->{data}}
   ]
}

sub get_member_by_index { $_[0]->_members->[$_[1]]; }

sub get_member_by_location {
   my ($self, $location) = @_;

   List::Util::first { $_->location eq $location } @{$self->_members};
}

sub member_count { scalar @{$_[0]->_members} }

1;

__END__