root/lang/perl/Apache2-BalanceLogic/trunk/lib/Apache2/BalanceLogic.pm @ 17772

package Apache2::BalanceLogic;

use strict;
use warnings;
use Apache2::RequestRec ();
use Apache2::RequestIO  ();
use Apache2::Connection ();
use APR::Table          ();
use Apache2::Const -compile => qw( OK DECLINED );
use YAML qw 'LoadFile';
use CGI::Cookie;
use Net::CIDR::Lite;
use UNIVERSAL::require;

our $VERSION = '0.0.1';

our $conf;
our $plugin;

sub handler {

    my $r = shift;

    # load main config file.
    $conf ||= LoadFile( $r->dir_config('CONFIG_PATH') ) or die;

    # load plugin config file and generate plugin object.
    $plugin ||= do {
        my $p_conf = LoadFile( $conf->{Plugin}->{Config} ) or die;
        my $class = __PACKAGE__ . '::Plugin::' . $conf->{Plugin}->{Name};
        $class->use or die $@;
        $class->new($p_conf);
    };

    # run!
    my $route_id = $plugin->run($r);
    return Apache2::Const::DECLINED unless $route_id;

    # you can forward a request for a server apointed in '__force__' query string.
    my $args = $r->args;
    if ( $args =~ /__force__=(\d+)$/ ) {
        my $force    = $1;
        my $ip       = $r->connection->remote_ip;
        my $cidr     = Net::CIDR::Lite->new;
        my $admin_ip = $conf->{ADMIN_IP} or die($!);
        for (@$admin_ip) {
            $cidr->add_any($_);
        }
        $route_id = $force if $cidr->find($ip);
    }

    # a inner cookie trick for "stickysession" in mod_proxy_balancer.
    my $cookie_str = $r->headers_in->get('Cookie');
    $cookie_str =~ s/route_id=\d+\;?//;
    $cookie_str = 'route_id=x.' . $route_id . '; ' . $cookie_str . ';';
    $r->headers_in->set( 'Cookie' => $cookie_str );

    # return OK
    return Apache2::Const::OK;
}

1;

__END__

=head1 NAME

Apache2::BalanceLogic - Perl extension for mod_proxy_balancer

=head1 SYNOPSIS

in httpd.conf

  PerlRequire /foo/bar/perl/startup.pl
  PerlHeaderParserHandler +Apache2::BalanceLogic
  perlSetVar CONFIG_PATH '/foo/bar/perl/Apache2/BalanceLogic/Config/MainConfig.yaml'

and write for mod_proxy_balancer

  ProxyPass / balancer://TEST/ stickysession=route_id
  <Proxy balancer://TEST/>
    BalancerMember http://your.backend.server_01/ route=1
    BalancerMember http://your.backend.server_02/ route=2
    BalancerMember http://your.backend.server_03/ route=3
    BalancerMember http://your.backend.server_04/ route=4
    BalancerMember http://your.backend.server_05/ route=5
  </Proxy>

Applcation Config file ( MainConfig.yaml )

  #--- select one Plugin module and config file
  Plugin:
    Name: 'DistByURL' 
    Config: '/foo/bar/perl/Apache2/BalanceLogic/Config/PluginConfig/DistByURL.yaml'
    #---
    #Name: 'DistByTime' 
    #Config: '/foo/bar/perl/Apache2/BalanceLogic/Config/PluginConfig/DistByTime.yaml'
    #---
    #Name: 'DistByCookie' 
    #Config: '/foo/bar/perl/Apache2/BalanceLogic/Config/PluginConfig/DistByCookie.yaml'
  #--- your server admin ipaddress. it can use __force__ option.
  ADMIN_IP:
    - 192.168.1.0/24


=head1 DESCRIPTION

This is a simple extention for 'mod_proxy_balancer'.
You can put your original Plungin code that distribute the requests among the backend servers by your original algorithm.
In other words, this is a  "inner cookie trick" for stickysession in mod_proxy_balancer.
Let's enjoy!

=head1 Plugin 

There are 3 sample Plugin modules. ( in Plugin directory )

  L<Apache2::BalanceLogic::Plugin::DistByCookie>
    distribute the requests by unique user cookie that maybe generated by usertrac module.
    this is implemented by a simple slurp division code.
  L<Apache2::BalanceLogic::Plugin::DistByTime>
    distribute the requests by time number ( hour ). see config file.
  L<Apache2::BalanceLogic::Plugin::DistByURL>
    by reqular expression on URL path string.


=head1 SEE ALSO

L<mod_perl>


=head1 AUTHOR

Takeshi Miki <miki@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 Takeshi Miki 

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut