]> git.donarmstrong.com Git - debbugs.git/commitdiff
abstract out set_done and set_merged; use write log records
authorDon Armstrong <don@donarmstrong.com>
Thu, 16 Feb 2012 04:37:32 +0000 (20:37 -0800)
committerDon Armstrong <don@donarmstrong.com>
Thu, 16 Feb 2012 04:37:32 +0000 (20:37 -0800)
Debbugs/Control.pm
scripts/service

index 4ec2a101ae878272f90646d489acbfeb5e7ecd15..e5a1dd24b2d0ce8e05d2dbec026574dba02d3b96 100644 (file)
@@ -82,7 +82,7 @@ BEGIN{
      $DEBUG = 0 unless defined $DEBUG;
 
      @EXPORT = ();
      $DEBUG = 0 unless defined $DEBUG;
 
      @EXPORT = ();
-     %EXPORT_TAGS = (reopen    => [qw(reopen)],
+     %EXPORT_TAGS = (done    => [qw(set_done)],
                     submitter => [qw(set_submitter)],
                     severity => [qw(set_severity)],
                     affects => [qw(affects)],
                     submitter => [qw(set_submitter)],
                     severity => [qw(set_severity)],
                     affects => [qw(affects)],
@@ -94,6 +94,7 @@ BEGIN{
                     fixed   => [qw(set_found set_fixed)],
                     package => [qw(set_package)],
                     block   => [qw(set_blocks)],
                     fixed   => [qw(set_found set_fixed)],
                     package => [qw(set_package)],
                     block   => [qw(set_blocks)],
+                    merge   => [qw(set_merged)],
                     tag     => [qw(set_tag)],
                     archive => [qw(bug_archive bug_unarchive),
                                ],
                     tag     => [qw(set_tag)],
                     archive => [qw(bug_archive bug_unarchive),
                                ],
@@ -109,10 +110,11 @@ use Debbugs::Config qw(:config);
 use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions);
 use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields get_bug_status);
 use Debbugs::CGI qw(html_escape);
 use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions);
 use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields get_bug_status);
 use Debbugs::CGI qw(html_escape);
-use Debbugs::Log qw(:misc);
+use Debbugs::Log qw(:misc :write);
 use Debbugs::Recipients qw(:add);
 use Debbugs::Packages qw(:versions :mapping);
 
 use Debbugs::Recipients qw(:add);
 use Debbugs::Packages qw(:versions :mapping);
 
+use Data::Dumper qw();
 use Params::Validate qw(validate_with :types);
 use File::Path qw(mkpath);
 use IO::File;
 use Params::Validate qw(validate_with :types);
 use File::Path qw(mkpath);
 use IO::File;
@@ -127,7 +129,7 @@ use Mail::RFC822::Address qw();
 use POSIX qw(strftime);
 
 use Storable qw(dclone nfreeze);
 use POSIX qw(strftime);
 
 use Storable qw(dclone nfreeze);
-use List::Util qw(first);
+use List::Util qw(first max);
 
 use Carp;
 
 
 use Carp;
 
@@ -166,6 +168,9 @@ my %common_options = (debug       => {type => SCALARREF|HANDLE,
                      request_replyto   => {type => SCALAR,
                                            optional => 1,
                                           },
                      request_replyto   => {type => SCALAR,
                                            optional => 1,
                                           },
+                     locks             => {type => HASHREF,
+                                           optional => 1,
+                                          },
                     );
 
 
                     );
 
 
@@ -191,8 +196,15 @@ my %append_action_options =
                                 qw(message),
                                ],
                    },
                                 qw(message),
                                ],
                    },
+      # locks is both an append_action option, and a common option;
+      # it's ok for it to be in both places.
+      locks     => {type => HASHREF,
+                   optional => 1,
+                  },
      );
 
      );
 
+our $locks = 0;
+
 
 # this is just a generic stub for Debbugs::Control functions.
 #
 
 # this is just a generic stub for Debbugs::Control functions.
 #
@@ -431,9 +443,14 @@ sub set_blocks {
        my $old_data = dclone($data);
        # remove blockers and/or add new ones as appropriate
        if ($data->{blockedby} eq '') {
        my $old_data = dclone($data);
        # remove blockers and/or add new ones as appropriate
        if ($data->{blockedby} eq '') {
-           print {$transcript} "Was not blocked by any bugs.\n";
+           print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n";
+       } else {
+           print {$transcript} "$data->{bug_num} was blocked by: $data->{blockedby}\n";
+       }
+       if ($data->{blocks} eq '') {
+           print {$transcript} "$data->{bug_num} was not blocking any bugs.\n";
        } else {
        } else {
-           print {$transcript} "Was blocked by: $data->{blockedby}\n";
+           print {$transcript} "$data->{bug_num} was blocking: $data->{blocks}\n";
        }
        my @changed;
        push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
        }
        my @changed;
        push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
@@ -463,17 +480,25 @@ sub set_blocks {
     my %mungable_blocks;
     $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
     $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
     my %mungable_blocks;
     $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
     $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
+    my $new_locks = 0;
     for my $add_remove (keys %mungable_blocks) {
        my @munge_blockers;
        my %munge_blockers;
        my $block_locks = 0;
        for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
            next if $munge_blockers{$blocker};
     for my $add_remove (keys %mungable_blocks) {
        my @munge_blockers;
        my %munge_blockers;
        my $block_locks = 0;
        for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
            next if $munge_blockers{$blocker};
-           my ($new_locks, @blocking_data) =
-               lock_read_all_merged_bugs($blocker,
-                                         ($param{archived}?'archive':()));
+           my ($temp_locks, @blocking_data) =
+               lock_read_all_merged_bugs(bug => $blocker,
+                                         ($param{archived}?(location => 'archive'):()),
+                                         exists $param{locks}?(locks => $param{locks}):(),
+                                        );
+           $locks+= $temp_locks;
+           $new_locks+=$temp_locks;
            if (not @blocking_data) {
            if (not @blocking_data) {
-               unfilelock() for $new_locks;
+               for (1..$new_locks) {
+                   unfilelock(exists $param{locks}?$param{locks}:());
+                   $locks--;
+               }
                die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
            }
            for (map {$_->{bug_num}} @blocking_data) {
                die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
            }
            for (map {$_->{bug_num}} @blocking_data) {
@@ -519,7 +544,10 @@ sub set_blocks {
                           transcript => $transcript,
                          );
 
                           transcript => $transcript,
                          );
 
-           unfilelock() for $new_locks;
+           for (1..$new_locks) {
+               unfilelock(exists $param{locks}?$param{locks}:());
+               $locks--;
+           }
        }
     }
     __end_control(%info);
        }
     }
     __end_control(%info);
@@ -710,7 +738,7 @@ sub set_tag {
        }
 
 Sets the severity of a bug. If severity is not passed, is undefined,
        }
 
 Sets the severity of a bug. If severity is not passed, is undefined,
-or has zero length, sets the severity to the defafult severity.
+or has zero length, sets the severity to the default severity.
 
 =cut
 
 
 =cut
 
@@ -750,7 +778,7 @@ sub set_severity {
     for my $data (@data) {
        if (not defined $data->{severity}) {
            $data->{severity} = $param{severity};
     for my $data (@data) {
        if (not defined $data->{severity}) {
            $data->{severity} = $param{severity};
-           $action = "Severity set to '$param{severity}'\n";
+           $action = "Severity set to '$param{severity}'";
        }
        else {
            if ($data->{severity} eq '') {
        }
        else {
            if ($data->{severity} eq '') {
@@ -760,7 +788,7 @@ sub set_severity {
                print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
                next;
            }
                print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
                next;
            }
-           $action = "Severity set to '$param{severity}' from '$data->{severity}'\n";
+           $action = "Severity set to '$param{severity}' from '$data->{severity}'";
            $data->{severity} = $param{severity};
        }
        append_action_to_log(bug => $data->{bug_num},
            $data->{severity} = $param{severity};
        }
        append_action_to_log(bug => $data->{bug_num},
@@ -778,19 +806,18 @@ sub set_severity {
 }
 
 
 }
 
 
-=head2 reopen
+=head2 set_done
 
      eval {
 
      eval {
-           set_foo(bug          => $ref,
-                   transcript   => $transcript,
-                   ($dl > 0 ? (debug => $transcript):()),
-                   requester    => $header{from},
-                   request_addr => $controlrequestaddr,
-                   message      => \@log,
-                  affected_packages => \%affected_packages,
-                   recipients   => \%recipients,
-                   summary      => undef,
-                 );
+           set_done(bug          => $ref,
+                    transcript   => $transcript,
+                    ($dl > 0 ? (debug => $transcript):()),
+                    requester    => $header{from},
+                    request_addr => $controlrequestaddr,
+                    message      => \@log,
+                     affected_packages => \%affected_packages,
+                    recipients   => \%recipients,
+                   );
        };
        if ($@) {
            $errors++;
        };
        if ($@) {
            $errors++;
@@ -801,31 +828,51 @@ Foo frobinates
 
 =cut
 
 
 =cut
 
-sub reopen {
+sub set_done {
     my %param = validate_with(params => \@_,
                              spec   => {bug => {type   => SCALAR,
                                                 regex  => qr/^\d+$/,
                                                },
     my %param = validate_with(params => \@_,
                              spec   => {bug => {type   => SCALAR,
                                                 regex  => qr/^\d+$/,
                                                },
-                                        # specific options here
-                                        submitter => {type => SCALAR|UNDEF,
-                                                      default => undef,
+                                        reopen    => {type => BOOLEAN,
+                                                      default => 0,
                                                      },
                                                      },
+                                        submitter => {type => SCALAR,
+                                                      optional => 1,
+                                                     },
+                                        clear_fixed => {type => BOOLEAN,
+                                                        default => 1,
+                                                       },
+                                        notify_submitter => {type => BOOLEAN,
+                                                             default => 1,
+                                                            },
+                                        original_report => {type => SCALARREF,
+                                                            optional => 1,
+                                                           },
+                                        done => {type => SCALAR|UNDEF,
+                                                 optional => 1,
+                                                },
                                         %common_options,
                                         %append_action_options,
                                        },
                             );
 
                                         %common_options,
                                         %append_action_options,
                                        },
                             );
 
-    $param{submitter} = undef if defined $param{submitter} and
-       not length $param{submitter};
-
-    if (defined $param{submitter} and
+    if (exists $param{submitter} and
        not Mail::RFC822::Address::valid($param{submitter})) {
        not Mail::RFC822::Address::valid($param{submitter})) {
-       die "New submitter address $param{submitter} is not a valid e-mail address";
+       die "New submitter address '$param{submitter}' is not a valid e-mail address";
+    }
+    if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
+       $param{done} = $param{requester};
+    }
+    if (exists $param{done} and
+       (not defined $param{done} or
+        not length $param{done})) {
+       delete $param{done};
+       $param{reopen} = 1;
     }
 
     my %info =
        __begin_control(%param,
     }
 
     my %info =
        __begin_control(%param,
-                       command  => 'reopen'
+                       command  => $param{reopen}?'reopen':'done',
                       );
     my ($debug,$transcript) =
        @info{qw(debug transcript)};
                       );
     my ($debug,$transcript) =
        @info{qw(debug transcript)};
@@ -833,45 +880,147 @@ sub reopen {
     my @bugs = @{$info{bugs}};
     my $action ='';
 
     my @bugs = @{$info{bugs}};
     my $action ='';
 
-    my $warn_fixed = 1; # avoid warning multiple times if there are
-                        # fixed versions
-    my @change_submitter = ();
-    my @bugs_to_reopen = ();
-    for my $data (@data) {
-       if (not exists $data->{done} or
-           not defined $data->{done} or
-           not length $data->{done}) {
-           print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
-           __end_control(%info);
-           return;
+    if ($param{reopen}) {
+       # avoid warning multiple times if there are fixed versions
+       my $warn_fixed = 1;
+       for my $data (@data) {
+           if (not exists $data->{done} or
+               not defined $data->{done} or
+               not length $data->{done}) {
+               print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
+               __end_control(%info);
+               return;
+           }
+           if (@{$data->{fixed_versions}} and $warn_fixed) {
+               print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
+               print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
+               $warn_fixed = 0;
+           }
        }
        }
-       if (@{$data->{fixed_versions}} and $warn_fixed) {
-           print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
-           print {$transcript} "you may need to use 'found' to remove fixed versions.\n";
-           $warn_fixed = 0;
+       __end_control(%info);
+       if (exists $param{submitter}) {
+           set_submitter(bug => $param{bug},
+                         submitter => $param{submitter},
+                         hash_slice(%param,
+                                    keys %common_options,
+                                    keys %append_action_options)
+                        );
        }
        }
-       if (defined $param{submitter} and length $param{submitter}
-           and $data->{originator} ne $param{submitter}) {
-           push @change_submitter,$data->{bug_num};
+       # clear the fixed revisions
+       if ($param{clear_fixed}) {
+           set_fixed(fixed => [],
+                     bug => $param{bug},
+                     reopen => 0,
+                     hash_slice(%param,
+                                keys %common_options,
+                                keys %append_action_options),
+                    );
        }
     }
        }
     }
-    __end_control(%info);
-    my @params_for_subcalls = 
-       map {exists $param{$_}?($_,$param{$_}):()}
-           (keys %common_options,
-            keys %append_action_options,
-           );
+    else {
+       my %submitter_notified;
+       my $requester_notified = 0;
+       my $orig_report_set = 0;
+       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 $orig_report;
+           {
+               local $/;
+               $orig_report= <$report_fh>;
+           }
+           close $report_fh;
+           if (not $orig_report_set and defined $orig_report and
+               length $orig_report and
+               exists $param{original_report}){
+               ${$param{original_report}} = $orig_report;
+               $orig_report_set = 1;
+           }
 
 
-    for my $bug (@change_submitter) {
-       set_submitter(bug=>$bug,
-                     submitter => $param{submitter},
-                     @params_for_subcalls,
+           if (exists $data->{done} and
+               defined $data->{done} and
+               length $data->{done}) {
+               print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n";
+               __end_control(%info);
+               return;
+           }
+           $action = "Marked $config{bug} as done";
+
+           # set done to the requester
+           $data->{done} = exists $param{done}?$param{done}:$param{requester};
+           append_action_to_log(bug => $data->{bug_num},
+                                command => 'done',
+                                new_data => $data,
+                                old_data => $old_data,
+                                get_lock => 0,
+                                __return_append_to_log_options(
+                                                               %param,
+                                                               action => $action,
+                                                              ),
+                               )
+               if not exists $param{append_log} or $param{append_log};
+           writebug($data->{bug_num},$data);
+           # get the original report
+           if ($param{notify_submitter}) {
+               my $submitter_message;
+               if(not exists $submitter_notified{$data->{originator}}) {
+                   $submitter_message =
+                       create_mime_message([default_headers(queue_file => $param{request_nn},
+                                                            data => $data,
+                                                            msgid => $param{request_msgid},
+                                                            msgtype => 'notifdone',
+                                                            pr_msg  => 'they-closed',
+                                                            headers =>
+                                                            [To => $data->{submitter},
+                                                             Subject => "$config{ubug}#$data->{bug_num} ".
+                                                             "closed by $param{requester} ($param{request_subject})",
+                                                            ],
+                                                           )
+                                           ],
+                                           __message_body_template('mail/process_your_bug_done',
+                                                                   {data     => $data,
+                                                                    replyto  => (exists $param{request_replyto} ?
+                                                                                 $param{request_replyto} :
+                                                                                 $param{requester} || 'Unknown'),
+                                                                    markedby => $param{requester},
+                                                                    subject => $param{request_subject},
+                                                                    messageid => $param{request_msgid},
+                                                                    config   => \%config,
+                                                                   }),
+                                           [join('',make_list($param{message})),$orig_report]
+                                          );
+                   send_mail_message(message => $submitter_message,
+                                     recipients => $old_data->{submitter},
+                                    );
+                   $submitter_notified{$data->{originator}} = $submitter_message;
+               }
+               else {
+                   $submitter_message = $submitter_notified{$data->{originator}};
+               }
+               append_action_to_log(bug => $data->{bug_num},
+                                    action => "Notification sent",
+                                    requester => '',
+                                    request_addr => $data->{originator},
+                                    desc => "$config{bug} acknowledged by developer.",
+                                    recips => [$data->{originator}],
+                                    message => $submitter_message,
+                                    get_lock => 0,
+                                   );
+           }
+       }
+       if (exists $param{fixed}) {
+           set_fixed(fixed => $param{fixed},
+                     bug => $param{bug},
+                     reopen => 0,
+                     hash_slice(%param,
+                                keys %common_options,
+                                keys %append_action_options
+                               ),
                     );
                     );
+       }
     }
     }
-    set_fixed(fixed => [],
-             bug => $param{bug},
-             reopen => 1,
-            );
 }
 
 
 }
 
 
@@ -1033,6 +1182,7 @@ sub set_forwarded {
     if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
        die "Non-printable characters are not allowed in the forwarded field";
     }
     if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
        die "Non-printable characters are not allowed in the forwarded field";
     }
+    $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded};
     my %info =
        __begin_control(%param,
                        command  => 'forwarded'
     my %info =
        __begin_control(%param,
                        command  => 'forwarded'
@@ -1045,9 +1195,9 @@ sub set_forwarded {
     for my $data (@data) {
        my $old_data = dclone($data);
        print {$debug} "Going to change bug forwarded\n";
     for my $data (@data) {
        my $old_data = dclone($data);
        print {$debug} "Going to change bug forwarded\n";
-       if (((not defined $param{forwarded} or not length $param{forwarded}) and
-             (not defined $data->{forwarded} or not length $data->{forwarded})) or
-            $param{forwarded} eq $data->{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();
            next;
            print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n"
                unless __internal_request();
            next;
@@ -1470,7 +1620,7 @@ sub set_found {
        push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
 #      push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
        push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
        push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
 #      push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
        push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
-       $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed;
+       $action = ucfirst(join ('; ',@changed)) if @changed;
        if ($reopened) {
            $action .= " and reopened"
        }
        if ($reopened) {
            $action .= " and reopened"
        }
@@ -1679,7 +1829,7 @@ sub set_fixed {
        push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
        push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
        push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
        push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
        push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
        push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
-       $action = "$config{bug} ".ucfirst(join ('; ',@changed)) if @changed;
+       $action = ucfirst(join ('; ',@changed)) if @changed;
        if ($reopened) {
            $action .= " and reopened"
        }
        if ($reopened) {
            $action .= " and reopened"
        }
@@ -1707,6 +1857,569 @@ sub set_fixed {
 }
 
 
 }
 
 
+=head2 set_merged
+
+     eval {
+           set_merged(bug          => $ref,
+                      transcript   => $transcript,
+                      ($dl > 0 ? (debug => $transcript):()),
+                      requester    => $header{from},
+                      request_addr => $controlrequestaddr,
+                      message      => \@log,
+                       affected_packages => \%affected_packages,
+                      recipients   => \%recipients,
+                      merge_with   => 12345,
+                       add          => 1,
+                       force        => 1,
+                       allow_reassign => 1,
+                       reassign_same_source_only => 1,
+                      );
+       };
+       if ($@) {
+           $errors++;
+           print {$transcript} "Failed to set merged on $ref: $@";
+       }
+
+
+Sets, adds, or removes the specified merged bugs of a bug
+
+By default, requires
+
+=cut
+
+sub set_merged {
+    my %param = validate_with(params => \@_,
+                             spec   => {bug => {type   => SCALAR,
+                                                regex  => qr/^\d+$/,
+                                               },
+                                        # specific options here
+                                        merge_with => {type => ARRAYREF|SCALAR,
+                                                       optional => 1,
+                                                      },
+                                        remove   => {type => BOOLEAN,
+                                                     default => 0,
+                                                    },
+                                        force    => {type => BOOLEAN,
+                                                     default => 0,
+                                                    },
+                                        masterbug => {type => BOOLEAN,
+                                                      default => 0,
+                                                     },
+                                        allow_reassign => {type => BOOLEAN,
+                                                           default => 0,
+                                                          },
+                                        reassign_different_sources => {type => BOOLEAN,
+                                                                       default => 1,
+                                                                      },
+                                        %common_options,
+                                        %append_action_options,
+                                       },
+                            );
+    my @merging = exists $param{merge_with} ? make_list($param{merge_with}):();
+    my %merging;
+    @merging{@merging} = (1) x @merging;
+    if (grep {$_ !~ /^\d+$/} @merging) {
+       croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging);
+    }
+    $param{locks} = {} if not exists $param{locks};
+    my %info =
+       __begin_control(%param,
+                       command  => 'merge'
+                      );
+    my ($debug,$transcript) =
+       @info{qw(debug transcript)};
+    if (not @merging and exists $param{merge_with}) {
+       print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
+       __end_control(%info);
+       return;
+    }
+    my @data = @{$info{data}};
+    my @bugs = @{$info{bugs}};
+    my %data;
+    my %merged_bugs;
+    for my $data (@data) {
+       $data{$data->{bug_num}} = $data;
+       my @merged_bugs = split / /, $data->{mergedwith};
+       @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
+    }
+    # handle unmerging
+    my $new_locks = 0;
+    if (not exists $param{merge_with}) {
+       my $ok_to_unmerge = 1;
+       delete $merged_bugs{$param{bug}};
+       if (not keys %merged_bugs) {
+           print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
+           __end_control(%info);
+           return;
+       }
+       my $action = "Disconnected #$param{bug} from all other report(s).";
+       for my $data (@data) {
+           my $old_data = dclone($data);
+           if ($data->{bug_num} == $param{bug}) {
+               $data->{mergedwith} = '';
+           }
+           else {
+               $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
+                                           keys %merged_bugs);
+           }
+           append_action_to_log(bug => $data->{bug_num},
+                                command  => 'merge',
+                                new_data => $data,
+                                old_data => $old_data,
+                                get_lock => 0,
+                                __return_append_to_log_options(%param,
+                                                               action => $action,
+                                                              ),
+                               )
+               if not exists $param{append_log} or $param{append_log};
+           writebug($data->{bug_num},$data);
+       }
+       print {$transcript} "$action\n";
+       __end_control(%info);
+       return;
+    }
+    # lock and load all of the bugs we need
+    my @bugs_to_load = keys %merging;
+    my $bug_to_load;
+    my %merge_added;
+    my ($data,$n_locks) =
+       __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
+                                   data => \@data,
+                                   locks => $param{locks},
+                                   debug => $debug,
+                                  );
+    $new_locks += $n_locks;
+    %data = %{$data};
+    @data = values %data;
+    if (not __check_limit(data => [@data],
+                         exists $param{limit}?(limit => $param{limit}):(),
+                         transcript => $transcript,
+                        )) {
+       die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
+    }
+    for my $data (@data) {
+       $data{$data->{bug_num}} = $data;
+       $merged_bugs{$data->{bug_num}} = 1;
+       my @merged_bugs = split / /, $data->{mergedwith};
+       @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
+       if (exists $param{affected_bugs}) {
+           $param{affected_bugs}{$data->{bug_num}} = 1;
+       }
+    }
+    __handle_affected_packages(%param,data => [@data]);
+    my %bug_info_shown; # which bugs have had information shown
+    $bug_info_shown{$param{bug}} = 1;
+    add_recipients(data => [@data],
+                  recipients => $param{recipients},
+                  (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
+                  debug      => $debug,
+                  (__internal_request()?(transcript => $transcript):()),
+                 );
+
+    # Figure out what the ideal state is for the bug, 
+    my ($merge_status,$bugs_to_merge) =
+       __calculate_merge_status(\@data,\%data,$param{bug});
+    # find out if we actually have any bugs to merge
+    if (not $bugs_to_merge) {
+       print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
+       for (1..$new_locks) {
+           unfilelock($param{locks});
+           $locks--;
+       }
+       __end_control(%info);
+       return;
+    }
+    # see what changes need to be made to merge the bugs
+    # check to make sure that the set of changes we need to make is allowed
+    my ($disallowed_changes,$changes) = 
+       __calculate_merge_changes(\@data,$merge_status,\%param);
+    # at this point, stop if there are disallowed changes, otherwise
+    # make the allowed changes, and then reread the bugs in question
+    # to get the new data, then recaculate the merges; repeat
+    # reloading and recalculating until we try too many times or there
+    # are no changes to make.
+
+    my $attempts = 0;
+    # we will allow at most 4 times through this; more than 1
+    # shouldn't really happen.
+    my %bug_changed;
+    while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) {
+       if ($attempts > 1) {
+           print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n";
+       }
+       if (@{$disallowed_changes}) {
+           # 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";
+           }
+           if ($attempts > 0) {
+               croak "Some bugs were altered while attempting to merge";
+           }
+           else {
+               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),
+                             );
+               }
+               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),
+                                    );
+           }
+       }
+       __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) {
+           next if $bug_info_shown{$data->{bug_num}};
+           print {$transcript} __bug_info($data);
+       }
+    }
+    if (keys %{$changes} or @{$disallowed_changes}) {
+       print {$transcript} "Unable to modify bugs so that they could be merged\n";
+       for (1..$new_locks) {
+           unfilelock($param{locks});
+           $locks--;
+       }
+       __end_control(%info);
+       return;
+    }
+
+    # finally, we can merge the bugs
+    my $action = "Merged ".join(' ',sort keys %merged_bugs);
+    for my $data (@data) {
+       my $old_data = dclone($data);
+       $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
+                                   keys %merged_bugs);
+       append_action_to_log(bug => $data->{bug_num},
+                            command  => 'merge',
+                            new_data => $data,
+                            old_data => $old_data,
+                            get_lock => 0,
+                            __return_append_to_log_options(%param,
+                                                           action => $action,
+                                                          ),
+                           )
+           if not exists $param{append_log} or $param{append_log};
+       writebug($data->{bug_num},$data);
+    }
+    print {$transcript} "$action\n";
+    # unlock the extra locks that we got earlier
+    for (1..$new_locks) {
+       unfilelock($param{locks});
+       $locks--;
+    }
+    __end_control(%info);
+}
+
+sub __allow_relocking{
+    my ($locks,$bugs) = @_;
+
+    for my $bug (@{$bugs}) {
+       my @lockfiles = grep {m{/\Q$bug\E$}} keys %{$locks->{locks}};
+       next unless @lockfiles;
+       $locks->{relockable}{$lockfiles[0]} = 0;
+    }
+}
+
+sub __disallow_relocking{
+    my ($locks) = @_;
+    delete $locks->{relockable};
+}
+
+sub __lock_and_load_merged_bugs{
+    my %param =
+       validate_with(params => \@_,
+                     spec =>
+                     {bugs_to_load => {type => ARRAYREF,
+                                       default => sub {[]},
+                                      },
+                      data         => {type => HASHREF|ARRAYREF,
+                                      },
+                      locks        => {type => HASHREF,
+                                       default => sub {{};},
+                                      },
+                      reload_all => {type => BOOLEAN,
+                                     default => 0,
+                                    },
+                      debug           => {type => HANDLE,
+                                         },
+                     },
+                    );
+    my %data;
+    my $new_locks = 0;
+    if (ref($param{data}) eq 'ARRAY') {
+       for my $data (@{$param{data}}) {
+           $data{$data->{bug_num}} = dclone($data);
+       }
+    }
+    else {
+       %data = %{dclone($param{data})};
+    }
+    my @bugs_to_load = @{$param{bugs_to_load}};
+    if ($param{reload_all}) {
+       push @bugs_to_load, keys %data;
+    }
+    my %temp;
+    @temp{@bugs_to_load} = (1) x @bugs_to_load;
+    @bugs_to_load = keys %temp;
+    my %loaded_this_time;
+    my $bug_to_load;
+    while ($bug_to_load = shift @bugs_to_load) {
+       if (not $param{reload_all}) {
+           next if exists $data{$bug_to_load};
+       }
+       else {
+           next if $loaded_this_time{$bug_to_load};
+       }
+       my $lock_bug = 1;
+       if ($param{reload_all}) {
+           if (exists $data{$bug_to_load}) {
+               $lock_bug = 0;
+           }
+       }
+       my $data =
+           read_bug(bug => $bug_to_load,
+                    lock => $lock_bug,
+                    locks => $param{locks},
+                   ) or
+                       die "Unable to load bug $bug_to_load";
+       print {$param{debug}} "read bug $bug_to_load\n";
+       $data{$data->{bug_num}} = $data;
+       $new_locks += $lock_bug;
+       $loaded_this_time{$data->{bug_num}} = 1;
+       push @bugs_to_load,
+           grep {not exists $data{$_}}
+               split / /,$data->{mergedwith};
+    }
+    return (\%data,$new_locks);
+}
+
+
+sub __calculate_merge_status{
+    my ($data_a,$data_h,$master_bug,$merge) = @_;
+    my %merge_status;
+    my %merged_bugs;
+    my $bugs_to_merge = 0;
+    for my $data (@{$data_a}) {
+       # check to see if this bug is unmerged in the set
+       if (not length $data->{mergedwith} or
+           grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) {
+           $merged_bugs{$data->{bug_num}} = 1;
+           $bugs_to_merge = 1;
+       }
+       # the master_bug is the bug that every other bug is made to
+       # look like. However, if merge is set, tags, fixed and found
+       # are merged.
+       if ($data->{bug_num} == $master_bug) {
+           for (qw(package forwarded severity blocks blockedby done owner summary affects)) {
+               $merge_status{$_} = $data->{$_}
+           }
+       }
+       if (not $merge) {
+           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;
+       }
+       $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}});
+       for (qw(fixed found)) {
+           @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
+       }
+    }
+    return (\%merge_status,$bugs_to_merge);
+}
+
+
+
+sub __calculate_merge_changes{
+    my ($datas,$merge_status,$param) = @_;
+    my %changes;
+    my @disallowed_changes;
+    for my $data (@{$datas}) {
+       # things that can be forced
+       #
+       # * func is the function to set the new value
+       #
+       # * key is the key of the function to set the value,
+
+       # * modify_value is a function which is called to modify the new
+       # value so that the function will accept it
+
+        # * options is an ARRAYREF of options to pass to the function
+
+       # * allowed is a BOOLEAN which controls whether this setting
+       # is allowed to be different by default.
+       my %force_functions =
+           (forwarded => {func => \&set_forwarded,
+                          key  => 'forwarded',
+                          options => [],
+                         },
+            severity  => {func => \&set_severity,
+                          key  => 'severity',
+                          options => [],
+                         },
+            blocks    => {func => \&set_blocks,
+                          modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
+                          key  => 'block',
+                          options => [],
+                         },
+            blockedby => {func => \&set_blocks,
+                          modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
+                          key  => 'block',
+                          options => [],
+                         },
+            done      => {func => \&set_done,
+                          key  => 'done',
+                          options => [],
+                         },
+            owner     => {func => \&owner,
+                          key  => 'owner',
+                          options => [],
+                         },
+            summary   => {func => \&summary,
+                          key  => 'summary',
+                          options => [],
+                         },
+            affects   => {func => \&affects,
+                          key  => 'package',
+                          options => [],
+                         },
+            package   => {func => \&set_package,
+                          key  => 'package',
+                          options => [],
+                         },
+            keywords   => {func => \&set_tag,
+                           key  => 'tag',
+                           modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]},
+                           allowed => 1,
+                          },
+            fixed_versions => {func => \&set_fixed,
+                               key => 'fixed',
+                               allowed => 1,
+                              },
+            found_versions => {func => \&set_found,
+                               key   => 'found',
+                               allowed => 1,
+                              },
+           );
+       for my $field (qw(forwarded severity blocks blockedby done owner summary affects package fixed_versions found_versions keywords)) {
+           # if the ideal bug already has the field set properly, we
+           # continue on.
+           if ($field eq 'keywords'){
+               next if join(' ',sort split /\s+/,$data->{keywords}) eq
+                   join(' ',sort keys %{$merge_status->{tag}});
+           }
+           elsif ($field =~ /^(?:fixed|found)_versions$/) {
+               next if join(' ', sort @{$data->{$field}}) eq
+                   join(' ',sort keys %{$merge_status->{$field}});
+           }
+           elsif ($merge_status->{$field} eq $data->{$field}) {
+               next;
+           }
+           my $change =
+               {field => $field,
+                bug => $data->{bug_num},
+                orig_value => $data->{$field},
+                func_value   =>
+                (exists $force_functions{$field}{modify_value} ?
+                 $force_functions{$field}{modify_value}->($merge_status->{$field}):
+                 $merge_status->{$field}),
+                value    => $merge_status->{$field},
+                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},
+               };
+           if ($param->{force}) {
+               if ($field ne 'package') {
+                   push @{$changes{$data->{bug_num}}},$change;
+                   next;
+               }
+               if ($param->{allow_reassign}) {
+                   if ($param->{reassign_different_sources}) {
+                       push @{$changes{$data->{bug_num}}},$change;
+                       next;
+                   }
+                   # allow reassigning if binary_to_source returns at
+                   # least one of the same source packages
+                   my @merge_status_source =
+                       binary_to_source(package => $merge_status->{package},
+                                        source_only => 1,
+                                       );
+                   my @other_bug_source =
+                       binary_to_source(package => $data->{package},
+                                        source_only => 1,
+                                       );
+                   my %merge_status_sources;
+                   @merge_status_sources{@merge_status_source} =
+                       (1) x @merge_status_source;
+                   if (grep {$merge_status_sources{$_}} @other_bug_source) {
+                       push @{$changes{$data->{bug_num}}},$change;
+                       next;
+                   }
+               }
+           }
+           push @disallowed_changes,$change;
+       }
+       # blocks and blocked by are weird; we have to go through and
+       # set blocks to the other half of the merged bugs
+    }
+    return (\@disallowed_changes,\%changes);
+}
 
 =head2 affects
 
 
 =head2 affects
 
@@ -1745,9 +2458,9 @@ sub affects {
                                                 regex  => qr/^\d+$/,
                                                },
                                         # specific options here
                                                 regex  => qr/^\d+$/,
                                                },
                                         # specific options here
-                                        packages => {type => SCALAR|ARRAYREF,
-                                                     default => [],
-                                                    },
+                                        package => {type => SCALAR|ARRAYREF|UNDEF,
+                                                    default => [],
+                                                   },
                                         add      => {type => BOOLEAN,
                                                      default => 0,
                                                     },
                                         add      => {type => BOOLEAN,
                                                      default => 0,
                                                     },
@@ -1761,6 +2474,9 @@ sub affects {
     if ($param{add} and $param{remove}) {
         croak "Asking to both add and remove affects is nonsensical";
     }
     if ($param{add} and $param{remove}) {
         croak "Asking to both add and remove affects is nonsensical";
     }
+    if (not defined $param{package}) {
+       $param{package} = [];
+    }
     my %info =
        __begin_control(%param,
                        command  => 'affects'
     my %info =
        __begin_control(%param,
                        command  => 'affects'
@@ -1778,7 +2494,7 @@ sub affects {
         @packages{@packages} = (1) x @packages;
         if ($param{add}) {
              my @added = ();
         @packages{@packages} = (1) x @packages;
         if ($param{add}) {
              my @added = ();
-             for my $package (make_list($param{packages})) {
+             for my $package (make_list($param{package})) {
                  next unless defined $package and length $package;
                  if (not $packages{$package}) {
                      $packages{$package} = 1;
                  next unless defined $package and length $package;
                  if (not $packages{$package}) {
                      $packages{$package} = 1;
@@ -1792,7 +2508,7 @@ sub affects {
         }
         elsif ($param{remove}) {
              my @removed = ();
         }
         elsif ($param{remove}) {
              my @removed = ();
-             for my $package (make_list($param{packages})) {
+             for my $package (make_list($param{package})) {
                   if ($packages{$package}) {
                       next unless defined $package and length $package;
                        delete $packages{$package};
                   if ($packages{$package}) {
                       next unless defined $package and length $package;
                        delete $packages{$package};
@@ -1806,7 +2522,7 @@ sub affects {
              my %added_packages = ();
              my %removed_packages = %packages;
              %packages = ();
              my %added_packages = ();
              my %removed_packages = %packages;
              %packages = ();
-             for my $package (make_list($param{packages})) {
+             for my $package (make_list($param{package})) {
                   next unless defined $package and length $package;
                   $packages{$package} = 1;
                   delete $removed_packages{$package};
                   next unless defined $package and length $package;
                   $packages{$package} = 1;
                   delete $removed_packages{$package};
@@ -1825,6 +2541,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();
        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();
+           next;
        }
         my $old_data = dclone($data);
         $data->{affects} = join(',',keys %packages);
        }
         my $old_data = dclone($data);
         $data->{affects} = join(',',keys %packages);
@@ -1874,8 +2591,9 @@ If summary is undef, unsets the summary
 If summary is 0, sets the summary to the first paragraph contained in
 the message passed.
 
 If summary is 0, sets the summary to the first paragraph contained in
 the message passed.
 
-If summary is numeric, sets the summary to the message specified.
+If summary is a positive integer, sets the summary to the message specified.
 
 
+Otherwise, sets summary to the value passed.
 
 =cut
 
 
 =cut
 
@@ -1893,8 +2611,8 @@ sub summary {
                                         %append_action_options,
                                        },
                             );
                                         %append_action_options,
                                        },
                             );
-    croak "summary must be numeric or undef" if
-       defined $param{summary} and not $param{summary} =~ /^\d+$/;
+# croak "summary must be numeric or undef" if
+#      defined $param{summary} and not $param{summary} =~ /^\d+/;
     my %info =
        __begin_control(%param,
                        command  => 'summary'
     my %info =
        __begin_control(%param,
                        command  => 'summary'
@@ -1912,7 +2630,7 @@ sub summary {
         print {$debug} "Removing summary fields\n";
         $action = 'Removed summary';
     }
         print {$debug} "Removing summary fields\n";
         $action = 'Removed summary';
     }
-    else {
+    elsif ($param{summary} =~ /^\d+$/) {
         my $log = [];
         my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
         if ($param{summary} == 0) {
         my $log = [];
         my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
         if ($param{summary} == 0) {
@@ -1975,6 +2693,9 @@ sub summary {
         # trim off a trailing spaces
         $summary =~ s/\ *$//;
     }
         # trim off a trailing spaces
         $summary =~ s/\ *$//;
     }
+    else {
+       $summary = $param{summary};
+    }
     for my $data (@data) {
         print {$debug} "Going to change summary\n";
         if (((not defined $summary or not length $summary) and
     for my $data (@data) {
         print {$debug} "Going to change summary\n";
         if (((not defined $summary or not length $summary) and
@@ -2014,6 +2735,8 @@ sub summary {
 
 
 
 
 
 
+
+
 =head1 OWNER FUNCTIONS
 
 =head2 owner
 =head1 OWNER FUNCTIONS
 
 =head2 owner
@@ -2353,12 +3076,18 @@ sub append_action_to_log{
                                          message  => {type => SCALAR|ARRAYREF,
                                                       default => '',
                                                      },
                                          message  => {type => SCALAR|ARRAYREF,
                                                       default => '',
                                                      },
+                                         recips   => {type => SCALAR|ARRAYREF,
+                                                      optional => 1
+                                                     },
                                          desc       => {type => SCALAR,
                                                         default => '',
                                                        },
                                          get_lock   => {type => BOOLEAN,
                                                         default => 1,
                                                        },
                                          desc       => {type => SCALAR,
                                                         default => '',
                                                        },
                                          get_lock   => {type => BOOLEAN,
                                                         default => 1,
                                                        },
+                                         locks      => {type => HASHREF,
+                                                        optional => 1,
+                                                       },
                                          # we don't use
                                          # append_action_options here
                                          # because some of these
                                          # we don't use
                                          # append_action_options here
                                          # because some of these
@@ -2373,10 +3102,12 @@ sub append_action_to_log{
      die "Unable to find .log for $param{bug}"
          if not defined $log_location;
      if ($param{get_lock}) {
      die "Unable to find .log for $param{bug}"
          if not defined $log_location;
      if ($param{get_lock}) {
-         filelock("lock/$param{bug}");
+         filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
+         $locks++;
      }
      }
-     my $log = IO::File->new(">>$log_location") or
-         die "Unable to open $log_location for appending: $!";
+     my @records;
+     my $logfh = IO::File->new(">>$log_location") or
+        die "Unable to open $log_location for appending: $!";
      # determine difference between old and new
      my $data_diff = '';
      if (exists $param{old_data} and exists $param{new_data}) {
      # determine difference between old and new
      my $data_diff = '';
      if (exists $param{old_data} and exists $param{new_data}) {
@@ -2397,7 +3128,6 @@ sub append_action_to_log{
                 ref($old_data->{$key}) and
                 ref($new_data->{$key}) eq ref($old_data->{$key})) {
                local $Storable::canonical = 1;
                 ref($old_data->{$key}) and
                 ref($new_data->{$key}) eq ref($old_data->{$key})) {
                local $Storable::canonical = 1;
-               # print STDERR Dumper($new_data,$old_data,$key);
                if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
                    delete $new_data->{$key};
                    delete $old_data->{$key};
                if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
                    delete $new_data->{$key};
                    delete $old_data->{$key};
@@ -2459,7 +3189,7 @@ sub append_action_to_log{
         $data_diff .= html_escape(Data::Dumper->Dump([\%od],[qw(old_data)]));
         $data_diff .= "-->\n";
      }
         $data_diff .= html_escape(Data::Dumper->Dump([\%od],[qw(old_data)]));
         $data_diff .= "-->\n";
      }
-     my $msg = join('',"\6\n",
+     my $msg = join('',
                    (exists $param{command} ?
                     "<!-- command:".html_escape($param{command})." -->\n":""
                    ),
                    (exists $param{command} ?
                     "<!-- command:".html_escape($param{command})." -->\n":""
                    ),
@@ -2484,15 +3214,23 @@ sub append_action_to_log{
      else {
          $msg .= ".\n";
      }
      else {
          $msg .= ".\n";
      }
-     $msg .= "\3\n";
+     push @records, {type => 'html',
+                    text => $msg,
+                   };
+     $msg = '';
      if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
      if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
-         $msg .= "\7\n".join('',escape_log(make_list($param{message})))."\n\3\n"
-              or die "Unable to append to $log_location: $!";
+        push @records, {type => exists $param{recips}?'recips':'incoming-recv',
+                        exists $param{recips}?(recips => [make_list($param{recips})]):(),
+                        text => join('',make_list($param{message})),
+                       };
      }
      }
-     print {$log} $msg or die "Unable to append to $log_location: $!";
-     close $log or die "Unable to close $log_location: $!";
+     write_log_records(logfh=>$logfh,
+                      records => \@records,
+                     );
+     close $logfh or die "Unable to close $log_location: $!";
      if ($param{get_lock}) {
      if ($param{get_lock}) {
-         unfilelock();
+         unfilelock(exists $param{locks}?$param{locks}:());
+         $locks--;
      }
 
 
      }
 
 
@@ -2619,8 +3357,7 @@ sub __return_append_to_log_options{
          $action = "unknown action";
      }
      return (action => $action,
          $action = "unknown action";
      }
      return (action => $action,
-            (map {exists $append_action_options{$_}?($_,$param{$_}):()}
-             keys %param),
+            hash_slice(%param,keys %append_action_options),
            );
 }
 
            );
 }
 
@@ -2657,7 +3394,7 @@ corresponding to this request
 
 =cut
 
 
 =cut
 
-our $locks = 0;
+our $lockhash;
 
 sub __begin_control {
     my %param = validate_with(params => \@_,
 
 sub __begin_control {
     my %param = validate_with(params => \@_,
@@ -2677,13 +3414,16 @@ sub __begin_control {
     my $new_locks;
     my ($debug,$transcript) = __handle_debug_transcript(@_);
     print {$debug} "$param{bug} considering\n";
     my $new_locks;
     my ($debug,$transcript) = __handle_debug_transcript(@_);
     print {$debug} "$param{bug} considering\n";
+    $lockhash = $param{locks} if exists $param{locks};
     my @data = ();
     my $old_die = $SIG{__DIE__};
     $SIG{__DIE__} = *sig_die{CODE};
 
     ($new_locks, @data) =
     my @data = ();
     my $old_die = $SIG{__DIE__};
     $SIG{__DIE__} = *sig_die{CODE};
 
     ($new_locks, @data) =
-       lock_read_all_merged_bugs($param{bug},
-                                 ($param{archived}?'archive':()));
+       lock_read_all_merged_bugs(bug => $param{bug},
+                                 $param{archived}?(location => 'archive'):(),
+                                 exists $param{locks} ? (locks => $param{locks}):(),
+                                );
     $locks += $new_locks;
     if (not @data) {
        die "Unable to read any bugs successfully.";
     $locks += $new_locks;
     if (not @data) {
        die "Unable to read any bugs successfully.";
@@ -2727,6 +3467,7 @@ sub __begin_control {
            debug      => $debug,
            transcript => $transcript,
            param      => \%param,
            debug      => $debug,
            transcript => $transcript,
            param      => \%param,
+           exists $param{locks}?(locks => $param{locks}):(),
           );
 }
 
           );
 }
 
@@ -2743,12 +3484,13 @@ sub __end_control {
     if (exists $info{new_locks} and $info{new_locks} > 0) {
        print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
        for (1..$info{new_locks}) {
     if (exists $info{new_locks} and $info{new_locks} > 0) {
        print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
        for (1..$info{new_locks}) {
-           unfilelock();
+           unfilelock(exists $info{locks}?$info{locks}:());
+           $locks--;
        }
     }
     $SIG{__DIE__} = $info{old_die};
        }
     }
     $SIG{__DIE__} = $info{old_die};
-    if (exists $info{param}{bugs_affected}) {
-       @{$info{param}{bugs_affected}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
+    if (exists $info{param}{affected_bugs}) {
+       @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
     }
     add_recipients(recipients => $info{param}{recipients},
                   (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
     }
     add_recipients(recipients => $info{param}{recipients},
                   (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
@@ -2850,12 +3592,12 @@ matter.]
 =cut
 
 sub sig_die{
 =cut
 
 sub sig_die{
-    #if ($^S) { # in eval
+    if ($^S) { # in eval
        if ($locks) {
        if ($locks) {
-           for (1..$locks) { unfilelock(); }
+           for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
            $locks = 0;
        }
            $locks = 0;
        }
-    #}
+    }
 }
 
 
 }
 
 
@@ -2892,6 +3634,25 @@ sub __message_body_template{
                            );
 }
 
                            );
 }
 
+sub __all_undef_or_equal {
+    my @values = @_;
+    return 1 if @values == 1 or @values == 0;
+    my $not_def = grep {not defined $_} @values;
+    if ($not_def == @values) {
+       return 1;
+    }
+    if ($not_def > 0 and $not_def != @values) {
+       return 0;
+    }
+    my $first_val = shift @values;
+    for my $val (@values) {
+       if ($first_val ne $val) {
+           return 0;
+       }
+    }
+    return 1;
+}
+
 
 1;
 
 
 1;
 
index 89ff785c4152234c72c62f02fb30ac9e17a755c1..f726417a5e715e80bb2253d563fe1f83ba2085ff 100755 (executable)
@@ -135,6 +135,7 @@ my @common_control_options =
      request_nn        => $nn,
      request_replyto   => $replyto,
      message           => \@log,
      request_nn        => $nn,
      request_replyto   => $replyto,
      message           => \@log,
+     affected_bugs     => \%bug_affected,
      affected_packages => \%affected_packages,
      recipients        => \%recipients,
      limit             => \%limit,
      affected_packages => \%affected_packages,
      recipients        => \%recipients,
      limit             => \%limit,
@@ -465,69 +466,35 @@ END
         }
 #### "developer only" ones start here
     } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
         }
 #### "developer only" ones start here
     } elsif (m/^close\s+\#?(-?\d+)(?:\s+(\d.*))?$/i) {
-       $ok++;
-       $ref= $1;
+        $ok++;
+        $ref= $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref}=1;
-       my $version= $2;
-       if (&setbug) {
-           print {$transcript} "'close' is deprecated; see http://$gWebDomain/Developer$gHTMLSuffix#closing.\n";
-           if (length($data->{done}) and not defined($version)) {
-               print {$transcript} "$gBug is already closed, cannot re-close.\n\n";
-                &nochangebug;
-            } else {
-                $action= "$gBug " .
-                    (defined($version) ?
-                        "marked as fixed in version $version" :
-                        "closed") .
-                    ", send any further explanations to $data->{originator}";
-                do {
-                  $affected_packages{$data->{package}} = 1;
-                   add_recipients(data => $data,
-                                 recipients => \%recipients,
-                                 actions_taken => {done => 1},
-                                 transcript   => $transcript,
-                                 ($dl > 0 ? (debug => $transcript):()),
-                                );
-                   $data->{done}= $replyto;
-                    my @keywords= split ' ', $data->{keywords};
-                   my $extramessage = '';
-                    if (grep $_ eq 'pending', @keywords) {
-                        $extramessage= "Removed pending tag.\n";
-                        $data->{keywords}= join ' ', grep $_ ne 'pending',
-                                                @keywords;
-                    }
-                    addfixedversions($data, $data->{package}, $version, 'binary');
-
-                   my $message= <<END;
-From: $gMaintainerEmail ($gProject $gBug Tracking System)
-To: $data->{originator}
-Subject: $gBug#$ref acknowledged by developer
-         ($header{'subject'})
-References: $header{'message-id'} $data->{msgid}
-In-Reply-To: $data->{msgid}
-Message-ID: <handler.$ref.$nn.notifdonectrl.$midix\@$gEmailDomain>
-Reply-To: $ref\@$gEmailDomain
-X-$gProject-PR-Message: they-closed-control $ref
-
-This is an automatic notification regarding your $gBug report
-#$ref: $data->{subject},
-which was filed against the $data->{package} package.
-
-It has been marked as closed by one of the developers, namely
-$replyto.
-
-You should be hearing from them with a substantive response shortly,
-in case you haven't already. If not, please contact them directly.
-
-$gMaintainer
-(administrator, $gProject $gBugs database)
-
-END
-                    &sendmailmessage($message,$data->{originator});
-                } while (&getnextbug);
-            }
-        }
+       if (defined $2) {
+           eval {
+               set_fixed(@common_control_options,
+                         bug   => $ref,
+                         fixed => $2,
+                         add   => 1,
+                        );
+           };
+           if ($@) {
+               $errors++;
+               print {$transcript} "Failed to add fixed version '$2' to $ref: ".cleanup_eval_fail($@,$debug)."\n";
+           }
+       }
+       eval {
+           set_done(@common_control_options,
+                    done      => 1,
+                    bug       => $ref,
+                    reopen    => 0,
+                    notify_submitter => 1,
+                    clear_fixed => 0,
+                   );
+       };
+       if ($@) {
+           $errors++;
+           print {$transcript} "Failed to mark $ref as done: ".cleanup_eval_fail($@,$debug)."\n";
+       }
     } elsif (m/^reassign\s+\#?(-?\d+)\s+ # bug and command
               (?:(?:((?:src:|source:)?$config{package_name_re}) # new package
               (?:\s+((?:$config{package_name_re}\/)?
     } elsif (m/^reassign\s+\#?(-?\d+)\s+ # bug and command
               (?:(?:((?:src:|source:)?$config{package_name_re}) # new package
               (?:\s+((?:$config{package_name_re}\/)?
@@ -546,7 +513,6 @@ END
        }
        @new_packages = map {y/A-Z/a-z/; s/^(?:src|source):/src:/; $_;} @new_packages;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
        }
        @new_packages = map {y/A-Z/a-z/; s/^(?:src|source):/src:/; $_;} @new_packages;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref}=1;
         my $version= $3;
        eval {
            set_package(@common_control_options,
         my $version= $3;
        eval {
            set_package(@common_control_options,
@@ -570,7 +536,6 @@ END
         $ok++;
         $ref= $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ok++;
         $ref= $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref}=1;
        my $new_submitter = $2;
        if (defined $new_submitter) {
            if ($new_submitter eq '=') {
        my $new_submitter = $2;
        if (defined $new_submitter) {
            if ($new_submitter eq '=') {
@@ -581,10 +546,11 @@ END
            }
        }
        eval {
            }
        }
        eval {
-           reopen(@common_control_options,
-                  bug          => $ref,
-                  submitter    => $new_submitter,
-                 );
+           set_done(@common_control_options,
+                    bug          => $ref,
+                    reopen       => 1,
+                    submitter    => $new_submitter,
+                   );
        };
        if ($@) {
            $errors++;
        };
        if ($@) {
            $errors++;
@@ -704,7 +670,6 @@ END
     elsif (m/^submitter\s+\#?(-?\d+)\s+(\!|\S.*\S)$/i) {
         $ok++;
         $ref= $1;
     elsif (m/^submitter\s+\#?(-?\d+)\s+(\!|\S.*\S)$/i) {
         $ok++;
         $ref= $1;
-       $bug_affected{$ref}=1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
        my $newsubmitter = $2 eq '!' ? $replyto : $2;
         if (not Mail::RFC822::Address::valid($newsubmitter)) {
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
        my $newsubmitter = $2 eq '!' ? $replyto : $2;
         if (not Mail::RFC822::Address::valid($newsubmitter)) {
@@ -728,7 +693,6 @@ END
         $ref= $1;
        my $forward_to= $2;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ref= $1;
        my $forward_to= $2;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref} = 1;
        eval {
            set_forwarded(@common_control_options,
                          bug          => $ref,
        eval {
            set_forwarded(@common_control_options,
                          bug          => $ref,
@@ -743,7 +707,6 @@ END
         $ok++;
         $ref= $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ok++;
         $ref= $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref} = 1;
        eval {
            set_forwarded(@common_control_options,
                          bug          => $ref,
        eval {
            set_forwarded(@common_control_options,
                          bug          => $ref,
@@ -758,7 +721,6 @@ END
         $ok++;
         $ref= $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ok++;
         $ref= $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref}=1;
         my $newseverity= $2;
         if (exists $gObsoleteSeverities{$newseverity}) {
             print {$transcript} "Severity level \`$newseverity' is obsolete. " .
         my $newseverity= $2;
         if (exists $gObsoleteSeverities{$newseverity}) {
             print {$transcript} "Severity level \`$newseverity' is obsolete. " .
@@ -785,7 +747,6 @@ END
        $ok++;
        $ref = $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
        $ok++;
        $ref = $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref}=1;
        my $tags = $2;
        my @tags = map {m/^([+=-])(.+)/ ? ($1,$2):($_)} split /[\s,]+/, $tags;
        # this is an array of hashrefs which contain two elements, the
        my $tags = $2;
        my @tags = map {m/^([+=-])(.+)/ ? ($1,$2):($_)} split /[\s,]+/, $tags;
        # this is an array of hashrefs which contain two elements, the
@@ -854,7 +815,6 @@ END
        my $add_remove = defined $1 && $1 eq 'un';
        my @blockers = map {exists $clonebugs{$_}?$clonebugs{$_}:$_} split /[\s,]+/, $3;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
        my $add_remove = defined $1 && $1 eq 'un';
        my @blockers = map {exists $clonebugs{$_}?$clonebugs{$_}:$_} split /[\s,]+/, $3;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref} = 1;
        eval {
             set_blocks(@common_control_options,
                        bug          => $ref,
        eval {
             set_blocks(@common_control_options,
                        bug          => $ref,
@@ -870,7 +830,6 @@ END
         $ok++;
         $ref= $1; my $newtitle= $2;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ok++;
         $ref= $1; my $newtitle= $2;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref} = 1;
        eval {
             set_title(@common_control_options,
                       bug          => $ref,
        eval {
             set_title(@common_control_options,
                       bug          => $ref,
@@ -884,162 +843,49 @@ END
     } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
        $ok++;
        $ref= $1;
     } elsif (m/^unmerge\s+\#?(-?\d+)$/i) {
        $ok++;
        $ref= $1;
-       $bug_affected{$ref} = 1;
-       if (&setbug) {
-           if (!length($data->{mergedwith})) {
-               print {$transcript} "$gBug is not marked as being merged with any others.\n\n";
-               &nochangebug;
-           } else {
-                $mergelowstate eq 'locked' || die "$mergelowstate ?";
-               $action= "Disconnected #$ref from all other report(s).";
-               my @newmergelist= split(/ /,$data->{mergedwith});
-                my $discref= $ref;
-               @bug_affected{@newmergelist} = 1 x @newmergelist;
-                do {
-                    $affected_packages{$data->{package}} = 1;
-                   add_recipients(data => $data,
-                                  recipients => \%recipients,
-                                  transcript   => $transcript,
-                                  ($dl > 0 ? (debug => $transcript):()),
-                                 );
-                   $data->{mergedwith}= ($ref == $discref) ? ''
-                        : join(' ',grep($_ ne $ref,@newmergelist));
-                } while (&getnextbug);
-           }
+       $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
+       eval {
+            set_merged(@common_control_options,
+                       bug          => $ref,
+                      );
+       };
+       if ($@) {
+           $errors++;
+           print {$transcript} "Failed to unmerge $ref: $@".cleanup_eval_fail($@,$debug)."\n";
        }
     } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
        $ok++;
        }
     } elsif (m/^merge\s+#?(-?\d+(\s+#?-?\d+)+)\s*$/i) {
        $ok++;
-        my @tomerge= sort { $a <=> $b } split(/\s+#?/,$1);
-        my @newmergelist= ();
-       my %tags = ();
-       my %found = ();
-       my %fixed = ();
-        &getmerge;
-        while (defined($ref= shift(@tomerge))) {
-            print {$transcript} "D| checking merge $ref\n" if $dl;
-           $ref+= 0;
-           if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
-               $ref = $clonebugs{$ref};
-           }
-           next if grep($_ == $ref,@newmergelist);
-           if (!&getbug) { &notfoundbug; @newmergelist=(); last }
-            if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
-            &foundbug;
-            print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
-           $mismatch= '';
-           &checkmatch('package','m_package',$data->{package},@newmergelist);
-           &checkmatch('forwarded addr','m_forwarded',$data->{forwarded},@newmergelist);
-           $data->{severity} = '$gDefaultSeverity' if $data->{severity} eq '';
-           &checkmatch('severity','m_severity',$data->{severity},@newmergelist);
-           &checkmatch('blocks','m_blocks',$data->{blocks},@newmergelist);
-           &checkmatch('blocked-by','m_blockedby',$data->{blockedby},@newmergelist);
-           &checkmatch('done mark','m_done',length($data->{done}) ? 'done' : 'open',@newmergelist);
-           &checkmatch('owner','m_owner',$data->{owner},@newmergelist);
-           &checkmatch('summary','m_summary',$data->{summary},@newmergelist);
-           &checkmatch('affects','m_affects',$data->{affects},@newmergelist);
-           foreach my $t (split /\s+/, $data->{keywords}) { $tags{$t} = 1; }
-           foreach my $f (@{$data->{found_versions}}) { $found{$f} = 1; }
-           foreach my $f (@{$data->{fixed_versions}}) { $fixed{$f} = 1; }
-           if (length($mismatch)) {
-               print {$transcript} "Mismatch - only $gBugs in same state can be merged:\n".
-                    $mismatch."\n";
-               $errors++;
-               &cancelbug; @newmergelist=(); last;
-           }
-            push(@newmergelist,$ref);
-            push(@tomerge,split(/ /,$data->{mergedwith}));
-           &cancelbug;
-       }
-       if (@newmergelist) {
-            @newmergelist= sort { $a <=> $b } @newmergelist;
-            $action= "Merged @newmergelist.";
-           delete @fixed{keys %found};
-           for $ref (@newmergelist) {
-               &getbug || die "huh ?  $gBug $ref disappeared during merge";
-                $affected_packages{$data->{package}} = 1;
-               add_recipients(data => $data,
-                              recipients => \%recipients,
-                              transcript   => $transcript,
-                              ($dl > 0 ? (debug => $transcript):()),
-                             );
-               @bug_affected{@newmergelist} = 1 x @newmergelist;
-               $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
-               $data->{keywords}= join(' ', keys %tags);
-               $data->{found_versions}= [sort keys %found];
-               $data->{fixed_versions}= [sort keys %fixed];
-               &savebug;
-           }
-           print {$transcript} "$action\n\n";
+       my @tomerge;
+        ($ref,@tomerge) = map {exists $clonebugs{$_}?$clonebugs{$_}:$_}
+           split(/\s+#?/,$1);
+       eval {
+            set_merged(@common_control_options,
+                       bug          => $ref,
+                       merge_with   => \@tomerge,
+                      );
+       };
+       if ($@) {
+           $errors++;
+           print {$transcript} "Failed to merge $ref: $@".cleanup_eval_fail($@,$debug)."\n";
        }
        }
-        &endmerge;
     } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
        $ok++;
     } elsif (m/^forcemerge\s+\#?(-?\d+(?:\s+\#?-?\d+)+)\s*$/i) {
        $ok++;
-       my @temp = split /\s+\#?/,$1;
-       my $master_bug = shift @temp;
-       my $master_bug_data;
-       my @tomerge = sort { $a <=> $b } @temp;
-        unshift @tomerge,$master_bug;
-       print {$transcript} "D| force merging ".join(',',@tomerge)."\n" if $dl;
-       my @newmergelist= ();
-       my %tags = ();
-       my %found = ();
-       my %fixed = ();
-       # Here we try to do the right thing.
-       # First, if the bugs are in the same package, we merge all of the found, fixed, and tags.
-       # If not, we discard the found and fixed.
-       # Everything else we set to the values of the first bug.
-        &getmerge;
-        while (defined($ref= shift(@tomerge))) {
-            print {$transcript} "D| checking merge $ref\n" if $dl;
-           $ref+= 0;
-           if ($ref =~ m/^-\d+$/ && defined $clonebugs{$ref}) {
-               $ref = $clonebugs{$ref};
-           }
-           next if grep($_ == $ref,@newmergelist);
-           if (!&getbug) { &notfoundbug; @newmergelist=(); last }
-            if (!&checkpkglimit) { &cancelbug; @newmergelist=(); last; }
-            &foundbug;
-            print {$transcript} "D| adding $ref ($data->{mergedwith})\n" if $dl;
-           $master_bug_data = $data if not defined $master_bug_data;
-           if ($data->{package} ne $master_bug_data->{package}) {
-                print {$transcript} "Mismatch - only $gBugs in the same package can be forcibly merged:\n".
-                    "$gBug $ref is not in the same package as $master_bug\n";
-               $errors++;
-               &cancelbug; @newmergelist=(); last;
-           }
-           for my $t (split /\s+/,$data->{keywords}) {
-                $tags{$t} = 1;
-           }
-           @found{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
-           @fixed{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
-           push(@newmergelist,$ref);
-            push(@tomerge,split(/ /,$data->{mergedwith}));
-           &cancelbug;
-       }
-       if (@newmergelist) {
-            @newmergelist= sort { $a <=> $b } @newmergelist;
-            $action= "Forcibly Merged @newmergelist.";
-           delete @fixed{keys %found};
-           for $ref (@newmergelist) {
-               &getbug || die "huh ?  $gBug $ref disappeared during merge";
-                $affected_packages{$data->{package}} = 1;
-               add_recipients(data => $data,
-                              recipients => \%recipients,
-                              transcript   => $transcript,
-                              ($dl > 0 ? (debug => $transcript):()),
-                             );
-               @bug_affected{@newmergelist} = 1 x @newmergelist;
-               $data->{mergedwith}= join(' ',grep($_ != $ref,@newmergelist));
-               $data->{keywords}= join(' ', keys %tags);
-               $data->{found_versions}= [sort keys %found];
-               $data->{fixed_versions}= [sort keys %fixed];
-               my @field_list = qw(forwarded package severity blocks blockedby owner done affects summary);
-               @{$data}{@field_list} = @{$master_bug_data}{@field_list};
-               &savebug;
-           }
-           print {$transcript} "$action\n\n";
+       my @tomerge;
+        ($ref,@tomerge) = map {exists $clonebugs{$_}?$clonebugs{$_}:$_}
+           split(/\s+#?/,$1);
+       eval {
+            set_merged(@common_control_options,
+                       bug          => $ref,
+                       merge_with   => \@tomerge,
+                       force        => 1,
+                       masterbug    => 1,
+                      );
+       };
+       if ($@) {
+           $errors++;
+           print {$transcript} $@;
+           print {$transcript} "Failed to forcibly merge $ref: ".cleanup_eval_fail($@,$debug)."\n";
        }
        }
-        &endmerge;
     } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
        $ok++;
 
     } elsif (m/^clone\s+#?(\d+)\s+((-\d+\s+)*-\d+)\s*$/i) {
        $ok++;
 
@@ -1061,7 +907,7 @@ END
                my $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
                my $firstref= $v+0;  $v += $newbugsneeded;
                open(NN,">nextnumber"); print NN "$v\n"; close(NN);
                my $v=<N>; $v =~ s/\n$// || die "nextnumber bad format";
                my $firstref= $v+0;  $v += $newbugsneeded;
                open(NN,">nextnumber"); print NN "$v\n"; close(NN);
-               &unfilelock;
+               unfilelock();
 
                my $lastref = $firstref + $newbugsneeded - 1;
 
 
                my $lastref = $firstref + $newbugsneeded - 1;
 
@@ -1153,11 +999,10 @@ END
        my $add_remove = $2 || '';
        my $packages = $3 || '';
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
        my $add_remove = $2 || '';
        my $packages = $3 || '';
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref} = 1;
        eval {
             affects(@common_control_options,
                     bug => $ref,
        eval {
             affects(@common_control_options,
                     bug => $ref,
-                    packages     => [splitpackages($3)],
+                    package     => [splitpackages($3)],
                     ($add_remove eq '+'?(add => 1):()),
                     ($add_remove eq '-'?(remove => 1):()),
                    );
                     ($add_remove eq '+'?(add => 1):()),
                     ($add_remove eq '-'?(remove => 1):()),
                    );
@@ -1172,7 +1017,6 @@ END
         $ref = $1;
        my $summary_msg = length($2)?$2:undef;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ref = $1;
        my $summary_msg = length($2)?$2:undef;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref} = 1;
        eval {
            summary(@common_control_options,
                    bug          => $ref,
        eval {
            summary(@common_control_options,
                    bug          => $ref,
@@ -1192,7 +1036,6 @@ END
        if ($newowner eq '!') {
            $newowner = $replyto;
        }
        if ($newowner eq '!') {
            $newowner = $replyto;
        }
-       $bug_affected{$ref} = 1;
        eval {
            owner(@common_control_options,
                  bug          => $ref,
        eval {
            owner(@common_control_options,
                  bug          => $ref,
@@ -1207,7 +1050,6 @@ END
         $ok++;
         $ref = $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ok++;
         $ref = $1;
        $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-       $bug_affected{$ref} = 1;
        eval {
            owner(@common_control_options,
                  bug          => $ref,
        eval {
            owner(@common_control_options,
                  bug          => $ref,
@@ -1222,7 +1064,6 @@ END
         $ok++;
         $ref = $1;
         $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ok++;
         $ref = $1;
         $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-        $bug_affected{$ref} = 1;
         eval {
              bug_unarchive(@common_control_options,
                            bug        => $ref,
         eval {
              bug_unarchive(@common_control_options,
                            bug        => $ref,
@@ -1236,7 +1077,6 @@ END
         $ok++;
         $ref = $1;
         $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
         $ok++;
         $ref = $1;
         $ref = $clonebugs{$ref} if exists $clonebugs{$ref};
-        $bug_affected{$ref} = 1;
         eval {
              bug_archive(@common_control_options,
                          bug => $ref,
         eval {
              bug_archive(@common_control_options,
                          bug => $ref,
@@ -1353,7 +1193,7 @@ sub fill_template{
      my $variables = {config => \%config,
                      defined($ref)?(ref    => $ref):(),
                      defined($data)?(data  => $data):(),
      my $variables = {config => \%config,
                      defined($ref)?(ref    => $ref):(),
                      defined($data)?(data  => $data):(),
-                     refs => [keys %bug_affected],
+                     refs => [map {exists $clonebugs{$_}?$clonebugs{$_}:$_} keys %bug_affected],
                      %{$extra_var},
                     };
      my $hole_var = {'&bugurl' =>
                      %{$extra_var},
                     };
      my $hole_var = {'&bugurl' =>