« mod_proxy_balancerのretry | メイン | CatalystでText::VimColorが動かない »

Load Balancer ManagerにアクセスするPerl Module

mod_proxy_balancerのLoad Balancer ManagerにアクセスするPerl Moduleなんかも作っていたりするので、簡略版を載せてみる。

my $manager = BalancerManager->new(
    manager => 'http://proxy/lbman',
    balancer => 'test',   # balancer://testの設定
);
$manager->enable('http://foo:8000'); #balancermanagerに登録してあるuri
$manager->disable('http://foo:8000');


enable/disableの戻り値は画面のまんまで、Ok or Dis or Err。
該当しない場合は、「-」になる。

↓Moduleのコード

package BalancerManager;

use strict;
use warnings;
use base qw/Class::Data::Accessor/;
use LWP::UserAgent;
use HTML::TableExtract;

__PACKAGE__->mk_classaccessors( qw/manager ua balancer/ );

sub new {
    my $class = shift;
    my $self = {
        ua => LWP::UserAgent->new,
        @_,
    };
    bless $self, $class;
}

sub enable {
    my $self = shift;
    my $host = shift;
    $self->_run( $host, 'Enable' );
}

sub disable {
    my $self = shift;
    my $host = shift;
    $self->_run( $host, 'Disable' );
}

sub _run {
    my $self = shift;
    my ( $host, $method ) = @_;
    my $manager = URI->new( $self->manager );
    $manager->query_form(
        dw => $method,
        b  => $self->balancer,
        w  => $host,
    );

    my $response = $self->ua->get($manager);
    die $response->status_line unless $response->is_sucess;

    my $report = $self->html_parser( $response->content );
    return $report->{$host} || '-';
}

sub html_parser {
    my ( $self, $html ) = @_;
    my %report;

    my $balancer = $self->balancer;
    if ( $html =~ m!<h3>.*?balancer://$balancer</a></h3>(.*?)<hr />!s ) {
        $html = $1;
    }

    my $te = HTML::TableExtract->new( headers => ['Worker URL','Route','RouteRedir','Factor','Status'] );
    $te->parse($html);
    my $table = $te->first_table_found;
    foreach my $row ( $table->rows ) {
        my $url = $row->[0];
        my $status = $row->[4];
        $url =~ s!<[^>]+?>!!gi;
        $report{$url} = $status;
    }
    return \%report;
}

1;