diff --git a/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Attributes.pm b/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Attributes.pm index 132573c84..3ae8c6016 100644 --- a/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Attributes.pm +++ b/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Attributes.pm @@ -30,7 +30,12 @@ sub types { "\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55"; } eval "$s $val"; - return $@ ? ( 1, "__badExpression__: $@" ) : 1; + my $err = join( + '', + grep( { $_ =~ /Undefined subroutine/ ? () : $_; } + split( /\n/, $@, 0 ) ) + ); + return $err ? ( 1, "__badExpression__: $err" ) : 1; } }, 'catAndAppList' => { @@ -867,7 +872,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0- "\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55"; } eval $s; - return $@ ? ( 1, "__badExpression__: $@" ) : 1; + my $err = join( + '', + grep( { $_ =~ /Undefined subroutine/ ? () : $_; } + split( /\n/, $@, 0 ) ) + ); + return $err ? ( 1, "__badExpression__: $err" ) : 1; } }, 'type' => 'keyTextContainer' @@ -931,7 +941,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0- "\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55"; } eval "$s $val"; - return $@ ? ( 1, "__badExpression__: $@" ) : 1; + my $err = join( + '', + grep( { $_ =~ /Undefined subroutine/ ? () : $_; } + split( /\n/, $@, 0 ) ) + ); + return $err ? ( 1, "__badExpression__: $err" ) : 1; }, 'test' => sub { 1; @@ -949,7 +964,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0- "\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55"; } eval "$s $val"; - return $@ ? ( 1, "__badExpression__: $@" ) : 1; + my $err = join( + '', + grep( { $_ =~ /Undefined subroutine/ ? () : $_; } + split( /\n/, $@, 0 ) ) + ); + return $err ? ( 1, "__badExpression__: $err" ) : 1; }, 'type' => 'keyTextContainer' }, @@ -1256,7 +1276,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0- "\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55"; } eval $s; - return $@ ? ( 1, "__badExpression__: $@" ) : 1; + my $err = join( + '', + grep( { $_ =~ /Undefined subroutine/ ? () : $_; } + split( /\n/, $@, 0 ) ) + ); + return $err ? ( 1, "__badExpression__: $err" ) : 1; } }, 'type' => 'ruleContainer' @@ -1285,7 +1310,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0- "\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55"; } eval "$s $val"; - return $@ ? ( 1, "__badExpression__: $@" ) : 1; + my $err = join( + '', + grep( { $_ =~ /Undefined subroutine/ ? () : $_; } + split( /\n/, $@, 0 ) ) + ); + return $err ? ( 1, "__badExpression__: $err" ) : 1; }, 'type' => 'keyTextContainer' }, @@ -1904,7 +1934,12 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0- "\x54\x55\x55\x55\x15\x55\x55\x55\x55\x55\x51\x55\x55\x55\x55\x55\x55"; } eval "$s $val"; - return $@ ? ( 1, "__badExpression__: $@" ) : 1; + my $err = join( + '', + grep( { $_ =~ /Undefined subroutine/ ? () : $_; } + split( /\n/, $@, 0 ) ) + ); + return $err ? ( 1, "__badExpression__: $err" ) : 1; }, 'msgFail' => '__badValue__', 'test' => qr/^\w+$/, diff --git a/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build/Attributes.pm b/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build/Attributes.pm index fe0d55cc2..80b815caf 100644 --- a/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build/Attributes.pm +++ b/lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build/Attributes.pm @@ -12,10 +12,12 @@ use Regexp::Common qw/URI/; my $perlExpr = sub { my ( $val, $conf ) = @_; - my $s = ''; + my $s = ''; no warnings( 'redefine', 'uninitialized' ); eval "$s $val"; - return $@ ? ( 1, "__badExpression__: $@" ) : (1); + my $err = join( '', + grep { $_ =~ /Undefined subroutine/ ? () : $_ } split( /\n/, $@ ) ); + return $err ? ( 1, "__badExpression__: $err" ) : (1); }; my $url = $RE{URI}{HTTP}{ -scheme => "https?" }; @@ -1043,7 +1045,10 @@ sub attributes { $s =~ s/\b(accept|deny|unprotect|skip)\b/1/g; no warnings( 'redefine', 'uninitialized' ); eval $s; - return $@ ? ( 1, "__badExpression__: $@" ) : (1); + my $err = join( '', + grep { $_ =~ /Undefined subroutine/ ? () : $_ } + split( /\n/, $@ ) ); + return $err ? ( 1, "__badExpression__: $err" ) : (1); }, msgFail => '__badExpression__', }, @@ -1067,7 +1072,10 @@ sub attributes { my $s = $val; no warnings( 'redefine', 'uninitialized' ); eval $s; - return $@ ? ( 1, "__badExpression__: $@" ) : (1); + my $err = join( '', + grep { $_ =~ /Undefined subroutine/ ? () : $_ } + split( /\n/, $@ ) ); + return $err ? ( 1, "__badExpression__: $err" ) : (1); } }, documentation => 'Virtualhost headers',