]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Control.pm
* Fix __internal_request in Debbugs::Control
[debbugs.git] / Debbugs / Control.pm
index e0e3458dd0e47f087970bb7e3a33604137835ab1..cf2ab8416566df3645c823d758393ce82cd27c0f 100644 (file)
@@ -94,6 +94,7 @@ BEGIN{
                     fixed   => [qw(set_found set_fixed)],
                     package => [qw(set_package)],
                     block   => [qw(set_blocks)],
+                    tag     => [qw(set_tag)],
                     archive => [qw(bug_archive bug_unarchive),
                                ],
                     log     => [qw(append_action_to_log),
@@ -106,7 +107,7 @@ BEGIN{
 
 use Debbugs::Config qw(:config);
 use Debbugs::Common qw(:lock buglog :misc get_hashname);
-use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages);
+use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields);
 use Debbugs::CGI qw(html_escape);
 use Debbugs::Log qw(:misc);
 use Debbugs::Recipients qw(:add);
@@ -346,9 +347,10 @@ sub set_blocks {
        my $data = read_bug(bug=>$blocker,
                           );
        if (defined $data and not $data->{archive}) {
+           $data = split_status_fields($data);
            $ok_blockers{$blocker} = 1;
            my @merged_bugs;
-           push @merged_bugs, split(' ',$data->{mergedwith}) if length $data->{mergedwith};
+           push @merged_bugs, make_list($data->{mergedwith});
            $ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
        }
        else {
@@ -434,8 +436,8 @@ sub set_blocks {
            print {$transcript} "Was blocked by: $data->{blockedby}\n";
        }
        my @changed;
-       push @changed, 'added blocking bug(s) '.english_join([keys %added_blockers]) if keys %added_blockers;
-       push @changed, 'removed blocking bug(s) '.english_join([keys %removed_blockers]) if keys %removed_blockers;
+       push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
+       push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
        $action = ucfirst(join ('; ',@changed)) if @changed;
        if (not @changed) {
            print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"
@@ -480,8 +482,9 @@ sub set_blocks {
            for my $data (@blocking_data) {
                my $old_data = dclone($data);
                my %blocks;
-               %blocks = split ' ', $data->{blocks};
-               my @blocks;
+               my @blocks = split ' ', $data->{blocks};
+               @blocks{@blocks} = (1) x @blocks;
+               @blocks = ();
                for my $bug (@bugs) {
                    if ($add_remove eq 'remove') {
                        next unless exists $blocks{$bug};
@@ -613,7 +616,7 @@ sub set_tag {
        my %tag_added = ();
        my %tag_removed = ();
        my %fixed_removed = ();
-       my @old_tags = split /\,\s*/, $data->{tags};
+       my @old_tags = split /\,\s*/, $data->{keywords};
        my %tags;
        @tags{@old_tags} = (1) x @old_tags;
        my $reopened = 0;
@@ -655,7 +658,7 @@ sub set_tag {
            print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
            print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
        }
-       $data->{tags} = join(', ',keys %tags); # double check this
+       $data->{keywords} = join(', ',keys %tags); # double check this
 
        my @changed;
        push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
@@ -1815,7 +1818,7 @@ sub affects {
              }
              if (keys %added_packages) {
                  $action .= "Added indication that $data->{bug_num} affects " .
-                  english_join([%added_packages]);
+                  english_join([keys %added_packages]);
              }
         }
        if (not length $action) {
@@ -2583,7 +2586,7 @@ C<__PACKAGE__>.
 sub __internal_request{
     my ($l) = @_;
     $l = 0 if not defined $l;
-    if (defined +(caller(2+$l))[0] and +(caller(2+$l))[0] eq __PACKAGE__) {
+    if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
        return 1;
     }
     return 0;
@@ -2682,10 +2685,19 @@ sub __begin_control {
     if (not @data) {
        die "Unable to read any bugs successfully.";
     }
-    ###
-    # XXX check the limit at this point, and die if it is exceeded.
-    # This is currently not done
-    ###
+    if (not $param{archived}) {
+       for my $data (@data) {
+           if ($data->{archived}) {
+               die "Not altering archived bugs; see unarchive.";
+           }
+       }
+    }
+    if (not __check_limit(data => \@data,
+                         exists $param{limit}?(limit => $param{limit}):(),
+                        )) {
+       die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
+    }
+
     __handle_affected_packages(%param,data => \@data);
     print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
     print {$debug} "$param{bug} read $locks locks\n";
@@ -2698,7 +2710,7 @@ sub __begin_control {
                   recipients => $param{recipients},
                   (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
                   debug      => $debug,
-                  transcript => $transcript,
+                  (__internal_request()?(transcript => $transcript):()),
                  );
 
     print {$debug} "$param{bug} read done\n";
@@ -2744,6 +2756,69 @@ sub __end_control {
 }
 
 
+=head2 __check_limit
+
+     __check_limit(data => \@data, limit => $param{limit});
+
+
+Checks to make sure that bugs match any limits; each entry of @data
+much satisfy the limit.
+
+Returns true if there are no entries in data, or there are no keys in
+limit; returns false (0) if there are any entries which do not match.
+
+The limit hashref elements can contain an arrayref of scalars to
+match; regexes are also acccepted. At least one of the entries in each
+element needs to match the corresponding field in all data for the
+limit to succeed.
+
+=cut
+
+
+sub __check_limit{
+    my %param = validate_with(params => \@_,
+                             spec   => {data  => {type => ARRAYREF|SCALAR,
+                                                 },
+                                        limit => {type => HASHREF|UNDEF,
+                                                 },
+                                       },
+                            );
+    my @data = make_list($param{data});
+    if (not @data or
+       not defined $param{limit} or
+       not keys %{$param{limit}}) {
+       return 1;
+    }
+    for my $data (@data) {
+       for my $field (keys %{$param{limit}}) {
+           next unless exists $param{limit}{$field};
+           my $match = 0;
+           for my $limit (make_list($param{limit}{$field})) {
+               if (not ref $limit) {
+                   if ($data->{$field} eq $limit) {
+                       $match = 1;
+                       last;
+                   }
+               }
+               elsif (ref($limit) eq 'Regexp') {
+                   if ($data->{$field} =~ $limit) {
+                       $match = 1;
+                       last;
+                   }
+               }
+               else {
+                   warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
+               }
+           }
+           if (not $match) {
+               return 0;
+           }
+       }
+    }
+    return 1;
+}
+
+
 =head2 die
 
      sig_die "foo"