Commit 9facd2a8 authored by sikeda's avatar sikeda
Browse files

[dev] Suppress most of runtime warnings.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@10739 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent 37b236f5
......@@ -146,8 +146,8 @@ sub authentication {
next if ($auth_service->{'auth_type'} eq 'authentication_info_url');
next if ($email !~ /$auth_service->{'regexp'}/i);
next
if (($email =~ /$auth_service->{'negative_regexp'}/i)
&& ($auth_service->{'negative_regexp'}));
if $auth_service->{'negative_regexp'}
and $email =~ /$auth_service->{'negative_regexp'}/i;
## Only 'user_table' and 'ldap' backends will need that Sympa collects
## the user passwords
......
......@@ -556,7 +556,9 @@ sub store {
my $message_already_on_spool;
if ($messagekey eq $message_fingerprint) {
if ( defined $message_fingerprint
and defined $messagekey
and $messagekey eq $message_fingerprint) {
$message_already_on_spool = 1;
} else {
......
......@@ -1173,7 +1173,7 @@ sub info {
if ($action =~ /do_it/i) {
my $data;
foreach my $key (%{$list->{'admin'}}) {
foreach my $key (keys %{$list->{'admin'}}) {
$data->{$key} = $list->{'admin'}{$key};
}
......@@ -3511,7 +3511,7 @@ sub get_auth_method {
my $that;
my $auth_method;
if ($sign_mod eq 'smime') {
if ($sign_mod and $sign_mod eq 'smime') {
$auth_method = 'smime';
} elsif ($auth ne '') {
......@@ -3542,7 +3542,7 @@ sub get_auth_method {
}
} else {
$auth_method = 'smtp';
$auth_method = 'dkim' if ($sign_mod eq 'dkim');
$auth_method = 'dkim' if $sign_mod and $sign_mod eq 'dkim';
}
return $auth_method;
......
......@@ -2321,7 +2321,11 @@ sub _set_listmasters_entry {
sub _check_double_url_usage {
my $param = shift;
my ($host, $path);
if ($param->{'config_hash'}{'http_host'} =~ /^([^\/]+)(\/.*)$/) {
if (tools::smart_eq(
$param->{'config_hash'}{'http_host'},
qr/^([^\/]+)(\/.*)$/
)
) {
($host, $path) = ($1, $2);
} else {
($host, $path) = ($param->{'config_hash'}{'http_host'}, '/');
......
......@@ -1606,8 +1606,9 @@ sub get_constraints {
## load param_constraint.conf
my $time_file = (stat("$self->{'dir'}/param_constraint.conf"))[9];
unless ((defined $self->{'param_constraint_conf'})
&& ($self->{'mtime'}{'param_constraint_conf'} >= $time_file)) {
$time_file ||= 0;
unless (defined($self->{'param_constraint_conf'})
and $self->{'mtime'}{'param_constraint_conf'} >= $time_file) {
$self->{'param_constraint_conf'} =
$self->_load_param_constraint_conf();
unless (defined $self->{'param_constraint_conf'}) {
......
......@@ -1072,7 +1072,7 @@ sub load {
$lock_fh->close();
} elsif ($self->{'name'} ne $name
|| $time_config > $self->{'mtime'}->[0]
|| $time_config > ($self->{'mtime'}->[0] || 0)
|| $options->{'reload_config'}) {
$admin =
_load_list_config_file($self->{'dir'}, $self->{'domain'},
......@@ -1181,7 +1181,7 @@ sub load {
}
## We have updated %users, Total may have changed
if ($m2 > $self->{'mtime'}[1]) {
if ($m2 > ($self->{'mtime'}[1] || 0)) {
$self->savestats();
}
......@@ -1854,8 +1854,9 @@ sub distribute_msg {
## Add Custom Subject
if ($self->{'admin'}{'custom_subject'}) {
my $subject_field = $message->{'decoded_subject'};
$subject_field =~
s/^\s*(.*)\s*$/$1/; ## Remove leading and trailing blanks
$subject_field = '' unless defined $subject_field;
## Remove leading and trailing blanks
$subject_field =~ s/^\s*(.*)\s*$/$1/;
## Search previous subject tagging in Subject
my $custom_subject = $self->{'admin'}{'custom_subject'};
......@@ -2054,8 +2055,9 @@ sub distribute_msg {
## store msg in digest if list accept digest mode (encrypted message can't
## be included in digest)
if ( ($self->is_digest())
and ($message->{'smime_crypted'} ne 'smime_crypted')) {
if ($self->is_digest()
and not tools::smart_eq($message->{'smime_crypted'}, 'smime_crypted'))
{
$self->store_digest($message);
}
......@@ -2565,7 +2567,7 @@ sub send_file {
# . a list should have several certificates and use if possible a
# certificate
# issued by the same CA as the recipient CA if it exists
if ($sign_mode eq 'smime') {
if ($sign_mode and $sign_mode eq 'smime') {
$data->{'fromlist'} = $self->get_list_address();
$data->{'replyto'} = $self->get_list_address('owner');
} else {
......@@ -2711,7 +2713,9 @@ sub send_msg {
## test to know if the rcpt suspended her subscription for this
## list
## if yes, don't send the message
if (defined $user_data && $user_data->{'suspend'} eq '1') {
if ( $user_data
and defined $user_data->{'suspend'}
and $user_data->{'suspend'} + 0) {
if (($user_data->{'startdate'} <= time)
&& ( (time <= $user_data->{'enddate'})
|| (!$user_data->{'enddate'}))
......@@ -4738,7 +4742,7 @@ sub get_total {
my $option = shift;
Log::do_log('debug3', 'List::get_total(%s)', $name);
if ($option eq 'nocache') {
if ($option and $option eq 'nocache') {
$self->{'total'} = $self->_load_total_db($option);
}
......@@ -5507,10 +5511,10 @@ sub get_first_list_member {
"SELECT user_subscriber AS email, comment_subscriber AS gecos, reception_subscriber AS reception, topics_subscriber AS topics, visibility_subscriber AS visibility, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address, %s AS date, %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute, suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s %s)",
SDM::get_canonical_read_date('date_subscriber'),
SDM::get_canonical_read_date('update_subscriber'),
$additional,
($additional || ''),
SDM::quote($name),
SDM::quote($self->{'domain'}),
$selection;
($selection || '');
## SORT BY
if ($sortby eq 'domain') {
......@@ -5527,7 +5531,7 @@ sub get_first_list_member {
'substring_length' => '50',
}
),
$additional,
($additional || ''),
SDM::quote($name),
SDM::quote($self->{'domain'});
......@@ -5682,7 +5686,7 @@ sub get_first_list_admin {
SDM::get_canonical_read_date('update_admin'),
SDM::quote($name),
SDM::quote($self->{'domain'}),
$selection,
($selection || ''),
SDM::quote($role);
## SORT BY
......@@ -6083,8 +6087,11 @@ sub update_list_member {
}
}
Log::do_log('debug2',
" custom_attribute id: $Conf::Conf{'custom_attribute'}");
Log::do_log(
'debug2',
' custom_attribute id: %s',
$Conf::Conf{'custom_attribute'}
);
## custom attributes
if (defined $Conf::Conf{'custom_attribute'}) {
foreach my $f (sort keys %{$Conf::Conf{'custom_attribute'}}) {
......@@ -6721,9 +6728,9 @@ sub is_listmaster {
my $who = shift;
my $robot = shift;
$who =~ y/A-Z/a-z/;
return unless $who;
return 0 unless ($who);
$who =~ y/A-Z/a-z/;
foreach my $listmaster (@{Conf::get_robot_conf($robot, 'listmasters')}) {
return 1 if (lc($listmaster) eq lc($who));
......@@ -6774,7 +6781,7 @@ sub am_i {
## Check cache first
if ($list_cache{'am_i'}{$function}{$self->{'domain'}}{$self->{'name'}}
{$who} == 1) {
{$who}) {
return 1;
}
......@@ -7099,8 +7106,10 @@ sub archive_msg {
if ($self->is_archived()) {
my $msg = $message->{'msg'};
if ( ($message->{'smime_crypted'} eq 'smime_crypted')
&& ($self->{admin}{archive_crypted_msg} eq 'original')) {
if ( tools::smart_eq($message->{'smime_crypted'}, 'smime_crypted')
and
tools::smart_eq($self->{admin}{archive_crypted_msg}, 'original'))
{
$msg = $message->{'orig_msg'};
}
......@@ -7110,10 +7119,16 @@ sub archive_msg {
## listname
## ignoring message with a no-archive flag
if ( ref($msg)
&& ($Conf::Conf{'ignore_x_no_archive_header_feature'} ne 'on')
&& ( ($msg->head->get('X-no-archive') =~ /yes/i)
|| ($msg->head->get('Restrict') =~ /no\-external\-archive/i))
if (ref($msg)
and !tools::smart_eq(
$Conf::Conf{'ignore_x_no_archive_header_feature'}, 'on')
and (
tools::smart_eq($msg->head->get('X-no-archive'), qr/yes/i)
or tools::smart_eq(
$msg->head->get('Restrict'),
qr/no\-external\-archive/i
)
)
) {
Log::do_log('info',
"Do not archive message with no-archive flag for list %s",
......@@ -9300,7 +9315,7 @@ sub sync_include {
## Load a hash with the new subscriber list
my $new_subscribers;
unless ($option eq 'purge') {
unless ($option and $option eq 'purge') {
my $result =
$self->_load_list_members_from_include(
$self->get_list_of_sources_id(\%old_subscribers));
......@@ -9609,7 +9624,7 @@ sub sync_include {
$self->{'total'} = $self->_load_total_db('nocache');
$self->{'last_sync'} = time;
$self->savestats();
$self->sync_include_ca($option eq 'purge');
$self->sync_include_ca($option and $option eq 'purge');
return 1;
}
......@@ -9666,8 +9681,7 @@ sub sync_include_admin {
my $new_admin_users_include;
## Load a hash with the new admin user users from the list config
my $new_admin_users_config;
unless ($option eq 'purge') {
unless ($option and $option eq 'purge') {
$new_admin_users_include =
$self->_load_list_admin_from_include($role);
......@@ -10013,7 +10027,7 @@ sub is_update_param {
$update = 1;
}
} else {
if (defined $old_param->{$p} && ($old_param->{$p} ne '')) {
if (defined $old_param->{$p} and $old_param->{$p} ne '') {
$resul->{$p} = '';
$update = 1;
}
......@@ -10578,7 +10592,7 @@ sub get_which {
}
} elsif ($function eq 'owner') {
if ($db_which->{$robot}{$l}{'owner'} == 1) {
if ($db_which->{$robot}{$l}{'owner'}) {
push @which, $list;
## Update cache
......@@ -10590,7 +10604,7 @@ sub get_which {
0;
}
} elsif ($function eq 'editor') {
if ($db_which->{$robot}{$l}{'editor'} == 1) {
if ($db_which->{$robot}{$l}{'editor'}) {
push @which, $list;
## Update cache
......@@ -10781,7 +10795,7 @@ sub load_topics {
|| ((stat($conf_file))[9] > $mtime{'topics'}{$robot})) {
## delete previous list of topics
%list_of_topics = undef;
%list_of_topics = ();
unless (-r $conf_file) {
Log::do_log('err', "Unable to read $conf_file");
......@@ -11068,15 +11082,13 @@ sub _load_list_param {
}
## Do we need to split param if it is not already an array
if ( ($p->{'occurrence'} =~ /n$/)
&& $p->{'split_char'}
&& !(ref($value) eq 'ARRAY')) {
my @array = split /$p->{'split_char'}/, $value;
foreach my $v (@array) {
$v =~ s/^\s*(.+)\s*$/$1/g;
}
return \@array;
if ( exists $p->{'occurrence'}
and $p->{'occurrence'} =~ /n$/
and $p->{'split_char'}
and defined $value
and ref $value ne 'ARRAY') {
$value =~ s/^\s*(.+)\s*$/$1/;
return [split /\s*$p->{'split_char'}\s*/, $value];
} else {
return $value;
}
......@@ -12441,7 +12453,7 @@ sub get_next_delivery_date {
my $self = shift;
my $dtime = $self->{'admin'}{'delivery_time'};
unless ($dtime =~ /(\d?\d)\:(\d\d)/) {
unless ($dtime and $dtime =~ /(\d?\d)\:(\d\d)/) {
# if delivery _time if not defined, the delivery time right now
return time();
}
......
......@@ -133,11 +133,11 @@ sub do_log {
my @call = caller(1);
## If called via wwslog, go one step ahead
if ($call[3] =~ /wwslog$/) {
if ($call[3] and $call[3] =~ /wwslog$/) {
my @call = caller(2);
}
$caller_string = $call[3] . '()';
$caller_string = ($call[3] || '') . '()';
}
$message = $caller_string . ' ' . $message if ($caller_string);
......@@ -263,11 +263,10 @@ sub db_log {
unless ($user_email) {
$user_email = 'anonymous';
}
unless ($list) {
unless (defined $list and length $list) {
$list = '';
}
#remove the robot name of the list name
if ($list =~ /(.+)\@(.+)/) {
} elsif ($list =~ /(.+)\@(.+)/) {
#remove the robot name of the list name
$list = $1;
unless ($robot) {
$robot = $2;
......@@ -325,10 +324,10 @@ sub db_stat_log {
my $id = $date . $random;
my $read = 0;
if (ref($list) =~ /List/i) {
if (ref $list eq 'List') {
$list = $list->{'name'};
}
if ($list =~ /(.+)\@(.+)/) { #remove the robot name of the list name
} elsif ($list and $list =~ /(.+)\@(.+)/) {
#remove the robot name of the list name
$list = $1;
unless ($robot) {
$robot = $2;
......@@ -370,7 +369,8 @@ sub db_stat_counter_log {
my $random = int(rand(1000000));
my $id = $date_deb . $random;
if ($list =~ /(.+)\@(.+)/) { #remove the robot name of the list name
if ($list and $list =~ /(.+)\@(.+)/) {
#remove the robot name of the list name
$list = $1;
unless ($robot) {
$robot = $2;
......@@ -941,7 +941,7 @@ sub aggregate_data {
} #end of foreach
my $d_deb = localtime($begin_date);
my $d_fin = localtime($end_date);
my $d_fin = localtime($end_date) if defined $end_date;
do_log('debug2', 'data aggregated from %s to %s', $d_deb, $d_fin);
}
......
......@@ -196,7 +196,7 @@ sub new {
## Store decoded subject and its original charset
my $subject = $hdr->get('Subject');
if ($subject =~ /\S/) {
if (defined $subject and $subject =~ /\S/) {
my @decoded_subject = MIME::EncWords::decode_mimewords($subject);
$message->{'subject_charset'} = 'US-ASCII';
foreach my $token (@decoded_subject) {
......@@ -222,16 +222,19 @@ sub new {
$message->{'subject_charset'} = undef;
}
if ($message->{'subject_charset'}) {
$message->{'decoded_subject'} =
MIME::EncWords::decode_mimewords($subject, Charset => 'utf8');
$message->{'decoded_subject'} = tools::decode_header($hdr, 'Subject');
} else {
if ($subject) {
chomp $subject;
$subject =~ s/(\r\n|\r|\n)(?=[ \t])//g;
$subject =~ s/\r\n|\r|\n/ /g;
}
$message->{'decoded_subject'} = $subject;
}
chomp $message->{'decoded_subject'};
## Extract recepient address (X-Sympa-To)
$message->{'rcpt'} = $hdr->get('X-Sympa-To');
chomp $message->{'rcpt'};
chomp $message->{'rcpt'} if defined $message->{'rcpt'};
unless (defined $noxsympato) {
# message.pm can be used not only for message comming from queue
unless ($message->{'rcpt'}) {
......
This diff is collapsed.
......@@ -79,11 +79,12 @@ sub new {
$self->{'passive_session'} = 1;
}
$self->{'passive_session'} = 1
if ($rss || $action eq 'wsdl' || $action eq 'css');
if $rss
or $action and ($action eq 'wsdl' or $action eq 'css');
# if a session cookie exist, try to restore an existing session, don't
# store sessions from bots
if (($cookie) && ($self->{'passive_session'} != 1)) {
if ($cookie and !$self->{'passive_session'}) {
my $status;
$status = $self->load($cookie);
unless (defined $status) {
......@@ -495,17 +496,20 @@ sub purge_old_sessions {
my @sessions;
my $sth;
my $robot_condition = sprintf "robot_session = %s", SDM::quote($robot)
unless (($robot eq '*') || ($robot));
my $robot_condition = '';
$robot_condition = sprintf "robot_session = %s", SDM::quote($robot)
if $robot and $robot ne '*';
my $delay_condition = time - $delay . ' > date_session' if ($delay);
my $anonymous_delay_condition =
time - $anonymous_delay . ' > date_session'
if ($anonymous_delay);
my $anonymous_delay_condition = '';
$anonymous_delay_condition = time - $anonymous_delay . ' > date_session'
if $anonymous_delay;
my $and = ' AND ' if (($delay_condition) && ($robot_condition));
my $anonymous_and = ' AND '
if (($anonymous_delay_condition) && ($robot_condition));
my $and = '';
$and = ' AND ' if $delay_condition and $robot_condition;
my $anonymous_and = '';
$anonymous_and = ' AND '
if $anonymous_delay_condition and $robot_condition;
my $count_statement = sprintf
q{SELECT count(*) FROM session_table WHERE %s %s %s},
......@@ -581,12 +585,15 @@ sub purge_old_tickets {
my @tickets;
my $sth;
my $robot_condition = sprintf "robot_one_time_ticket = %s",
my $robot_condition = '';
$robot_condition = sprintf "robot_one_time_ticket = %s",
SDM::quote($robot)
unless (($robot eq '*') || ($robot));
my $delay_condition = time - $delay . ' > date_one_time_ticket'
if ($delay);
my $and = ' AND ' if (($delay_condition) && ($robot_condition));
if $robot and $robot ne '*';
my $delay_condition = '';
$delay_condition = time - $delay . ' > date_one_time_ticket'
if $delay;
my $and = '';
$and = ' AND ' if $delay_condition and $robot_condition;
my $count_statement = sprintf
"SELECT count(*) FROM one_time_ticket_table WHERE $robot_condition $and $delay_condition";
my $statement = sprintf
......@@ -666,20 +673,10 @@ sub list_sessions {
# Subroutines to read cookies #
###############################
## Generic subroutine to get a cookie value
## Subroutine to get session cookie value
sub get_session_cookie {
my $http_cookie = shift;
if ($http_cookie =~ /\S+/g) {
my %cookies = CGI::Cookie->parse($http_cookie);
foreach (keys %cookies) {
my $cookie = $cookies{$_};
next unless ($cookie->name eq 'sympa_session');
return ($cookie->value);
}
}
return (undef);
return cookielib::generic_get_cookie($http_cookie, 'sympa_session');
}
## Generic subroutine to set a cookie
......
......@@ -117,8 +117,8 @@ sub list_tasks {
## Maintain list of tasks
push @task_list, $task;
my $list_id = $task->{'id'};
my $model = $task->{'model'};
my $list_id = (defined $task->{'id'}) ? $task->{'id'} : '';
my $model = $task->{'model'};
$task_by_model{$model}{$list_id} = $task;
$task_by_list{$list_id}{$model} = $task;
......
......@@ -147,15 +147,14 @@ sub generic_get_cookie {
my $http_cookie = shift;
my $cookie_name = shift;
if ($http_cookie =~ /\S+/g) {
my %cookies = parse CGI::Cookie($http_cookie);
foreach (keys %cookies) {
my $cookie = $cookies{$_};
next unless ($cookie->name eq $cookie_name);
if ($http_cookie and $http_cookie =~ /\S+/g) {
my %cookies = CGI::Cookie->parse($http_cookie);
foreach my $cookie (values %cookies) {
next unless $cookie->name eq $cookie_name;
return ($cookie->value);
}
}
return (undef);
return;
}
## Returns user information extracted from the cookie
......@@ -184,7 +183,7 @@ sub check_cookie_extern {
my $extern_value = generic_get_cookie($http_cookie, 'sympa_altemails');
if ($extern_value =~ /^(\S+)&(\w+)$/) {
if ($extern_value and $extern_value =~ /^(\S+)&(\w+)$/) {
return undef unless (get_mac($1, $secret) eq $2);
my %alt_emails;
......
......@@ -402,9 +402,10 @@ sub mail_message {
$#rcpt + 1,
$tag_as_last
);
return 0 if ($#rcpt == -1);
return 0 unless @rcpt;
my ($i, $j, $nrcpt, $size);
my ($i, $j, $nrcpt);
my $size = 0;
my $numsmtp = 0;
## If message contain a footer or header added by Sympa use the object
......@@ -429,8 +430,8 @@ sub mail_message {
my $db_type = $Conf::Conf{'db_type'};
while (defined($i = shift(@rcpt))) {
my @k = reverse(split(/[\.@]/, $i));
my @l = reverse(split(/[\.@]/, $j));
my @k = reverse split /[\.@]/, $i;
my @l = reverse split /[\.@]/, (defined $j ? $j : '@');
my $dom;
if ($i =~ /\@(.*)$/) {
......@@ -438,8 +439,12 @@ sub mail_message {
chomp $dom;
}
$rcpt_by_dom{$dom} += 1;
Log::do_log('debug2',
"domain: $dom ; rcpt by dom: $rcpt_by_dom{$dom} ; limit for this domain: $Conf::Conf{'nrcpt_by_domain'}{$dom}"
Log::do_log(
'debug2',
'domain: %s ; rcpt by dom: %s ; limit for this domain: %s',
$dom,
$rcpt_by_dom{$dom},
$Conf::Conf{'nrcpt_by_domain'}{$dom}
);
if (
......@@ -784,7 +789,7 @@ sub sendto {
my $msg;
if ($encrypt eq 'smime_crypted') {
if ($encrypt and $encrypt eq 'smime_crypted') {
# encrypt message for each rcpt and send the message
# this MUST be moved to the bulk mailer. This way, merge will be
# applied after the SMIME encryption is applied ! This is a bug !
......@@ -906,7 +911,7 @@ sub sending {
my $fh;
my $signed_msg; # if signing