]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Control.pm
try every bug in a changeset on every attempt
[debbugs.git] / Debbugs / Control.pm
index 358842cd023e5003d66bd8a53c0b45a630b07b70..915b6749d93e48dbb182fda110adce7c9e97c8ff 100644 (file)
@@ -5,7 +5,7 @@
 #
 # [Other people have contributed to this file; their copyrights should
 # go here too.]
 #
 # [Other people have contributed to this file; their copyrights should
 # go here too.]
-# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
+# Copyright 2007,2008,2009 by Don Armstrong <don@donarmstrong.com>.
 
 package Debbugs::Control;
 
 
 package Debbugs::Control;
 
@@ -82,7 +82,10 @@ BEGIN{
      $DEBUG = 0 unless defined $DEBUG;
 
      @EXPORT = ();
      $DEBUG = 0 unless defined $DEBUG;
 
      @EXPORT = ();
-     %EXPORT_TAGS = (affects => [qw(affects)],
+     %EXPORT_TAGS = (done    => [qw(set_done)],
+                    submitter => [qw(set_submitter)],
+                    severity => [qw(set_severity)],
+                    affects => [qw(affects)],
                     summary => [qw(summary)],
                     owner   => [qw(owner)],
                     title   => [qw(set_title)],
                     summary => [qw(summary)],
                     owner   => [qw(owner)],
                     title   => [qw(set_title)],
@@ -90,6 +93,10 @@ BEGIN{
                     found   => [qw(set_found set_fixed)],
                     fixed   => [qw(set_found set_fixed)],
                     package => [qw(set_package)],
                     found   => [qw(set_found set_fixed)],
                     fixed   => [qw(set_found set_fixed)],
                     package => [qw(set_package)],
+                    block   => [qw(set_blocks)],
+                    merge   => [qw(set_merged)],
+                    tag     => [qw(set_tag)],
+                    clone   => [qw(clone_bug)],
                     archive => [qw(bug_archive bug_unarchive),
                                ],
                     log     => [qw(append_action_to_log),
                     archive => [qw(bug_archive bug_unarchive),
                                ],
                     log     => [qw(append_action_to_log),
@@ -101,27 +108,30 @@ BEGIN{
 }
 
 use Debbugs::Config qw(:config);
 }
 
 use Debbugs::Config qw(:config);
-use Debbugs::Common qw(:lock buglog :misc get_hashname);
-use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages);
+use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions);
+use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
 use Debbugs::CGI qw(html_escape);
 use Debbugs::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 Params::Validate qw(validate_with :types);
 use File::Path qw(mkpath);
+use File::Copy qw(copy);
 use IO::File;
 
 use Debbugs::Text qw(:templates);
 
 use IO::File;
 
 use Debbugs::Text qw(:templates);
 
-use Debbugs::Mail qw(rfc822_date);
+use Debbugs::Mail qw(rfc822_date send_mail_message default_headers);
+use Debbugs::MIME qw(create_mime_message);
 
 use Mail::RFC822::Address qw();
 
 use POSIX qw(strftime);
 
 use Storable qw(dclone nfreeze);
 
 use Mail::RFC822::Address qw();
 
 use POSIX qw(strftime);
 
 use Storable qw(dclone nfreeze);
-use List::Util qw(first);
+use List::Util qw(first max);
 
 use Carp;
 
 
 use Carp;
 
@@ -157,6 +167,12 @@ my %common_options = (debug       => {type => SCALARREF|HANDLE,
                      request_nn       => {type => SCALAR,
                                           optional => 1,
                                          },
                      request_nn       => {type => SCALAR,
                                           optional => 1,
                                          },
+                     request_replyto   => {type => SCALAR,
+                                           optional => 1,
+                                          },
+                     locks             => {type => HASHREF,
+                                           optional => 1,
+                                          },
                     );
 
 
                     );
 
 
@@ -182,8 +198,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.
 #
@@ -242,9 +265,297 @@ my %append_action_options =
 #      writebug($data->{bug_num},$data);
 #      print {$transcript} "$action\n";
 #     }
 #      writebug($data->{bug_num},$data);
 #      print {$transcript} "$action\n";
 #     }
-#     __end_control(\%info);
+#     __end_control(%info);
 # }
 
 # }
 
+
+=head2 set_blocks
+
+     eval {
+           set_block(bug          => $ref,
+                     transcript   => $transcript,
+                     ($dl > 0 ? (debug => $transcript):()),
+                     requester    => $header{from},
+                     request_addr => $controlrequestaddr,
+                     message      => \@log,
+                      affected_packages => \%affected_packages,
+                     recipients   => \%recipients,
+                     block        => [],
+                     );
+       };
+       if ($@) {
+           $errors++;
+           print {$transcript} "Failed to set blockers of $ref: $@";
+       }
+
+Alters the set of bugs that block this bug from being fixed
+
+This requires altering both this bug (and those it's merged with) as
+well as the bugs that block this bug from being fixed (and those that
+it's merged with)
+
+=over
+
+=item block -- scalar or arrayref of blocking bugs to set, add or remove
+
+=item add -- if true, add blocking bugs
+
+=item remove -- if true, remove blocking bugs
+
+=back
+
+=cut
+
+sub set_blocks {
+    my %param = validate_with(params => \@_,
+                             spec   => {bug => {type   => SCALAR,
+                                                regex  => qr/^\d+$/,
+                                               },
+                                        # specific options here
+                                        block => {type => SCALAR|ARRAYREF,
+                                                  default => [],
+                                                 },
+                                        add    => {type => BOOLEAN,
+                                                   default => 0,
+                                                  },
+                                        remove => {type => BOOLEAN,
+                                                   default => 0,
+                                                  },
+                                        %common_options,
+                                        %append_action_options,
+                                       },
+                            );
+    if ($param{add} and $param{remove}) {
+       croak "It's nonsensical to add and remove the same blocking bugs";
+    }
+    if (grep {$_ !~ /^\d+$/} make_list($param{block})) {
+       croak "Invalid blocking bug(s):".
+           join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
+    }
+    my $mode = 'set';
+    if ($param{add}) {
+       $mode = 'add';
+    }
+    elsif ($param{remove}) {
+       $mode = 'remove';
+    }
+
+    my %info =
+       __begin_control(%param,
+                       command  => 'blocks'
+                      );
+    my ($debug,$transcript) =
+       @info{qw(debug transcript)};
+    my @data = @{$info{data}};
+    my @bugs = @{$info{bugs}};
+
+
+    # The first bit of this code is ugly, and should be cleaned up.
+    # Its purpose is to populate %removed_blockers and %add_blockers
+    # with all of the bugs that should be added or removed as blockers
+    # of all of the bugs which are merged with $param{bug}
+    my %ok_blockers;
+    my %bad_blockers;
+    for my $blocker (make_list($param{block})) {
+       next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
+       my $data = read_bug(bug=>$blocker,
+                          );
+       if (defined $data and not $data->{archive}) {
+           $data = split_status_fields($data);
+           $ok_blockers{$blocker} = 1;
+           my @merged_bugs;
+           push @merged_bugs, make_list($data->{mergedwith});
+           @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
+       }
+       else {
+           $bad_blockers{$blocker} = 1;
+       }
+    }
+
+    # throw an error if we are setting the blockers and there is a bad
+    # blocker
+    if (keys %bad_blockers and $mode eq 'set') {
+       croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
+           keys %ok_blockers?'':" and no known blocking bug(s)";
+    }
+    # if there are no ok blockers and we are not setting the blockers,
+    # there's an error.
+    if (not keys %ok_blockers and $mode ne 'set') {
+       print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
+       if (keys %bad_blockers) {
+           croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
+       }
+       __end_control(%info);
+       return;
+    }
+
+    my @change_blockers = keys %ok_blockers;
+
+    my %removed_blockers;
+    my %added_blockers;
+    my $action = '';
+    my @blockers = map {split ' ', $_->{blockedby}} @data;
+    my %blockers;
+    @blockers{@blockers} = (1) x @blockers;
+
+    # it is nonsensical for a bug to block itself (or a merged
+    # partner); We currently don't allow removal because we'd possibly
+    # deadlock
+
+    my %bugs;
+    @bugs{@bugs} = (1) x @bugs;
+    for my $blocker (@change_blockers) {
+       if ($bugs{$blocker}) {
+           croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
+       }
+    }
+    @blockers = keys %blockers;
+    if ($param{add}) {
+       %removed_blockers = ();
+       for my $blocker (@change_blockers) {
+           next if exists $blockers{$blocker};
+           $blockers{$blocker} = 1;
+           $added_blockers{$blocker} = 1;
+       }
+    }
+    elsif ($param{remove}) {
+       %added_blockers = ();
+       for my $blocker (@change_blockers) {
+           next if exists $removed_blockers{$blocker};
+           delete $blockers{$blocker};
+           $removed_blockers{$blocker} = 1;
+       }
+    }
+    else {
+       @removed_blockers{@blockers} = (1) x @blockers;
+       %blockers = ();
+       for my $blocker (@change_blockers) {
+           next if exists $blockers{$blocker};
+           $blockers{$blocker} = 1;
+           if (exists $removed_blockers{$blocker}) {
+               delete $removed_blockers{$blocker};
+           }
+           else {
+               $added_blockers{$blocker} = 1;
+           }
+       }
+    }
+    my @new_blockers = keys %blockers;
+    for my $data (@data) {
+       my $old_data = dclone($data);
+       # remove blockers and/or add new ones as appropriate
+       if ($data->{blockedby} eq '') {
+           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 {
+           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;
+       push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
+       $action = ucfirst(join ('; ',@changed)) if @changed;
+       if (not @changed) {
+           print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n";
+           next;
+       }
+       $data->{blockedby} = join(' ',keys %blockers);
+       append_action_to_log(bug => $data->{bug_num},
+                            command  => 'block',
+                            old_data => $old_data,
+                            new_data => $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";
+    }
+    # we do this bit below to avoid code duplication
+    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};
+           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) {
+               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) {
+               $munge_blockers{$_} = 1;
+           }
+           for my $data (@blocking_data) {
+               my $old_data = dclone($data);
+               my %blocks;
+               my @blocks = split ' ', $data->{blocks};
+               @blocks{@blocks} = (1) x @blocks;
+               @blocks = ();
+               for my $bug (@bugs) {
+                   if ($add_remove eq 'remove') {
+                       next unless exists $blocks{$bug};
+                       delete $blocks{$bug};
+                   }
+                   else {
+                       next if exists $blocks{$bug};
+                       $blocks{$bug} = 1;
+                   }
+                   push @blocks, $bug;
+               }
+               $data->{blocks} = join(' ',sort keys %blocks);
+               my $action = ($add_remove eq 'add'?'Added':'Removed').
+                   " indication that bug $data->{bug_num} blocks ".
+                   join(',',@blocks);
+               append_action_to_log(bug => $data->{bug_num},
+                                    command => 'block',
+                                    old_data => $old_data,
+                                    new_data => $data,
+                                    get_lock => 0,
+                                    __return_append_to_log_options(%param,
+                                                                  action => $action
+                                                                  )
+                                   );
+               writebug($data->{bug_num},$data);
+           }
+           __handle_affected_packages(%param,data=>\@blocking_data);
+           add_recipients(recipients => $param{recipients},
+                          actions_taken => {blocks => 1},
+                          data       => \@blocking_data,
+                          debug      => $debug,
+                          transcript => $transcript,
+                         );
+
+           for (1..$new_locks) {
+               unfilelock(exists $param{locks}?$param{locks}:());
+               $locks--;
+           }
+       }
+    }
+    __end_control(%info);
+}
+
+
+
 =head2 set_tag
 
      eval {
 =head2 set_tag
 
      eval {
@@ -331,17 +642,11 @@ sub set_tag {
     # first things first, make the versions fully qualified source
     # versions
     for my $data (@data) {
     # first things first, make the versions fully qualified source
     # versions
     for my $data (@data) {
-       # The 'done' field gets a bit weird with version tracking,
-       # because a bug may be closed by multiple people in different
-       # branches. Until we have something more flexible, we set it
-       # every time a bug is fixed, and clear it when a bug is found
-       # in a version greater than any version in which the bug is
-       # fixed or when a bug is found and there is no fixed version
        my $action = 'Did not alter tags';
        my %tag_added = ();
        my %tag_removed = ();
        my %fixed_removed = ();
        my $action = 'Did not alter tags';
        my %tag_added = ();
        my %tag_removed = ();
        my %fixed_removed = ();
-       my @old_tags = split /\,\s*/, $data->{tags};
+       my @old_tags = split /\,?\s+/, $data->{keywords};
        my %tags;
        @tags{@old_tags} = (1) x @old_tags;
        my $reopened = 0;
        my %tags;
        @tags{@old_tags} = (1) x @old_tags;
        my $reopened = 0;
@@ -383,15 +688,14 @@ sub set_tag {
            print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
            print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
        }
            print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
            print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
        }
-       $data->{tags} = join(', ',keys %tags); # double check this
+       $data->{keywords} = join(' ',keys %tags);
 
        my @changed;
        push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
        push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
        $action = ucfirst(join ('; ',@changed)) if @changed;
        if (not @changed) {
 
        my @changed;
        push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
        push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
        $action = ucfirst(join ('; ',@changed)) if @changed;
        if (not @changed) {
-           print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
            next;
        }
        $action .= '.';
            next;
        }
        $action .= '.';
@@ -434,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
 
@@ -474,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 '') {
@@ -484,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},
@@ -498,23 +802,22 @@ sub set_severity {
        writebug($data->{bug_num},$data);
        print {$transcript} "$action\n";
     }
        writebug($data->{bug_num},$data);
        print {$transcript} "$action\n";
     }
-    __end_control(\%info);
+    __end_control(%info);
 }
 
 
 }
 
 
-=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++;
@@ -525,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)};
@@ -557,45 +880,169 @@ 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;
+       $action = "Bug reopened";
+       for my $data (@data) {
+           my $old_data = dclone($data);
+           $data->{done} = '';
+           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);
        }
        }
-       if (defined $param{submitter} and length $param{submitter}
-           and $data->{originator} ne $param{submitter}) {
-           push @change_submitter,$data->{bug_num};
+       print {$transcript} "$action\n";
+       __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)
+                        );
+       }
+       # 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) {
+           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;
+           }
+       }
+       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,
+           $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);
+           print {$transcript} "$action\n";
+           # 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,
+                                   );
+           }
+       }
+       __end_control(%info);
+       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,
-            );
 }
 
 
 }
 
 
@@ -657,21 +1104,21 @@ sub set_submitter {
        my $old_data = dclone($data);
        print {$debug} "Going to change bug submitter\n";
        if (((not defined $param{submitter} or not length $param{submitter}) and
        my $old_data = dclone($data);
        print {$debug} "Going to change bug submitter\n";
        if (((not defined $param{submitter} or not length $param{submitter}) and
-             (not defined $data->{submitter} or not length $data->{submitter})) or
-            $param{submitter} eq $data->{submitter}) {
-           print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n"
-               unless __internal_request();
+             (not defined $data->{originator} or not length $data->{originator})) or
+            (defined $param{submitter} and defined $data->{originator} and
+             $param{submitter} eq $data->{originator})) {
+           print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
            next;
        }
        else {
            next;
        }
        else {
-           if (defined $data->{submitter} and length($data->{submitter})) {
-               $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{submitter}'";
+           if (defined $data->{originator} and length($data->{originator})) {
+               $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'";
                $notify_old_submitter = 1;
            }
            else {
                $action= "Set $config{bug} submitter to '$param{submitter}'.";
            }
                $notify_old_submitter = 1;
            }
            else {
                $action= "Set $config{bug} submitter to '$param{submitter}'.";
            }
-           $data->{submitter} = $param{submitter};
+           $data->{originator} = $param{submitter};
        }
         append_action_to_log(bug => $data->{bug_num},
                             command => 'submitter',
        }
         append_action_to_log(bug => $data->{bug_num},
                             command => 'submitter',
@@ -689,26 +1136,23 @@ sub set_submitter {
        # notify old submitter
        if ($notify_old_submitter and $param{notify_submitter}) {
            send_mail_message(message =>
        # notify old submitter
        if ($notify_old_submitter and $param{notify_submitter}) {
            send_mail_message(message =>
-                             create_mime_message(["X-Loop"      => $config{maintainer_email},
-                                                  From          => "$config{maintainer_email} ($config{project} $config{ubug} Tracking System)",
-                                                  To            => $old_data->{submitter},
-                                                  Subject       => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
-                                                  "Message-ID"  => "<$data->{bug_num}.$param{request_nn}.ackfwdd\@$config{email_domain}>",
-                                                  "In-Reply-To" => $param{request_msgid},
-                                                  References    => join(' ',grep {defined $_} $param{request_msgid},$data->{msgid}),
-                                                  Precedence    => 'bulk',
-                                                  "X-$gProject-PR-Message"  => "submitter-changed $data->{bug_num}",
-                                                  "X-$gProject-PR-Package"  => $data->{package},
-                                                  "X-$gProject-PR-Keywords" => $data->{keywords},
-                                                  # Only have a X-$gProject-PR-Source when we know the source package
-                                                  (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
+                             create_mime_message([default_headers(queue_file => $param{request_nn},
+                                                                  data => $data,
+                                                                  msgid => $param{request_msgid},
+                                                                  msgtype => 'ack',
+                                                                  pr_msg  => 'submitter-changed',
+                                                                  headers =>
+                                                                  [To => $old_data->{submitter},
+                                                                   Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
+                                                                  ],
+                                                                 )
                                                  ],
                                                  ],
-                                                 message_body_template('mail/submitter_changed',
-                                                                       {old_data => $old_data,
-                                                                        data     => $data,
-                                                                        replyto  => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
-                                                                        config   => \%config,
-                                                                       })
+                                                 __message_body_template('mail/submitter_changed',
+                                                                         {old_data => $old_data,
+                                                                          data     => $data,
+                                                                          replyto  => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
+                                                                          config   => \%config,
+                                                                         })
                                                 ),
                              recipients => $old_data->{submitter},
                             );
                                                 ),
                              recipients => $old_data->{submitter},
                             );
@@ -759,6 +1203,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'
@@ -771,11 +1216,10 @@ 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}) {
-           print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n"
-               unless __internal_request();
+       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";
            next;
        }
        else {
            next;
        }
        else {
@@ -863,8 +1307,7 @@ sub set_title {
        print {$debug} "Going to change bug title\n";
        if (defined $data->{subject} and length($data->{subject}) and
            $data->{subject} eq $param{title}) {
        print {$debug} "Going to change bug title\n";
        if (defined $data->{subject} and length($data->{subject}) and
            $data->{subject} eq $param{title}) {
-           print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
            next;
        }
        else {
            next;
        }
        else {
@@ -968,8 +1411,7 @@ sub set_package {
        print {$debug} "Going to change assigned package\n";
        if (defined $data->{package} and length($data->{package}) and
            $data->{package} eq $new_package) {
        print {$debug} "Going to change assigned package\n";
        if (defined $data->{package} and length($data->{package}) and
            $data->{package} eq $new_package) {
-           print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
            next;
        }
        else {
            next;
        }
        else {
@@ -1133,6 +1575,12 @@ sub set_found {
                if (not @svers) {
                    @svers = $version;
                }
                if (not @svers) {
                    @svers = $version;
                }
+               else {
+                   if (exists $found_versions{$version}) {
+                       delete $found_versions{$version};
+                       $found_removed{$version} = 1;
+                   }
+               }
                for my $sver (@svers) {
                    if (not exists $found_versions{$sver}) {
                        $found_versions{$sver} = 1;
                for my $sver (@svers) {
                    if (not exists $found_versions{$sver}) {
                        $found_versions{$sver} = 1;
@@ -1148,11 +1596,11 @@ sub set_found {
                # We only care about reopening the bug if the bug is
                # not done
                if (defined $data->{done} and length $data->{done}) {
                # We only care about reopening the bug if the bug is
                # not done
                if (defined $data->{done} and length $data->{done}) {
-                   my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
-                       map {m{([^/]+)$}; $1;} @svers;
+                   my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
+                                                   @svers);
                    # determine if we need to reopen
                    # determine if we need to reopen
-                   my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
-                       map {m{([^/]+)$}; $1;} keys %fixed_versions;
+                   my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
+                                                   keys %fixed_versions);
                    if (not @fixed_order or
                        (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
                        $reopened = 1;
                    if (not @fixed_order or
                        (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
                        $reopened = 1;
@@ -1196,13 +1644,12 @@ 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 (not $reopened and not @changed) {
        if ($reopened) {
            $action .= " and reopened"
        }
        if (not $reopened and not @changed) {
-           print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
            next;
        }
        $action .= '.';
            next;
        }
        $action .= '.';
@@ -1345,6 +1792,12 @@ sub set_fixed {
                if (not @svers) {
                    @svers = $version;
                }
                if (not @svers) {
                    @svers = $version;
                }
+               else {
+                   if (exists $fixed_versions{$version}) {
+                       $fixed_removed{$version} = 1;
+                       delete $fixed_versions{$version};
+                   }
+               }
                for my $sver (@svers) {
                    if (not exists $fixed_versions{$sver}) {
                        $fixed_versions{$sver} = 1;
                for my $sver (@svers) {
                    if (not exists $fixed_versions{$sver}) {
                        $fixed_versions{$sver} = 1;
@@ -1405,13 +1858,12 @@ 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 (not $reopened and not @changed) {
        if ($reopened) {
            $action .= " and reopened"
        }
        if (not $reopened and not @changed) {
-           print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
            next;
        }
        $action .= '.';
            next;
        }
        $action .= '.';
@@ -1433,6 +1885,594 @@ 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->{text_orig_value}' not '$change->{text_value}'\n";
+           }
+           if ($attempts > 0) {
+               croak "Some bugs were altered while attempting to merge";
+           }
+           else {
+               croak "Did not alter merged bugs";
+           }
+       }
+       my @bugs_to_change = keys %{$changes};
+       for my $change_bug (@bugs_to_change) {
+           next unless exists $changes->{$change_bug};
+           $bug_changed{$change_bug}++;
+           print {$transcript} __bug_info($data{$change_bug}) if
+               $param{show_bug_info} and not __internal_request(1);
+           $bug_info_shown{$change_bug} = 1;
+           __allow_relocking($param{locks},[keys %data]);
+           for my $change (@{$changes->{$change_bug}}) {
+               if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
+                   my %target_blockedby;
+                   @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
+                   my %unhandled_targets = %target_blockedby;
+                   my @blocks_to_remove;
+                   for my $key (split / /,$change->{orig_value}) {
+                       delete $unhandled_targets{$key};
+                       next if exists $target_blockedby{$key};
+                       set_blocks(bug    => $change->{field} eq 'blocks' ? $key : $change->{bug},
+                                  block  => $change->{field} eq 'blocks' ? $change->{bug} : $key,
+                                  remove => 1,
+                                  hash_slice(%param,
+                                             keys %common_options,
+                                             keys %append_action_options),
+                                 );
+                   }
+                   for my $key (keys %unhandled_targets) {
+                       set_blocks(bug    => $change->{field} eq 'blocks' ? $key : $change->{bug},
+                                  block  => $change->{field} eq 'blocks' ? $change->{bug} : $key,
+                                  add   => 1,
+                                  hash_slice(%param,
+                                             keys %common_options,
+                                             keys %append_action_options),
+                                 );
+                   }
+               }
+               else {
+                   $change->{function}->(bug => $change->{bug},
+                                         $change->{key}, $change->{func_value},
+                                         exists $change->{options}?@{$change->{options}}:(),
+                                         hash_slice(%param,
+                                                    keys %common_options,
+                                                    keys %append_action_options),
+                                        );
+               }
+           }
+           __disallow_relocking($param{locks});
+           my ($data,$n_locks) =
+               __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
+                                           data => \@data,
+                                           locks => $param{locks},
+                                           debug => $debug,
+                                           reload_all => 1,
+                                          );
+           $new_locks += $n_locks;
+           $locks += $n_locks;
+           %data = %{$data};
+           @data = values %data;
+           ($merge_status,$bugs_to_merge) =
+               __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
+           ($disallowed_changes,$changes) = 
+               __calculate_merge_changes(\@data,$merge_status,\%param);
+           $attempts = max(values %bug_changed);
+       }
+    }
+    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} "After four attempts, the following changes were unable to be made:\n";
+       for (1..$new_locks) {
+           unfilelock($param{locks});
+           $locks--;
+       }
+       __end_control(%info);
+       for my $change (values %{$changes}, @{$disallowed_changes}) {
+           print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
+       }
+       die "Unable to modify bugs so they could be merged";
+       return;
+    }
+
+    # 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) = @_;
+
+    my @locks = (@{$bugs},'merge');
+    for my $lock (@locks) {
+       my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
+       next unless @lockfiles;
+       $locks->{relockable}{$lockfiles[0]} = 0;
+    }
+}
+
+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_status) = @_;
+    my %merge_status = %{$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 (defined $merge_status) {
+           next unless $data->{bug_num} == $master_bug;
+       }
+       $merge_status{tag} = {} if not exists $merge_status{tag};
+       for my $tag (split /\s+/, $data->{keywords}) {
+           $merge_status{tag}{$tag} = 1;
+       }
+       $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',
+                               modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
+                               allowed => 1,
+                              },
+            found_versions => {func => \&set_found,
+                               key   => 'found',
+                               modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
+                               allowed => 1,
+                              },
+           );
+       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 ($field eq 'done') {
+               # for done, we only care if the bug is done or not
+               # done, not the value it's set to.
+               if (defined $merge_status->{$field} and length $merge_status->{$field} and
+                   defined $data->{$field}         and length $data->{$field}) {
+                   next;
+               }
+               elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
+                      (not defined $data->{$field}         or not length $data->{$field})
+                     ) {
+                   next;
+               }
+           }
+           elsif ($merge_status->{$field} eq $data->{$field}) {
+               next;
+           }
+           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} ? $force_functions{$field}{allowed} : 0,
+               };
+           $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
+           $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
+           if ($param->{force} or $change->{allowed}) {
+               if ($field ne 'package' or $change->{allowed}) {
+                   push @{$changes{$data->{bug_num}}},$change;
+                   next;
+               }
+               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
 
@@ -1471,9 +2511,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,
                                                     },
@@ -1487,6 +2527,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'
@@ -1504,7 +2547,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;
@@ -1518,7 +2561,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};
@@ -1532,7 +2575,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};
@@ -1545,12 +2588,12 @@ sub affects {
              }
              if (keys %added_packages) {
                  $action .= "Added indication that $data->{bug_num} affects " .
              }
              if (keys %added_packages) {
                  $action .= "Added indication that $data->{bug_num} affects " .
-                  english_join([%added_packages]);
+                  english_join([keys %added_packages]);
              }
         }
        if (not length $action) {
              }
         }
        if (not length $action) {
-           print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n"
-               unless __internal_request();
+           print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
+           next;
        }
         my $old_data = dclone($data);
         $data->{affects} = join(',',keys %packages);
        }
         my $old_data = dclone($data);
         $data->{affects} = join(',',keys %packages);
@@ -1600,8 +2643,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
 
@@ -1619,8 +2663,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'
@@ -1638,7 +2682,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) {
@@ -1675,12 +2719,14 @@ sub summary {
              }
              # skip a paragraph if it looks like it's control or
              # pseudo-headers
              }
              # skip a paragraph if it looks like it's control or
              # pseudo-headers
-             if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
-                                (?:package|(?:no|)owner|severity|tag|summary| #control
-                                     reopen|close|(?:not|)(?:fixed|found)|clone|
-                                     (?:force|)merge|user(?:category|tag|)
-                                )
-                           )\s+\S}x) {
+             if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
+                 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
+                                \#|reopen|close|(?:not|)(?:fixed|found)|clone|
+                                debug|(?:not|)forwarded|priority|
+                                (?:un|)block|limit|(?:un|)archive|
+                                reassign|retitle|affects|wrongpackage
+                                (?:un|force|)merge|user(?:category|tags?|)
+                            )\s+\S}xis) {
                   if (not length $paragraph) {
                        print {$debug} "Found control/pseudo-headers and skiping them\n";
                        $in_pseudoheaders = 1;
                   if (not length $paragraph) {
                        print {$debug} "Found control/pseudo-headers and skiping them\n";
                        $in_pseudoheaders = 1;
@@ -1699,13 +2745,15 @@ 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
              (not defined $data->{summary} or not length $data->{summary})) or
             $summary eq $data->{summary}) {
     for my $data (@data) {
         print {$debug} "Going to change summary\n";
         if (((not defined $summary or not length $summary) and
              (not defined $data->{summary} or not length $data->{summary})) or
             $summary eq $data->{summary}) {
-            print {$transcript} "Ignoring request to change the summary of bug $param{bug} to the same value\n"
-                unless __internal_request();
+            print {$transcript} "Ignoring request to change the summary of bug $param{bug} to the same value\n";
             next;
         }
         if (length $summary) {
             next;
         }
         if (length $summary) {
@@ -1737,6 +2785,140 @@ sub summary {
 
 
 
 
 
 
+=head2 clone_bug
+
+     eval {
+           clone_bug(bug          => $ref,
+                     transcript   => $transcript,
+                     ($dl > 0 ? (debug => $transcript):()),
+                     requester    => $header{from},
+                     request_addr => $controlrequestaddr,
+                     message      => \@log,
+                      affected_packages => \%affected_packages,
+                     recipients   => \%recipients,
+                    );
+       };
+       if ($@) {
+           $errors++;
+           print {$transcript} "Failed to clone bug $ref bar: $@";
+       }
+
+Clones the given bug.
+
+We currently don't support cloning merged bugs, but this could be
+handled by internally unmerging, cloning, then remerging the bugs.
+
+=cut
+
+sub clone_bug {
+    my %param = validate_with(params => \@_,
+                             spec   => {bug => {type   => SCALAR,
+                                                regex  => qr/^\d+$/,
+                                               },
+                                        new_bugs => {type => ARRAYREF,
+                                                    },
+                                        new_clones => {type => HASHREF,
+                                                       default => {},
+                                                      },
+                                        %common_options,
+                                        %append_action_options,
+                                       },
+                            );
+    my %info =
+       __begin_control(%param,
+                       command  => 'clone'
+                      );
+    my ($debug,$transcript) =
+       @info{qw(debug transcript)};
+    my @data = @{$info{data}};
+    my @bugs = @{$info{bugs}};
+
+    my $action = '';
+    for my $data (@data) {
+       if (length($data->{mergedwith})) {
+           die "Bug is marked as being merged with others. Use an existing clone.\n";
+       }
+    }
+    if (@data != 1) {
+       die "Not exactly one bug‽ This shouldn't happen.";
+    }
+    my $data = $data[0];
+    my %clones;
+    for my $newclone_id (@{$param{new_bugs}}) {
+       my $new_bug_num = new_bug(copy => $data->{bug_num});
+       $param{new_clones}{$newclone_id} = $new_bug_num;
+       $clones{$newclone_id} = $new_bug_num;
+    }
+    my @new_bugs = sort values %clones;
+    my @collapsed_ids;
+    for my $new_bug (@new_bugs) {
+       # no collapsed ids or the higher collapsed id is not one less
+       # than the next highest new bug
+       if (not @collapsed_ids or 
+           $collapsed_ids[-1][1]+1 != $new_bug) {
+           push @collapsed_ids,[$new_bug,$new_bug];
+       }
+       else {
+           $collapsed_ids[-1][1] = $new_bug;
+       }
+    }
+    my @collapsed;
+    for my $ci (@collapsed_ids) {
+       if ($ci->[0] == $ci->[1]) {
+           push @collapsed,$ci->[0];
+       }
+       else {
+           push @collapsed,$ci->[0].'-'.$ci->[1]
+       }
+    }
+    my $collapsed_str = english_join(\@collapsed);
+    $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str;
+    for my $new_bug (@new_bugs) {
+       append_action_to_log(bug => $new_bug,
+                            get_lock => 1,
+                            __return_append_to_log_options(
+                                                           %param,
+                                                           action => $action,
+                                                          ),
+                           )
+           if not exists $param{append_log} or $param{append_log};
+    }
+    append_action_to_log(bug => $data->{bug_num},
+                        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);
+    # bugs that this bug is blocking are also blocked by the new clone(s)
+    for my $bug (split ' ', $data->{blocks}) {
+       for my $new_bug (@new_bugs) {
+           set_blocks(bug => $new_bug,
+                      blocks => $bug,
+                      hash_slice(%param,
+                                 keys %common_options,
+                                 keys %append_action_options),
+                     );
+       }
+    }
+    # bugs that this bug is blocked by are also blocking the new clone(s)
+    for my $bug (split ' ', $data->{blockedby}) {
+       for my $new_bug (@new_bugs) {
+           set_blocks(bug => $bug,
+                      blocks => $new_bug,
+                      hash_slice(%param,
+                                 keys %common_options,
+                                 keys %append_action_options),
+                     );
+       }
+    }
+}
+
+
 
 =head1 OWNER FUNCTIONS
 
 
 =head1 OWNER FUNCTIONS
 
@@ -1788,8 +2970,7 @@ sub owner {
          print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
          if (not defined $param{owner} or not length $param{owner}) {
              if (not defined $data->{owner} or not length $data->{owner}) {
          print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
          if (not defined $param{owner} or not length $param{owner}) {
              if (not defined $data->{owner} or not length $data->{owner}) {
-                 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n"
-                     unless __internal_request();
+                 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
                  next;
              }
              $param{owner} = '';
                  next;
              }
              $param{owner} = '';
@@ -1900,7 +3081,6 @@ sub bug_archive {
          print {$transcript} "Bug $param{bug} cannot be archived\n";
          die "Bug $param{bug} cannot be archived";
      }
          print {$transcript} "Bug $param{bug} cannot be archived\n";
          die "Bug $param{bug} cannot be archived";
      }
-     print {$debug} "$param{bug} considering\n";
      if (not $param{archive_unarchived} and
         not exists $data[0]{unarchived}
        ) {
      if (not $param{archive_unarchived} and
         not exists $data[0]{unarchived}
        ) {
@@ -1956,7 +3136,7 @@ sub bug_archive {
               print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
          }
          unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
               print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
          }
          unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
-         print {$transcript} "deleted $bug (from $param{bug})\n";
+         print {$debug} "deleted $bug (from $param{bug})\n";
      }
      bughook_archive(@bugs);
      __end_control(%info);
      }
      bughook_archive(@bugs);
      __end_control(%info);
@@ -2077,12 +3257,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
@@ -2097,10 +3283,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}) {
@@ -2121,7 +3309,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};
@@ -2183,7 +3370,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":""
                    ),
@@ -2208,15 +3395,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--;
      }
 
 
      }
 
 
@@ -2313,7 +3508,7 @@ C<__PACKAGE__>.
 sub __internal_request{
     my ($l) = @_;
     $l = 0 if not defined $l;
 sub __internal_request{
     my ($l) = @_;
     $l = 0 if not defined $l;
-    if (defined +(caller(2+$l))[0] and +(caller(2+$l))[0] eq __PACKAGE__) {
+    if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
        return 1;
     }
     return 0;
        return 1;
     }
     return 0;
@@ -2343,8 +3538,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),
            );
 }
 
            );
 }
 
@@ -2381,7 +3575,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 => \@_,
@@ -2400,22 +3594,36 @@ sub __begin_control {
                             );
     my $new_locks;
     my ($debug,$transcript) = __handle_debug_transcript(@_);
                             );
     my $new_locks;
     my ($debug,$transcript) = __handle_debug_transcript(@_);
-    print {$debug} "$param{bug} considering\n";
+    print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
+#    print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
+    $lockhash = $param{locks} if exists $param{locks};
     my @data = ();
     my $old_die = $SIG{__DIE__};
     $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.";
     }
-    ###
-    # XXX check the limit at this point, and die if it is exceeded.
-    # This is currently not done
-    ###
+    if (not $param{archived}) {
+       for my $data (@data) {
+           if ($data->{archived}) {
+               die "Not altering archived bugs; see unarchive.";
+           }
+       }
+    }
+    if (not __check_limit(data => \@data,
+                         exists $param{limit}?(limit => $param{limit}):(),
+                         transcript => $transcript,
+                        )) {
+       die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
+    }
+
     __handle_affected_packages(%param,data => \@data);
     print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
     print {$debug} "$param{bug} read $locks locks\n";
     __handle_affected_packages(%param,data => \@data);
     print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
     print {$debug} "$param{bug} read $locks locks\n";
@@ -2428,7 +3636,7 @@ sub __begin_control {
                   recipients => $param{recipients},
                   (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
                   debug      => $debug,
                   recipients => $param{recipients},
                   (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
                   debug      => $debug,
-                  transcript => $transcript,
+                  (__internal_request()?(transcript => $transcript):()),
                  );
 
     print {$debug} "$param{bug} read done\n";
                  );
 
     print {$debug} "$param{bug} read done\n";
@@ -2441,6 +3649,7 @@ sub __begin_control {
            debug      => $debug,
            transcript => $transcript,
            param      => \%param,
            debug      => $debug,
            transcript => $transcript,
            param      => \%param,
+           exists $param{locks}?(locks => $param{locks}):(),
           );
 }
 
           );
 }
 
@@ -2457,15 +3666,16 @@ 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},
     }
     add_recipients(recipients => $info{param}{recipients},
-                  (exists $info{param}{command}?(actions_taken => {$info{param}{command} => 1}):()),
+                  (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
                   data       => $info{data},
                   debug      => $info{debug},
                   transcript => $info{transcript},
                   data       => $info{data},
                   debug      => $info{debug},
                   transcript => $info{transcript},
@@ -2474,6 +3684,85 @@ sub __end_control {
 }
 
 
 }
 
 
+=head2 __check_limit
+
+     __check_limit(data => \@data, limit => $param{limit});
+
+
+Checks to make sure that bugs match any limits; each entry of @data
+much satisfy the limit.
+
+Returns true if there are no entries in data, or there are no keys in
+limit; returns false (0) if there are any entries which do not match.
+
+The limit hashref elements can contain an arrayref of scalars to
+match; regexes are also acccepted. At least one of the entries in each
+element needs to match the corresponding field in all data for the
+limit to succeed.
+
+=cut
+
+
+sub __check_limit{
+    my %param = validate_with(params => \@_,
+                             spec   => {data  => {type => ARRAYREF|SCALAR,
+                                                 },
+                                        limit => {type => HASHREF|UNDEF,
+                                                 },
+                                        transcript  => {type => SCALARREF|HANDLE,
+                                                        optional => 1,
+                                                       },
+                                       },
+                            );
+    my @data = make_list($param{data});
+    if (not @data or
+       not defined $param{limit} or
+       not keys %{$param{limit}}) {
+       return 1;
+    }
+    my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
+    my $going_to_fail = 0;
+    for my $data (@data) {
+       $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
+                                                  status => dclone($data),
+                                                 ));
+       for my $field (keys %{$param{limit}}) {
+           next unless exists $param{limit}{$field};
+           my $match = 0;
+           my @data_fields = make_list($data->{$field});
+LIMIT:     for my $limit (make_list($param{limit}{$field})) {
+               if (not ref $limit) {
+                   for my $data_field (@data_fields) {
+                       if ($data_field eq $limit) {
+                           $match = 1;
+                           last LIMIT;
+                       }
+                   }
+               }
+               elsif (ref($limit) eq 'Regexp') {
+                   for my $data_field (@data_fields) {
+                       if ($data_field =~ $limit) {
+                           $match = 1;
+                           last LIMIT;
+                       }
+                   }
+               }
+               else {
+                   warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
+               }
+           }
+           if (not $match) {
+               $going_to_fail = 1;
+               print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
+                   "' does not match at least one of ".
+                   join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
+           }
+       }
+    }
+    return $going_to_fail?0:1;
+}
+
+
 =head2 die
 
      sig_die "foo"
 =head2 die
 
      sig_die "foo"
@@ -2485,12 +3774,65 @@ 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;
        }
-    #}
+    }
+}
+
+
+# =head2 __message_body_template
+#
+#      message_body_template('mail/ack',{ref=>'foo'});
+#
+# Creates a message body using a template
+#
+# =cut
+
+sub __message_body_template{
+     my ($template,$extra_var) = @_;
+     $extra_var ||={};
+     my $hole_var = {'&bugurl' =>
+                    sub{"$_[0]: ".
+                            'http://'.$config{cgi_domain}.'/'.
+                                Debbugs::CGI::bug_url($_[0]);
+                    }
+                   };
+
+     my $body = fill_in_template(template => $template,
+                                variables => {config => \%config,
+                                              %{$extra_var},
+                                             },
+                                hole_var => $hole_var,
+                               );
+     return fill_in_template(template => 'mail/message_body',
+                            variables => {config => \%config,
+                                          %{$extra_var},
+                                          body => $body,
+                                         },
+                            hole_var => $hole_var,
+                           );
+}
+
+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;
 }
 
 
 }