Commit a2cb14e0 authored by Xavier Guimard's avatar Xavier Guimard

Split handlers with AutoLoader (49% reduction for Simple.pm)

Closes: #188
parent 7f25fedd
/usr/share/perl5/auto/Lemonldap/NG/Handler*
/usr/share/perl5/Lemonldap/NG/Handler*
/usr/share/man/man3/Lemonldap::NG::Handler*
/var/lib/lemonldap-ng/test
......
......@@ -5,9 +5,11 @@
# This class adds virtual host support for Lemonldap::NG handlers.
package Lemonldap::NG::Handler::Vhost;
use strict;
use AutoLoader 'AUTOLOAD';
use Lemonldap::NG::Handler::Simple qw(:locationRules :headers :post :apache)
; #inherits
use strict;
use MIME::Base64;
use constant SAFEWRAP => ( Safe->can("wrap_code_ref") ? 1 : 0 );
......@@ -165,110 +167,6 @@ sub grant {
return &{ $defaultCondition->{$vhost} }($datas);
}
## @imethod protected void postUrlInit()
# Prepare methods to post form attributes
sub postUrlInit {
my ( $class, $args ) = splice @_;
# Do nothing if no POST configured
return unless ( $args->{post} );
# Load required modules
eval 'use Apache2::Filter;use URI';
# Prepare transform sub
$transform = {};
# Browse all vhost
foreach my $vhost ( keys %{ $args->{post} } ) {
# Browse all POST URI
while ( my ( $url, $d ) = each( %{ $args->{post}->{$vhost} } ) ) {
# Where to POST
$d->{postUrl} ||= $url;
# Register POST form for POST URL
$transform->{$vhost}->{ $d->{postUrl} } =
sub { $class->buildPostForm( $d->{postUrl} ) }
if ( $url ne $d->{postUrl} );
# Get datas to POST
my $expr = $d->{expr};
my %postdata;
# Manage old and new configuration format
# OLD: expr => 'param1 => value1, param2 => value2',
# NEW : expr => { param1 => value1, param2 => value2 },
if ( ref $expr eq 'HASH' ) {
%postdata = %$expr;
}
else {
%postdata = split /(?:\s*=>\s*|\s*,\s*)/, $expr;
}
# Build string for URI::query_form
my $tmp;
foreach ( keys %postdata ) {
$postdata{$_} =~ s/\$(\w+)/\$datas->{$1}/g;
$postdata{$_} = "'$postdata{$_}'"
if ( $postdata{$_} =~ /^\w+$/ );
$tmp .= "'$_'=>$postdata{$_},";
}
# Build subroutine
my $sub = "sub{
my \$f = shift;
my \$l;
unless(\$f->ctx){
\$f->ctx(1);
my \$u=URI->new('http:');
\$u->query_form({$tmp});
my \$s=\$u->query();
\$l = \$f->r->headers_in->{'Content-Length'};
\$f->r->headers_in->set( 'Content-Length' => length(\$s) );
\$f->r->headers_in->set( 'Content-Type' => 'application/x-www-form-urlencoded' );
\$f->print(\$s);
while ( \$f->read( my \$b, \$l ) ) {}
\$f->seen_eos(1);
}
return OK;
}"
;
$sub = (
SAFEWRAP
? $class->safe->wrap_code_ref( $class->safe->reval($sub) )
: $class->safe->reval($sub)
);
$class->lmLog( "Compiling POST request for $url (vhost $vhost)",
'debug' );
$transform->{$vhost}->{$url} = sub {
return $class->buildPostForm($url)
if ( $apacheRequest->method ne 'POST' );
$apacheRequest->add_input_filter($sub);
OK;
}
}
}
}
## @rmethod protected transformUri(string uri)
# Transform URI to replay POST forms
# @param uri URI to catch
# @return Apache2::Const
sub transformUri {
my ( $class, $uri ) = splice @_;
my $vhost = $apacheRequest->hostname;
if ( defined( $transform->{$vhost}->{$uri} ) ) {
return &{ $transform->{$vhost}->{$uri} };
}
OK;
}
## @cmethod private string _buildUrl(string s)
# Transform /<s> into http(s?)://<host>:<port>/s
# @param $s path
......@@ -373,3 +271,108 @@ it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.
=cut
## @imethod protected void postUrlInit()
# Prepare methods to post form attributes
sub postUrlInit {
my ( $class, $args ) = splice @_;
# Do nothing if no POST configured
return unless ( $args->{post} );
# Load required modules
eval 'use Apache2::Filter;use URI';
# Prepare transform sub
$transform = {};
# Browse all vhost
foreach my $vhost ( keys %{ $args->{post} } ) {
# Browse all POST URI
while ( my ( $url, $d ) = each( %{ $args->{post}->{$vhost} } ) ) {
# Where to POST
$d->{postUrl} ||= $url;
# Register POST form for POST URL
$transform->{$vhost}->{ $d->{postUrl} } =
sub { $class->buildPostForm( $d->{postUrl} ) }
if ( $url ne $d->{postUrl} );
# Get datas to POST
my $expr = $d->{expr};
my %postdata;
# Manage old and new configuration format
# OLD: expr => 'param1 => value1, param2 => value2',
# NEW : expr => { param1 => value1, param2 => value2 },
if ( ref $expr eq 'HASH' ) {
%postdata = %$expr;
}
else {
%postdata = split /(?:\s*=>\s*|\s*,\s*)/, $expr;
}
# Build string for URI::query_form
my $tmp;
foreach ( keys %postdata ) {
$postdata{$_} =~ s/\$(\w+)/\$datas->{$1}/g;
$postdata{$_} = "'$postdata{$_}'"
if ( $postdata{$_} =~ /^\w+$/ );
$tmp .= "'$_'=>$postdata{$_},";
}
# Build subroutine
my $sub = "sub{
my \$f = shift;
my \$l;
unless(\$f->ctx){
\$f->ctx(1);
my \$u=URI->new('http:');
\$u->query_form({$tmp});
my \$s=\$u->query();
\$l = \$f->r->headers_in->{'Content-Length'};
\$f->r->headers_in->set( 'Content-Length' => length(\$s) );
\$f->r->headers_in->set( 'Content-Type' => 'application/x-www-form-urlencoded' );
\$f->print(\$s);
while ( \$f->read( my \$b, \$l ) ) {}
\$f->seen_eos(1);
}
return OK;
}"
;
$sub = (
SAFEWRAP
? $class->safe->wrap_code_ref( $class->safe->reval($sub) )
: $class->safe->reval($sub)
);
$class->lmLog( "Compiling POST request for $url (vhost $vhost)",
'debug' );
$transform->{$vhost}->{$url} = sub {
return $class->buildPostForm($url)
if ( $apacheRequest->method ne 'POST' );
$apacheRequest->add_input_filter($sub);
OK;
}
}
}
}
## @rmethod protected transformUri(string uri)
# Transform URI to replay POST forms
# @param uri URI to catch
# @return Apache2::Const
sub transformUri {
my ( $class, $uri ) = splice @_;
my $vhost = $apacheRequest->hostname;
if ( defined( $transform->{$vhost}->{$uri} ) ) {
return &{ $transform->{$vhost}->{$uri} };
}
OK;
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment