Allow the default sendmail options to be specified in the config file;

[debbugs.git] / Debbugs / Control.pm

diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm
index cf2ab8416566df3645c823d758393ce82cd27c0f..d994170bb0f24fa6c5f72cd525ebb505556f64a2 100644 (file)
--- a/Debbugs/Control.pm
+++ b/Debbugs/Control.pm
@@ -107,7 +107,7 @@ BEGIN{
 
 use Debbugs::Config qw(:config);
 use Debbugs::Common qw(:lock buglog :misc get_hashname);
-use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields);
+use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields get_bug_status);
 use Debbugs::CGI qw(html_escape);
 use Debbugs::Log qw(:misc);
 use Debbugs::Recipients qw(:add);
@@ -319,10 +319,10 @@ sub set_blocks {
            join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
     }
     my $mode = 'set';
-    if (exists $param{add}) {
+    if ($param{add}) {
        $mode = 'add';
     }
-    elsif (exists $param{remove}) {
+    elsif ($param{remove}) {
        $mode = 'remove';
     }
 
@@ -351,7 +351,7 @@ sub set_blocks {
            $ok_blockers{$blocker} = 1;
            my @merged_bugs;
            push @merged_bugs, make_list($data->{mergedwith});
-           $ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
+           @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
        }
        else {
            $bad_blockers{$blocker} = 1;
@@ -440,7 +440,7 @@ sub set_blocks {
        push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
        $action = ucfirst(join ('; ',@changed)) if @changed;
        if (not @changed) {
-           print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"
+           print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n"
                unless __internal_request();
            next;
        }
@@ -498,7 +498,7 @@ sub set_blocks {
                }
                $data->{blocks} = join(' ',sort keys %blocks);
                my $action = ($add_remove eq 'add'?'Added':'Removed').
-                   " indication that bug $data->{bug_num} blocks".
+                   " indication that bug $data->{bug_num} blocks ".
                    join(',',@blocks);
                append_action_to_log(bug => $data->{bug_num},
                                     command => 'block',
@@ -509,6 +509,7 @@ sub set_blocks {
                                                                   action => $action
                                                                   )
                                    );
+               writebug($data->{bug_num},$data);
            }
            __handle_affected_packages(%param,data=>\@blocking_data);
            add_recipients(recipients => $param{recipients},
@@ -616,7 +617,7 @@ sub set_tag {
        my %tag_added = ();
        my %tag_removed = ();
        my %fixed_removed = ();
-       my @old_tags = split /\,\s*/, $data->{keywords};
+       my @old_tags = split /\,?\s+/, $data->{keywords};
        my %tags;
        @tags{@old_tags} = (1) x @old_tags;
        my $reopened = 0;
@@ -658,7 +659,7 @@ sub set_tag {
            print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
            print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
        }
-       $data->{keywords} = join(', ',keys %tags); # double check this
+       $data->{keywords} = join(' ',keys %tags);
 
        my @changed;
        push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
@@ -1948,12 +1949,14 @@ sub summary {
              }
              # skip a paragraph if it looks like it's control or
              # pseudo-headers
-             if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
-                                (?:package|(?:no|)owner|severity|tag|summary| #control
-                                     reopen|close|(?:not|)(?:fixed|found)|clone|
-                                     (?:force|)merge|user(?:category|tag|)
-                                )
-                           )\s+\S}x) {
+             if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
+                 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
+                                \#|reopen|close|(?:not|)(?:fixed|found)|clone|
+                                debug|(?:not|)forwarded|priority|
+                                (?:un|)block|limit|(?:un|)archive|
+                                reassign|retitle|affects|wrongpackage
+                                (?:un|force|)merge|user(?:category|tags?|)
+                            )\s+\S}xis) {
                   if (not length $paragraph) {
                        print {$debug} "Found control/pseudo-headers and skiping them\n";
                        $in_pseudoheaders = 1;
@@ -2694,6 +2697,7 @@ sub __begin_control {
     }
     if (not __check_limit(data => \@data,
                          exists $param{limit}?(limit => $param{limit}):(),
+                         transcript => $transcript,
                         )) {
        die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
     }
@@ -2781,6 +2785,9 @@ sub __check_limit{
                                                  },
                                         limit => {type => HASHREF|UNDEF,
                                                  },
+                                        transcript  => {type => SCALARREF|HANDLE,
+                                                        optional => 1,
+                                                       },
                                        },
                             );
     my @data = make_list($param{data});
@@ -2789,21 +2796,31 @@ sub __check_limit{
        not keys %{$param{limit}}) {
        return 1;
     }
+    my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
+    my $going_to_fail = 0;
     for my $data (@data) {
+       $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
+                                                  status => dclone($data),
+                                                 ));
        for my $field (keys %{$param{limit}}) {
            next unless exists $param{limit}{$field};
            my $match = 0;
-           for my $limit (make_list($param{limit}{$field})) {
+           my @data_fields = make_list($data->{$field});
+LIMIT:     for my $limit (make_list($param{limit}{$field})) {
                if (not ref $limit) {
-                   if ($data->{$field} eq $limit) {
-                       $match = 1;
-                       last;
+                   for my $data_field (@data_fields) {
+                       if ($data_field eq $limit) {
+                           $match = 1;
+                           last LIMIT;
+                       }
                    }
                }
                elsif (ref($limit) eq 'Regexp') {
-                   if ($data->{$field} =~ $limit) {
-                       $match = 1;
-                       last;
+                   for my $data_field (@data_fields) {
+                       if ($data_field =~ $limit) {
+                           $match = 1;
+                           last LIMIT;
+                       }
                    }
                }
                else {
@@ -2811,11 +2828,14 @@ sub __check_limit{
                }
            }
            if (not $match) {
-               return 0;
+               $going_to_fail = 1;
+               print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
+                   "' does not match at least one of ".
+                   join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
            }
        }
     }
-    return 1;
+    return $going_to_fail?0:1;
 }