dani/lemonldap-ng
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Allow to use HASHREF in expr parameter of POST feature (#174)

Browse Source
This commit is contained in:
Clément Oudot 2010-09-29 11:07:42 +00:00
parent a406d79d2f
commit 595c2ad96e
1 changed files with 33 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
modules/lemonldap-ng-handler/lib/Lemonldap/NG/Handler/Simple.pm
View File

@ -731,23 +731,50 @@ sub initLocalStorage {
# Prepare methods to post form attributes # Prepare methods to post form attributes
sub postUrlInit { sub postUrlInit {
my ( $class, $args ) = splice @_; my ( $class, $args ) = splice @_;
# Do nothing if no POST configured
return unless ( $args->{post} ); return unless ( $args->{post} );
# Load required modules
eval 'use Apache2::Filter;use URI'; eval 'use Apache2::Filter;use URI';
# Prepare transform sub
$transform = {}; $transform = {};
# Browse all POST URI
while ( my ( $url, $d ) = each( %{ $args->{post} } ) ) { while ( my ( $url, $d ) = each( %{ $args->{post} } ) ) {
# Where to POST
$d->{postUrl} ||= $url; $d->{postUrl} ||= $url;
# Register POST form for POST URL
$transform->{ $d->{postUrl} } = $transform->{ $d->{postUrl} } =
sub { $class->buildPostForm( $d->{postUrl} ) } sub { $class->buildPostForm( $d->{postUrl} ) }
if ( $url ne $d->{postUrl} ); if ( $url ne $d->{postUrl} );
# Get datas to POST
my $expr = $d->{expr}; my $expr = $d->{expr};
$expr =~ s/\$(\w+)/\$datas->{$1}/g; my %postdata;
my %h = split /(?:\s*=>\s*|\s*,\s*)/, $expr;
my $tmp; # Manage old and new configuration format
foreach ( keys %h ) { # OLD: expr => 'param1 => value1, param2 => value2',
$h{$_} = "'$h{$_}'" if ( $h{$_} =~ /^\w+$/ ); # NEW : expr => { param1 => value1, param2 => value2 },
$tmp .= "'$_'=>$h{$_},"; 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 $sub = "sub{
my \$f = shift; my \$f = shift;
my \$l; my \$l;