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