File Coverage

blib/lib/Net/MCMP.pm

Criterion	Covered	Total	%
statement	26	167	15.5
branch	2	100	2.0
condition	1	12	8.3
subroutine	8	27	29.6
pod	16	19	84.2
total	53	325	16.3

package Net::MCMP;

use strict;
use warnings;

use HTTP::Request;
use LWP::UserAgent;

our $VERSION = '0.08';

sub new {
	my ( $class, $ref ) = @_;

	unless ( exists $ref->{uri} ) {
		die 'missing uri';
	}

	$ref->{uri} =~ s/\s+//g;

	my $self = { _uri => $ref->{uri} };

	if ( exists $ref->{debug} && $ref->{debug} ) {
		$self->{_debug} = 1;
	}

	bless $self, $class;
	return $self;
}

sub uri {
	return $_[0]->{_uri};
}

sub debug {
	return ($_[0]->{_debug} || $ENV{MCMP_TRACE} || undef);
}

use constant DEFAULT_MCMP_CONFIG => {
	Balancer            => 'mycluster',
	StickySession       => 'yes',
	StickySessionCookie => 'JSESSIONID',
	StickySessionPath   => 'jsessionid',
	StickySessionRemove => 'no',
	StickySessionForce  => 'yes',
	WaitWorker          => 0,
	MaxAttempts         => 1,
	JvmRoute            => undef,
	Domain              => 'mycluster',
	Host                => 'localhost',
	Port                => '8009',
	Type                => 'ajp',
	FlushPackets        => 'off',
	FlushWait           => 1,
	Ping                => 10,
	Smax                => undef,
	Ttl                 => 60,
	Timeout             => 0,
	Context             => undef,
	Alias               => undef,
};

# FROM: https://community.jboss.org/wiki/Mod-Clusternodebalancer
#
# JvmRoute: See http://wiki.jboss.org/wiki/Mod-ClusterManagementProtocol Default: Mandatory
# Domain: See http://wiki.jboss.org/wiki/Mod-ClusterManagementProtocol Default: "" empty string
# Host: See http://wiki.jboss.org/wiki/Mod-ClusterManagementProtocol Default: "localhost"
# Port: See http://wiki.jboss.org/wiki/Mod-ClusterManagementProtocol Default: "8009"
# Type: See http://wiki.jboss.org/wiki/Mod-ClusterManagementProtocol Default: "ajp"
# flushpackets: Tell how to flush the packets. On: Send immediately, Auto wait for flushwait time before sending, Off don't flush. Default: "Off"
# flushwait: Time to wait before flushing. Value in milliseconds. Default: 10
# ping: Time to wait for a pong answer to a ping. 0 means we don't try to ping before sending. Value in secondes Default: 10
# smax: soft max inactive connection over that limit after ttl are closed. Default depends on the mpm configuration (See below for more information)
# ttl: max time in seconds to life for connection above smax. Default 60 seconds.
# Timeout: Max time httpd will wait for the backend connection. Default 0 no timeout value in seconds.

# Balancer: Name of the balancer. max size: 40 Default: "mycluster"
# StickySession: Yes: use JVMRoute to stick a request to a node, No: ignore JVMRoute. Default: "Yes"
# StickySessionCookie: Name of the cookie containing the sessionid. Max size: 30 Default: "JSESSIONID"
# StickySessionPath: Name of the parametre containing the sessionid. Max size: 30. Default: "jsessionid"
# StickySessionRemove: Yes: remove the sessionid (cookie or parameter) when the request can't be routed to the right node. No: send it anyway. Default: "No"
# StickySessionForce: Yes: Return an error if the request can't be routed according to JVMRoute, No: Route it to another node. Default: "Yes"
# WaitWorker: value in seconds: time to wait for an available worker. Default: "0" no wait.
# Maxattempts: value: number of attemps to send the request to the backend server. Default: "1".

sub config {
	my ( $self, $ref ) = @_;

	unless ( ref $ref eq 'HASH' ) {
		die 'passed reference must be a HASH reference';
	}

	foreach my $key ( keys %{ $self->DEFAULT_MCMP_CONFIG } ) {
		unless ( defined $ref->{$key} ) {
			$ref->{$key} = $self->DEFAULT_MCMP_CONFIG->{$key};
		}
	}

	unless ( $ref->{JvmRoute} ) {
		die 'JvmRoute is missing';
	}

	if ( length $ref->{JvmRoute} > 80 ) {
		die 'JvmRoute cannot exceed 80 characters';
	}

	if ( length $ref->{Balancer} > 40 ) {
		die 'Balancer cannot exceed 40 characters';
	}

	if ( $ref->{StickySession} !~ /^(yes|no)$/i ) {
		die 'invalid StickySession value, should be yes|no';
	}

	if ( length $ref->{StickySessionCookie} > 30 ) {
		die 'StickySessionCookie cannot exceed 30 characters';
	}

	if ( length $ref->{StickySessionPath} > 30 ) {
		die 'StickySessionCookie cannot exceed 30 characters';
	}

	if ( $ref->{StickySessionRemove} !~ /^(yes|no)$/i ) {
		die 'invalid StickySessionRemove value, should be yes|no';
	}

	if ( $ref->{StickySessionForce} !~ /^(yes|no)$/i ) {
		die 'invalid StickySessionForce value, should be yes|no';
	}

	if ( $ref->{WaitWorker} < 0 ) {
		die 'WaitWorker cannot be less than 0';
	}

	if ( $ref->{MaxAttempts} < 1 ) {
		die 'MaxAttempts cannot be less than 1';
	}

	if ( length $ref->{Domain} > 20 ) {
		die 'Domain cannot exceed 20 characters';
	}

	if ( length $ref->{Host} > 64 ) {
		die 'Host cannot exceed 64 characters';
	}

	if ( length $ref->{Port} < 0 || length $ref->{Port} > 65545 ) {
		die 'Port must be between 0 and 65545';
	}

	if ( $ref->{Type} !~ /^(https|http|ajp)$/i ) {
		die 'invalid Type value, should be https|http|ajp';
	}

	if ( $ref->{FlushPackets} !~ /^(on|off|auto)$/i ) {
		die 'invalid FlushPackets value, should be on|off|auto';
	}

	if ( $ref->{FlushWait} < 0 ) {
		die 'FlushWait cannot be less than 0';
	}

	if ( $ref->{Ping} < 0 ) {
		die 'Ping cannot be less than 0';
	}

	if ( $ref->{Ttl} < 0 ) {
		die 'Ttl cannot be less than 0';
	}

	if ( $ref->{Timeout} < 0 ) {
		die 'Timeout cannot be less than 0';
	}

	return $self->request( 'CONFIG', $self->uri, $ref );

}

use constant DEFAULT_MCMP_APP => {
	JvmRoute => undef,
	Context  => undef,
	Alias    => undef,
};

sub enable_app {
	shift->_app( 'ENABLE-APP', @_ );
}

sub disable_app {
	shift->_app( 'DISABLE-APP', @_ );
}

sub stop_app {
	shift->_app( 'STOP-APP', @_ );
}

sub remove_app {
	shift->_app( 'REMOVE-APP', @_ );
}

sub _app {
	my ( $self, $method, $ref ) = @_;

	unless ( ref $ref eq 'HASH' ) {
		die 'passed reference must be a HASH reference';
	}

	foreach my $key ( keys %{ $self->DEFAULT_MCMP_APP } ) {
		unless ( defined $ref->{$key} ) {
			$ref->{$key} = $self->DEFAULT_MCMP_APP->{$key};
		}
	}

	unless ( $ref->{JvmRoute} ) {
		die 'JvmRoute is missing';
	}

	unless ( $ref->{Context} ) {
		die 'Context is missing';
	}

	unless ( $ref->{Alias} ) {
		die 'Alias is missing';
	}

	return $self->request( $method, $self->uri, $ref );
}

sub enable_route {
	shift->_route( 'ENABLE-APP', @_ );
}

sub disable_route {
	shift->_route( 'DISABLE-APP', @_ );
}

sub stop_route {
	shift->_route( 'STOP-APP', @_ );
}

sub remove_route {
	shift->_route( 'REMOVE-APP', @_ );
}

sub _route {
	my ( $self, $method, $ref ) = @_;

	unless ( ref $ref eq 'HASH' ) {
		die 'passed reference must be a HASH reference';
	}

	unless ( $ref->{JvmRoute} ) {
		die 'JvmRoute is missing';
	}

	return $self->request( $method, $self->uri . '/*', $ref );
}

sub status {
	my ( $self, $ref ) = @_;

	unless ( ref $ref eq 'HASH' ) {
		die 'passed reference must be a HASH reference';
	}

	unless ( $ref->{JvmRoute} ) {
		die 'JvmRoute is missing';
	}

	unless ( $ref->{Load} ) {
		die 'Load is missing';
	}
	return $self->request( 'STATUS', $self->uri, $ref );
}

sub ping {
	my ( $self, $ref ) = @_;

	unless ( ref $ref eq 'HASH' ) {
		die 'passed reference must be a HASH reference';
	}

	unless ( $ref->{JvmRoute} ) {
		die 'JvmRoute is missing';
	}

	return $self->request( 'PING', $self->uri, $ref );
}

sub dump {
	my ($self) = @_;

	return $self->request( 'DUMP', $self->uri );
}

sub info {
	my ($self) = @_;

	return $self->request( 'INFO', $self->uri );
}

sub request {
	my ( $self, $method, $uri, $params ) = @_;

	unless ( exists $self->{_ua} ) {
		$self->{_ua} = LWP::UserAgent->new;
	}

	my $ua   = $self->{_ua};
	my $path = URI->new();
	if ( defined $params ) {
		foreach my $key ( qw/Context Alias/ ) {
			next unless defined $params->{$key};
			$params->{$key} =~ s/\s+//g;
		}

		$path->query_form($params);
	}

	if ( $self->debug ) {
		if ( $path->query ) {
			warn "Making a $method request to $uri with these params: "
			  . $path->query;
		}
		else {
			warn "Making a $method request to $uri";
		}

	}
	my $req = HTTP::Request->new( $method, $uri, undef, $path->query || undef );
	$req->header( 'Accept' => 'text/plain' );
	$req->header( 'Content-Type' => 'application/x-www-form-urlencoded' );
	my $response = $ua->request($req);

	if ( $response->is_success ) {
		if ( $response->content ) {

			if ( $self->debug ) {
				warn "RESPONSE: " . $response->content;
			}

			if ( $method eq 'DUMP' ) {

				# dump parser
				return $response->content;
			}
			elsif ( $method eq 'INFO' ) {

				# info parser
				return $response->content;
			}
			else {
				my $resp_uri        = URI->new( '?' . $response->content );
				my %parsed_response = $resp_uri->query_form;

				# fix return inconsistencies
				foreach my $key ( keys %parsed_response ) {
					if ( $key =~ /jvmroute/i ) {
						$parsed_response{JvmRoute} = $parsed_response{$key};
						delete $parsed_response{$key};
					}
				}

				return \%parsed_response;

			}
		}
		else {
			return 1;
		}
	}
	else {
		$self->error( $response->header('mess') );
		if ( $self->debug ) {
			if ( $path->query ) {
				warn "CURL for debugging: curl -X $method '$uri' -d '"
				  . $path->query . "'";
			}
			else {
				warn "CURL for debugging: curl -X $method '$uri'";
			}

		}
		return undef;
	}
}

sub has_error {
	return exists $_[0]->{_error};
}

sub error {
	my ( $self, $error ) = @_;
	if ($error) {
		if ( $self->debug ) {
			warn "FAILURE: $error";
		}
		$self->{_error} = $error;
	}
	else {
		return $self->{_error} || undef;
	}
}

1;

__END__