]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/Control/Service.pm
Prefer "use Exporter qw(import)" to inheriting from it
[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::Util 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 $origref = $matches[0];
565         my @newclonedids = split /\s+/, $matches[1];
566         my $newbugsneeded = scalar(@newclonedids);
567
568         eval {
569             my %new_clones;
570             clone_bug(@{$param{common_control_options}},
571                       bug => $ref,
572                       new_bugs => \@newclonedids,
573                       new_clones => \%new_clones,
574                      );
575             %{$param{clonebugs}} = (%{$param{clonebugs}},
576                                     %new_clones);
577         };
578         if ($@) {
579             $errors++;
580             print {$transcript} "Failed to clone $ref: ".cleanup_eval_fail($@,$debug)."\n";
581         }
582     } elsif ($ctl eq 'package') {
583         my @pkgs = split /\s+/, $matches[0];
584         if (scalar(@pkgs) > 0) {
585                 $param{limit}{package} = [@pkgs];
586                 print {$transcript} "Limiting to bugs with field 'package' containing at least one of ".join(', ',map {qq('$_')} @pkgs)."\n";
587                 print {$transcript} "Limit currently set to";
588                 for my $limit_field (keys %{$param{limit}}) {
589                     print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
590                 }
591                 print {$transcript} "\n";
592         } else {
593             $param{limit}{package} = [];
594             print {$transcript} "Limit cleared.\n\n";
595         }
596     } elsif ($ctl eq 'limit') {
597         my ($field,@options) = split /\s+/, $matches[0];
598         $field = lc($field);
599         if ($field =~ /^(?:clear|unset|blank)$/) {
600             %{$param{limit}} = ();
601             print {$transcript} "Limit cleared.\n\n";
602         }
603         elsif (exists $Debbugs::Status::fields{$field} or $field eq 'source') {
604             # %{$param{limit}} can actually contain regexes, but because they're
605             # not evaluated in Safe, DO NOT allow them through without
606             # fixing this.
607             $param{limit}{$field} = [@options];
608             print {$transcript} "Limiting to bugs with field '$field' containing at least one of ".join(', ',map {qq('$_')} @options)."\n";
609             print {$transcript} "Limit currently set to";
610             for my $limit_field (keys %{$param{limit}}) {
611                 print {$transcript} " '$limit_field':".join(', ',map {qq('$_')} @{$param{limit}{$limit_field}})."\n";
612             }
613             print {$transcript} "\n";
614         }
615         else {
616             print {$transcript} "Limit key $field not understood. Stopping processing here.\n\n";
617             $errors++;
618             # this needs to be fixed
619             syntax error for fixing it
620             last;
621         }
622     } elsif ($ctl eq 'affects') {
623         my $add_remove = $matches[1];
624         my $packages = $matches[2];
625         # if there isn't a package given, assume that we should unset
626         # affects; otherwise default to adding
627         if (not defined $packages or
628             not length $packages) {
629             $packages = '';
630             $add_remove ||= '=';
631         }
632         elsif (not defined $add_remove or
633                not length $add_remove) {
634             $add_remove = '+';
635         }
636         eval {
637              affects(@{$param{common_control_options}},
638                      bug => $ref,
639                      package     => [splitpackages($packages)],
640                      ($add_remove eq '+'?(add => 1):()),
641                      ($add_remove eq '-'?(remove => 1):()),
642                     );
643         };
644         if ($@) {
645             $errors++;
646             print {$transcript} "Failed to mark $ref as affecting package(s): ".cleanup_eval_fail($@,$debug)."\n";
647         }
648
649     } elsif ($ctl eq 'summary') {
650         my $summary_msg = length($matches[1])?$matches[1]:undef;
651         eval {
652             summary(@{$param{common_control_options}},
653                     bug          => $ref,
654                     summary      => $summary_msg,
655                    );
656         };
657         if ($@) {
658             $errors++;
659             print {$transcript} "Failed to give $ref a summary: ".cleanup_eval_fail($@,$debug)."\n";
660         }
661
662     } elsif ($ctl eq 'outlook') {
663         my $outlook_msg = length($matches[1])?$matches[1]:undef;
664         eval {
665             outlook(@{$param{common_control_options}},
666                     bug          => $ref,
667                     outlook      => $outlook_msg,
668                    );
669         };
670         if ($@) {
671             $errors++;
672             print {$transcript} "Failed to give $ref a outlook: ".cleanup_eval_fail($@,$debug)."\n";
673         }
674
675     } elsif ($ctl eq 'owner') {
676         my $newowner = $matches[1];
677         if ($newowner eq '!') {
678             $newowner = $param{replyto};
679         }
680         eval {
681             owner(@{$param{common_control_options}},
682                   bug          => $ref,
683                   owner        => $newowner,
684                  );
685         };
686         if ($@) {
687             $errors++;
688             print {$transcript} "Failed to mark $ref as having an owner: ".cleanup_eval_fail($@,$debug)."\n";
689         }
690     } elsif ($ctl eq 'noowner') {
691         eval {
692             owner(@{$param{common_control_options}},
693                   bug          => $ref,
694                   owner        => undef,
695                  );
696         };
697         if ($@) {
698             $errors++;
699             print {$transcript} "Failed to mark $ref as not having an owner: ".cleanup_eval_fail($@,$debug)."\n";
700         }
701     } elsif ($ctl eq 'unarchive') {
702          eval {
703               bug_unarchive(@{$param{common_control_options}},
704                             bug        => $ref,
705                            );
706          };
707          if ($@) {
708               $errors++;
709          }
710     } elsif ($ctl eq 'archive') {
711          eval {
712               bug_archive(@{$param{common_control_options}},
713                           bug => $ref,
714                           ignore_time => 1,
715                           archive_unarchived => 0,
716                          );
717          };
718          if ($@) {
719               $errors++;
720          }
721     }
722     if ($errors) {
723         ${$param{errors}}+=$errors;
724     }
725     return($errors,$terminate_control);
726 }
727
728 1;
729
730 __END__