view release on metacpan or  search on metacpan

lib/Apache/BalancerManager.pm  view on Meta::CPAN

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}}