]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/Control/Service.pm
Apply fix for ! in owner et al; fixes #681853 Thanks to jwilk for reporting
[debbugs.git] / Debbugs / Control / Service.pm
1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
5 #
6 # [Other people have contributed to this file; their copyrights should
7 # go here too.]
8 # Copyright 2007,2008,2009 by Don Armstrong <don@donarmstrong.com>.
9
10 package Debbugs::Control::Service;
11
12 =head1 NAME
13
14 Debbugs::Control::Service -- Handles the modification parts of scripts/service by calling Debbugs::Control
15
16 =head1 SYNOPSIS
17
18 use Debbugs::Control::Service;
19
20
21 =head1 DESCRIPTION
22
23 This module contains the code to implement the grammar of control@. It
24 is abstracted here so that it can be called from process at submit
25 time.
26
27 All of the public functions take the following options:
28
29 =over
30
31 =item debug -- scalar reference to which debbuging information is
32 appended
33
34 =item transcript -- scalar reference to which transcript information
35 is appended
36
37 =item affected_bugs -- hashref which is updated with bugs affected by
38 this function
39
40
41 =back
42
43 Functions which should (probably) append to the .log file take the
44 following options:
45
46 =over
47
48 =item requester -- Email address of the individual who requested the change
49
50 =item request_addr -- Address to which the request was sent
51
52 =item request_nn -- Name of queue file which caused this request
53
54 =item request_msgid -- Message id of message which caused this request
55
56 =item location -- Optional location; currently ignored but may be
57 supported in the future for updating archived bugs upon archival
58
59 =item message -- The original message which caused the action to be taken
60
61 =item append_log -- Whether or not to append information to the log.
62
63 =back
64
65 B<append_log> (for most functions) is a special option. When set to
66 false, no appending to the log is done at all. When it is not present,
67 the above information is faked, and appended to the log file. When it
68 is true, the above options must be present, and their values are used.
69
70
71 =head1 GENERAL FUNCTIONS
72
73 =cut
74
75 use warnings;
76 use strict;
77 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
78 use base qw(Exporter);
79
80 BEGIN{
81      $VERSION = 1.00;
82      $DEBUG = 0 unless defined $DEBUG;
83
84      @EXPORT = ();
85      %EXPORT_TAGS = (control => [qw(control_line valid_control)],
86                     );
87      @EXPORT_OK = ();
88      Exporter::export_ok_tags(keys %EXPORT_TAGS);
89      $EXPORT_TAGS{all} = [@EXPORT_OK];
90 }
91
92 use Debbugs::Config qw(:config);
93 use Debbugs::Common qw(cleanup_eval_fail);
94 use Debbugs::Control qw(:all);
95 use Debbugs::Status qw(splitpackages);
96 use Params::Validate qw(:types validate_with);
97 use List::Util qw(first);
98
99 my %control_grammar =
100     (close => qr/(?i)^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/,
101      reassign => qr/(?i)^reassign\s+\#?(-?\d+)\s+ # bug and command
102                     (?:(?:((?:src:|source:)?$config{package_name_re}) # new package
103                             (?:\s+((?:$config{package_name_re}\/)?
104                                     $config{package_version_re}))?)| # optional version
105                         ((?:src:|source:)?$config{package_name_re} # multiple package form
106                             (?:\s*\,\s*(?:src:|source:)?$config{package_name_re})+))
107                     \s*$/x,
108      reopen => qr/(?i)^reopen\s+\#?(-?\d+)(?:\s+([\=\!]|(?:\S.*\S)))?$/,
109      found => qr{^(?:(?i)found)\s+\#?(-?\d+)
110                  (?:\s+((?:$config{package_name_re}\/)?
111                          $config{package_version_re}
112                          # allow for multiple packages
113                          (?:\s*,\s*(?:$config{package_name_re}\/)?
114                              $config{package_version_re})*)
115                  )?$}x,
116      notfound => qr{^(?:(?i)notfound)\s+\#?(-?\d+)
117                     \s+((?:$config{package_name_re}\/)?
118                         $config{package_version_re}
119                         # allow for multiple packages
120                         (?:\s*,\s*(?:$config{package_name_re}\/)?
121                             $config{package_version_re})*
122                     )$}x,
123      fixed => qr{^(?:(?i)fixed)\s+\#?(-?\d+)
124              \s+((?:$config{package_name_re}\/)?
125                     $config{package_version_re}
126                 # allow for multiple packages
127                 (?:\s*,\s*(?:$config{package_name_re}\/)?
128                     $config{package_version_re})*)
129             \s*$}x,
130      notfixed => qr{^(?:(?i)notfixed)\s+\#?(-?\d+)
131              \s+((?:$config{package_name_re}\/)?
132                     $config{package_version_re}
133                 # allow for multiple packages
134                 (?:\s*,\s*(?:$config{package_name_re}\/)?
135                     $config{package_version_re})*)
136             \s*$}x,
137      submitter => qr/(?i)^submitter\s+\#?(-?\d+)\s+(\!|\S.*\S)$/,
138      forwarded => qr/(?i)^forwarded\s+\#?(-?\d+)\s+(\S.*\S)$/,
139      notforwarded => qr/(?i)^notforwarded\s+\#?(-?\d+)$/,
140      severity => qr/(?i)^(?:severity|priority)\s+\#?(-?\d+)\s+([-0-9a-z]+)$/,
141      tag => qr/(?i)^tags?\s+\#?(-?\d+)\s+(\S.*)$/,
142      block => qr/(?i)^(un)?block\s+\#?(-?\d+)\s+(?:by|with)\s+(\S.*)?$/,
143      retitle => qr/(?i)^retitle\s+\#?(-?\d+)\s+(\S.*\S)\s*$/,
144      unmerge => qr/(?i)^unmerge\s+\#?(-?\d+)$/,
145      merge   => qr/(?i)^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/,
146      forcemerge => qr/(?i)^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/,
147      clone => qr/(?i)^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/,
148      package => qr/(?i)^package\:?\s+(\S.*\S)?\s*$/,
149      limit => qr/(?i)^limit\:?\s+(\S.*\S)\s*$/,
150      affects => qr/(?i)^affects?\s+\#?(-?\d+)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/,
151      summary => qr/(?i)^summary\s+\#?(-?\d+)\s*(\d+|)\s*$/,
152      outlook => qr/(?i)^outlook\s+\#?(-?\d+)\s*(\d+|)\s*$/,
153      owner => qr/(?i)^owner\s+\#?(-?\d+)\s+((?:\S.*\S)|\!)\s*$/,
154      noowner => qr/(?i)^noowner\s+\#?(-?\d+)\s*$/,
155      unarchive => qr/(?i)^unarchive\s+#?(\d+)$/,
156      archive => qr/(?i)^archive\s+#?(\d+)$/,
157     );
158
159 sub valid_control {
160     my ($line,$matches) = @_;
161     my @matches;
162     for my $ctl (keys %control_grammar) {
163         if (@matches = $line =~ $control_grammar{$ctl}) {
164             @{$matches} = @matches if defined $matches and ref($matches) eq 'ARRAY';
165             return $ctl;
166         }
167     }
168     @{$matches} = () if defined $matches and ref($matches) eq 'ARRAY';
169     return undef;
170 }
171
172 sub control_line {
173     my %param =
174         validate_with(params => \@_,
175                       spec => {line => {type => SCALAR,
176                                        },
177                                clonebugs => {type => HASHREF,
178                                             },
179                                common_control_options => {type => ARRAYREF,
180                                                          },
181                                errors => {type => SCALARREF,
182                                          },
183                                transcript => {type => HANDLE,
184                                              },
185                                debug => {type => SCALAR,
186                                          default => 0,
187                                         },
188                                ok => {type => SCALARREF,
189                                      },
190                                limit => {type => HASHREF,
191                                         },
192                                replyto => {type => SCALAR,
193                                           },
194                               },
195                      );
196     my $line = $param{line};
197     my @matches;
198     my $ctl = valid_control($line,\@matches);
199     my $transcript = $param{transcript};
200     my $debug = $param{debug};
201     if (not defined $ctl) {
202         ${$param{errors}}++;
203         print {$param{transcript}} "Unknown command or invalid options to control\n";
204         return;
205     }
206     # in almost all cases, the first match is the bug; the exception
207     # to this is block.
208     my $ref = $matches[0];
209     if (defined $ref) {
210         $ref = $param{clonebugs}{$ref} if exists $param{clonebugs}{$ref};
211     }
212     ${$param{ok}}++;
213     my $errors = 0;
214     my $terminate_control = 0;
215
216     if ($ctl eq 'close') {
217         if (defined $matches[1]) {
218             eval {
219                 set_fixed(@{$param{common_control_options}},
220                           bug   => $ref,
221                           fixed => $matches[1],
222                           add   => 1,
223                          );
224             };
225             if ($@) {
226                 $errors++;
227                 print {$transcript} "Failed to add fixed version '$matches[1]' to $ref: ".cleanup_eval_fail($@,$debug)."\n";
228             }
229         }
230         eval {
231             set_done(@{$param{common_control_options}},
232                      done      => 1,
233                      bug       => $ref,
234                      reopen    => 0,
235                      notify_submitter => 1,
236                      clear_fixed => 0,
237                     );
238         };
239         if ($@) {
240             $errors++;
241             print {$transcript} "Failed to mark $ref as done: ".cleanup_eval_fail($@,$debug)."\n";
242         }
243     } elsif ($ctl eq 'reassign') {
244         my @new_packages;
245         if (not defined $matches[1]) {
246             push @new_packages, split /\s*\,\s*/,$matches[3];
247         }
248         else {
249             push @new_packages, $matches[1];
250         }
251         @new_packages = map {y/A-Z/a-z/; s/^(?:src|source):/src:/; $_;} @new_packages;
252         my $version= $matches[2];
253         eval {
254             set_package(@{$param{common_control_options}},
255                         bug          => $ref,
256                         package      => \@new_packages,
257                        );
258             # if there is a version passed, we make an internal call
259             # to set_found
260             if (defined($version) && length $version) {
261                 set_found(@{$param{common_control_options}},
262                           bug   => $ref,
263                           found => $version,
264                          );
265             }
266         };
267         if ($@) {
268             $errors++;
269             print {$transcript} "Failed to clear fixed versions and reopen on $ref: ".cleanup_eval_fail($@,$debug)."\n";
270         }
271     } elsif ($ctl eq 'reopen') {
272         my $new_submitter = $matches[1];
273         if (defined $new_submitter) {
274             if ($new_submitter eq '=') {
275                 undef $new_submitter;
276             }
277             elsif ($new_submitter eq '!') {
278                 $new_submitter = $param{replyto};
279             }
280         }
281         eval {
282             set_done(@{$param{common_control_options}},
283                      bug          => $ref,
284                      reopen       => 1,
285                      defined $new_submitter? (submitter    => $new_submitter):(),
286                     );
287         };
288         if ($@) {
289             $errors++;
290             print {$transcript} "Failed to reopen $ref: ".cleanup_eval_fail($@,$debug)."\n";
291         }
292     } elsif ($ctl eq 'found') {
293         my @versions;
294         if (defined $matches[1]) {
295             @versions = split /\s*,\s*/,$matches[1];
296             eval {
297                 set_found(@{$param{common_control_options}},
298                           bug          => $ref,
299                           found        => \@versions,
300                           add          => 1,
301                          );
302             };
303             if ($@) {
304                 $errors++;
305                 print {$transcript} "Failed to add found on $ref: ".cleanup_eval_fail($@,$debug)."\n";
306             }
307         }
308         else {
309             eval {
310                 set_fixed(@{$param{common_control_options}},
311                           bug          => $ref,
312                           fixed        => [],
313                           reopen       => 1,
314                          );
315             };
316             if ($@) {
317                 $errors++;
318                 print {$transcript} "Failed to clear fixed versions and reopen on $ref: ".cleanup_eval_fail($@,$debug)."\n";
319             }
320         }
321     }
322     elsif ($ctl eq 'notfound') {
323         my @versions;
324         @versions = split /\s*,\s*/,$matches[1];
325         eval {
326             set_found(@{$param{common_control_options}},
327                       bug          => $ref,
328                       found        => \@versions,
329                       remove       => 1,
330                      );
331         };
332         if ($@) {
333             $errors++;
334             print {$transcript} "Failed to remove found on $ref: ".cleanup_eval_fail($@,$debug)."\n";
335         }
336     }
337     elsif ($ctl eq 'fixed') {
338         my @versions;
339         @versions = split /\s*,\s*/,$matches[1];
340         eval {
341             set_fixed(@{$param{common_control_options}},
342                       bug          => $ref,
343                       fixed        => \@versions,
344                       add          => 1,
345                      );
346         };
347         if ($@) {
348             $errors++;
349             print {$transcript} "Failed to add fixed on $ref: ".cleanup_eval_fail($@,$debug)."\n";
350         }
351     }
352     elsif ($ctl eq 'notfixed') {
353         my @versions;
354         @versions = split /\s*,\s*/,$matches[1];
355         eval {
356             set_fixed(@{$param{common_control_options}},
357                       bug          => $ref,
358                       fixed        => \@versions,
359                       remove       => 1,
360                      );
361         };
362         if ($@) {
363             $errors++;
364             print {$transcript} "Failed to remove fixed on $ref: ".cleanup_eval_fail($@,$debug)."\n";
365         }
366     }
367     elsif ($ctl eq 'submitter') {
368         my $newsubmitter = $matches[1] eq '!' ? $param{replyto} : $matches[1];
369         if (not Mail::RFC822::Address::valid($newsubmitter)) {
370              print {$transcript} "$newsubmitter is not a valid e-mail address; not changing submitter\n";
371              $errors++;
372         }
373         else {
374             eval {
375                 set_submitter(@{$param{common_control_options}},
376                               bug       => $ref,
377                               submitter => $newsubmitter,
378                              );
379             };
380             if ($@) {
381                 $errors++;
382                 print {$transcript} "Failed to set submitter on $ref: ".cleanup_eval_fail($@,$debug)."\n";
383             }
384         }
385     } elsif ($ctl eq 'forwarded') {
386         my $forward_to= $matches[1];
387         eval {
388             set_forwarded(@{$param{common_control_options}},
389                           bug          => $ref,
390                           forwarded    => $forward_to,
391                           );
392         };
393         if ($@) {
394             $errors++;
395             print {$transcript} "Failed to set the forwarded-to-address of $ref: ".cleanup_eval_fail($@,$debug)."\n";
396         }
397     } elsif ($ctl eq 'notforwarded') {
398         eval {
399             set_forwarded(@{$param{common_control_options}},
400                           bug          => $ref,
401                           forwarded    => undef,
402                           );
403         };
404         if ($@) {
405             $errors++;
406             print {$transcript} "Failed to clear the forwarded-to-address of $ref: ".cleanup_eval_fail($@,$debug)."\n";
407         }
408     } elsif ($ctl eq 'severity') {
409         my $newseverity= $matches[1];
410         if (exists $config{obsolete_severities}{$newseverity}) {
411             print {$transcript} "Severity level \`$newseverity' is obsolete. " .
412                  "Use $config{obsolete_severities}{$newseverity} instead.\n\n";
413                 $errors++;
414         } elsif (not defined first {$_ eq $newseverity}
415             (@{$config{severity_list}}, $config{default_severity})) {
416              print {$transcript} "Severity level \`$newseverity' is not known.\n".
417                   "Recognized are: $config{show_severities}.\n\n";
418             $errors++;
419         } else {
420             eval {
421                 set_severity(@{$param{common_control_options}},
422                              bug => $ref,
423                              severity => $newseverity,
424                             );
425             };
426             if ($@) {
427                 $errors++;
428                 print {$transcript} "Failed to set severity of $config{bug} $ref to $newseverity: ".cleanup_eval_fail($@,$debug)."\n";
429             }
430         }
431     } elsif ($ctl eq 'tag') {
432         my $tags = $matches[1];
433         my @tags = map {m/^([+=-])(.+)/ ? ($1,$2):($_)} split /[\s,]+/, $tags;
434         # this is an array of hashrefs which contain two elements, the
435         # first of which is the array of tags, the second is the
436         # option to pass to set_tag (we use a hashref here to make it
437         # more obvious what is happening)
438         my @tag_operations;
439         my @badtags;
440         for my $tag (@tags) {
441             if ($tag =~ /^[=+-]$/) {
442                 if ($tag eq '=') {
443                     @tag_operations = {tags => [],
444                                        option => [],
445                                       };
446                 }
447                 elsif ($tag eq '-') {
448                     push @tag_operations,
449                         {tags => [],
450                          option => [remove => 1],
451                         };
452                 }
453                 elsif ($tag eq '+') {
454                     push @tag_operations,
455                         {tags => [],
456                          option => [add => 1],
457                         };
458                 }
459                 next;
460             }
461             if (not defined first {$_ eq $tag} @{$config{tags}}) {
462                 push @badtags, $tag;
463                 next;
464             }
465             if (not @tag_operations) {
466                 @tag_operations = {tags => [],
467                                    option => [add => 1],
468                                   };
469             }
470             push @{$tag_operations[-1]{tags}},$tag;
471         }
472         if (@badtags) {
473             print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
474                  "Recognized are: ".join(' ', @{$config{tags}}).".\n\n";
475             $errors++;
476         }
477         eval {
478             for my $operation (@tag_operations) {
479                 set_tag(@{$param{common_control_options}},
480                         bug => $ref,
481                         tag => [@{$operation->{tags}}],
482                         warn_on_bad_tags => 0, # don't warn on bad tags,
483                         # 'cause we do that above
484                         @{$operation->{option}},
485                        );
486             }
487         };
488         if ($@) {
489             # we intentionally have two errors here if there is a bad
490             # tag and the above fails for some reason
491             $errors++;
492             print {$transcript} "Failed to alter tags of $config{bug} $ref: ".cleanup_eval_fail($@,$debug)."\n";
493         }
494     } elsif ($ctl eq 'block') {
495         my $add_remove = defined $matches[0] && $matches[0] eq 'un';
496         $ref = $matches[1];
497         $ref = exists $param{clonebugs}{$ref} ? $param{clonebugs}{$ref} : $ref;
498         my @blockers = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_} split /[\s,]+/, $matches[2];
499         eval {
500              set_blocks(@{$param{common_control_options}},
501                         bug          => $ref,
502                         block        => \@blockers,
503                         $add_remove ? (remove => 1):(add => 1),
504                        );
505         };
506         if ($@) {
507             $errors++;
508             print {$transcript} "Failed to set blocking bugs of $ref: ".cleanup_eval_fail($@,$debug)."\n";
509         }
510     } elsif ($ctl eq 'retitle') {
511         my $newtitle= $matches[1];
512         eval {
513              set_title(@{$param{common_control_options}},
514                        bug          => $ref,
515                        title        => $newtitle,
516                       );
517         };
518         if ($@) {
519             $errors++;
520             print {$transcript} "Failed to set the title of $ref: ".cleanup_eval_fail($@,$debug)."\n";
521         }
522     } elsif ($ctl eq 'unmerge') {
523         eval {
524              set_merged(@{$param{common_control_options}},
525                         bug          => $ref,
526                        );
527         };
528         if ($@) {
529             $errors++;
530             print {$transcript} "Failed to unmerge $ref: ".cleanup_eval_fail($@,$debug)."\n";
531         }
532     } elsif ($ctl eq 'merge') {
533         my @tomerge;
534         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
535             split(/\s+#?/,$matches[0]);
536         eval {
537              set_merged(@{$param{common_control_options}},
538                         bug          => $ref,
539                         merge_with   => \@tomerge,
540                        );
541         };
542         if ($@) {
543             $errors++;
544             print {$transcript} "Failed to merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
545         }
546     } elsif ($ctl eq 'forcemerge') {
547         my @tomerge;
548         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
549             split(/\s+#?/,$matches[0]);
550         eval {
551              set_merged(@{$param{common_control_options}},
552                         bug          => $ref,
553                         merge_with   => \@tomerge,
554                         force        => 1,
555                         masterbug    => 1,
556                        );
557         };
558         if ($@) {
559             $errors++;
560             print {$transcript} "Failed to forcibly merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
561         }
562     } elsif ($ctl eq 'clone') {
563         my $origref = $matches[0];
564         my @newclonedids = split /\s+/, $matches[1];
565         my $newbugsneeded = scalar(@newclonedids);
566
567         eval {
568             my %new_clones;
569             clone_bug(@{$param{common_control_options}},
570                       bug => $ref,
571                       new_bugs => \@newclonedids,
572                       new_clones => \%new_clones,
573                      );
574             %{$param{clonebugs}} = (%{$param{clonebugs}},
575                                     %new_clones);
576         };
577         if ($@) {
578             $errors++;
579             print {$transcript} "Failed to clone $ref: ".cleanup_eval_fail($@,$debug)."\n";
580         }
581     } elsif ($ctl eq 'package') {
582         my @pkgs = split /\s+/, $matches[0];
583         if (scalar(@pkgs) > 0) {
584                 $param{limit}{package} = [@pkgs];
585                 print {$transcript} "Limiting to bugs with field 'package' containing at least one of ".join(', ',map {qq('$_')} @pkgs)."\n";
586                 print {$transcript} "Limit currently set to";
587                 for my $limit_field (keys %{$param{limit}}) {
588                     print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
589                 }
590                 print {$transcript} "\n";
591         } else {
592             $param{limit}{package} = [];
593             print {$transcript} "Limit cleared.\n\n";
594         }
595     } elsif ($ctl eq 'limit') {
596         my ($field,@options) = split /\s+/, $matches[0];
597         $field = lc($field);
598         if ($field =~ /^(?:clear|unset|blank)$/) {
599             %{$param{limit}} = ();
600             print {$transcript} "Limit cleared.\n\n";
601         }
602         elsif (exists $Debbugs::Status::fields{$field} or $field eq 'source') {
603             # %{$param{limit}} can actually contain regexes, but because they're
604             # not evaluated in Safe, DO NOT allow them through without
605             # fixing this.
606             $param{limit}{$field} = [@options];
607             print {$transcript} "Limiting to bugs with field '$field' containing at least one of ".join(', ',map {qq('$_')} @options)."\n";
608             print {$transcript} "Limit currently set to";
609             for my $limit_field (keys %{$param{limit}}) {
610                 print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
611             }
612             print {$transcript} "\n";
613         }
614         else {
615             print {$transcript} "Limit key $field not understood. Stopping processing here.\n\n";
616             $errors++;
617             # this needs to be fixed
618             syntax error for fixing it
619             last;
620         }
621     } elsif ($ctl eq 'affects') {
622         my $add_remove = $matches[1];
623         my $packages = $matches[2];
624         # if there isn't a package given, assume that we should unset
625         # affects; otherwise default to adding
626         if (not defined $packages or
627             not length $packages) {
628             $packages = '';
629             $add_remove ||= '=';
630         }
631         elsif (not defined $add_remove or
632                not length $add_remove) {
633             $add_remove = '+';
634         }
635         eval {
636              affects(@{$param{common_control_options}},
637                      bug => $ref,
638                      package     => [splitpackages($packages)],
639                      ($add_remove eq '+'?(add => 1):()),
640                      ($add_remove eq '-'?(remove => 1):()),
641                     );
642         };
643         if ($@) {
644             $errors++;
645             print {$transcript} "Failed to mark $ref as affecting package(s): ".cleanup_eval_fail($@,$debug)."\n";
646         }
647
648     } elsif ($ctl eq 'summary') {
649         my $summary_msg = length($matches[1])?$matches[1]:undef;
650         eval {
651             summary(@{$param{common_control_options}},
652                     bug          => $ref,
653                     summary      => $summary_msg,
654                    );
655         };
656         if ($@) {
657             $errors++;
658             print {$transcript} "Failed to give $ref a summary: ".cleanup_eval_fail($@,$debug)."\n";
659         }
660
661     } elsif ($ctl eq 'outlook') {
662         my $outlook_msg = length($matches[1])?$matches[1]:undef;
663         eval {
664             outlook(@{$param{common_control_options}},
665                     bug          => $ref,
666                     outlook      => $outlook_msg,
667                    );
668         };
669         if ($@) {
670             $errors++;
671             print {$transcript} "Failed to give $ref a outlook: ".cleanup_eval_fail($@,$debug)."\n";
672         }
673
674     } elsif ($ctl eq 'owner') {
675         my $newowner = $matches[1];
676         if ($newowner eq '!') {
677             $newowner = $param{replyto};
678         }
679         eval {
680             owner(@{$param{common_control_options}},
681                   bug          => $ref,
682                   owner        => $newowner,
683                  );
684         };
685         if ($@) {
686             $errors++;
687             print {$transcript} "Failed to mark $ref as having an owner: ".cleanup_eval_fail($@,$debug)."\n";
688         }
689     } elsif ($ctl eq 'noowner') {
690         eval {
691             owner(@{$param{common_control_options}},
692                   bug          => $ref,
693                   owner        => undef,
694                  );
695         };
696         if ($@) {
697             $errors++;
698             print {$transcript} "Failed to mark $ref as not having an owner: ".cleanup_eval_fail($@,$debug)."\n";
699         }
700     } elsif ($ctl eq 'unarchive') {
701          eval {
702               bug_unarchive(@{$param{common_control_options}},
703                             bug        => $ref,
704                            );
705          };
706          if ($@) {
707               $errors++;
708          }
709     } elsif ($ctl eq 'archive') {
710          eval {
711               bug_archive(@{$param{common_control_options}},
712                           bug => $ref,
713                           ignore_time => 1,
714                           archive_unarchived => 0,
715                          );
716          };
717          if ($@) {
718               $errors++;
719          }
720     }
721     if ($errors) {
722         ${$param{errors}}+=$errors;
723     }
724     return($errors,$terminate_control);
725 }
726
727 1;
728
729 __END__