Hide undefined sub from tests (#1160)

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+$/,

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',