Fix code warning messages in newer Perl installs

This commit is contained in:
Manuel Cillero 2020-04-12 12:50:11 +02:00
parent 58ead7c11f
commit 27ed9214ef
7 changed files with 48 additions and 22 deletions

View file

@ -138,7 +138,7 @@ sub cgiapp_prerun {
my ($download_mode, $filename_extension) = split(',', cgiapp_param('dm'));
my $package = $run_mode;
my @packages = split('::', $run_mode);
if (scalar(@packages) > 1) {
if (scalar @packages > 1) {
$package = pop(@packages);
$package = pop(@packages) if is_eq($package, $CURRENT_PACKAGE{RUN});
}
@ -200,9 +200,19 @@ sub APP_confirm {
return __login($user, 2, _t('User not active!'), _t('Consult with your systems manager to activate your user')) if $user_data[5] eq 0;
# Check if user is in the Active Directory:
my $ad = Authen::Simple::ActiveDirectory->new(host => CONFIG('LDAP_DOMAIN'), principal => CONFIG('LDAP_DOMAIN'), timeout => 20);
if (!$ad->authenticate($user, $pass)) {
# Unidentified user. Or is it a local user:
my $ad = undef;
if (!is_empty(CONFIG('AD_DOMAIN'))) {
if (!is_empty(CONFIG('AD_SERVER'))) {
$ad = Authen::Simple::ActiveDirectory->new(host => CONFIG('AD_SERVER'), principal => CONFIG('AD_DOMAIN'), timeout => 5);
$ad = undef if !$ad->authenticate($user, $pass);
}
if (!defined($ad)) {
$ad = Authen::Simple::ActiveDirectory->new(host => CONFIG('AD_DOMAIN'), principal => CONFIG('AD_DOMAIN'), timeout => 10);
$ad = undef if !$ad->authenticate($user, $pass);
}
}
# Check if user is local:
if (!defined($ad)) {
my $passcrypt = __crypt_password($pass);
# Unidentified user. Request the login again:
return __login($user, 3) if !defined($user_data[1]) || $user_data[1] ne $passcrypt;

View file

@ -63,7 +63,7 @@ sub Action__html {
if (!is_empty($$arg_ref{DEFAULT})) {
my @default = split(' ', $$arg_ref{DEFAULT});
if (defined($list_columns{$default[0]}) && !defined($default[2])) {
my $dir = in_array(uc($default[1]), 'ASC', 'DESC') ? uc($default[1]) : 'ASC';
my $dir = defined($default[1]) && in_array(uc($default[1]), 'ASC', 'DESC') ? uc($default[1]) : 'ASC';
$default = strval($default[0], ' ', $dir);
}
}
@ -106,7 +106,7 @@ sub Action__js {
if (!is_empty($$arg_ref{DEFAULT})) {
my @default = split(' ', $$arg_ref{DEFAULT});
if (defined($list_columns{$default[0]}) && !defined($default[2])) {
my $dir = in_array(uc($default[1]), 'ASC', 'DESC') ? uc($default[1]) : 'ASC';
my $dir = defined($default[1]) && in_array(uc($default[1]), 'ASC', 'DESC') ? uc($default[1]) : 'ASC';
$default = strval($default[0], ' ', $dir);
}
}

View file

@ -75,7 +75,7 @@ sub Control__html {
__arguments($arg_ref);
my $multicheck_value = !is_report() && !is_empty($$arg_ref{DEFAULT}) ? $$arg_ref{DEFAULT} : strval_join(',', cgiapp_param($$arg_ref{ID}));
my $multicheck_value = !is_report() && !is_empty($$arg_ref{DEFAULT}) ? $$arg_ref{DEFAULT} : strval_join(',', cgiapp_multi($$arg_ref{ID}));
my $form_group = 'form-group';
@ -123,7 +123,7 @@ sub Get {
$id = $ID_DEFAULT if is_empty($id);
return strval_join(',', cgiapp_param($id));
return strval_join(',', cgiapp_multi($id));
}

View file

@ -62,6 +62,7 @@ our @EXPORT = qw(
User__has_access
cgiapp_param
cgiapp_multi
cgiapp_cookie
cgiapp_upload
cgiapp_uploadInfo
@ -360,7 +361,7 @@ sub Component__Get {
my $error = $@;
fatal($error, "\n", 'Form element "', $type, '" can not be loaded');
};
return (scalar(@value) == 1 ? $value[0] : @value) if @value;
return (scalar @value == 1 ? $value[0] : @value) if @value;
return undef;
}
@ -515,7 +516,21 @@ sub User__has_access {
sub cgiapp_param {
return RESERVED('CGIAPP')->query()->param(@_);
return scalar RESERVED('CGIAPP')->query()->param(@_);
}
sub cgiapp_multi {
my @multi = ();
eval {
@multi = RESERVED('CGIAPP')->query()->multi_param(@_);
1;
} or do {
@multi = RESERVED('CGIAPP')->query()->param(@_);
};
return @multi;
}
@ -974,8 +989,8 @@ sub __filter_messages {
my $REPORT_MESSAGES = strval('REPORT_', $arg{MESSAGES});
my $MESSAGES = RESERVED(strval('REF_', $REPORT_MESSAGES));
$arg{TMPL_FILTER}->param($REPORT_MESSAGES => strval(
!is_eq($arg{MESSAGES}, 'INFO') ? strval('<strong>', _t(strval($arg{MESSAGES}, scalar(@$MESSAGES) > 1 ? 'S!' : '!')), '</strong> ') : '',
scalar(@$MESSAGES) == 1 ? $$MESSAGES[0] : strval('<ul>', "\n", '<li>', strval_join(strval('</li>', "\n", '<li>'), @$MESSAGES), '</li>', '</ul>', "\n")
!is_eq($arg{MESSAGES}, 'INFO') ? strval('<strong>', _t(strval($arg{MESSAGES}, scalar @$MESSAGES > 1 ? 'S!' : '!')), '</strong> ') : '',
scalar @$MESSAGES == 1 ? $$MESSAGES[0] : strval('<ul>', "\n", '<li>', strval_join(strval('</li>', "\n", '<li>'), @$MESSAGES), '</li>', '</ul>', "\n")
)) if @$MESSAGES;
}
@ -1021,7 +1036,7 @@ sub __global_messages {
$row = trim($row);
push(@warnings, $row) if $row && !is_eq(substr($row, 0, 1), '#');
}
return '' if scalar(@warnings) == 0;
return '' if scalar @warnings == 0;
my $warnings = '';
my $title = is_eq($type, 'fatal') ? '<h4 class="blink">¡Atención!</h4>' : '<h4>Aviso</h4>';
foreach my $warn (@warnings) { $warnings .= "<li>$warn</li>"; }

View file

@ -511,7 +511,7 @@ sub COMPARE {
my ($field, $op, $value) = @_;
$field = trim($field);
$op = trim(one_space(uc($op)));
$op = uc(trim(one_space($op)));
return '' if is_empty($field) || is_empty($op);
$value = trim($value);
if (is_empty($value)) {
@ -528,7 +528,7 @@ sub COMPARE_STR {
my ($field, $op, $string) = @_;
$field = trim($field);
$op = trim(one_space(uc($op)));
$op = uc(trim(one_space($op)));
return '' if is_empty($field) || is_empty($op);
if (is_empty(trim($string))) {
return is_eq($op, 'IS NULL') || is_eq($op, 'IS NOT NULL') ? strval(' ', $field, ' ', $op) : '';
@ -612,7 +612,7 @@ sub IN_FIELD {
}
}
return $isnull if scalar(@infield) == 0;
return $isnull if scalar @infield == 0;
my $infield = strval($field, $isnot ? ' NOT IN ( ' : ' IN ( ', strval_join(', ', @infield), ' )');
return is_empty($isnull) ? $infield : strval("( $infield ", $isnot ? 'AND' : 'OR', " $isnull )");
}

View file

@ -263,7 +263,7 @@ sub strval_join {
my ($separator, @str) = @_;
return '' if !@str;
@str = @{$str[0]} if scalar(@str) == 1 && ref($str[0]) eq 'ARRAY';
@str = @{$str[0]} if scalar @str == 1 && ref($str[0]) eq 'ARRAY';
$separator = '' if is_empty($separator);
return join($separator, grep { !is_empty($_) } @str);
}
@ -373,7 +373,7 @@ sub in_array {
my ($element, @array) = @_;
return FALSE if !defined($element) || !@array;
@array = @{$array[0]} if scalar(@array) == 1 && ref($array[0]) eq 'ARRAY';
@array = @{$array[0]} if scalar @array == 1 && ref($array[0]) eq 'ARRAY';
my %hash_array = map { $_ => 1 } @array;
return defined($hash_array{$element}) ? TRUE : FALSE;
@ -399,7 +399,7 @@ sub index_in_array {
my ($element, @array) = @_;
return -1 if !defined($element) || !@array;
@array = @{$array[0]} if scalar(@array) == 1 && ref($array[0]) eq 'ARRAY';
@array = @{$array[0]} if scalar @array == 1 && ref($array[0]) eq 'ARRAY';
my $index = 0;
foreach my $current (@array) {
@ -428,7 +428,7 @@ sub occurrences_in_array {
my ($element, @array) = @_;
return -1 if !defined($element) || !@array;
@array = @{$array[0]} if scalar(@array) == 1 && ref($array[0]) eq 'ARRAY';
@array = @{$array[0]} if scalar @array == 1 && ref($array[0]) eq 'ARRAY';
return grep { $_ eq $element } @array;
}

View file

@ -85,9 +85,10 @@ my %CONFIG_VARS = (
DB_USER => 'user',
DB_PASSWORD => 'password',
# LDAP DOMAIN/SERVER:
# ACTIVE DIRECTORY CONFIGURATION:
LDAP_DOMAIN => '',
AD_DOMAIN => '',
AD_SERVER => '',
# MESSAGES TRANSLATION: