]> git.donarmstrong.com Git - debbugs.git/blob - lib/Debbugs/Control/Service.pm
encode addresses before checking if they are valid
[debbugs.git] / lib / 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 Debbugs::MIME qw(encode_rfc1522);
97 use Params::Validate qw(:types validate_with);
98 use List::AllUtils qw(first);
99
100 my $bug_num_re = '-?\d+';
101 my %control_grammar =
102     (close => qr/(?i)^close\s+\#?($bug_num_re)(?:\s+(\d.*))?$/,
103      reassign => qr/(?i)^reassign\s+\#?($bug_num_re)\s+ # bug and command
104                     (?:(?:((?:src:|source:)?$config{package_name_re}) # new package
105                             (?:\s+((?:$config{package_name_re}\/)?
106                                     $config{package_version_re}))?)| # optional version
107                         ((?:src:|source:)?$config{package_name_re} # multiple package form
108                             (?:\s*\,\s*(?:src:|source:)?$config{package_name_re})+))
109                     \s*$/x,
110      reopen => qr/(?i)^reopen\s+\#?($bug_num_re)(?:\s+([\=\!]|(?:\S.*\S)))?$/,
111      found => qr{^(?:(?i)found)\s+\#?($bug_num_re)
112                  (?:\s+((?:$config{package_name_re}\/)?
113                          $config{package_version_re}
114                          # allow for multiple packages
115                          (?:\s*,\s*(?:$config{package_name_re}\/)?
116                              $config{package_version_re})*)
117                  )?$}x,
118      notfound => qr{^(?:(?i)notfound)\s+\#?($bug_num_re)
119                     \s+((?:$config{package_name_re}\/)?
120                         $config{package_version_re}
121                         # allow for multiple packages
122                         (?:\s*,\s*(?:$config{package_name_re}\/)?
123                             $config{package_version_re})*
124                     )$}x,
125      fixed => qr{^(?:(?i)fixed)\s+\#?($bug_num_re)
126              \s+((?:$config{package_name_re}\/)?
127                     $config{package_version_re}
128                 # allow for multiple packages
129                 (?:\s*,\s*(?:$config{package_name_re}\/)?
130                     $config{package_version_re})*)
131             \s*$}x,
132      notfixed => qr{^(?:(?i)notfixed)\s+\#?($bug_num_re)
133              \s+((?:$config{package_name_re}\/)?
134                     $config{package_version_re}
135                 # allow for multiple packages
136                 (?:\s*,\s*(?:$config{package_name_re}\/)?
137                     $config{package_version_re})*)
138             \s*$}x,
139      submitter => qr/(?i)^submitter\s+\#?($bug_num_re)\s+(\!|\S.*\S)$/,
140      forwarded => qr/(?i)^forwarded\s+\#?($bug_num_re)\s+(\S.*\S)$/,
141      notforwarded => qr/(?i)^notforwarded\s+\#?($bug_num_re)$/,
142      severity => qr/(?i)^(?:severity|priority)\s+\#?($bug_num_re)\s+([-0-9a-z]+)$/,
143      tag => qr/(?i)^tags?\s+\#?($bug_num_re)\s+(\S.*)$/,
144      block => qr/(?i)^(un)?block\s+\#?($bug_num_re)\s+(?:by|with)\s+(\S.*)?$/,
145      retitle => qr/(?i)^retitle\s+\#?($bug_num_re)\s+(\S.*\S)\s*$/,
146      unmerge => qr/(?i)^unmerge\s+\#?($bug_num_re)$/,
147      merge   => qr/(?i)^merge\s+#?($bug_num_re(\s+#?$bug_num_re)+)\s*$/,
148      forcemerge => qr/(?i)^forcemerge\s+\#?($bug_num_re(?:\s+\#?$bug_num_re)+)\s*$/,
149      clone => qr/(?i)^clone\s+#?($bug_num_re)\s+((?:$bug_num_re\s+)*$bug_num_re)\s*$/,
150      package => qr/(?i)^package\:?\s+(\S.*\S)?\s*$/,
151      limit => qr/(?i)^limit\:?\s+(\S.*\S)\s*$/,
152      affects => qr/(?i)^affects?\s+\#?($bug_num_re)(?:\s+((?:[=+-])?)\s*(\S.*)?)?\s*$/,
153      summary => qr/(?i)^summary\s+\#?($bug_num_re)\s*(.*)\s*$/,
154      outlook => qr/(?i)^outlook\s+\#?($bug_num_re)\s*(.*)\s*$/,
155      owner => qr/(?i)^owner\s+\#?($bug_num_re)\s+((?:\S.*\S)|\!)\s*$/,
156      noowner => qr/(?i)^noowner\s+\#?($bug_num_re)\s*$/,
157      unarchive => qr/(?i)^unarchive\s+#?($bug_num_re)$/,
158      archive => qr/(?i)^archive\s+#?($bug_num_re)$/,
159     );
160
161 sub valid_control {
162     my ($line,$matches) = @_;
163     my @matches;
164     for my $ctl (keys %control_grammar) {
165         if (@matches = $line =~ $control_grammar{$ctl}) {
166             @{$matches} = @matches if defined $matches and ref($matches) eq 'ARRAY';
167             return $ctl;
168         }
169     }
170     @{$matches} = () if defined $matches and ref($matches) eq 'ARRAY';
171     return undef;
172 }
173
174 sub control_line {
175     my %param =
176         validate_with(params => \@_,
177                       spec => {line => {type => SCALAR,
178                                        },
179                                clonebugs => {type => HASHREF,
180                                             },
181                                common_control_options => {type => ARRAYREF,
182                                                          },
183                                errors => {type => SCALARREF,
184                                          },
185                                transcript => {type => HANDLE,
186                                              },
187                                debug => {type => SCALAR,
188                                          default => 0,
189                                         },
190                                ok => {type => SCALARREF,
191                                      },
192                                limit => {type => HASHREF,
193                                         },
194                                replyto => {type => SCALAR,
195                                           },
196                               },
197                      );
198     my $line = $param{line};
199     my @matches;
200     my $ctl = valid_control($line,\@matches);
201     my $transcript = $param{transcript};
202     my $debug = $param{debug};
203     if (not defined $ctl) {
204         ${$param{errors}}++;
205         print {$param{transcript}} "Unknown command or invalid options to control\n";
206         return;
207     }
208     # in almost all cases, the first match is the bug; the exception
209     # to this is block.
210     my $ref = $matches[0];
211     if (defined $ref) {
212         $ref = $param{clonebugs}{$ref} if exists $param{clonebugs}{$ref};
213     }
214     ${$param{ok}}++;
215     my $errors = 0;
216     my $terminate_control = 0;
217
218     if ($ctl eq 'close') {
219         if (defined $matches[1]) {
220             eval {
221                 set_fixed(@{$param{common_control_options}},
222                           bug   => $ref,
223                           fixed => $matches[1],
224                           add   => 1,
225                          );
226             };
227             if ($@) {
228                 $errors++;
229                 print {$transcript} "Failed to add fixed version '$matches[1]' to $ref: ".cleanup_eval_fail($@,$debug)."\n";
230             }
231         }
232         eval {
233             set_done(@{$param{common_control_options}},
234                      done      => 1,
235                      bug       => $ref,
236                      reopen    => 0,
237                      notify_submitter => 1,
238                      clear_fixed => 0,
239                     );
240         };
241         if ($@) {
242             $errors++;
243             print {$transcript} "Failed to mark $ref as done: ".cleanup_eval_fail($@,$debug)."\n";
244         }
245     } elsif ($ctl eq 'reassign') {
246         my @new_packages;
247         if (not defined $matches[1]) {
248             push @new_packages, split /\s*\,\s*/,$matches[3];
249         }
250         else {
251             push @new_packages, $matches[1];
252         }
253         @new_packages = map {y/A-Z/a-z/; s/^(?:src|source):/src:/; $_;} @new_packages;
254         my $version= $matches[2];
255         eval {
256             set_package(@{$param{common_control_options}},
257                         bug          => $ref,
258                         package      => \@new_packages,
259                        );
260             # if there is a version passed, we make an internal call
261             # to set_found
262             if (defined($version) && length $version) {
263                 set_found(@{$param{common_control_options}},
264                           bug   => $ref,
265                           found => $version,
266                          );
267             }
268         };
269         if ($@) {
270             $errors++;
271             print {$transcript} "Failed to clear fixed versions and reopen on $ref: ".cleanup_eval_fail($@,$debug)."\n";
272         }
273     } elsif ($ctl eq 'reopen') {
274         my $new_submitter = $matches[1];
275         if (defined $new_submitter) {
276             if ($new_submitter eq '=') {
277                 undef $new_submitter;
278             }
279             elsif ($new_submitter eq '!') {
280                 $new_submitter = $param{replyto};
281             }
282         }
283         eval {
284             set_done(@{$param{common_control_options}},
285                      bug          => $ref,
286                      reopen       => 1,
287                      defined $new_submitter? (submitter    => $new_submitter):(),
288                     );
289         };
290         if ($@) {
291             $errors++;
292             print {$transcript} "Failed to reopen $ref: ".cleanup_eval_fail($@,$debug)."\n";
293         }
294     } elsif ($ctl eq 'found') {
295         my @versions;
296         if (defined $matches[1]) {
297             @versions = split /\s*,\s*/,$matches[1];
298             eval {
299                 set_found(@{$param{common_control_options}},
300                           bug          => $ref,
301                           found        => \@versions,
302                           add          => 1,
303                          );
304             };
305             if ($@) {
306                 $errors++;
307                 print {$transcript} "Failed to add found on $ref: ".cleanup_eval_fail($@,$debug)."\n";
308             }
309         }
310         else {
311             eval {
312                 set_fixed(@{$param{common_control_options}},
313                           bug          => $ref,
314                           fixed        => [],
315                           reopen       => 1,
316                          );
317             };
318             if ($@) {
319                 $errors++;
320                 print {$transcript} "Failed to clear fixed versions and reopen on $ref: ".cleanup_eval_fail($@,$debug)."\n";
321             }
322         }
323     }
324     elsif ($ctl eq 'notfound') {
325         my @versions;
326         @versions = split /\s*,\s*/,$matches[1];
327         eval {
328             set_found(@{$param{common_control_options}},
329                       bug          => $ref,
330                       found        => \@versions,
331                       remove       => 1,
332                      );
333         };
334         if ($@) {
335             $errors++;
336             print {$transcript} "Failed to remove found on $ref: ".cleanup_eval_fail($@,$debug)."\n";
337         }
338     }
339     elsif ($ctl eq 'fixed') {
340         my @versions;
341         @versions = split /\s*,\s*/,$matches[1];
342         eval {
343             set_fixed(@{$param{common_control_options}},
344                       bug          => $ref,
345                       fixed        => \@versions,
346                       add          => 1,
347                      );
348         };
349         if ($@) {
350             $errors++;
351             print {$transcript} "Failed to add fixed on $ref: ".cleanup_eval_fail($@,$debug)."\n";
352         }
353     }
354     elsif ($ctl eq 'notfixed') {
355         my @versions;
356         @versions = split /\s*,\s*/,$matches[1];
357         eval {
358             set_fixed(@{$param{common_control_options}},
359                       bug          => $ref,
360                       fixed        => \@versions,
361                       remove       => 1,
362                      );
363         };
364         if ($@) {
365             $errors++;
366             print {$transcript} "Failed to remove fixed on $ref: ".cleanup_eval_fail($@,$debug)."\n";
367         }
368     }
369     elsif ($ctl eq 'submitter') {
370         my $newsubmitter = $matches[1] eq '!' ? $param{replyto} : $matches[1];
371         if (not Mail::RFC822::Address::valid(encode_rfc1522($newsubmitter))) {
372              print {$transcript} "$newsubmitter is not a valid e-mail address; not changing submitter\n";
373              $errors++;
374         }
375         else {
376             eval {
377                 set_submitter(@{$param{common_control_options}},
378                               bug       => $ref,
379                               submitter => $newsubmitter,
380                              );
381             };
382             if ($@) {
383                 $errors++;
384                 print {$transcript} "Failed to set submitter on $ref: ".cleanup_eval_fail($@,$debug)."\n";
385             }
386         }
387     } elsif ($ctl eq 'forwarded') {
388         my $forward_to= $matches[1];
389         eval {
390             set_forwarded(@{$param{common_control_options}},
391                           bug          => $ref,
392                           forwarded    => $forward_to,
393                           );
394         };
395         if ($@) {
396             $errors++;
397             print {$transcript} "Failed to set the forwarded-to-address of $ref: ".cleanup_eval_fail($@,$debug)."\n";
398         }
399     } elsif ($ctl eq 'notforwarded') {
400         eval {
401             set_forwarded(@{$param{common_control_options}},
402                           bug          => $ref,
403                           forwarded    => undef,
404                           );
405         };
406         if ($@) {
407             $errors++;
408             print {$transcript} "Failed to clear the forwarded-to-address of $ref: ".cleanup_eval_fail($@,$debug)."\n";
409         }
410     } elsif ($ctl eq 'severity') {
411         my $newseverity= $matches[1];
412         if (exists $config{obsolete_severities}{$newseverity}) {
413             print {$transcript} "Severity level \`$newseverity' is obsolete. " .
414                  "Use $config{obsolete_severities}{$newseverity} instead.\n\n";
415                 $errors++;
416         } elsif (not defined first {$_ eq $newseverity}
417             (@{$config{severity_list}}, $config{default_severity})) {
418              print {$transcript} "Severity level \`$newseverity' is not known.\n".
419                   "Recognized are: $config{show_severities}.\n\n";
420             $errors++;
421         } else {
422             eval {
423                 set_severity(@{$param{common_control_options}},
424                              bug => $ref,
425                              severity => $newseverity,
426                             );
427             };
428             if ($@) {
429                 $errors++;
430                 print {$transcript} "Failed to set severity of $config{bug} $ref to $newseverity: ".cleanup_eval_fail($@,$debug)."\n";
431             }
432         }
433     } elsif ($ctl eq 'tag') {
434         my $tags = $matches[1];
435         my @tags = map {m/^([+=-])(.+)/ ? ($1,$2):($_)} split /[\s,]+/, $tags;
436         # this is an array of hashrefs which contain two elements, the
437         # first of which is the array of tags, the second is the
438         # option to pass to set_tag (we use a hashref here to make it
439         # more obvious what is happening)
440         my @tag_operations;
441         my @badtags;
442         for my $tag (@tags) {
443             if ($tag =~ /^[=+-]$/) {
444                 if ($tag eq '=') {
445                     @tag_operations = {tags => [],
446                                        option => [],
447                                       };
448                 }
449                 elsif ($tag eq '-') {
450                     push @tag_operations,
451                         {tags => [],
452                          option => [remove => 1],
453                         };
454                 }
455                 elsif ($tag eq '+') {
456                     push @tag_operations,
457                         {tags => [],
458                          option => [add => 1],
459                         };
460                 }
461                 next;
462             }
463             if (not defined first {$_ eq $tag} @{$config{tags}}) {
464                 push @badtags, $tag;
465                 next;
466             }
467             if (not @tag_operations) {
468                 @tag_operations = {tags => [],
469                                    option => [add => 1],
470                                   };
471             }
472             push @{$tag_operations[-1]{tags}},$tag;
473         }
474         if (@badtags) {
475             print {$transcript} "Unknown tag/s: ".join(', ', @badtags).".\n".
476                  "Recognized are: ".join(' ', @{$config{tags}}).".\n\n";
477             $errors++;
478         }
479         eval {
480             for my $operation (@tag_operations) {
481                 set_tag(@{$param{common_control_options}},
482                         bug => $ref,
483                         tag => [@{$operation->{tags}}],
484                         warn_on_bad_tags => 0, # don't warn on bad tags,
485                         # 'cause we do that above
486                         @{$operation->{option}},
487                        );
488             }
489         };
490         if ($@) {
491             # we intentionally have two errors here if there is a bad
492             # tag and the above fails for some reason
493             $errors++;
494             print {$transcript} "Failed to alter tags of $config{bug} $ref: ".cleanup_eval_fail($@,$debug)."\n";
495         }
496     } elsif ($ctl eq 'block') {
497         my $add_remove = defined $matches[0] && $matches[0] eq 'un';
498         $ref = $matches[1];
499         $ref = exists $param{clonebugs}{$ref} ? $param{clonebugs}{$ref} : $ref;
500         my @blockers = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_} split /[\s,]+/, $matches[2];
501         eval {
502              set_blocks(@{$param{common_control_options}},
503                         bug          => $ref,
504                         block        => \@blockers,
505                         $add_remove ? (remove => 1):(add => 1),
506                        );
507         };
508         if ($@) {
509             $errors++;
510             print {$transcript} "Failed to set blocking bugs of $ref: ".cleanup_eval_fail($@,$debug)."\n";
511         }
512     } elsif ($ctl eq 'retitle') {
513         my $newtitle= $matches[1];
514         eval {
515              set_title(@{$param{common_control_options}},
516                        bug          => $ref,
517                        title        => $newtitle,
518                       );
519         };
520         if ($@) {
521             $errors++;
522             print {$transcript} "Failed to set the title of $ref: ".cleanup_eval_fail($@,$debug)."\n";
523         }
524     } elsif ($ctl eq 'unmerge') {
525         eval {
526              set_merged(@{$param{common_control_options}},
527                         bug          => $ref,
528                        );
529         };
530         if ($@) {
531             $errors++;
532             print {$transcript} "Failed to unmerge $ref: ".cleanup_eval_fail($@,$debug)."\n";
533         }
534     } elsif ($ctl eq 'merge') {
535         my @tomerge;
536         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
537             split(/\s+#?/,$matches[0]);
538         eval {
539              set_merged(@{$param{common_control_options}},
540                         bug          => $ref,
541                         merge_with   => \@tomerge,
542                        );
543         };
544         if ($@) {
545             $errors++;
546             print {$transcript} "Failed to merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
547         }
548     } elsif ($ctl eq 'forcemerge') {
549         my @tomerge;
550         ($ref,@tomerge) = map {exists $param{clonebugs}{$_}?$param{clonebugs}{$_}:$_}
551             split(/\s+#?/,$matches[0]);
552         eval {
553              set_merged(@{$param{common_control_options}},
554                         bug          => $ref,
555                         merge_with   => \@tomerge,
556                         force        => 1,
557                         masterbug    => 1,
558                        );
559         };
560         if ($@) {
561             $errors++;
562             print {$transcript} "Failed to forcibly merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
563         }
564     } elsif ($ctl eq 'clone') {
565         my @newclonedids = split /\s+/, $matches[1];
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__