]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Control.pm
export check_limit
[debbugs.git] / Debbugs / Control.pm
index 78efdf12e512f0c940222508c5163e0990fe8370..afd85bded1d051be0373bee6d4afd4e79fac173f 100644 (file)
@@ -99,6 +99,7 @@ BEGIN{
                     clone   => [qw(clone_bug)],
                     archive => [qw(bug_archive bug_unarchive),
                                ],
+                    limit   => [qw(check_limit)],
                     log     => [qw(append_action_to_log),
                                ],
                    );
@@ -108,7 +109,7 @@ BEGIN{
 }
 
 use Debbugs::Config qw(:config);
-use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions);
+use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions :utf8);
 use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
 use Debbugs::CGI qw(html_escape);
 use Debbugs::Log qw(:misc :write);
@@ -132,6 +133,7 @@ use POSIX qw(strftime);
 
 use Storable qw(dclone nfreeze);
 use List::Util qw(first max);
+use Encode qw(encode_utf8);
 
 use Carp;
 
@@ -459,8 +461,7 @@ sub set_blocks {
        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 blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n";
            next;
        }
        $data->{blockedby} = join(' ',keys %blockers);
@@ -696,8 +697,7 @@ sub set_tag {
        push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
        $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"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
            next;
        }
        $action .= '.';
@@ -953,8 +953,8 @@ sub set_done {
        for my $data (@data) {
            my $old_data = dclone($data);
            my $hash = get_hashname($data->{bug_num});
-           my $report_fh = IO::File->new("db-h/$hash/$data->{bug_num}.report",'r') or
-               die "Unable to open original report db-h/$hash/$data->{bug_num}.report for reading: $!";
+           my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or
+               die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!";
            my $orig_report;
            {
                local $/;
@@ -998,7 +998,7 @@ sub set_done {
                                                             headers =>
                                                             [To => $data->{submitter},
                                                              Subject => "$config{ubug}#$data->{bug_num} ".
-                                                             "closed by $param{requester} ($param{request_subject})",
+                                                             "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
                                                             ],
                                                            )
                                            ],
@@ -1109,8 +1109,7 @@ sub set_submitter {
              (not defined $data->{originator} or not length $data->{originator})) or
             (defined $param{submitter} and defined $data->{originator} and
              $param{submitter} eq $data->{originator})) {
-           print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
            next;
        }
        else {
@@ -1222,8 +1221,7 @@ sub set_forwarded {
        if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or
            (not defined $param{forwarded} and
             defined $data->{forwarded} and not length $data->{forwarded})) {
-           print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n";
            next;
        }
        else {
@@ -1311,8 +1309,7 @@ sub set_title {
        print {$debug} "Going to change bug title\n";
        if (defined $data->{subject} and length($data->{subject}) and
            $data->{subject} eq $param{title}) {
-           print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
            next;
        }
        else {
@@ -1416,8 +1413,7 @@ sub set_package {
        print {$debug} "Going to change assigned package\n";
        if (defined $data->{package} and length($data->{package}) and
            $data->{package} eq $new_package) {
-           print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
            next;
        }
        else {
@@ -1581,6 +1577,12 @@ sub set_found {
                if (not @svers) {
                    @svers = $version;
                }
+               else {
+                   if (exists $found_versions{$version}) {
+                       delete $found_versions{$version};
+                       $found_removed{$version} = 1;
+                   }
+               }
                for my $sver (@svers) {
                    if (not exists $found_versions{$sver}) {
                        $found_versions{$sver} = 1;
@@ -1649,8 +1651,7 @@ sub set_found {
            $action .= " and reopened"
        }
        if (not $reopened and not @changed) {
-           print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
            next;
        }
        $action .= '.';
@@ -1793,6 +1794,12 @@ sub set_fixed {
                if (not @svers) {
                    @svers = $version;
                }
+               else {
+                   if (exists $fixed_versions{$version}) {
+                       $fixed_removed{$version} = 1;
+                       delete $fixed_versions{$version};
+                   }
+               }
                for my $sver (@svers) {
                    if (not exists $fixed_versions{$sver}) {
                        $fixed_versions{$sver} = 1;
@@ -1858,8 +1865,7 @@ sub set_fixed {
            $action .= " and reopened"
        }
        if (not $reopened and not @changed) {
-           print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
            next;
        }
        $action .= '.';
@@ -2015,7 +2021,7 @@ sub set_merged {
     $new_locks += $n_locks;
     %data = %{$data};
     @data = values %data;
-    if (not __check_limit(data => [@data],
+    if (not check_limit(data => [@data],
                          exists $param{limit}?(limit => $param{limit}):(),
                          transcript => $transcript,
                         )) {
@@ -2075,7 +2081,7 @@ sub set_merged {
            # figure out the problems
            print {$transcript} "Unable to merge bugs because:\n";
            for my $change (@{$disallowed_changes}) {
-               print {$transcript} "$change->{field} of #$change->{bug} is '$change->{orig_value}' not '$change->{value}'\n";
+               print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
            }
            if ($attempts > 0) {
                croak "Some bugs were altered while attempting to merge";
@@ -2084,66 +2090,69 @@ sub set_merged {
                croak "Did not alter merged bugs";
            }
        }
-       my ($change_bug) = keys %{$changes};
-       $bug_changed{$change_bug}++;
-       print {$transcript} __bug_info($data{$change_bug}) if
-           $param{show_bug_info} and not __internal_request(1);
-       $bug_info_shown{$change_bug} = 1;
-       __allow_relocking($param{locks},[keys %data]);
-       for my $change (@{$changes->{$change_bug}}) {
-           if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
-               my %target_blockedby;
-               @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
-               my %unhandled_targets = %target_blockedby;
-               my @blocks_to_remove;
-               for my $key (split / /,$change->{orig_value}) {
-                   delete $unhandled_targets{$key};
-                   next if exists $target_blockedby{$key};
-                   set_blocks(bug    => $change->{field} eq 'blocks' ? $key : $change->{bug},
-                              block  => $change->{field} eq 'blocks' ? $change->{bug} : $key,
-                              remove => 1,
-                              hash_slice(%param,
-                                         keys %common_options,
-                                         keys %append_action_options),
-                             );
+       my @bugs_to_change = keys %{$changes};
+       for my $change_bug (@bugs_to_change) {
+           next unless exists $changes->{$change_bug};
+           $bug_changed{$change_bug}++;
+           print {$transcript} __bug_info($data{$change_bug}) if
+               $param{show_bug_info} and not __internal_request(1);
+           $bug_info_shown{$change_bug} = 1;
+           __allow_relocking($param{locks},[keys %data]);
+           for my $change (@{$changes->{$change_bug}}) {
+               if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
+                   my %target_blockedby;
+                   @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
+                   my %unhandled_targets = %target_blockedby;
+                   my @blocks_to_remove;
+                   for my $key (split / /,$change->{orig_value}) {
+                       delete $unhandled_targets{$key};
+                       next if exists $target_blockedby{$key};
+                       set_blocks(bug    => $change->{field} eq 'blocks' ? $key : $change->{bug},
+                                  block  => $change->{field} eq 'blocks' ? $change->{bug} : $key,
+                                  remove => 1,
+                                  hash_slice(%param,
+                                             keys %common_options,
+                                             keys %append_action_options),
+                                 );
+                   }
+                   for my $key (keys %unhandled_targets) {
+                       set_blocks(bug    => $change->{field} eq 'blocks' ? $key : $change->{bug},
+                                  block  => $change->{field} eq 'blocks' ? $change->{bug} : $key,
+                                  add   => 1,
+                                  hash_slice(%param,
+                                             keys %common_options,
+                                             keys %append_action_options),
+                                 );
+                   }
                }
-               for my $key (keys %unhandled_targets) {
-                   set_blocks(bug    => $change->{field} eq 'blocks' ? $key : $change->{bug},
-                              block  => $change->{field} eq 'blocks' ? $change->{bug} : $key,
-                              add   => 1,
-                              hash_slice(%param,
-                                         keys %common_options,
-                                         keys %append_action_options),
-                             );
+               else {
+                   $change->{function}->(bug => $change->{bug},
+                                         $change->{key}, $change->{func_value},
+                                         exists $change->{options}?@{$change->{options}}:(),
+                                         hash_slice(%param,
+                                                    keys %common_options,
+                                                    keys %append_action_options),
+                                        );
                }
            }
-           else {
-               $change->{function}->(bug => $change->{bug},
-                                     $change->{key}, $change->{func_value},
-                                     exists $change->{options}?@{$change->{options}}:(),
-                                     hash_slice(%param,
-                                                keys %common_options,
-                                                keys %append_action_options),
-                                    );
-           }
+           __disallow_relocking($param{locks});
+           my ($data,$n_locks) =
+               __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
+                                           data => \@data,
+                                           locks => $param{locks},
+                                           debug => $debug,
+                                           reload_all => 1,
+                                          );
+           $new_locks += $n_locks;
+           $locks += $n_locks;
+           %data = %{$data};
+           @data = values %data;
+           ($merge_status,$bugs_to_merge) =
+               __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
+           ($disallowed_changes,$changes) = 
+               __calculate_merge_changes(\@data,$merge_status,\%param);
+           $attempts = max(values %bug_changed);
        }
-       __disallow_relocking($param{locks});
-       my ($data,$n_locks) =
-           __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
-                                       data => \@data,
-                                       locks => $param{locks},
-                                       debug => $debug,
-                                       reload_all => 1,
-                                      );
-       $new_locks += $n_locks;
-       $locks += $n_locks;
-       %data = %{$data};
-       @data = values %data;
-       ($merge_status,$bugs_to_merge) =
-           __calculate_merge_status(\@data,\%data,$param{bug});
-       ($disallowed_changes,$changes) = 
-           __calculate_merge_changes(\@data,$merge_status,\%param);
-       $attempts = max(values %bug_changed);
     }
     if ($param{show_bug_info} and not __internal_request(1)) {
        for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) {
@@ -2152,12 +2161,16 @@ sub set_merged {
        }
     }
     if (keys %{$changes} or @{$disallowed_changes}) {
-       print {$transcript} "Unable to modify bugs so that they could be merged\n";
+       print {$transcript} "After four attempts, the following changes were unable to be made:\n";
        for (1..$new_locks) {
            unfilelock($param{locks});
            $locks--;
        }
        __end_control(%info);
+       for my $change (values %{$changes}, @{$disallowed_changes}) {
+           print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
+       }
+       die "Unable to modify bugs so they could be merged";
        return;
     }
 
@@ -2191,8 +2204,9 @@ sub set_merged {
 sub __allow_relocking{
     my ($locks,$bugs) = @_;
 
-    for my $bug (@{$bugs}) {
-       my @lockfiles = grep {m{/\Q$bug\E$}} keys %{$locks->{locks}};
+    my @locks = (@{$bugs},'merge');
+    for my $lock (@locks) {
+       my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
        next unless @lockfiles;
        $locks->{relockable}{$lockfiles[0]} = 0;
     }
@@ -2273,8 +2287,8 @@ sub __lock_and_load_merged_bugs{
 
 
 sub __calculate_merge_status{
-    my ($data_a,$data_h,$master_bug,$merge) = @_;
-    my %merge_status;
+    my ($data_a,$data_h,$master_bug,$merge_status) = @_;
+    my %merge_status = %{$merge_status // {}};
     my %merged_bugs;
     my $bugs_to_merge = 0;
     for my $data (@{$data_a}) {
@@ -2292,9 +2306,9 @@ sub __calculate_merge_status{
                $merge_status{$_} = $data->{$_}
            }
        }
-       if (not $merge) {
-           next unless $data->{bug_num} == $master_bug;
-       }
+       if (defined $merge_status) {
+           next unless $data->{bug_num} == $master_bug;
+       }
        $merge_status{tag} = {} if not exists $merge_status{tag};
        for my $tag (split /\s+/, $data->{keywords}) {
            $merge_status{tag}{$tag} = 1;
@@ -2373,10 +2387,12 @@ sub __calculate_merge_changes{
                           },
             fixed_versions => {func => \&set_fixed,
                                key => 'fixed',
+                               modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
                                allowed => 1,
                               },
             found_versions => {func => \&set_found,
                                key   => 'found',
+                               modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
                                allowed => 1,
                               },
            );
@@ -2391,6 +2407,19 @@ sub __calculate_merge_changes{
                next if join(' ', sort @{$data->{$field}}) eq
                    join(' ',sort keys %{$merge_status->{$field}});
            }
+           elsif ($field eq 'done') {
+               # for done, we only care if the bug is done or not
+               # done, not the value it's set to.
+               if (defined $merge_status->{$field} and length $merge_status->{$field} and
+                   defined $data->{$field}         and length $data->{$field}) {
+                   next;
+               }
+               elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
+                      (not defined $data->{$field}         or not length $data->{$field})
+                     ) {
+                   next;
+               }
+           }
            elsif ($merge_status->{$field} eq $data->{$field}) {
                next;
            }
@@ -2406,10 +2435,12 @@ sub __calculate_merge_changes{
                 function => $force_functions{$field}{func},
                 key      => $force_functions{$field}{key},
                 options  => $force_functions{$field}{options},
-                allowed  => exists $force_functions{$field}{allowed} ? 0 : $force_functions{$field}{allowed},
+                allowed  => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
                };
-           if ($param->{force}) {
-               if ($field ne 'package') {
+           $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
+           $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
+           if ($param->{force} or $change->{allowed}) {
+               if ($field ne 'package' or $change->{allowed}) {
                    push @{$changes{$data->{bug_num}}},$change;
                    next;
                }
@@ -2563,8 +2594,7 @@ sub affects {
              }
         }
        if (not length $action) {
-           print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
            next;
        }
         my $old_data = dclone($data);
@@ -2725,8 +2755,7 @@ sub summary {
         if (((not defined $summary or not length $summary) and
              (not defined $data->{summary} or not length $data->{summary})) or
             $summary eq $data->{summary}) {
-            print {$transcript} "Ignoring request to change the summary of bug $param{bug} to the same value\n"
-                unless __internal_request();
+            print {$transcript} "Ignoring request to change the summary of bug $param{bug} to the same value\n";
             next;
         }
         if (length $summary) {
@@ -2871,7 +2900,7 @@ sub clone_bug {
     for my $bug (split ' ', $data->{blocks}) {
        for my $new_bug (@new_bugs) {
            set_blocks(bug => $new_bug,
-                      blocks => $bug,
+                      block => $bug,
                       hash_slice(%param,
                                  keys %common_options,
                                  keys %append_action_options),
@@ -2882,7 +2911,7 @@ sub clone_bug {
     for my $bug (split ' ', $data->{blockedby}) {
        for my $new_bug (@new_bugs) {
            set_blocks(bug => $bug,
-                      blocks => $new_bug,
+                      block => $new_bug,
                       hash_slice(%param,
                                  keys %common_options,
                                  keys %append_action_options),
@@ -2943,8 +2972,7 @@ sub owner {
          print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
          if (not defined $param{owner} or not length $param{owner}) {
              if (not defined $data->{owner} or not length $data->{owner}) {
-                 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n"
-                     unless __internal_request();
+                 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
                  next;
              }
              $param{owner} = '';
@@ -3055,7 +3083,6 @@ sub bug_archive {
          print {$transcript} "Bug $param{bug} cannot be archived\n";
          die "Bug $param{bug} cannot be archived";
      }
-     print {$debug} "$param{bug} considering\n";
      if (not $param{archive_unarchived} and
         not exists $data[0]{unarchived}
        ) {
@@ -3330,7 +3357,7 @@ sub append_action_to_log{
             $nd{$key} = $new_data->{$key};
             # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n";
         }
-        $data_diff .= html_escape(Data::Dumper->Dump([\%nd],[qw(new_data)]));
+        $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)]));
         $data_diff .= "-->\n";
         $data_diff .= "<!-- old_data:\n";
         my %od;
@@ -3342,30 +3369,30 @@ sub append_action_to_log{
             $od{$key} = $old_data->{$key};
             # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $old_data->{$key}")."\n";
         }
-        $data_diff .= html_escape(Data::Dumper->Dump([\%od],[qw(old_data)]));
+        $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%od)],[qw(old_data)]));
         $data_diff .= "-->\n";
      }
      my $msg = join('',
                    (exists $param{command} ?
-                    "<!-- command:".html_escape($param{command})." -->\n":""
+                    "<!-- command:".html_escape(encode_utf8($param{command}))." -->\n":""
                    ),
                    (length $param{requester} ?
-                    "<!-- requester: ".html_escape($param{requester})." -->\n":""
+                    "<!-- requester: ".html_escape(encode_utf8($param{requester}))." -->\n":""
                    ),
                    (length $param{request_addr} ?
-                    "<!-- request_addr: ".html_escape($param{request_addr})." -->\n":""
+                    "<!-- request_addr: ".html_escape(encode_utf8($param{request_addr}))." -->\n":""
                    ),
                    "<!-- time:".time()." -->\n",
                    $data_diff,
-                   "<strong>".html_escape($param{action})."</strong>\n");
+                   "<strong>".html_escape(encode_utf8($param{action}))."</strong>\n");
      if (length $param{requester}) {
-          $msg .= "Request was from <code>".html_escape($param{requester})."</code>\n";
+          $msg .= "Request was from <code>".html_escape(encode_utf8($param{requester}))."</code>\n";
      }
      if (length $param{request_addr}) {
-          $msg .= "to <code>".html_escape($param{request_addr})."</code>";
+          $msg .= "to <code>".html_escape(encode_utf8($param{request_addr}))."</code>";
      }
      if (length $param{desc}) {
-         $msg .= ":<br>\n$param{desc}\n";
+         $msg .= ":<br>\n".encode_utf8($param{desc})."\n";
      }
      else {
          $msg .= ".\n";
@@ -3569,7 +3596,8 @@ sub __begin_control {
                             );
     my $new_locks;
     my ($debug,$transcript) = __handle_debug_transcript(@_);
-    print {$debug} "$param{bug} considering\n";
+    print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
+#    print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
     $lockhash = $param{locks} if exists $param{locks};
     my @data = ();
     my $old_die = $SIG{__DIE__};
@@ -3591,7 +3619,7 @@ sub __begin_control {
            }
        }
     }
-    if (not __check_limit(data => \@data,
+    if (not check_limit(data => \@data,
                          exists $param{limit}?(limit => $param{limit}):(),
                          transcript => $transcript,
                         )) {
@@ -3658,9 +3686,9 @@ sub __end_control {
 }
 
 
-=head2 __check_limit
+=head2 check_limit
 
-     __check_limit(data => \@data, limit => $param{limit});
+     check_limit(data => \@data, limit => $param{limit});
 
 
 Checks to make sure that bugs match any limits; each entry of @data
@@ -3677,7 +3705,7 @@ limit to succeed.
 =cut
 
 
-sub __check_limit{
+sub check_limit{
     my %param = validate_with(params => \@_,
                              spec   => {data  => {type => ARRAYREF|SCALAR,
                                                  },