X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FControl%2FService.pm;h=520db3eb7820bfb9133638c9c266b09e5f712d80;hb=64d0fa452631c6e228fad18f8ae469582e3734b3;hp=5e7cb0041af37d8ea9f4075671dbae96d058a78d;hpb=57207dfb5b9192725a127821ab3a3ff5b4ac13c7;p=debbugs.git

diff --git a/Debbugs/Control/Service.pm b/Debbugs/Control/Service.pm
index 5e7cb00..520db3e 100644
--- a/Debbugs/Control/Service.pm
+++ b/Debbugs/Control/Service.pm
@@ -82,7 +82,7 @@ BEGIN{
      $DEBUG = 0 unless defined $DEBUG;
 
      @EXPORT = ();
-     %EXPORT_TAGS = (control => [qw(control_line)],
+     %EXPORT_TAGS = (control => [qw(control_line valid_control)],
 		    );
      @EXPORT_OK = ();
      Exporter::export_ok_tags(keys %EXPORT_TAGS);
@@ -90,65 +90,71 @@ BEGIN{
 }
 
 use Debbugs::Config qw(:config);
+use Debbugs::Common qw(cleanup_eval_fail);
 use Debbugs::Control qw(:all);
+use Debbugs::Status qw(splitpackages);
+use Params::Validate qw(:types validate_with);
+use List::Util qw(first);
 
+my $bug_num_re = '-?\d+';
 my %control_grammar =
-    (close => qr/(?i)^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/,
-     reassign => qr/(?i)^reassign\s+\#?(-?\d+)\s+ # bug and command
+    (close => qr/(?i)^close\s+\#?($bug_num_re)(?:\s+(\d.*))?$/,
+     reassign => qr/(?i)^reassign\s+\#?($bug_num_re)\s+ # bug and command
 		    (?:(?:((?:src:|source:)?$config{package_name_re}) # new package
 			    (?:\s+((?:$config{package_name_re}\/)?
 				    $config{package_version_re}))?)| # optional version
 			((?:src:|source:)?$config{package_name_re} # multiple package form
 			    (?:\s*\,\s*(?:src:|source:)?$config{package_name_re})+))
 		    \s*$/x,
-     reopen => qr/(?i)^reopen\s+\#?(-?\d+)(?:\s+([\=\!]|(?:\S.*\S)))?$/,
-     found => qr{^(?:(?i)found)\s+\#?(-?\d+)
+     reopen => qr/(?i)^reopen\s+\#?($bug_num_re)(?:\s+([\=\!]|(?:\S.*\S)))?$/,
+     found => qr{^(?:(?i)found)\s+\#?($bug_num_re)
 		 (?:\s+((?:$config{package_name_re}\/)?
 			 $config{package_version_re}
 			 # allow for multiple packages
 			 (?:\s*,\s*(?:$config{package_name_re}\/)?
 			     $config{package_version_re})*)
 		 )?$}x,
-     notfound => qr{^(?:(?i)notfound)\s+\#?(-?\d+)
+     notfound => qr{^(?:(?i)notfound)\s+\#?($bug_num_re)
 		    \s+((?:$config{package_name_re}\/)?
 			$config{package_version_re}
 			# allow for multiple packages
 			(?:\s*,\s*(?:$config{package_name_re}\/)?
 			    $config{package_version_re})*
 		    )$}x,
-     fixed => qr{^(?:(?i)fixed)\s+\#?(-?\d+)
+     fixed => qr{^(?:(?i)fixed)\s+\#?($bug_num_re)
 	     \s+((?:$config{package_name_re}\/)?
 		    $config{package_version_re}
 		# allow for multiple packages
 		(?:\s*,\s*(?:$config{package_name_re}\/)?
 		    $config{package_version_re})*)
 	    \s*$}x,
-     notfixed => qr{^(?:(?i)notfixed)\s+\#?(-?\d+)
+     notfixed => qr{^(?:(?i)notfixed)\s+\#?($bug_num_re)
 	     \s+((?:$config{package_name_re}\/)?
 		    $config{package_version_re}
 		# allow for multiple packages
 		(?:\s*,\s*(?:$config{package_name_re}\/)?
 		    $config{package_version_re})*)
 	    \s*$}x,
-     submitter => qr/(?i)^submitter\s+\#?(-?\d+)\s+(\!|\S.*\S)$/.
-     forwarded => qr/(?i)^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/,
-     notforwarded => qr/(?i)^notforwarded\s+\#?(-?\d+)$/,
-     severity => qr/(?i)^(?:severity|priority)\s+\#?(-?\d+)\s+([-0-9a-z]+)$/,
-     tag => qr/(?i)^tags?\s+\#?(-?\d+)\s+(\S.*)$/,
-     block => qr/(?i)^(un)?block\s+\#?(-?\d+)\s+(?:by|with)\s+(\S.*)?$/,
-     retitle => qr/(?i)^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/,
-     unmerge => qr/(?i)^unmerge\s+\#?(-?\d+)$/,
-     merge   => qr/(?i)^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/,
-     forcemerge => qr/(?i)^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/,
-     clone => qr/(?i)^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/,
+     submitter => qr/(?i)^submitter\s+\#?($bug_num_re)\s+(\!|\S.*\S)$/,
+     forwarded => qr/(?i)^forwarded\s+\#?($bug_num_re)\s+(\S.*\S)$/,
+     notforwarded => qr/(?i)^notforwarded\s+\#?($bug_num_re)$/,
+     severity => qr/(?i)^(?:severity|priority)\s+\#?($bug_num_re)\s+([-0-9a-z]+)$/,
+     tag => qr/(?i)^tags?\s+\#?($bug_num_re)\s+(\S.*)$/,
+     block => qr/(?i)^(un)?block\s+\#?($bug_num_re)\s+(?:by|with)\s+(\S.*)?$/,
+     retitle => qr/(?i)^retitle\s+\#?($bug_num_re)\s+(\S.*\S)\s*$/,
+     unmerge => qr/(?i)^unmerge\s+\#?($bug_num_re)$/,
+     merge   => qr/(?i)^merge\s+#?($bug_num_re(\s+#?$bug_num_re)+)\s*$/,
+     forcemerge => qr/(?i)^forcemerge\s+\#?($bug_num_re(?:\s+\#?$bug_num_re)+)\s*$/,
+     clone => qr/(?i)^clone\s+#?($bug_num_re)\s+((?:$bug_num_re\s+)*$bug_num_re)\s*$/,
      package => qr/(?i)^package\:?\s+(\S.*\S)?\s*$/,
      limit => qr/(?i)^limit\:?\s+(\S.*\S)\s*$/,
-     affects => qr/(?i)^affects?\s+\#?(-?\d+)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/,
-     summary => qr/(?i)^summary\s+\#?(-?\d+)\s*(\d+|)\s*$/,
-     owner => qr/(?i)^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/,
-     noowner => qr/(?i)^noowner\s+\#?(-?\d+)\s*$/,
-     unarchive => qr/(?i)^unarchive\s+#?(\d+)$/,
-     archive => qr/(?i)^archive\s+#?(\d+)$/,
+     affects => qr/(?i)^affects?\s+\#?($bug_num_re)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/,
+     summary => qr/(?i)^summary\s+\#?($bug_num_re)\s*(.*)\s*$/,
+     outlook => qr/(?i)^outlook\s+\#?($bug_num_re)\s*(.*)\s*$/,
+     owner => qr/(?i)^owner\s+\#?($bug_num_re)\s+((?:\S.*\S)|\!)\s*$/,
+     noowner => qr/(?i)^noowner\s+\#?($bug_num_re)\s*$/,
+     unarchive => qr/(?i)^unarchive\s+#?($bug_num_re)$/,
+     archive => qr/(?i)^archive\s+#?($bug_num_re)$/,
     );
 
 sub valid_control {
@@ -175,39 +181,51 @@ sub control_line {
 							 },
 			       errors => {type => SCALARREF,
 					 },
-			       transcript => {type => FILEHANDLE,
+			       transcript => {type => HANDLE,
 					     },
+			       debug => {type => SCALAR,
+					 default => 0,
+					},
 			       ok => {type => SCALARREF,
 				     },
+			       limit => {type => HASHREF,
+					},
+			       replyto => {type => SCALAR,
+					  },
 			      },
 		     );
     my $line = $param{line};
     my @matches;
     my $ctl = valid_control($line,\@matches);
     my $transcript = $param{transcript};
+    my $debug = $param{debug};
     if (not defined $ctl) {
 	${$param{errors}}++;
 	print {$param{transcript}} "Unknown command or invalid options to control\n";
 	return;
     }
-    my $ref = $matches[1];
-    $ref = $param{clonebugs}{$ref} if exists $param{clonebugs}{$ref};
+    # in almost all cases, the first match is the bug; the exception
+    # to this is block.
+    my $ref = $matches[0];
+    if (defined $ref) {
+	$ref = $param{clonebugs}{$ref} if exists $param{clonebugs}{$ref};
+    }
     ${$param{ok}}++;
     my $errors = 0;
     my $terminate_control = 0;
 
     if ($ctl eq 'close') {
-	if (defined $matches[2]) {
+	if (defined $matches[1]) {
 	    eval {
 		set_fixed(@{$param{common_control_options}},
 			  bug   => $ref,
-			  fixed => $matches[2],
+			  fixed => $matches[1],
 			  add   => 1,
 			 );
 	    };
 	    if ($@) {
 		$errors++;
-		print {$transcript} "Failed to add fixed version '$matches[2]' to $ref: ".cleanup_eval_fail($@,$debug)."\n";
+		print {$transcript} "Failed to add fixed version '$matches[1]' to $ref: ".cleanup_eval_fail($@,$debug)."\n";
 	    }
 	}
 	eval {
@@ -225,14 +243,14 @@ sub control_line {
 	}
     } elsif ($ctl eq 'reassign') {
 	my @new_packages;
-	if (not defined $matches[2]) {
-	    push @new_packages, split /\s*\,\s*/,$matches[4];
+	if (not defined $matches[1]) {
+	    push @new_packages, split /\s*\,\s*/,$matches[3];
 	}
 	else {
-	    push @new_packages, $matches[2];
+	    push @new_packages, $matches[1];
 	}
 	@new_packages = map {y/A-Z/a-z/; s/^(?:src|source):/src:/; $_;} @new_packages;
-        my $version= $matches[3];
+        my $version= $matches[2];
     	eval {
 	    set_package(@{$param{common_control_options}},
 			bug          => $ref,
@@ -252,13 +270,13 @@ sub control_line {
 	    print {$transcript} "Failed to clear fixed versions and reopen on $ref: ".cleanup_eval_fail($@,$debug)."\n";
 	}
     } elsif ($ctl eq 'reopen') {
-	my $new_submitter = $matches[2];
+	my $new_submitter = $matches[1];
 	if (defined $new_submitter) {
 	    if ($new_submitter eq '=') {
 		undef $new_submitter;
 	    }
 	    elsif ($new_submitter eq '!') {
-		$new_submitter = $replyto;
+		$new_submitter = $param{replyto};
 	    }
 	}
 	eval {
@@ -274,8 +292,8 @@ sub control_line {
 	}
     } elsif ($ctl eq 'found') {
 	my @versions;
-        if (defined $matches[2]) {
-	    @versions = split /\s*,\s*/,$matches[2];
+        if (defined $matches[1]) {
+	    @versions = split /\s*,\s*/,$matches[1];
 	    eval {
 		set_found(@{$param{common_control_options}},
 			  bug          => $ref,
@@ -304,7 +322,7 @@ sub control_line {
     }
     elsif ($ctl eq 'notfound') {
 	my @versions;
-        @versions = split /\s*,\s*/,$matches[2];
+        @versions = split /\s*,\s*/,$matches[1];
 	eval {
 	    set_found(@{$param{common_control_options}},
 		      bug          => $ref,
@@ -319,7 +337,7 @@ sub control_line {
     }
     elsif ($ctl eq 'fixed') {
 	my @versions;
-        @versions = split /\s*,\s*/,$matches[2];
+        @versions = split /\s*,\s*/,$matches[1];
 	eval {
 	    set_fixed(@{$param{common_control_options}},
 		      bug          => $ref,
@@ -334,7 +352,7 @@ sub control_line {
     }
     elsif ($ctl eq 'notfixed') {
 	my @versions;
-        @versions = split /\s*,\s*/,$matches[2];
+        @versions = split /\s*,\s*/,$matches[1];
 	eval {
 	    set_fixed(@{$param{common_control_options}},
 		      bug          => $ref,
@@ -348,7 +366,7 @@ sub control_line {
 	}
     }
     elsif ($ctl eq 'submitter') {
-	my $newsubmitter = $matches[2] eq '!' ? $replyto : $matches[2];
+	my $newsubmitter = $matches[1] eq '!' ? $param{replyto} : $matches[1];
         if (not Mail::RFC822::Address::valid($newsubmitter)) {
 	     print {$transcript} "$newsubmitter is not a valid e-mail address; not changing submitter\n";
 	     $errors++;
@@ -366,7 +384,7 @@ sub control_line {
 	    }
         }
     } elsif ($ctl eq 'forwarded') {
-	my $forward_to= $matches[2];
+	my $forward_to= $matches[1];
 	eval {
 	    set_forwarded(@{$param{common_control_options}},
 			  bug          => $ref,
@@ -389,15 +407,15 @@ sub control_line {
 	    print {$transcript} "Failed to clear the forwarded-to-address of $ref: ".cleanup_eval_fail($@,$debug)."\n";
 	}
     } elsif ($ctl eq 'severity') {
-        my $newseverity= $matches[2];
-        if (exists $gObsoleteSeverities{$newseverity}) {
+	my $newseverity= $matches[1];
+        if (exists $config{obsolete_severities}{$newseverity}) {
             print {$transcript} "Severity level \`$newseverity' is obsolete. " .
-		 "Use $gObsoleteSeverities{$newseverity} instead.\n\n";
+		 "Use $config{obsolete_severities}{$newseverity} instead.\n\n";
 	    	$errors++;
         } elsif (not defined first {$_ eq $newseverity}
-	    (@gSeverityList, "$gDefaultSeverity")) {
+	    (@{$config{severity_list}}, $config{default_severity})) {
 	     print {$transcript} "Severity level \`$newseverity' is not known.\n".
-		  "Recognized are: $gShowSeverities.\n\n";
+		  "Recognized are: $config{show_severities}.\n\n";
 	    $errors++;
         } else {
 	    eval {
@@ -412,7 +430,7 @@ sub control_line {
 	    }
 	}
     } elsif ($ctl eq 'tag') {
-	my $tags = $matches[2];
+	my $tags = $matches[1];
 	my @tags = map {m/^([+=-])(.+)/ ? ($1,$2):($_)} split /[\s,]+/, $tags;
 	# this is an array of hashrefs which contain two elements, the
 	# first of which is the array of tags, the second is the
@@ -454,7 +472,7 @@ sub control_line {
 	}
 	if (@badtags) {
             print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
-		 "Recognized are: ".join(' ', @gTags).".\n\n";
+		 "Recognized are: ".join(' ', @{$config{tags}}).".\n\n";
 	    $errors++;
 	}
 	eval {
@@ -474,11 +492,11 @@ sub control_line {
 	    $errors++;
 	    print {$transcript} "Failed to alter tags of $config{bug} $ref: ".cleanup_eval_fail($@,$debug)."\n";
 	}
-    } elsif (m/^(un)?block\s+\#?(-?\d+)\s+(?:by|with)\s+(\S.*)?$/i) {
-	my $add_remove = defined $matches[1] && $matches[1] eq 'un';
-	$ref = $matches[2];
-	$ref = exists $param{clonebugs}{$ref} ? $param{clonebugs}{$ref};
-	my @blockers = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_} split /[\s,]+/, $matches[3];
+    } elsif ($ctl eq 'block') {
+	my $add_remove = defined $matches[0] && $matches[0] eq 'un';
+	$ref = $matches[1];
+	$ref = exists $param{clonebugs}{$ref} ? $param{clonebugs}{$ref} : $ref;
+	my @blockers = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_} split /[\s,]+/, $matches[2];
 	eval {
 	     set_blocks(@{$param{common_control_options}},
 			bug          => $ref,
@@ -491,7 +509,7 @@ sub control_line {
 	    print {$transcript} "Failed to set blocking bugs of $ref: ".cleanup_eval_fail($@,$debug)."\n";
 	}
     } elsif ($ctl eq 'retitle') {
-        my $newtitle= $matches[2];
+        my $newtitle= $matches[1];
 	eval {
 	     set_title(@{$param{common_control_options}},
 		       bug          => $ref,
@@ -515,7 +533,7 @@ sub control_line {
     } elsif ($ctl eq 'merge') {
 	my @tomerge;
         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
-	    split(/\s+#?/,$matches[1]);
+	    split(/\s+#?/,$matches[0]);
 	eval {
 	     set_merged(@{$param{common_control_options}},
 			bug          => $ref,
@@ -529,7 +547,7 @@ sub control_line {
     } elsif ($ctl eq 'forcemerge') {
 	my @tomerge;
         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
-	    split(/\s+#?/,$matches[1]);
+	    split(/\s+#?/,$matches[0]);
 	eval {
 	     set_merged(@{$param{common_control_options}},
 			bug          => $ref,
@@ -543,11 +561,10 @@ sub control_line {
 	    print {$transcript} "Failed to forcibly merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
 	}
     } elsif ($ctl eq 'clone') {
-	my $origref = $matches[1];
-	my @newclonedids = split /\s+/, $matches[2];
+	my $origref = $matches[0];
+	my @newclonedids = split /\s+/, $matches[1];
 	my $newbugsneeded = scalar(@newclonedids);
 
-	$bug_affected{$ref} = 1;
 	eval {
 	    my %new_clones;
 	    clone_bug(@{$param{common_control_options}},
@@ -563,37 +580,35 @@ sub control_line {
 	    print {$transcript} "Failed to clone $ref: ".cleanup_eval_fail($@,$debug)."\n";
 	}
     } elsif ($ctl eq 'package') {
-	my @pkgs = split /\s+/, $matches[1];
+	my @pkgs = split /\s+/, $matches[0];
 	if (scalar(@pkgs) > 0) {
-		%limit_pkgs = map { ($_, 1) } @pkgs;
-		$limit{package} = [@pkgs];
+		$param{limit}{package} = [@pkgs];
 		print {$transcript} "Limiting to bugs with field 'package' containing at least one of ".join(', ',map {qq('$_')} @pkgs)."\n";
 		print {$transcript} "Limit currently set to";
-		for my $limit_field (keys %limit) {
-		    print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$limit{$limit_field}})."\n";
+		for my $limit_field (keys %{$param{limit}}) {
+		    print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
 		}
 		print {$transcript} "\n";
 	} else {
-	    %limit_pkgs = ();
-	    $limit{package} = [];
+	    $param{limit}{package} = [];
 	    print {$transcript} "Limit cleared.\n\n";
 	}
     } elsif ($ctl eq 'limit') {
-	my ($field,@options) = split /\s+/, $matches[1];
+	my ($field,@options) = split /\s+/, $matches[0];
 	$field = lc($field);
 	if ($field =~ /^(?:clear|unset|blank)$/) {
-	    %limit = ();
+	    %{$param{limit}} = ();
 	    print {$transcript} "Limit cleared.\n\n";
 	}
 	elsif (exists $Debbugs::Status::fields{$field} or $field eq 'source') {
-	    # %limit can actually contain regexes, but because they're
+	    # %{$param{limit}} can actually contain regexes, but because they're
 	    # not evaluated in Safe, DO NOT allow them through without
 	    # fixing this.
-	    $limit{$field} = [@options];
+	    $param{limit}{$field} = [@options];
 	    print {$transcript} "Limiting to bugs with field '$field' containing at least one of ".join(', ',map {qq('$_')} @options)."\n";
 	    print {$transcript} "Limit currently set to";
-	    for my $limit_field (keys %limit) {
-		print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$limit{$limit_field}})."\n";
+	    for my $limit_field (keys %{$param{limit}}) {
+		print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
 	    }
 	    print {$transcript} "\n";
 	}
@@ -605,8 +620,8 @@ sub control_line {
 	    last;
 	}
     } elsif ($ctl eq 'affects') {
-	my $add_remove = $matches[2];
-	my $packages = $matches[3];
+	my $add_remove = $matches[1];
+	my $packages = $matches[2];
 	# if there isn't a package given, assume that we should unset
 	# affects; otherwise default to adding
 	if (not defined $packages or
@@ -621,7 +636,7 @@ sub control_line {
 	eval {
 	     affects(@{$param{common_control_options}},
 		     bug => $ref,
-		     package     => [splitpackages($matches[3])],
+		     package     => [splitpackages($packages)],
 		     ($add_remove eq '+'?(add => 1):()),
 		     ($add_remove eq '-'?(remove => 1):()),
 		    );
@@ -632,7 +647,7 @@ sub control_line {
 	}
 
     } elsif ($ctl eq 'summary') {
-	my $summary_msg = length($matches[2])?$matches[2]:undef;
+	my $summary_msg = length($matches[1])?$matches[1]:undef;
 	eval {
 	    summary(@{$param{common_control_options}},
 		    bug          => $ref,
@@ -644,10 +659,23 @@ sub control_line {
 	    print {$transcript} "Failed to give $ref a summary: ".cleanup_eval_fail($@,$debug)."\n";
 	}
 
+    } elsif ($ctl eq 'outlook') {
+	my $outlook_msg = length($matches[1])?$matches[1]:undef;
+	eval {
+	    outlook(@{$param{common_control_options}},
+		    bug          => $ref,
+		    outlook      => $outlook_msg,
+		   );
+	};
+	if ($@) {
+	    $errors++;
+	    print {$transcript} "Failed to give $ref a outlook: ".cleanup_eval_fail($@,$debug)."\n";
+	}
+
     } elsif ($ctl eq 'owner') {
-	my $newowner = $matches[2];
+	my $newowner = $matches[1];
 	if ($newowner eq '!') {
-	    $newowner = $replyto;
+	    $newowner = $param{replyto};
 	}
 	eval {
 	    owner(@{$param{common_control_options}},
@@ -674,7 +702,6 @@ sub control_line {
 	 eval {
 	      bug_unarchive(@{$param{common_control_options}},
 			    bug        => $ref,
-			    recipients => \%recipients,
 			   );
 	 };
 	 if ($@) {