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