]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/Control/Service.pm
52d7d10dab6f14aa3794c42a8dde0e728140ebef
[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 Exporter qw(import);
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::AllUtils qw(first);
98
99 my $bug_num_re = '-?\d+';
100 my %control_grammar =
101     (close => qr/(?i)^close\s+\#?($bug_num_re)(?:\s+(\d.*))?$/,
102      reassign => qr/(?i)^reassign\s+\#?($bug_num_re)\s+ # bug and command
103                     (?:(?:((?:src:|source:)?$config{package_name_re}) # new package
104                             (?:\s+((?:$config{package_name_re}\/)?
105                                     $config{package_version_re}))?)| # optional version
106                         ((?:src:|source:)?$config{package_name_re} # multiple package form
107                             (?:\s*\,\s*(?:src:|source:)?$config{package_name_re})+))
108                     \s*$/x,
109      reopen => qr/(?i)^reopen\s+\#?($bug_num_re)(?:\s+([\=\!]|(?:\S.*\S)))?$/,
110      found => qr{^(?:(?i)found)\s+\#?($bug_num_re)
111                  (?:\s+((?:$config{package_name_re}\/)?
112                          $config{package_version_re}
113                          # allow for multiple packages
114                          (?:\s*,\s*(?:$config{package_name_re}\/)?
115                              $config{package_version_re})*)
116                  )?$}x,
117      notfound => qr{^(?:(?i)notfound)\s+\#?($bug_num_re)
118                     \s+((?:$config{package_name_re}\/)?
119                         $config{package_version_re}
120                         # allow for multiple packages
121                         (?:\s*,\s*(?:$config{package_name_re}\/)?
122                             $config{package_version_re})*
123                     )$}x,
124      fixed => qr{^(?:(?i)fixed)\s+\#?($bug_num_re)
125              \s+((?:$config{package_name_re}\/)?
126                     $config{package_version_re}
127                 # allow for multiple packages
128                 (?:\s*,\s*(?:$config{package_name_re}\/)?
129                     $config{package_version_re})*)
130             \s*$}x,
131      notfixed => qr{^(?:(?i)notfixed)\s+\#?($bug_num_re)
132              \s+((?:$config{package_name_re}\/)?
133                     $config{package_version_re}
134                 # allow for multiple packages
135                 (?:\s*,\s*(?:$config{package_name_re}\/)?
136                     $config{package_version_re})*)
137             \s*$}x,
138      submitter => qr/(?i)^submitter\s+\#?($bug_num_re)\s+(\!|\S.*\S)$/,
139      forwarded => qr/(?i)^forwarded\s+\#?($bug_num_re)\s+(\S.*\S)$/,
140      notforwarded => qr/(?i)^notforwarded\s+\#?($bug_num_re)$/,
141      severity => qr/(?i)^(?:severity|priority)\s+\#?($bug_num_re)\s+([-0-9a-z]+)$/,
142      tag => qr/(?i)^tags?\s+\#?($bug_num_re)\s+(\S.*)$/,
143      block => qr/(?i)^(un)?block\s+\#?($bug_num_re)\s+(?:by|with)\s+(\S.*)?$/,
144      retitle => qr/(?i)^retitle\s+\#?($bug_num_re)\s+(\S.*\S)\s*$/,
145      unmerge => qr/(?i)^unmerge\s+\#?($bug_num_re)$/,
146      merge   => qr/(?i)^merge\s+#?($bug_num_re(\s+#?$bug_num_re)+)\s*$/,
147      forcemerge => qr/(?i)^forcemerge\s+\#?($bug_num_re(?:\s+\#?$bug_num_re)+)\s*$/,
148      clone => qr/(?i)^clone\s+#?($bug_num_re)\s+((?:$bug_num_re\s+)*$bug_num_re)\s*$/,
149      package => qr/(?i)^package\:?\s+(\S.*\S)?\s*$/,
150      limit => qr/(?i)^limit\:?\s+(\S.*\S)\s*$/,
151      affects => qr/(?i)^affects?\s+\#?($bug_num_re)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/,
152      summary => qr/(?i)^summary\s+\#?($bug_num_re)\s*(.*)\s*$/,
153      outlook => qr/(?i)^outlook\s+\#?($bug_num_re)\s*(.*)\s*$/,
154      owner => qr/(?i)^owner\s+\#?($bug_num_re)\s+((?:\S.*\S)|\!)\s*$/,
155      noowner => qr/(?i)^noowner\s+\#?($bug_num_re)\s*$/,
156      unarchive => qr/(?i)^unarchive\s+#?($bug_num_re)$/,
157      archive => qr/(?i)^archive\s+#?($bug_num_re)$/,
158     );
159
160 sub valid_control {
161     my ($line,$matches) = @_;
162     my @matches;
163     for my $ctl (keys %control_grammar) {
164         if (@matches = $line =~ $control_grammar{$ctl}) {
165             @{$matches} = @matches if defined $matches and ref($matches) eq 'ARRAY';
166             return $ctl;
167         }
168     }
169     @{$matches} = () if defined $matches and ref($matches) eq 'ARRAY';
170     return undef;
171 }
172
173 sub control_line {
174     my %param =
175         validate_with(params => \@_,
176                       spec => {line => {type => SCALAR,
177                                        },
178                                clonebugs => {type => HASHREF,
179                                             },
180                                common_control_options => {type => ARRAYREF,
181                                                          },
182                                errors => {type => SCALARREF,
183                                          },
184                                transcript => {type => HANDLE,
185                                              },
186                                debug => {type => SCALAR,
187                                          default => 0,
188                                         },
189                                ok => {type => SCALARREF,
190                                      },
191                                limit => {type => HASHREF,
192                                         },
193                                replyto => {type => SCALAR,
194                                           },
195                               },
196                      );
197     my $line = $param{line};
198     my @matches;
199     my $ctl = valid_control($line,\@matches);
200     my $transcript = $param{transcript};
201     my $debug = $param{debug};
202     if (not defined $ctl) {
203         ${$param{errors}}++;
204         print {$param{transcript}} "Unknown command or invalid options to control\n";
205         return;
206     }
207     # in almost all cases, the first match is the bug; the exception
208     # to this is block.
209     my $ref = $matches[0];
210     if (defined $ref) {
211         $ref = $param{clonebugs}{$ref} if exists $param{clonebugs}{$ref};
212     }
213     ${$param{ok}}++;
214     my $errors = 0;
215     my $terminate_control = 0;
216
217     if ($ctl eq 'close') {
218         if (defined $matches[1]) {
219             eval {
220                 set_fixed(@{$param{common_control_options}},
221                           bug   => $ref,
222                           fixed => $matches[1],
223                           add   => 1,
224                          );
225             };
226             if ($@) {
227                 $errors++;
228                 print {$transcript} "Failed to add fixed version '$matches[1]' to $ref: ".cleanup_eval_fail($@,$debug)."\n";
229             }
230         }
231         eval {
232             set_done(@{$param{common_control_options}},
233                      done      => 1,
234                      bug       => $ref,
235                      reopen    => 0,
236                      notify_submitter => 1,
237                      clear_fixed => 0,
238                     );
239         };
240         if ($@) {
241             $errors++;
242             print {$transcript} "Failed to mark $ref as done: ".cleanup_eval_fail($@,$debug)."\n";
243         }
244     } elsif ($ctl eq 'reassign') {
245         my @new_packages;
246         if (not defined $matches[1]) {
247             push @new_packages, split /\s*\,\s*/,$matches[3];
248         }
249         else {
250             push @new_packages, $matches[1];
251         }
252         @new_packages = map {y/A-Z/a-z/; s/^(?:src|source):/src:/; $_;} @new_packages;
253         my $version= $matches[2];
254         eval {
255             set_package(@{$param{common_control_options}},
256                         bug          => $ref,
257                         package      => \@new_packages,
258                        );
259             # if there is a version passed, we make an internal call
260             # to set_found
261             if (defined($version) && length $version) {
262                 set_found(@{$param{common_control_options}},
263                           bug   => $ref,
264                           found => $version,
265                          );
266             }
267         };
268         if ($@) {
269             $errors++;
270             print {$transcript} "Failed to clear fixed versions and reopen on $ref: ".cleanup_eval_fail($@,$debug)."\n";
271         }
272     } elsif ($ctl eq 'reopen') {
273         my $new_submitter = $matches[1];
274         if (defined $new_submitter) {
275             if ($new_submitter eq '=') {
276                 undef $new_submitter;
277             }
278             elsif ($new_submitter eq '!') {
279                 $new_submitter = $param{replyto};
280             }
281         }
282         eval {
283             set_done(@{$param{common_control_options}},
284                      bug          => $ref,
285                      reopen       => 1,
286                      defined $new_submitter? (submitter    => $new_submitter):(),
287                     );
288         };
289         if ($@) {
290             $errors++;
291             print {$transcript} "Failed to reopen $ref: ".cleanup_eval_fail($@,$debug)."\n";
292         }
293     } elsif ($ctl eq 'found') {
294         my @versions;
295         if (defined $matches[1]) {
296             @versions = split /\s*,\s*/,$matches[1];
297             eval {
298                 set_found(@{$param{common_control_options}},
299                           bug          => $ref,
300                           found        => \@versions,
301                           add          => 1,
302                          );
303             };
304             if ($@) {
305                 $errors++;
306                 print {$transcript} "Failed to add found on $ref: ".cleanup_eval_fail($@,$debug)."\n";
307             }
308         }
309         else {
310             eval {
311                 set_fixed(@{$param{common_control_options}},
312                           bug          => $ref,
313                           fixed        => [],
314                           reopen       => 1,
315                          );
316             };
317             if ($@) {
318                 $errors++;
319                 print {$transcript} "Failed to clear fixed versions and reopen on $ref: ".cleanup_eval_fail($@,$debug)."\n";
320             }
321         }
322     }
323     elsif ($ctl eq 'notfound') {
324         my @versions;
325         @versions = split /\s*,\s*/,$matches[1];
326         eval {
327             set_found(@{$param{common_control_options}},
328                       bug          => $ref,
329                       found        => \@versions,
330                       remove       => 1,
331                      );
332         };
333         if ($@) {
334             $errors++;
335             print {$transcript} "Failed to remove found on $ref: ".cleanup_eval_fail($@,$debug)."\n";
336         }
337     }
338     elsif ($ctl eq 'fixed') {
339         my @versions;
340         @versions = split /\s*,\s*/,$matches[1];
341         eval {
342             set_fixed(@{$param{common_control_options}},
343                       bug          => $ref,
344                       fixed        => \@versions,
345                       add          => 1,
346                      );
347         };
348         if ($@) {
349             $errors++;
350             print {$transcript} "Failed to add fixed on $ref: ".cleanup_eval_fail($@,$debug)."\n";
351         }
352     }
353     elsif ($ctl eq 'notfixed') {
354         my @versions;
355         @versions = split /\s*,\s*/,$matches[1];
356         eval {
357             set_fixed(@{$param{common_control_options}},
358                       bug          => $ref,
359                       fixed        => \@versions,
360                       remove       => 1,
361                      );
362         };
363         if ($@) {
364             $errors++;
365             print {$transcript} "Failed to remove fixed on $ref: ".cleanup_eval_fail($@,$debug)."\n";
366         }
367     }
368     elsif ($ctl eq 'submitter') {
369         my $newsubmitter = $matches[1] eq '!' ? $param{replyto} : $matches[1];
370         if (not Mail::RFC822::Address::valid($newsubmitter)) {
371              print {$transcript} "$newsubmitter is not a valid e-mail address; not changing submitter\n";
372              $errors++;
373         }
374         else {
375             eval {
376                 set_submitter(@{$param{common_control_options}},
377                               bug       => $ref,
378                               submitter => $newsubmitter,
379                              );
380             };
381             if ($@) {
382                 $errors++;
383                 print {$transcript} "Failed to set submitter on $ref: ".cleanup_eval_fail($@,$debug)."\n";
384             }
385         }
386     } elsif ($ctl eq 'forwarded') {
387         my $forward_to= $matches[1];
388         eval {
389             set_forwarded(@{$param{common_control_options}},
390                           bug          => $ref,
391                           forwarded    => $forward_to,
392                           );
393         };
394         if ($@) {
395             $errors++;
396             print {$transcript} "Failed to set the forwarded-to-address of $ref: ".cleanup_eval_fail($@,$debug)."\n";
397         }
398     } elsif ($ctl eq 'notforwarded') {
399         eval {
400             set_forwarded(@{$param{common_control_options}},
401                           bug          => $ref,
402                           forwarded    => undef,
403                           );
404         };
405         if ($@) {
406             $errors++;
407             print {$transcript} "Failed to clear the forwarded-to-address of $ref: ".cleanup_eval_fail($@,$debug)."\n";
408         }
409     } elsif ($ctl eq 'severity') {
410         my $newseverity= $matches[1];
411         if (exists $config{obsolete_severities}{$newseverity}) {
412             print {$transcript} "Severity level \`$newseverity' is obsolete. " .
413                  "Use $config{obsolete_severities}{$newseverity} instead.\n\n";
414                 $errors++;
415         } elsif (not defined first {$_ eq $newseverity}
416             (@{$config{severity_list}}, $config{default_severity})) {
417              print {$transcript} "Severity level \`$newseverity' is not known.\n".
418                   "Recognized are: $config{show_severities}.\n\n";
419             $errors++;
420         } else {
421             eval {
422                 set_severity(@{$param{common_control_options}},
423                              bug => $ref,
424                              severity => $newseverity,
425                             );
426             };
427             if ($@) {
428                 $errors++;
429                 print {$transcript} "Failed to set severity of $config{bug} $ref to $newseverity: ".cleanup_eval_fail($@,$debug)."\n";
430             }
431         }
432     } elsif ($ctl eq 'tag') {
433         my $tags = $matches[1];
434         my @tags = map {m/^([+=-])(.+)/ ? ($1,$2):($_)} split /[\s,]+/, $tags;
435         # this is an array of hashrefs which contain two elements, the
436         # first of which is the array of tags, the second is the
437         # option to pass to set_tag (we use a hashref here to make it
438         # more obvious what is happening)
439         my @tag_operations;
440         my @badtags;
441         for my $tag (@tags) {
442             if ($tag =~ /^[=+-]$/) {
443                 if ($tag eq '=') {
444                     @tag_operations = {tags => [],
445                                        option => [],
446                                       };
447                 }
448                 elsif ($tag eq '-') {
449                     push @tag_operations,
450                         {tags => [],
451                          option => [remove => 1],
452                         };
453                 }
454                 elsif ($tag eq '+') {
455                     push @tag_operations,
456                         {tags => [],
457                          option => [add => 1],
458                         };
459                 }
460                 next;
461             }
462             if (not defined first {$_ eq $tag} @{$config{tags}}) {
463                 push @badtags, $tag;
464                 next;
465             }
466             if (not @tag_operations) {
467                 @tag_operations = {tags => [],
468                                    option => [add => 1],
469                                   };
470             }
471             push @{$tag_operations[-1]{tags}},$tag;
472         }
473         if (@badtags) {
474             print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
475                  "Recognized are: ".join(' ', @{$config{tags}}).".\n\n";
476             $errors++;
477         }
478         eval {
479             for my $operation (@tag_operations) {
480                 set_tag(@{$param{common_control_options}},
481                         bug => $ref,
482                         tag => [@{$operation->{tags}}],
483                         warn_on_bad_tags => 0, # don't warn on bad tags,
484                         # 'cause we do that above
485                         @{$operation->{option}},
486                        );
487             }
488         };
489         if ($@) {
490             # we intentionally have two errors here if there is a bad
491             # tag and the above fails for some reason
492             $errors++;
493             print {$transcript} "Failed to alter tags of $config{bug} $ref: ".cleanup_eval_fail($@,$debug)."\n";
494         }
495     } elsif ($ctl eq 'block') {
496         my $add_remove = defined $matches[0] && $matches[0] eq 'un';
497         $ref = $matches[1];
498         $ref = exists $param{clonebugs}{$ref} ? $param{clonebugs}{$ref} : $ref;
499         my @blockers = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_} split /[\s,]+/, $matches[2];
500         eval {
501              set_blocks(@{$param{common_control_options}},
502                         bug          => $ref,
503                         block        => \@blockers,
504                         $add_remove ? (remove => 1):(add => 1),
505                        );
506         };
507         if ($@) {
508             $errors++;
509             print {$transcript} "Failed to set blocking bugs of $ref: ".cleanup_eval_fail($@,$debug)."\n";
510         }
511     } elsif ($ctl eq 'retitle') {
512         my $newtitle= $matches[1];
513         eval {
514              set_title(@{$param{common_control_options}},
515                        bug          => $ref,
516                        title        => $newtitle,
517                       );
518         };
519         if ($@) {
520             $errors++;
521             print {$transcript} "Failed to set the title of $ref: ".cleanup_eval_fail($@,$debug)."\n";
522         }
523     } elsif ($ctl eq 'unmerge') {
524         eval {
525              set_merged(@{$param{common_control_options}},
526                         bug          => $ref,
527                        );
528         };
529         if ($@) {
530             $errors++;
531             print {$transcript} "Failed to unmerge $ref: ".cleanup_eval_fail($@,$debug)."\n";
532         }
533     } elsif ($ctl eq 'merge') {
534         my @tomerge;
535         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
536             split(/\s+#?/,$matches[0]);
537         eval {
538              set_merged(@{$param{common_control_options}},
539                         bug          => $ref,
540                         merge_with   => \@tomerge,
541                        );
542         };
543         if ($@) {
544             $errors++;
545             print {$transcript} "Failed to merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
546         }
547     } elsif ($ctl eq 'forcemerge') {
548         my @tomerge;
549         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
550             split(/\s+#?/,$matches[0]);
551         eval {
552              set_merged(@{$param{common_control_options}},
553                         bug          => $ref,
554                         merge_with   => \@tomerge,
555                         force        => 1,
556                         masterbug    => 1,
557                        );
558         };
559         if ($@) {
560             $errors++;
561             print {$transcript} "Failed to forcibly merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
562         }
563     } elsif ($ctl eq 'clone') {
564         my @newclonedids = split /\s+/, $matches[1];
565
566         eval {
567             my %new_clones;
568             clone_bug(@{$param{common_control_options}},
569                       bug => $ref,
570                       new_bugs => \@newclonedids,
571                       new_clones => \%new_clones,
572                      );
573             %{$param{clonebugs}} = (%{$param{clonebugs}},
574                                     %new_clones);
575         };
576         if ($@) {
577             $errors++;
578             print {$transcript} "Failed to clone $ref: ".cleanup_eval_fail($@,$debug)."\n";
579         }
580     } elsif ($ctl eq 'package') {
581         my @pkgs = split /\s+/, $matches[0];
582         if (scalar(@pkgs) > 0) {
583                 $param{limit}{package} = [@pkgs];
584                 print {$transcript} "Limiting to bugs with field 'package' containing at least one of ".join(', ',map {qq('$_')} @pkgs)."\n";
585                 print {$transcript} "Limit currently set to";
586                 for my $limit_field (keys %{$param{limit}}) {
587                     print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
588                 }
589                 print {$transcript} "\n";
590         } else {
591             $param{limit}{package} = [];
592             print {$transcript} "Limit cleared.\n\n";
593         }
594     } elsif ($ctl eq 'limit') {
595         my ($field,@options) = split /\s+/, $matches[0];
596         $field = lc($field);
597         if ($field =~ /^(?:clear|unset|blank)$/) {
598             %{$param{limit}} = ();
599             print {$transcript} "Limit cleared.\n\n";
600         }
601         elsif (exists $Debbugs::Status::fields{$field} or $field eq 'source') {
602             # %{$param{limit}} can actually contain regexes, but because they're
603             # not evaluated in Safe, DO NOT allow them through without
604             # fixing this.
605             $param{limit}{$field} = [@options];
606             print {$transcript} "Limiting to bugs with field '$field' containing at least one of ".join(', ',map {qq('$_')} @options)."\n";
607             print {$transcript} "Limit currently set to";
608             for my $limit_field (keys %{$param{limit}}) {
609                 print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
610             }
611             print {$transcript} "\n";
612         }
613         else {
614             print {$transcript} "Limit key $field not understood. Stopping processing here.\n\n";
615             $errors++;
616             # this needs to be fixed
617             syntax error for fixing it
618             last;
619         }
620     } elsif ($ctl eq 'affects') {
621         my $add_remove = $matches[1];
622         my $packages = $matches[2];
623         # if there isn't a package given, assume that we should unset
624         # affects; otherwise default to adding
625         if (not defined $packages or
626             not length $packages) {
627             $packages = '';
628             $add_remove ||= '=';
629         }
630         elsif (not defined $add_remove or
631                not length $add_remove) {
632             $add_remove = '+';
633         }
634         eval {
635              affects(@{$param{common_control_options}},
636                      bug => $ref,
637                      package     => [splitpackages($packages)],
638                      ($add_remove eq '+'?(add => 1):()),
639                      ($add_remove eq '-'?(remove => 1):()),
640                     );
641         };
642         if ($@) {
643             $errors++;
644             print {$transcript} "Failed to mark $ref as affecting package(s): ".cleanup_eval_fail($@,$debug)."\n";
645         }
646
647     } elsif ($ctl eq 'summary') {
648         my $summary_msg = length($matches[1])?$matches[1]:undef;
649         eval {
650             summary(@{$param{common_control_options}},
651                     bug          => $ref,
652                     summary      => $summary_msg,
653                    );
654         };
655         if ($@) {
656             $errors++;
657             print {$transcript} "Failed to give $ref a summary: ".cleanup_eval_fail($@,$debug)."\n";
658         }
659
660     } elsif ($ctl eq 'outlook') {
661         my $outlook_msg = length($matches[1])?$matches[1]:undef;
662         eval {
663             outlook(@{$param{common_control_options}},
664                     bug          => $ref,
665                     outlook      => $outlook_msg,
666                    );
667         };
668         if ($@) {
669             $errors++;
670             print {$transcript} "Failed to give $ref a outlook: ".cleanup_eval_fail($@,$debug)."\n";
671         }
672
673     } elsif ($ctl eq 'owner') {
674         my $newowner = $matches[1];
675         if ($newowner eq '!') {
676             $newowner = $param{replyto};
677         }
678         eval {
679             owner(@{$param{common_control_options}},
680                   bug          => $ref,
681                   owner        => $newowner,
682                  );
683         };
684         if ($@) {
685             $errors++;
686             print {$transcript} "Failed to mark $ref as having an owner: ".cleanup_eval_fail($@,$debug)."\n";
687         }
688     } elsif ($ctl eq 'noowner') {
689         eval {
690             owner(@{$param{common_control_options}},
691                   bug          => $ref,
692                   owner        => undef,
693                  );
694         };
695         if ($@) {
696             $errors++;
697             print {$transcript} "Failed to mark $ref as not having an owner: ".cleanup_eval_fail($@,$debug)."\n";
698         }
699     } elsif ($ctl eq 'unarchive') {
700          eval {
701               bug_unarchive(@{$param{common_control_options}},
702                             bug        => $ref,
703                            );
704          };
705          if ($@) {
706               $errors++;
707          }
708     } elsif ($ctl eq 'archive') {
709          eval {
710               bug_archive(@{$param{common_control_options}},
711                           bug => $ref,
712                           ignore_time => 1,
713                           archive_unarchived => 0,
714                          );
715          };
716          if ($@) {
717               $errors++;
718          }
719     }
720     if ($errors) {
721         ${$param{errors}}+=$errors;
722     }
723     return($errors,$terminate_control);
724 }
725
726 1;
727
728 __END__