X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FControl.pm;h=f79c58372efc10cbd62dd6d592b37dddfee67de1;hb=ca125564b322a7aba71d9f81a73a02528927c80f;hp=a36321a4ee2cf6f3469adf37309c0bb7e13e46ff;hpb=14f7d80b0cd0adfa02ae77d30111fe6daca53456;p=debbugs.git

diff --git a/Debbugs/Control.pm b/Debbugs/Control.pm
index a36321a..f79c583 100644
--- 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;
@@ -2586,7 +2589,7 @@ C<__PACKAGE__>.
 sub __internal_request{
     my ($l) = @_;
     $l = 0 if not defined $l;
-    if (defined +(caller(2+$l))[0] and +(caller(2+$l))[0] eq __PACKAGE__) {
+    if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
 	return 1;
     }
     return 0;
@@ -2685,8 +2688,16 @@ sub __begin_control {
     if (not @data) {
 	die "Unable to read any bugs successfully.";
     }
+    if (not $param{archived}) {
+	for my $data (@data) {
+	    if ($data->{archived}) {
+		die "Not altering archived bugs; see unarchive.";
+	    }
+	}
+    }
     if (not __check_limit(data => \@data,
 			  exists $param{limit}?(limit => $param{limit}):(),
+			  transcript => $transcript,
 			 )) {
 	die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
     }
@@ -2703,7 +2714,7 @@ sub __begin_control {
 		   recipients => $param{recipients},
 		   (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
 		   debug      => $debug,
-		   transcript => $transcript,
+		   (__internal_request()?(transcript => $transcript):()),
 		  );
 
     print {$debug} "$param{bug} read done\n";
@@ -2774,6 +2785,9 @@ sub __check_limit{
 						  },
 					 limit => {type => HASHREF|UNDEF,
 						  },
+					 transcript  => {type => SCALARREF|HANDLE,
+							 optional => 1,
+							},
 					},
 			     );
     my @data = make_list($param{data});
@@ -2782,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 {
@@ -2804,11 +2828,13 @@ sub __check_limit{
 		}
 	    }
 	    if (not $match) {
-		return 0;
+		$going_to_fail = 1;
+		print {$transcript} "$field: '$data->{$field}' does not match at least one of ".
+		    join(', ',map {ref($_)?'(regex)':$_} make_list($param{limit}{$field}))."\n";
 	    }
 	}
     }
-    return 1;
+    return $going_to_fail?0:1;
 }