Fix some warnings

This commit is contained in:
Xavier Guimard 2018-11-29 21:13:09 +01:00
parent f6f1072ef6
commit 74fb013e73
3 changed files with 14 additions and 19 deletions

View File

@ -29,7 +29,7 @@ sub types {
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -671,7 +671,7 @@ sub attributes {
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -1047,7 +1047,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'test' => sub {
my ( $val, $conf ) = @_;
my $s = $val;
eval $s;
'Safe'->new->reval("no warnings;$s");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -1131,7 +1131,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'keyTest' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -1149,7 +1149,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -1503,7 +1503,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
: ( 0, '__badUrl__' );
}
$s =~ s/\b(accept|deny|unprotect|skip)\b/1/g;
eval $s;
'Safe'->new->reval("no warnings;$s");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -1544,7 +1544,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -1904,7 +1904,7 @@ qr/^(?:\*\.)?(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -2251,7 +2251,7 @@ qr/(?:(?:https?):\/\/(?:(?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.]
'keyTest' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }
@ -2987,7 +2987,7 @@ qr/(?:(?:https?):\/\/(?:(?:(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.]
'test' => sub {
my ( $val, $conf ) = @_;
my $s = '';
eval "$s $val";
'Safe'->new->reval("no warning; $s $val");
my $err = join(
'',
grep( { $_ =~ /Undefined subroutine/ ? () : $_; }

View File

@ -13,8 +13,7 @@ use Regexp::Common qw/URI/;
my $perlExpr = sub {
my ( $val, $conf ) = @_;
my $s = '';
no warnings( 'redefine', 'uninitialized' );
eval "$s $val";
Safe->new->reval("no warning; $s $val");
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ } split( /\n/, $@ ) );
return $err ? ( 1, "__badExpression__: $err" ) : (1);
@ -1498,8 +1497,7 @@ sub attributes {
: ( 0, '__badUrl__' );
}
$s =~ s/\b(accept|deny|unprotect|skip)\b/1/g;
no warnings( 'redefine', 'uninitialized' );
eval $s;
Safe->new->reval("no warnings;$s");
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ }
split( /\n/, $@ ) );
@ -1524,8 +1522,7 @@ sub attributes {
test => sub {
my ( $val, $conf ) = @_;
my $s = $val;
no warnings( 'redefine', 'uninitialized' );
eval $s;
Safe->new->reval("no warnings;$s");
my $err = join( '',
grep { $_ =~ /Undefined subroutine/ ? () : $_ }
split( /\n/, $@ ) );

View File

@ -14,7 +14,6 @@ SKIP: {
if ($@) {
skip 'DBD::SQLite not found', $maintests;
}
require 't/test-ldap.pm';
my $dbh = DBI->connect("dbi:SQLite:dbname=t/userdb.db");
$dbh->do('CREATE TABLE users (user text,password text,name text)');
$dbh->do("INSERT INTO users VALUES ('dwho','dwho','Doctor who')");
@ -36,7 +35,7 @@ SKIP: {
'Demo;Demo;Null;https://test.example.com;$env->{ipAddr} =~ /127.0.0.1/',
'4_demo' =>
'Demo;Demo;Null;https://test.example.com;$env->{ipAddr} =~ /1.2.3.4/',
'5_ssl' => 'SSL;LDAP;LDAP',
'5_ssl' => 'SSL;Demo;Demo',
'6_FakeCustom' => 'Custom;Demo;Demo',
},
@ -96,6 +95,5 @@ SKIP: {
}
count($maintests);
eval { unlink 't/userdb.db' };
stopLdapServer() if $ENV{LLNGTESTLDAP};
clean_sessions();
done_testing( count() );