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