manuelcillero/perl-dam
manuelcillero/perl-dam
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix code warning messages in newer Perl installs

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

18
Dam/Application.pm
View file

@ -138,7 +138,7 @@ sub cgiapp_prerun {
my ($download_mode, $filename_extension) = split(',', cgiapp_param('dm')); my ($download_mode, $filename_extension) = split(',', cgiapp_param('dm'));
my $package = $run_mode; my $package = $run_mode;
my @packages = split('::', $run_mode); my @packages = split('::', $run_mode);
if (scalar(@packages) > 1) { if (scalar @packages > 1) {
$package = pop(@packages); $package = pop(@packages);
$package = pop(@packages) if is_eq($package, $CURRENT_PACKAGE{RUN}); $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; 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: # Check if user is in the Active Directory:
my $ad = Authen::Simple::ActiveDirectory->new(host => CONFIG('LDAP_DOMAIN'), principal => CONFIG('LDAP_DOMAIN'), timeout => 20); my $ad = undef;
if (!$ad->authenticate($user, $pass)) { if (!is_empty(CONFIG('AD_DOMAIN'))) {
# Unidentified user. Or is it a local user: 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); my $passcrypt = __crypt_password($pass);
# Unidentified user. Request the login again: # Unidentified user. Request the login again:
return __login($user, 3) if !defined($user_data[1]) || $user_data[1] ne $passcrypt; return __login($user, 3) if !defined($user_data[1]) || $user_data[1] ne $passcrypt;

4
Dam/Components/Actions/Sort.pm
View file

@ -63,7 +63,7 @@ sub Action__html {
if (!is_empty($$arg_ref{DEFAULT})) { if (!is_empty($$arg_ref{DEFAULT})) {
my @default = split(' ', $$arg_ref{DEFAULT}); my @default = split(' ', $$arg_ref{DEFAULT});
if (defined($list_columns{$default[0]}) && !defined($default[2])) { 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); $default = strval($default[0], ' ', $dir);
} }
} }
@ -106,7 +106,7 @@ sub Action__js {
if (!is_empty($$arg_ref{DEFAULT})) { if (!is_empty($$arg_ref{DEFAULT})) {
my @default = split(' ', $$arg_ref{DEFAULT}); my @default = split(' ', $$arg_ref{DEFAULT});
if (defined($list_columns{$default[0]}) && !defined($default[2])) { 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); $default = strval($default[0], ' ', $dir);
} }
} }

4
Dam/Components/Controls/MultiCheck.pm
View file

@ -75,7 +75,7 @@ sub Control__html {
__arguments($arg_ref); __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'; my $form_group = 'form-group';
@ -123,7 +123,7 @@ sub Get {
$id = $ID_DEFAULT if is_empty($id); $id = $ID_DEFAULT if is_empty($id);
return strval_join(',', cgiapp_param($id)); return strval_join(',', cgiapp_multi($id));
} }

25
Dam/DamLogic.pm
View file

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

6
Dam/Database.pm
View file

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

8
Dam/Util.pm
View file

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

5
Dam/Var.pm
View file

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