1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007,2008,2009 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Control;
14 Debbugs::Control -- Routines for modifying the state of bugs
23 This module is an abstraction of a lot of functions which originally
24 were only present in service.in, but as time has gone on needed to be
25 called from elsewhere.
27 All of the public functions take the following options:
31 =item debug -- scalar reference to which debbuging information is
34 =item transcript -- scalar reference to which transcript information
37 =item affected_bugs -- hashref which is updated with bugs affected by
43 Functions which should (probably) append to the .log file take the
48 =item requester -- Email address of the individual who requested the change
50 =item request_addr -- Address to which the request was sent
52 =item request_nn -- Name of queue file which caused this request
54 =item request_msgid -- Message id of message which caused this request
56 =item location -- Optional location; currently ignored but may be
57 supported in the future for updating archived bugs upon archival
59 =item message -- The original message which caused the action to be taken
61 =item append_log -- Whether or not to append information to the log.
65 B<append_log> (for most functions) is a special option. When set to
66 false, no appending to the log is done at all. When it is not present,
67 the above information is faked, and appended to the log file. When it
68 is true, the above options must be present, and their values are used.
71 =head1 GENERAL FUNCTIONS
77 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
78 use base qw(Exporter);
82 $DEBUG = 0 unless defined $DEBUG;
85 %EXPORT_TAGS = (done => [qw(set_done)],
86 submitter => [qw(set_submitter)],
87 severity => [qw(set_severity)],
88 affects => [qw(affects)],
89 summary => [qw(summary)],
90 outlook => [qw(outlook)],
92 title => [qw(set_title)],
93 forward => [qw(set_forwarded)],
94 found => [qw(set_found set_fixed)],
95 fixed => [qw(set_found set_fixed)],
96 package => [qw(set_package)],
97 block => [qw(set_blocks)],
98 merge => [qw(set_merged)],
100 clone => [qw(clone_bug)],
101 archive => [qw(bug_archive bug_unarchive),
103 limit => [qw(check_limit)],
104 log => [qw(append_action_to_log),
108 Exporter::export_ok_tags(keys %EXPORT_TAGS);
109 $EXPORT_TAGS{all} = [@EXPORT_OK];
112 use Debbugs::Config qw(:config);
113 use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions :utf8);
114 use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
115 use Debbugs::CGI qw(html_escape);
116 use Debbugs::Log qw(:misc :write);
117 use Debbugs::Recipients qw(:add);
118 use Debbugs::Packages qw(:versions :mapping);
120 use Data::Dumper qw();
121 use Params::Validate qw(validate_with :types);
122 use File::Path qw(mkpath);
123 use File::Copy qw(copy);
126 use Debbugs::Text qw(:templates);
128 use Debbugs::Mail qw(rfc822_date send_mail_message default_headers);
129 use Debbugs::MIME qw(create_mime_message);
131 use Mail::RFC822::Address qw();
133 use POSIX qw(strftime);
135 use Storable qw(dclone nfreeze);
136 use List::Util qw(first max);
137 use Encode qw(encode_utf8);
141 # These are a set of options which are common to all of these functions
143 my %common_options = (debug => {type => SCALARREF|HANDLE,
146 transcript => {type => SCALARREF|HANDLE,
149 affected_bugs => {type => HASHREF,
152 affected_packages => {type => HASHREF,
155 recipients => {type => HASHREF,
158 limit => {type => HASHREF,
161 show_bug_info => {type => BOOLEAN,
164 request_subject => {type => SCALAR,
165 default => 'Unknown Subject',
167 request_msgid => {type => SCALAR,
170 request_nn => {type => SCALAR,
173 request_replyto => {type => SCALAR,
176 locks => {type => HASHREF,
182 my %append_action_options =
183 (action => {type => SCALAR,
186 requester => {type => SCALAR,
189 request_addr => {type => SCALAR,
192 location => {type => SCALAR,
195 message => {type => SCALAR|ARRAYREF,
198 append_log => {type => BOOLEAN,
200 depends => [qw(requester request_addr),
204 # locks is both an append_action option, and a common option;
205 # it's ok for it to be in both places.
206 locks => {type => HASHREF,
214 # this is just a generic stub for Debbugs::Control functions.
219 # set_foo(bug => $ref,
220 # transcript => $transcript,
221 # ($dl > 0 ? (debug => $transcript):()),
222 # requester => $header{from},
223 # request_addr => $controlrequestaddr,
225 # affected_packages => \%affected_packages,
226 # recipients => \%recipients,
232 # print {$transcript} "Failed to set foo $ref bar: $@";
240 # my %param = validate_with(params => \@_,
241 # spec => {bug => {type => SCALAR,
242 # regex => qr/^\d+$/,
244 # # specific options here
246 # %append_action_options,
250 # __begin_control(%param,
253 # my ($debug,$transcript) =
254 # @info{qw(debug transcript)};
255 # my @data = @{$info{data}};
256 # my @bugs = @{$info{bugs}};
259 # for my $data (@data) {
260 # append_action_to_log(bug => $data->{bug_num},
262 # __return_append_to_log_options(
267 # if not exists $param{append_log} or $param{append_log};
268 # writebug($data->{bug_num},$data);
269 # print {$transcript} "$action\n";
271 # __end_control(%info);
278 set_block(bug => $ref,
279 transcript => $transcript,
280 ($dl > 0 ? (debug => $transcript):()),
281 requester => $header{from},
282 request_addr => $controlrequestaddr,
284 affected_packages => \%affected_packages,
285 recipients => \%recipients,
291 print {$transcript} "Failed to set blockers of $ref: $@";
294 Alters the set of bugs that block this bug from being fixed
296 This requires altering both this bug (and those it's merged with) as
297 well as the bugs that block this bug from being fixed (and those that
302 =item block -- scalar or arrayref of blocking bugs to set, add or remove
304 =item add -- if true, add blocking bugs
306 =item remove -- if true, remove blocking bugs
313 my %param = validate_with(params => \@_,
314 spec => {bug => {type => SCALAR,
317 # specific options here
318 block => {type => SCALAR|ARRAYREF,
321 add => {type => BOOLEAN,
324 remove => {type => BOOLEAN,
328 %append_action_options,
331 if ($param{add} and $param{remove}) {
332 croak "It's nonsensical to add and remove the same blocking bugs";
334 if (grep {$_ !~ /^\d+$/} make_list($param{block})) {
335 croak "Invalid blocking bug(s):".
336 join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
342 elsif ($param{remove}) {
347 __begin_control(%param,
350 my ($debug,$transcript) =
351 @info{qw(debug transcript)};
352 my @data = @{$info{data}};
353 my @bugs = @{$info{bugs}};
356 # The first bit of this code is ugly, and should be cleaned up.
357 # Its purpose is to populate %removed_blockers and %add_blockers
358 # with all of the bugs that should be added or removed as blockers
359 # of all of the bugs which are merged with $param{bug}
362 for my $blocker (make_list($param{block})) {
363 next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
364 my $data = read_bug(bug=>$blocker,
366 if (defined $data and not $data->{archive}) {
367 $data = split_status_fields($data);
368 $ok_blockers{$blocker} = 1;
370 push @merged_bugs, make_list($data->{mergedwith});
371 @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
374 $bad_blockers{$blocker} = 1;
378 # throw an error if we are setting the blockers and there is a bad
380 if (keys %bad_blockers and $mode eq 'set') {
381 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
382 keys %ok_blockers?'':" and no known blocking bug(s)";
384 # if there are no ok blockers and we are not setting the blockers,
386 if (not keys %ok_blockers and $mode ne 'set') {
387 print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
388 if (keys %bad_blockers) {
389 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
391 __end_control(%info);
395 my @change_blockers = keys %ok_blockers;
397 my %removed_blockers;
400 my @blockers = map {split ' ', $_->{blockedby}} @data;
402 @blockers{@blockers} = (1) x @blockers;
404 # it is nonsensical for a bug to block itself (or a merged
405 # partner); We currently don't allow removal because we'd possibly
409 @bugs{@bugs} = (1) x @bugs;
410 for my $blocker (@change_blockers) {
411 if ($bugs{$blocker}) {
412 croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
415 @blockers = keys %blockers;
417 %removed_blockers = ();
418 for my $blocker (@change_blockers) {
419 next if exists $blockers{$blocker};
420 $blockers{$blocker} = 1;
421 $added_blockers{$blocker} = 1;
424 elsif ($param{remove}) {
425 %added_blockers = ();
426 for my $blocker (@change_blockers) {
427 next if exists $removed_blockers{$blocker};
428 delete $blockers{$blocker};
429 $removed_blockers{$blocker} = 1;
433 @removed_blockers{@blockers} = (1) x @blockers;
435 for my $blocker (@change_blockers) {
436 next if exists $blockers{$blocker};
437 $blockers{$blocker} = 1;
438 if (exists $removed_blockers{$blocker}) {
439 delete $removed_blockers{$blocker};
442 $added_blockers{$blocker} = 1;
446 my @new_blockers = keys %blockers;
447 for my $data (@data) {
448 my $old_data = dclone($data);
449 # remove blockers and/or add new ones as appropriate
450 if ($data->{blockedby} eq '') {
451 print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n";
453 print {$transcript} "$data->{bug_num} was blocked by: $data->{blockedby}\n";
455 if ($data->{blocks} eq '') {
456 print {$transcript} "$data->{bug_num} was not blocking any bugs.\n";
458 print {$transcript} "$data->{bug_num} was blocking: $data->{blocks}\n";
461 push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
462 push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
463 $action = ucfirst(join ('; ',@changed)) if @changed;
465 print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n";
468 $data->{blockedby} = join(' ',keys %blockers);
469 append_action_to_log(bug => $data->{bug_num},
471 old_data => $old_data,
474 __return_append_to_log_options(
479 if not exists $param{append_log} or $param{append_log};
480 writebug($data->{bug_num},$data);
481 print {$transcript} "$action\n";
483 # we do this bit below to avoid code duplication
485 $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
486 $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
488 for my $add_remove (keys %mungable_blocks) {
492 for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
493 next if $munge_blockers{$blocker};
494 my ($temp_locks, @blocking_data) =
495 lock_read_all_merged_bugs(bug => $blocker,
496 ($param{archived}?(location => 'archive'):()),
497 exists $param{locks}?(locks => $param{locks}):(),
499 $locks+= $temp_locks;
500 $new_locks+=$temp_locks;
501 if (not @blocking_data) {
502 for (1..$new_locks) {
503 unfilelock(exists $param{locks}?$param{locks}:());
506 die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
508 for (map {$_->{bug_num}} @blocking_data) {
509 $munge_blockers{$_} = 1;
511 for my $data (@blocking_data) {
512 my $old_data = dclone($data);
514 my @blocks = split ' ', $data->{blocks};
515 @blocks{@blocks} = (1) x @blocks;
517 for my $bug (@bugs) {
518 if ($add_remove eq 'remove') {
519 next unless exists $blocks{$bug};
520 delete $blocks{$bug};
523 next if exists $blocks{$bug};
528 $data->{blocks} = join(' ',sort keys %blocks);
529 my $action = ($add_remove eq 'add'?'Added':'Removed').
530 " indication that bug $data->{bug_num} blocks ".
532 append_action_to_log(bug => $data->{bug_num},
534 old_data => $old_data,
537 __return_append_to_log_options(%param,
541 writebug($data->{bug_num},$data);
543 __handle_affected_packages(%param,data=>\@blocking_data);
544 add_recipients(recipients => $param{recipients},
545 actions_taken => {blocks => 1},
546 data => \@blocking_data,
548 transcript => $transcript,
551 for (1..$new_locks) {
552 unfilelock(exists $param{locks}?$param{locks}:());
557 __end_control(%info);
566 transcript => $transcript,
567 ($dl > 0 ? (debug => $transcript):()),
568 requester => $header{from},
569 request_addr => $controlrequestaddr,
571 affected_packages => \%affected_packages,
572 recipients => \%recipients,
579 print {$transcript} "Failed to set tag on $ref: $@";
583 Sets, adds, or removes the specified tags on a bug
587 =item tag -- scalar or arrayref of tags to set, add or remove
589 =item add -- if true, add tags
591 =item remove -- if true, remove tags
593 =item warn_on_bad_tags -- if true (the default) warn if bad tags are
601 my %param = validate_with(params => \@_,
602 spec => {bug => {type => SCALAR,
605 # specific options here
606 tag => {type => SCALAR|ARRAYREF,
609 add => {type => BOOLEAN,
612 remove => {type => BOOLEAN,
615 warn_on_bad_tags => {type => BOOLEAN,
619 %append_action_options,
622 if ($param{add} and $param{remove}) {
623 croak "It's nonsensical to add and remove the same tags";
627 __begin_control(%param,
630 my ($debug,$transcript) =
631 @info{qw(debug transcript)};
632 my @data = @{$info{data}};
633 my @bugs = @{$info{bugs}};
634 my @tags = make_list($param{tag});
635 if (not @tags and ($param{remove} or $param{add})) {
636 if ($param{remove}) {
637 print {$transcript} "Requested to remove no tags; doing nothing.\n";
640 print {$transcript} "Requested to add no tags; doing nothing.\n";
642 __end_control(%info);
645 # first things first, make the versions fully qualified source
647 for my $data (@data) {
648 my $action = 'Did not alter tags';
650 my %tag_removed = ();
651 my %fixed_removed = ();
652 my @old_tags = split /\,?\s+/, $data->{keywords};
654 @tags{@old_tags} = (1) x @old_tags;
656 my $old_data = dclone($data);
657 if (not $param{add} and not $param{remove}) {
658 $tag_removed{$_} = 1 for @old_tags;
662 for my $tag (@tags) {
663 if (not $param{remove} and
664 not defined first {$_ eq $tag} @{$config{tags}}) {
665 push @bad_tags, $tag;
669 if (not exists $tags{$tag}) {
671 $tag_added{$tag} = 1;
674 elsif ($param{remove}) {
675 if (exists $tags{$tag}) {
677 $tag_removed{$tag} = 1;
681 if (exists $tag_removed{$tag}) {
682 delete $tag_removed{$tag};
685 $tag_added{$tag} = 1;
690 if (@bad_tags and $param{warn_on_bad_tags}) {
691 print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
692 print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
694 $data->{keywords} = join(' ',keys %tags);
697 push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
698 push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
699 $action = ucfirst(join ('; ',@changed)) if @changed;
701 print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
705 append_action_to_log(bug => $data->{bug_num},
708 old_data => $old_data,
710 __return_append_to_log_options(
715 if not exists $param{append_log} or $param{append_log};
716 writebug($data->{bug_num},$data);
717 print {$transcript} "$action\n";
719 __end_control(%info);
727 set_severity(bug => $ref,
728 transcript => $transcript,
729 ($dl > 0 ? (debug => $transcript):()),
730 requester => $header{from},
731 request_addr => $controlrequestaddr,
733 affected_packages => \%affected_packages,
734 recipients => \%recipients,
735 severity => 'normal',
740 print {$transcript} "Failed to set the severity of bug $ref: $@";
743 Sets the severity of a bug. If severity is not passed, is undefined,
744 or has zero length, sets the severity to the default severity.
749 my %param = validate_with(params => \@_,
750 spec => {bug => {type => SCALAR,
753 # specific options here
754 severity => {type => SCALAR|UNDEF,
755 default => $config{default_severity},
758 %append_action_options,
761 if (not defined $param{severity} or
762 not length $param{severity}
764 $param{severity} = $config{default_severity};
767 # check validity of new severity
768 if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) {
769 die "Severity '$param{severity}' is not a valid severity level";
772 __begin_control(%param,
773 command => 'severity'
775 my ($debug,$transcript) =
776 @info{qw(debug transcript)};
777 my @data = @{$info{data}};
778 my @bugs = @{$info{bugs}};
781 for my $data (@data) {
782 if (not defined $data->{severity}) {
783 $data->{severity} = $param{severity};
784 $action = "Severity set to '$param{severity}'";
787 if ($data->{severity} eq '') {
788 $data->{severity} = $config{default_severity};
790 if ($data->{severity} eq $param{severity}) {
791 print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
794 $action = "Severity set to '$param{severity}' from '$data->{severity}'";
795 $data->{severity} = $param{severity};
797 append_action_to_log(bug => $data->{bug_num},
799 __return_append_to_log_options(
804 if not exists $param{append_log} or $param{append_log};
805 writebug($data->{bug_num},$data);
806 print {$transcript} "$action\n";
808 __end_control(%info);
815 set_done(bug => $ref,
816 transcript => $transcript,
817 ($dl > 0 ? (debug => $transcript):()),
818 requester => $header{from},
819 request_addr => $controlrequestaddr,
821 affected_packages => \%affected_packages,
822 recipients => \%recipients,
827 print {$transcript} "Failed to set foo $ref bar: $@";
835 my %param = validate_with(params => \@_,
836 spec => {bug => {type => SCALAR,
839 reopen => {type => BOOLEAN,
842 submitter => {type => SCALAR,
845 clear_fixed => {type => BOOLEAN,
848 notify_submitter => {type => BOOLEAN,
851 original_report => {type => SCALARREF,
854 done => {type => SCALAR|UNDEF,
858 %append_action_options,
862 if (exists $param{submitter} and
863 not Mail::RFC822::Address::valid($param{submitter})) {
864 die "New submitter address '$param{submitter}' is not a valid e-mail address";
866 if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
867 $param{done} = $param{requester};
869 if (exists $param{done} and
870 (not defined $param{done} or
871 not length $param{done})) {
877 __begin_control(%param,
878 command => $param{reopen}?'reopen':'done',
880 my ($debug,$transcript) =
881 @info{qw(debug transcript)};
882 my @data = @{$info{data}};
883 my @bugs = @{$info{bugs}};
886 if ($param{reopen}) {
887 # avoid warning multiple times if there are fixed versions
889 for my $data (@data) {
890 if (not exists $data->{done} or
891 not defined $data->{done} or
892 not length $data->{done}) {
893 print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
894 __end_control(%info);
897 if (@{$data->{fixed_versions}} and $warn_fixed) {
898 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
899 print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
903 $action = "Bug reopened";
904 for my $data (@data) {
905 my $old_data = dclone($data);
907 append_action_to_log(bug => $data->{bug_num},
910 old_data => $old_data,
912 __return_append_to_log_options(
917 if not exists $param{append_log} or $param{append_log};
918 writebug($data->{bug_num},$data);
920 print {$transcript} "$action\n";
921 __end_control(%info);
922 if (exists $param{submitter}) {
923 set_submitter(bug => $param{bug},
924 submitter => $param{submitter},
926 keys %common_options,
927 keys %append_action_options)
930 # clear the fixed revisions
931 if ($param{clear_fixed}) {
932 set_fixed(fixed => [],
936 keys %common_options,
937 keys %append_action_options),
942 my %submitter_notified;
943 my $requester_notified = 0;
944 my $orig_report_set = 0;
945 for my $data (@data) {
946 if (exists $data->{done} and
947 defined $data->{done} and
948 length $data->{done}) {
949 print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n";
950 __end_control(%info);
954 for my $data (@data) {
955 my $old_data = dclone($data);
956 my $hash = get_hashname($data->{bug_num});
957 my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or
958 die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!";
962 $orig_report= <$report_fh>;
965 if (not $orig_report_set and defined $orig_report and
966 length $orig_report and
967 exists $param{original_report}){
968 ${$param{original_report}} = $orig_report;
969 $orig_report_set = 1;
972 $action = "Marked $config{bug} as done";
974 # set done to the requester
975 $data->{done} = exists $param{done}?$param{done}:$param{requester};
976 append_action_to_log(bug => $data->{bug_num},
979 old_data => $old_data,
981 __return_append_to_log_options(
986 if not exists $param{append_log} or $param{append_log};
987 writebug($data->{bug_num},$data);
988 print {$transcript} "$action\n";
989 # get the original report
990 if ($param{notify_submitter}) {
991 my $submitter_message;
992 if(not exists $submitter_notified{$data->{originator}}) {
994 create_mime_message([default_headers(queue_file => $param{request_nn},
996 msgid => $param{request_msgid},
997 msgtype => 'notifdone',
998 pr_msg => 'they-closed',
1000 [To => $data->{submitter},
1001 Subject => "$config{ubug}#$data->{bug_num} ".
1002 "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
1006 __message_body_template('mail/process_your_bug_done',
1008 replyto => (exists $param{request_replyto} ?
1009 $param{request_replyto} :
1010 $param{requester} || 'Unknown'),
1011 markedby => $param{requester},
1012 subject => $param{request_subject},
1013 messageid => $param{request_msgid},
1016 [join('',make_list($param{message})),$orig_report]
1018 send_mail_message(message => $submitter_message,
1019 recipients => $old_data->{submitter},
1021 $submitter_notified{$data->{originator}} = $submitter_message;
1024 $submitter_message = $submitter_notified{$data->{originator}};
1026 append_action_to_log(bug => $data->{bug_num},
1027 action => "Notification sent",
1029 request_addr => $data->{originator},
1030 desc => "$config{bug} acknowledged by developer.",
1031 recips => [$data->{originator}],
1032 message => $submitter_message,
1037 __end_control(%info);
1038 if (exists $param{fixed}) {
1039 set_fixed(fixed => $param{fixed},
1043 keys %common_options,
1044 keys %append_action_options
1052 =head2 set_submitter
1055 set_submitter(bug => $ref,
1056 transcript => $transcript,
1057 ($dl > 0 ? (debug => $transcript):()),
1058 requester => $header{from},
1059 request_addr => $controlrequestaddr,
1061 affected_packages => \%affected_packages,
1062 recipients => \%recipients,
1063 submitter => $new_submitter,
1064 notify_submitter => 1,
1069 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1072 Sets the submitter of a bug. If notify_submitter is true (the
1073 default), notifies the old submitter of a bug on changes
1078 my %param = validate_with(params => \@_,
1079 spec => {bug => {type => SCALAR,
1082 # specific options here
1083 submitter => {type => SCALAR,
1085 notify_submitter => {type => BOOLEAN,
1089 %append_action_options,
1092 if (not Mail::RFC822::Address::valid($param{submitter})) {
1093 die "New submitter address $param{submitter} is not a valid e-mail address";
1096 __begin_control(%param,
1097 command => 'submitter'
1099 my ($debug,$transcript) =
1100 @info{qw(debug transcript)};
1101 my @data = @{$info{data}};
1102 my @bugs = @{$info{bugs}};
1104 # here we only concern ourselves with the first of the merged bugs
1105 for my $data ($data[0]) {
1106 my $notify_old_submitter = 0;
1107 my $old_data = dclone($data);
1108 print {$debug} "Going to change bug submitter\n";
1109 if (((not defined $param{submitter} or not length $param{submitter}) and
1110 (not defined $data->{originator} or not length $data->{originator})) or
1111 (defined $param{submitter} and defined $data->{originator} and
1112 $param{submitter} eq $data->{originator})) {
1113 print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
1117 if (defined $data->{originator} and length($data->{originator})) {
1118 $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'";
1119 $notify_old_submitter = 1;
1122 $action= "Set $config{bug} submitter to '$param{submitter}'.";
1124 $data->{originator} = $param{submitter};
1126 append_action_to_log(bug => $data->{bug_num},
1127 command => 'submitter',
1129 old_data => $old_data,
1131 __return_append_to_log_options(
1136 if not exists $param{append_log} or $param{append_log};
1137 writebug($data->{bug_num},$data);
1138 print {$transcript} "$action\n";
1139 # notify old submitter
1140 if ($notify_old_submitter and $param{notify_submitter}) {
1141 send_mail_message(message =>
1142 create_mime_message([default_headers(queue_file => $param{request_nn},
1144 msgid => $param{request_msgid},
1146 pr_msg => 'submitter-changed',
1148 [To => $old_data->{submitter},
1149 Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
1153 __message_body_template('mail/submitter_changed',
1154 {old_data => $old_data,
1156 replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
1160 recipients => $old_data->{submitter},
1164 __end_control(%info);
1169 =head2 set_forwarded
1172 set_forwarded(bug => $ref,
1173 transcript => $transcript,
1174 ($dl > 0 ? (debug => $transcript):()),
1175 requester => $header{from},
1176 request_addr => $controlrequestaddr,
1178 affected_packages => \%affected_packages,
1179 recipients => \%recipients,
1180 forwarded => $forward_to,
1185 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1188 Sets the location to which a bug is forwarded. Given an undef
1189 forwarded, unsets forwarded.
1195 my %param = validate_with(params => \@_,
1196 spec => {bug => {type => SCALAR,
1199 # specific options here
1200 forwarded => {type => SCALAR|UNDEF,
1203 %append_action_options,
1206 if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
1207 die "Non-printable characters are not allowed in the forwarded field";
1209 $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded};
1211 __begin_control(%param,
1212 command => 'forwarded'
1214 my ($debug,$transcript) =
1215 @info{qw(debug transcript)};
1216 my @data = @{$info{data}};
1217 my @bugs = @{$info{bugs}};
1219 for my $data (@data) {
1220 my $old_data = dclone($data);
1221 print {$debug} "Going to change bug forwarded\n";
1222 if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or
1223 (not defined $param{forwarded} and
1224 defined $data->{forwarded} and not length $data->{forwarded})) {
1225 print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n";
1229 if (not defined $param{forwarded}) {
1230 $action= "Unset $config{bug} forwarded-to-address";
1232 elsif (defined $data->{forwarded} and length($data->{forwarded})) {
1233 $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'";
1236 $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
1238 $data->{forwarded} = $param{forwarded};
1240 append_action_to_log(bug => $data->{bug_num},
1241 command => 'forwarded',
1243 old_data => $old_data,
1245 __return_append_to_log_options(
1250 if not exists $param{append_log} or $param{append_log};
1251 writebug($data->{bug_num},$data);
1252 print {$transcript} "$action\n";
1254 __end_control(%info);
1263 set_title(bug => $ref,
1264 transcript => $transcript,
1265 ($dl > 0 ? (debug => $transcript):()),
1266 requester => $header{from},
1267 request_addr => $controlrequestaddr,
1269 affected_packages => \%affected_packages,
1270 recipients => \%recipients,
1271 title => $new_title,
1276 print {$transcript} "Failed to set the title of $ref: $@";
1279 Sets the title of a specific bug
1285 my %param = validate_with(params => \@_,
1286 spec => {bug => {type => SCALAR,
1289 # specific options here
1290 title => {type => SCALAR,
1293 %append_action_options,
1296 if ($param{title} =~ /[^[:print:]]/) {
1297 die "Non-printable characters are not allowed in bug titles";
1300 my %info = __begin_control(%param,
1303 my ($debug,$transcript) =
1304 @info{qw(debug transcript)};
1305 my @data = @{$info{data}};
1306 my @bugs = @{$info{bugs}};
1308 for my $data (@data) {
1309 my $old_data = dclone($data);
1310 print {$debug} "Going to change bug title\n";
1311 if (defined $data->{subject} and length($data->{subject}) and
1312 $data->{subject} eq $param{title}) {
1313 print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
1317 if (defined $data->{subject} and length($data->{subject})) {
1318 $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'";
1320 $action= "Set $config{bug} title to '$param{title}'.";
1322 $data->{subject} = $param{title};
1324 append_action_to_log(bug => $data->{bug_num},
1327 old_data => $old_data,
1329 __return_append_to_log_options(
1334 if not exists $param{append_log} or $param{append_log};
1335 writebug($data->{bug_num},$data);
1336 print {$transcript} "$action\n";
1338 __end_control(%info);
1345 set_package(bug => $ref,
1346 transcript => $transcript,
1347 ($dl > 0 ? (debug => $transcript):()),
1348 requester => $header{from},
1349 request_addr => $controlrequestaddr,
1351 affected_packages => \%affected_packages,
1352 recipients => \%recipients,
1353 package => $new_package,
1359 print {$transcript} "Failed to assign or reassign $ref to a package: $@";
1362 Indicates that a bug is in a particular package. If is_source is true,
1363 indicates that the package is a source package. [Internally, this
1364 causes src: to be prepended to the package name.]
1366 The default for is_source is 0. As a special case, if the package
1367 starts with 'src:', it is assumed to be a source package and is_source
1370 The package option must match the package_name_re regex.
1375 my %param = validate_with(params => \@_,
1376 spec => {bug => {type => SCALAR,
1379 # specific options here
1380 package => {type => SCALAR|ARRAYREF,
1382 is_source => {type => BOOLEAN,
1386 %append_action_options,
1389 my @new_packages = map {splitpackages($_)} make_list($param{package});
1390 if (grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages) {
1391 croak "Invalid package name '".
1392 join(',',grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages).
1395 my %info = __begin_control(%param,
1396 command => 'package',
1398 my ($debug,$transcript) =
1399 @info{qw(debug transcript)};
1400 my @data = @{$info{data}};
1401 my @bugs = @{$info{bugs}};
1402 # clean up the new package
1406 ($temp =~ s/^src:// or
1407 $param{is_source}) ? 'src:'.$temp:$temp;
1411 my $package_reassigned = 0;
1412 for my $data (@data) {
1413 my $old_data = dclone($data);
1414 print {$debug} "Going to change assigned package\n";
1415 if (defined $data->{package} and length($data->{package}) and
1416 $data->{package} eq $new_package) {
1417 print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
1421 if (defined $data->{package} and length($data->{package})) {
1422 $package_reassigned = 1;
1423 $action= "$config{bug} reassigned from package '$data->{package}'".
1424 " to '$new_package'.";
1426 $action= "$config{bug} assigned to package '$new_package'.";
1428 $data->{package} = $new_package;
1430 append_action_to_log(bug => $data->{bug_num},
1431 command => 'package',
1433 old_data => $old_data,
1435 __return_append_to_log_options(
1440 if not exists $param{append_log} or $param{append_log};
1441 writebug($data->{bug_num},$data);
1442 print {$transcript} "$action\n";
1444 __end_control(%info);
1445 # Only clear the fixed/found versions if the package has been
1447 if ($package_reassigned) {
1448 my @params_for_found_fixed =
1449 map {exists $param{$_}?($_,$param{$_}):()}
1451 keys %common_options,
1452 keys %append_action_options,
1454 set_found(found => [],
1455 @params_for_found_fixed,
1457 set_fixed(fixed => [],
1458 @params_for_found_fixed,
1466 set_found(bug => $ref,
1467 transcript => $transcript,
1468 ($dl > 0 ? (debug => $transcript):()),
1469 requester => $header{from},
1470 request_addr => $controlrequestaddr,
1472 affected_packages => \%affected_packages,
1473 recipients => \%recipients,
1480 print {$transcript} "Failed to set found on $ref: $@";
1484 Sets, adds, or removes the specified found versions of a package
1486 If the version list is empty, and the bug is currently not "done",
1487 causes the done field to be cleared.
1489 If any of the versions added to found are greater than any version in
1490 which the bug is fixed (or when the bug is found and there are no
1491 fixed versions) the done field is cleared.
1496 my %param = validate_with(params => \@_,
1497 spec => {bug => {type => SCALAR,
1500 # specific options here
1501 found => {type => SCALAR|ARRAYREF,
1504 add => {type => BOOLEAN,
1507 remove => {type => BOOLEAN,
1511 %append_action_options,
1514 if ($param{add} and $param{remove}) {
1515 croak "It's nonsensical to add and remove the same versions";
1519 __begin_control(%param,
1522 my ($debug,$transcript) =
1523 @info{qw(debug transcript)};
1524 my @data = @{$info{data}};
1525 my @bugs = @{$info{bugs}};
1527 for my $version (make_list($param{found})) {
1528 next unless defined $version;
1529 $versions{$version} =
1530 [make_source_versions(package => [splitpackages($data[0]{package})],
1531 warnings => $transcript,
1534 versions => $version,
1537 # This is really ugly, but it's what we have to do
1538 if (not @{$versions{$version}}) {
1539 print {$transcript} "Unable to make a source version for version '$version'\n";
1542 if (not keys %versions and ($param{remove} or $param{add})) {
1543 if ($param{remove}) {
1544 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1547 print {$transcript} "Requested to add no versions; doing nothing.\n";
1549 __end_control(%info);
1552 # first things first, make the versions fully qualified source
1554 for my $data (@data) {
1555 # The 'done' field gets a bit weird with version tracking,
1556 # because a bug may be closed by multiple people in different
1557 # branches. Until we have something more flexible, we set it
1558 # every time a bug is fixed, and clear it when a bug is found
1559 # in a version greater than any version in which the bug is
1560 # fixed or when a bug is found and there is no fixed version
1561 my $action = 'Did not alter found versions';
1562 my %found_added = ();
1563 my %found_removed = ();
1564 my %fixed_removed = ();
1566 my $old_data = dclone($data);
1567 if (not $param{add} and not $param{remove}) {
1568 $found_removed{$_} = 1 for @{$data->{found_versions}};
1569 $data->{found_versions} = [];
1572 @found_versions{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1574 @fixed_versions{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1575 for my $version (keys %versions) {
1577 my @svers = @{$versions{$version}};
1582 if (exists $found_versions{$version}) {
1583 delete $found_versions{$version};
1584 $found_removed{$version} = 1;
1587 for my $sver (@svers) {
1588 if (not exists $found_versions{$sver}) {
1589 $found_versions{$sver} = 1;
1590 $found_added{$sver} = 1;
1592 # if the found we are adding matches any fixed
1593 # versions, remove them
1594 my @temp = grep m{(^|/)\Q$sver\E}, keys %fixed_versions;
1595 delete $fixed_versions{$_} for @temp;
1596 $fixed_removed{$_} = 1 for @temp;
1599 # We only care about reopening the bug if the bug is
1601 if (defined $data->{done} and length $data->{done}) {
1602 my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
1604 # determine if we need to reopen
1605 my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
1606 keys %fixed_versions);
1607 if (not @fixed_order or
1608 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1614 elsif ($param{remove}) {
1615 # in the case of removal, we only concern ourself with
1616 # the version passed, not the source version it maps
1618 my @temp = grep m{(^|/)\Q$version\E}, keys %found_versions;
1619 delete $found_versions{$_} for @temp;
1620 $found_removed{$_} = 1 for @temp;
1623 # set the keys to exactly these values
1624 my @svers = @{$versions{$version}};
1628 for my $sver (@svers) {
1629 if (not exists $found_versions{$sver}) {
1630 $found_versions{$sver} = 1;
1631 if (exists $found_removed{$sver}) {
1632 delete $found_removed{$sver};
1635 $found_added{$sver} = 1;
1642 $data->{found_versions} = [keys %found_versions];
1643 $data->{fixed_versions} = [keys %fixed_versions];
1646 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1647 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1648 # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
1649 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1650 $action = ucfirst(join ('; ',@changed)) if @changed;
1652 $action .= " and reopened"
1654 if (not $reopened and not @changed) {
1655 print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
1659 append_action_to_log(bug => $data->{bug_num},
1662 old_data => $old_data,
1664 __return_append_to_log_options(
1669 if not exists $param{append_log} or $param{append_log};
1670 writebug($data->{bug_num},$data);
1671 print {$transcript} "$action\n";
1673 __end_control(%info);
1679 set_fixed(bug => $ref,
1680 transcript => $transcript,
1681 ($dl > 0 ? (debug => $transcript):()),
1682 requester => $header{from},
1683 request_addr => $controlrequestaddr,
1685 affected_packages => \%affected_packages,
1686 recipients => \%recipients,
1694 print {$transcript} "Failed to set fixed on $ref: $@";
1698 Sets, adds, or removes the specified fixed versions of a package
1700 If the fixed versions are empty (or end up being empty after this
1701 call) or the greatest fixed version is less than the greatest found
1702 version and the reopen option is true, the bug is reopened.
1704 This function is also called by the reopen function, which causes all
1705 of the fixed versions to be cleared.
1710 my %param = validate_with(params => \@_,
1711 spec => {bug => {type => SCALAR,
1714 # specific options here
1715 fixed => {type => SCALAR|ARRAYREF,
1718 add => {type => BOOLEAN,
1721 remove => {type => BOOLEAN,
1724 reopen => {type => BOOLEAN,
1728 %append_action_options,
1731 if ($param{add} and $param{remove}) {
1732 croak "It's nonsensical to add and remove the same versions";
1735 __begin_control(%param,
1738 my ($debug,$transcript) =
1739 @info{qw(debug transcript)};
1740 my @data = @{$info{data}};
1741 my @bugs = @{$info{bugs}};
1743 for my $version (make_list($param{fixed})) {
1744 next unless defined $version;
1745 $versions{$version} =
1746 [make_source_versions(package => [splitpackages($data[0]{package})],
1747 warnings => $transcript,
1750 versions => $version,
1753 # This is really ugly, but it's what we have to do
1754 if (not @{$versions{$version}}) {
1755 print {$transcript} "Unable to make a source version for version '$version'\n";
1758 if (not keys %versions and ($param{remove} or $param{add})) {
1759 if ($param{remove}) {
1760 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1763 print {$transcript} "Requested to add no versions; doing nothing.\n";
1765 __end_control(%info);
1768 # first things first, make the versions fully qualified source
1770 for my $data (@data) {
1771 my $old_data = dclone($data);
1772 # The 'done' field gets a bit weird with version tracking,
1773 # because a bug may be closed by multiple people in different
1774 # branches. Until we have something more flexible, we set it
1775 # every time a bug is fixed, and clear it when a bug is found
1776 # in a version greater than any version in which the bug is
1777 # fixed or when a bug is found and there is no fixed version
1778 my $action = 'Did not alter fixed versions';
1779 my %found_added = ();
1780 my %found_removed = ();
1781 my %fixed_added = ();
1782 my %fixed_removed = ();
1784 if (not $param{add} and not $param{remove}) {
1785 $fixed_removed{$_} = 1 for @{$data->{fixed_versions}};
1786 $data->{fixed_versions} = [];
1789 @found_versions{@{$data->{found_versions}||[]}} = (1) x @{$data->{found_versions}||[]};
1791 @fixed_versions{@{$data->{fixed_versions}||[]}} = (1) x @{$data->{fixed_versions}||[]};
1792 for my $version (keys %versions) {
1794 my @svers = @{$versions{$version}};
1799 if (exists $fixed_versions{$version}) {
1800 $fixed_removed{$version} = 1;
1801 delete $fixed_versions{$version};
1804 for my $sver (@svers) {
1805 if (not exists $fixed_versions{$sver}) {
1806 $fixed_versions{$sver} = 1;
1807 $fixed_added{$sver} = 1;
1811 elsif ($param{remove}) {
1812 # in the case of removal, we only concern ourself with
1813 # the version passed, not the source version it maps
1815 my @temp = grep m{(?:^|\/)\Q$version\E$}, keys %fixed_versions;
1816 delete $fixed_versions{$_} for @temp;
1817 $fixed_removed{$_} = 1 for @temp;
1820 # set the keys to exactly these values
1821 my @svers = @{$versions{$version}};
1825 for my $sver (@svers) {
1826 if (not exists $fixed_versions{$sver}) {
1827 $fixed_versions{$sver} = 1;
1828 if (exists $fixed_removed{$sver}) {
1829 delete $fixed_removed{$sver};
1832 $fixed_added{$sver} = 1;
1839 $data->{found_versions} = [keys %found_versions];
1840 $data->{fixed_versions} = [keys %fixed_versions];
1842 # If we're supposed to consider reopening, reopen if the
1843 # fixed versions are empty or the greatest found version
1844 # is greater than the greatest fixed version
1845 if ($param{reopen} and defined $data->{done}
1846 and length $data->{done}) {
1847 my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1848 map {m{([^/]+)$}; $1;} @{$data->{found_versions}};
1849 # determine if we need to reopen
1850 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1851 map {m{([^/]+)$}; $1;} @{$data->{fixed_versions}};
1852 if (not @fixed_order or
1853 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1860 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1861 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1862 push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
1863 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1864 $action = ucfirst(join ('; ',@changed)) if @changed;
1866 $action .= " and reopened"
1868 if (not $reopened and not @changed) {
1869 print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
1873 append_action_to_log(bug => $data->{bug_num},
1876 old_data => $old_data,
1878 __return_append_to_log_options(
1883 if not exists $param{append_log} or $param{append_log};
1884 writebug($data->{bug_num},$data);
1885 print {$transcript} "$action\n";
1887 __end_control(%info);
1894 set_merged(bug => $ref,
1895 transcript => $transcript,
1896 ($dl > 0 ? (debug => $transcript):()),
1897 requester => $header{from},
1898 request_addr => $controlrequestaddr,
1900 affected_packages => \%affected_packages,
1901 recipients => \%recipients,
1902 merge_with => 12345,
1905 allow_reassign => 1,
1906 reassign_same_source_only => 1,
1911 print {$transcript} "Failed to set merged on $ref: $@";
1915 Sets, adds, or removes the specified merged bugs of a bug
1917 By default, requires
1922 my %param = validate_with(params => \@_,
1923 spec => {bug => {type => SCALAR,
1926 # specific options here
1927 merge_with => {type => ARRAYREF|SCALAR,
1930 remove => {type => BOOLEAN,
1933 force => {type => BOOLEAN,
1936 masterbug => {type => BOOLEAN,
1939 allow_reassign => {type => BOOLEAN,
1942 reassign_different_sources => {type => BOOLEAN,
1946 %append_action_options,
1949 my @merging = exists $param{merge_with} ? make_list($param{merge_with}):();
1951 @merging{@merging} = (1) x @merging;
1952 if (grep {$_ !~ /^\d+$/} @merging) {
1953 croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging);
1955 $param{locks} = {} if not exists $param{locks};
1957 __begin_control(%param,
1960 my ($debug,$transcript) =
1961 @info{qw(debug transcript)};
1962 if (not @merging and exists $param{merge_with}) {
1963 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
1964 __end_control(%info);
1967 my @data = @{$info{data}};
1968 my @bugs = @{$info{bugs}};
1971 for my $data (@data) {
1972 $data{$data->{bug_num}} = $data;
1973 my @merged_bugs = split / /, $data->{mergedwith};
1974 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
1978 if (not exists $param{merge_with}) {
1979 my $ok_to_unmerge = 1;
1980 delete $merged_bugs{$param{bug}};
1981 if (not keys %merged_bugs) {
1982 print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
1983 __end_control(%info);
1986 my $action = "Disconnected #$param{bug} from all other report(s).";
1987 for my $data (@data) {
1988 my $old_data = dclone($data);
1989 if ($data->{bug_num} == $param{bug}) {
1990 $data->{mergedwith} = '';
1993 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
1996 append_action_to_log(bug => $data->{bug_num},
1999 old_data => $old_data,
2001 __return_append_to_log_options(%param,
2005 if not exists $param{append_log} or $param{append_log};
2006 writebug($data->{bug_num},$data);
2008 print {$transcript} "$action\n";
2009 __end_control(%info);
2012 # lock and load all of the bugs we need
2013 my @bugs_to_load = keys %merging;
2016 my ($data,$n_locks) =
2017 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2019 locks => $param{locks},
2022 $new_locks += $n_locks;
2024 @data = values %data;
2025 if (not check_limit(data => [@data],
2026 exists $param{limit}?(limit => $param{limit}):(),
2027 transcript => $transcript,
2029 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
2031 for my $data (@data) {
2032 $data{$data->{bug_num}} = $data;
2033 $merged_bugs{$data->{bug_num}} = 1;
2034 my @merged_bugs = split / /, $data->{mergedwith};
2035 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
2036 if (exists $param{affected_bugs}) {
2037 $param{affected_bugs}{$data->{bug_num}} = 1;
2040 __handle_affected_packages(%param,data => [@data]);
2041 my %bug_info_shown; # which bugs have had information shown
2042 $bug_info_shown{$param{bug}} = 1;
2043 add_recipients(data => [@data],
2044 recipients => $param{recipients},
2045 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
2047 (__internal_request()?(transcript => $transcript):()),
2050 # Figure out what the ideal state is for the bug,
2051 my ($merge_status,$bugs_to_merge) =
2052 __calculate_merge_status(\@data,\%data,$param{bug});
2053 # find out if we actually have any bugs to merge
2054 if (not $bugs_to_merge) {
2055 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
2056 for (1..$new_locks) {
2057 unfilelock($param{locks});
2060 __end_control(%info);
2063 # see what changes need to be made to merge the bugs
2064 # check to make sure that the set of changes we need to make is allowed
2065 my ($disallowed_changes,$changes) =
2066 __calculate_merge_changes(\@data,$merge_status,\%param);
2067 # at this point, stop if there are disallowed changes, otherwise
2068 # make the allowed changes, and then reread the bugs in question
2069 # to get the new data, then recaculate the merges; repeat
2070 # reloading and recalculating until we try too many times or there
2071 # are no changes to make.
2074 # we will allow at most 4 times through this; more than 1
2075 # shouldn't really happen.
2077 while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) {
2078 if ($attempts > 1) {
2079 print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n";
2081 if (@{$disallowed_changes}) {
2082 # figure out the problems
2083 print {$transcript} "Unable to merge bugs because:\n";
2084 for my $change (@{$disallowed_changes}) {
2085 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2087 if ($attempts > 0) {
2088 croak "Some bugs were altered while attempting to merge";
2091 croak "Did not alter merged bugs";
2094 my @bugs_to_change = keys %{$changes};
2095 for my $change_bug (@bugs_to_change) {
2096 next unless exists $changes->{$change_bug};
2097 $bug_changed{$change_bug}++;
2098 print {$transcript} __bug_info($data{$change_bug}) if
2099 $param{show_bug_info} and not __internal_request(1);
2100 $bug_info_shown{$change_bug} = 1;
2101 __allow_relocking($param{locks},[keys %data]);
2102 for my $change (@{$changes->{$change_bug}}) {
2103 if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
2104 my %target_blockedby;
2105 @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
2106 my %unhandled_targets = %target_blockedby;
2107 my @blocks_to_remove;
2108 for my $key (split / /,$change->{orig_value}) {
2109 delete $unhandled_targets{$key};
2110 next if exists $target_blockedby{$key};
2111 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2112 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2115 keys %common_options,
2116 keys %append_action_options),
2119 for my $key (keys %unhandled_targets) {
2120 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2121 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2124 keys %common_options,
2125 keys %append_action_options),
2130 $change->{function}->(bug => $change->{bug},
2131 $change->{key}, $change->{func_value},
2132 exists $change->{options}?@{$change->{options}}:(),
2134 keys %common_options,
2135 keys %append_action_options),
2139 __disallow_relocking($param{locks});
2140 my ($data,$n_locks) =
2141 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2143 locks => $param{locks},
2147 $new_locks += $n_locks;
2150 @data = values %data;
2151 ($merge_status,$bugs_to_merge) =
2152 __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
2153 ($disallowed_changes,$changes) =
2154 __calculate_merge_changes(\@data,$merge_status,\%param);
2155 $attempts = max(values %bug_changed);
2158 if ($param{show_bug_info} and not __internal_request(1)) {
2159 for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) {
2160 next if $bug_info_shown{$data->{bug_num}};
2161 print {$transcript} __bug_info($data);
2164 if (keys %{$changes} or @{$disallowed_changes}) {
2165 print {$transcript} "After four attempts, the following changes were unable to be made:\n";
2166 for (1..$new_locks) {
2167 unfilelock($param{locks});
2170 __end_control(%info);
2171 for my $change (values %{$changes}, @{$disallowed_changes}) {
2172 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2174 die "Unable to modify bugs so they could be merged";
2178 # finally, we can merge the bugs
2179 my $action = "Merged ".join(' ',sort keys %merged_bugs);
2180 for my $data (@data) {
2181 my $old_data = dclone($data);
2182 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
2184 append_action_to_log(bug => $data->{bug_num},
2187 old_data => $old_data,
2189 __return_append_to_log_options(%param,
2193 if not exists $param{append_log} or $param{append_log};
2194 writebug($data->{bug_num},$data);
2196 print {$transcript} "$action\n";
2197 # unlock the extra locks that we got earlier
2198 for (1..$new_locks) {
2199 unfilelock($param{locks});
2202 __end_control(%info);
2205 sub __allow_relocking{
2206 my ($locks,$bugs) = @_;
2208 my @locks = (@{$bugs},'merge');
2209 for my $lock (@locks) {
2210 my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
2211 next unless @lockfiles;
2212 $locks->{relockable}{$lockfiles[0]} = 0;
2216 sub __disallow_relocking{
2218 delete $locks->{relockable};
2221 sub __lock_and_load_merged_bugs{
2223 validate_with(params => \@_,
2225 {bugs_to_load => {type => ARRAYREF,
2226 default => sub {[]},
2228 data => {type => HASHREF|ARRAYREF,
2230 locks => {type => HASHREF,
2231 default => sub {{};},
2233 reload_all => {type => BOOLEAN,
2236 debug => {type => HANDLE,
2242 if (ref($param{data}) eq 'ARRAY') {
2243 for my $data (@{$param{data}}) {
2244 $data{$data->{bug_num}} = dclone($data);
2248 %data = %{dclone($param{data})};
2250 my @bugs_to_load = @{$param{bugs_to_load}};
2251 if ($param{reload_all}) {
2252 push @bugs_to_load, keys %data;
2255 @temp{@bugs_to_load} = (1) x @bugs_to_load;
2256 @bugs_to_load = keys %temp;
2257 my %loaded_this_time;
2259 while ($bug_to_load = shift @bugs_to_load) {
2260 if (not $param{reload_all}) {
2261 next if exists $data{$bug_to_load};
2264 next if $loaded_this_time{$bug_to_load};
2267 if ($param{reload_all}) {
2268 if (exists $data{$bug_to_load}) {
2273 read_bug(bug => $bug_to_load,
2275 locks => $param{locks},
2277 die "Unable to load bug $bug_to_load";
2278 print {$param{debug}} "read bug $bug_to_load\n";
2279 $data{$data->{bug_num}} = $data;
2280 $new_locks += $lock_bug;
2281 $loaded_this_time{$data->{bug_num}} = 1;
2283 grep {not exists $data{$_}}
2284 split / /,$data->{mergedwith};
2286 return (\%data,$new_locks);
2290 sub __calculate_merge_status{
2291 my ($data_a,$data_h,$master_bug,$merge_status) = @_;
2292 my %merge_status = %{$merge_status // {}};
2294 my $bugs_to_merge = 0;
2295 for my $data (@{$data_a}) {
2296 # check to see if this bug is unmerged in the set
2297 if (not length $data->{mergedwith} or
2298 grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) {
2299 $merged_bugs{$data->{bug_num}} = 1;
2302 # the master_bug is the bug that every other bug is made to
2303 # look like. However, if merge is set, tags, fixed and found
2305 if ($data->{bug_num} == $master_bug) {
2306 for (qw(package forwarded severity blocks blockedby done owner summary outlook affects)) {
2307 $merge_status{$_} = $data->{$_}
2310 if (defined $merge_status) {
2311 next unless $data->{bug_num} == $master_bug;
2313 $merge_status{tag} = {} if not exists $merge_status{tag};
2314 for my $tag (split /\s+/, $data->{keywords}) {
2315 $merge_status{tag}{$tag} = 1;
2317 $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}});
2318 for (qw(fixed found)) {
2319 @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
2322 return (\%merge_status,$bugs_to_merge);
2327 sub __calculate_merge_changes{
2328 my ($datas,$merge_status,$param) = @_;
2330 my @disallowed_changes;
2331 for my $data (@{$datas}) {
2332 # things that can be forced
2334 # * func is the function to set the new value
2336 # * key is the key of the function to set the value,
2338 # * modify_value is a function which is called to modify the new
2339 # value so that the function will accept it
2341 # * options is an ARRAYREF of options to pass to the function
2343 # * allowed is a BOOLEAN which controls whether this setting
2344 # is allowed to be different by default.
2345 my %force_functions =
2346 (forwarded => {func => \&set_forwarded,
2350 severity => {func => \&set_severity,
2354 blocks => {func => \&set_blocks,
2355 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2359 blockedby => {func => \&set_blocks,
2360 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2364 done => {func => \&set_done,
2368 owner => {func => \&owner,
2372 summary => {func => \&summary,
2376 outlook => {func => \&outlook,
2380 affects => {func => \&affects,
2384 package => {func => \&set_package,
2388 keywords => {func => \&set_tag,
2390 modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]},
2393 fixed_versions => {func => \&set_fixed,
2395 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2398 found_versions => {func => \&set_found,
2400 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2404 for my $field (qw(forwarded severity blocks blockedby done owner summary outlook affects package fixed_versions found_versions keywords)) {
2405 # if the ideal bug already has the field set properly, we
2407 if ($field eq 'keywords'){
2408 next if join(' ',sort split /\s+/,$data->{keywords}) eq
2409 join(' ',sort keys %{$merge_status->{tag}});
2411 elsif ($field =~ /^(?:fixed|found)_versions$/) {
2412 next if join(' ', sort @{$data->{$field}}) eq
2413 join(' ',sort keys %{$merge_status->{$field}});
2415 elsif ($field eq 'done') {
2416 # for done, we only care if the bug is done or not
2417 # done, not the value it's set to.
2418 if (defined $merge_status->{$field} and length $merge_status->{$field} and
2419 defined $data->{$field} and length $data->{$field}) {
2422 elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
2423 (not defined $data->{$field} or not length $data->{$field})
2428 elsif ($merge_status->{$field} eq $data->{$field}) {
2433 bug => $data->{bug_num},
2434 orig_value => $data->{$field},
2436 (exists $force_functions{$field}{modify_value} ?
2437 $force_functions{$field}{modify_value}->($merge_status->{$field}):
2438 $merge_status->{$field}),
2439 value => $merge_status->{$field},
2440 function => $force_functions{$field}{func},
2441 key => $force_functions{$field}{key},
2442 options => $force_functions{$field}{options},
2443 allowed => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
2445 $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
2446 $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
2447 if ($param->{force} or $change->{allowed}) {
2448 if ($field ne 'package' or $change->{allowed}) {
2449 push @{$changes{$data->{bug_num}}},$change;
2452 if ($param->{allow_reassign}) {
2453 if ($param->{reassign_different_sources}) {
2454 push @{$changes{$data->{bug_num}}},$change;
2457 # allow reassigning if binary_to_source returns at
2458 # least one of the same source packages
2459 my @merge_status_source =
2460 binary_to_source(package => $merge_status->{package},
2463 my @other_bug_source =
2464 binary_to_source(package => $data->{package},
2467 my %merge_status_sources;
2468 @merge_status_sources{@merge_status_source} =
2469 (1) x @merge_status_source;
2470 if (grep {$merge_status_sources{$_}} @other_bug_source) {
2471 push @{$changes{$data->{bug_num}}},$change;
2476 push @disallowed_changes,$change;
2478 # blocks and blocked by are weird; we have to go through and
2479 # set blocks to the other half of the merged bugs
2481 return (\@disallowed_changes,\%changes);
2487 affects(bug => $ref,
2488 transcript => $transcript,
2489 ($dl > 0 ? (debug => $transcript):()),
2490 requester => $header{from},
2491 request_addr => $controlrequestaddr,
2493 affected_packages => \%affected_packages,
2494 recipients => \%recipients,
2502 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
2505 This marks a bug as affecting packages which the bug is not actually
2506 in. This should only be used in cases where fixing the bug instantly
2507 resolves the problem in the other packages.
2509 By default, the packages are set to the list of packages passed.
2510 However, if you pass add => 1 or remove => 1, the list of packages
2511 passed are added or removed from the affects list, respectively.
2516 my %param = validate_with(params => \@_,
2517 spec => {bug => {type => SCALAR,
2520 # specific options here
2521 package => {type => SCALAR|ARRAYREF|UNDEF,
2524 add => {type => BOOLEAN,
2527 remove => {type => BOOLEAN,
2531 %append_action_options,
2534 if ($param{add} and $param{remove}) {
2535 croak "Asking to both add and remove affects is nonsensical";
2537 if (not defined $param{package}) {
2538 $param{package} = [];
2541 __begin_control(%param,
2542 command => 'affects'
2544 my ($debug,$transcript) =
2545 @info{qw(debug transcript)};
2546 my @data = @{$info{data}};
2547 my @bugs = @{$info{bugs}};
2549 for my $data (@data) {
2551 print {$debug} "Going to change affects\n";
2552 my @packages = splitpackages($data->{affects});
2554 @packages{@packages} = (1) x @packages;
2557 for my $package (make_list($param{package})) {
2558 next unless defined $package and length $package;
2559 if (not $packages{$package}) {
2560 $packages{$package} = 1;
2561 push @added,$package;
2565 $action = "Added indication that $data->{bug_num} affects ".
2566 english_join(\@added);
2569 elsif ($param{remove}) {
2571 for my $package (make_list($param{package})) {
2572 if ($packages{$package}) {
2573 next unless defined $package and length $package;
2574 delete $packages{$package};
2575 push @removed,$package;
2578 $action = "Removed indication that $data->{bug_num} affects " .
2579 english_join(\@removed);
2582 my %added_packages = ();
2583 my %removed_packages = %packages;
2585 for my $package (make_list($param{package})) {
2586 next unless defined $package and length $package;
2587 $packages{$package} = 1;
2588 delete $removed_packages{$package};
2589 $added_packages{$package} = 1;
2591 if (keys %removed_packages) {
2592 $action = "Removed indication that $data->{bug_num} affects ".
2593 english_join([keys %removed_packages]);
2594 $action .= "\n" if keys %added_packages;
2596 if (keys %added_packages) {
2597 $action .= "Added indication that $data->{bug_num} affects " .
2598 english_join([keys %added_packages]);
2601 if (not length $action) {
2602 print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
2605 my $old_data = dclone($data);
2606 $data->{affects} = join(',',keys %packages);
2607 append_action_to_log(bug => $data->{bug_num},
2609 command => 'affects',
2611 old_data => $old_data,
2612 __return_append_to_log_options(
2617 if not exists $param{append_log} or $param{append_log};
2618 writebug($data->{bug_num},$data);
2619 print {$transcript} "$action\n";
2621 __end_control(%info);
2625 =head1 SUMMARY FUNCTIONS
2630 summary(bug => $ref,
2631 transcript => $transcript,
2632 ($dl > 0 ? (debug => $transcript):()),
2633 requester => $header{from},
2634 request_addr => $controlrequestaddr,
2636 affected_packages => \%affected_packages,
2637 recipients => \%recipients,
2643 print {$transcript} "Failed to mark $ref with summary foo: $@";
2646 Handles all setting of summary fields
2648 If summary is undef, unsets the summary
2650 If summary is 0, sets the summary to the first paragraph contained in
2653 If summary is a positive integer, sets the summary to the message specified.
2655 Otherwise, sets summary to the value passed.
2661 # outlook and summary are exactly the same, basically
2662 return _summary('summary',@_);
2665 =head1 OUTLOOK FUNCTIONS
2670 outlook(bug => $ref,
2671 transcript => $transcript,
2672 ($dl > 0 ? (debug => $transcript):()),
2673 requester => $header{from},
2674 request_addr => $controlrequestaddr,
2676 affected_packages => \%affected_packages,
2677 recipients => \%recipients,
2683 print {$transcript} "Failed to mark $ref with outlook foo: $@";
2686 Handles all setting of outlook fields
2688 If outlook is undef, unsets the outlook
2690 If outlook is 0, sets the outlook to the first paragraph contained in
2693 If outlook is a positive integer, sets the outlook to the message specified.
2695 Otherwise, sets outlook to the value passed.
2701 return _summary('outlook',@_);
2705 my ($cmd,@params) = @_;
2706 my %param = validate_with(params => \@params,
2707 spec => {bug => {type => SCALAR,
2710 # specific options here
2711 $cmd , {type => SCALAR|UNDEF,
2715 %append_action_options,
2719 __begin_control(%param,
2722 my ($debug,$transcript) =
2723 @info{qw(debug transcript)};
2724 my @data = @{$info{data}};
2725 my @bugs = @{$info{bugs}};
2726 # figure out the log that we're going to use
2728 my $summary_msg = '';
2730 if (not defined $param{$cmd}) {
2732 print {$debug} "Removing $cmd fields\n";
2733 $action = "Removed $cmd";
2735 elsif ($param{$cmd} =~ /^\d+$/) {
2737 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
2738 if ($param{$cmd} == 0) {
2739 $log = $param{message};
2740 $summary_msg = @records + 1;
2743 if (($param{$cmd} - 1 ) > $#records) {
2744 die "Message number '$param{$cmd}' exceeds the maximum message '$#records'";
2746 my $record = $records[($param{$cmd} - 1 )];
2747 if ($record->{type} !~ /incoming-recv|recips/) {
2748 die "Message number '$param{$cmd}' is a invalid message type '$record->{type}'";
2750 $summary_msg = $param{$cmd};
2751 $log = [$record->{text}];
2753 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
2754 my $body = $p_o->{body};
2755 my $in_pseudoheaders = 0;
2757 # walk through body until we get non-blank lines
2758 for my $line (@{$body}) {
2759 if ($line =~ /^\s*$/) {
2760 if (length $paragraph) {
2761 if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
2767 $in_pseudoheaders = 0;
2770 # skip a paragraph if it looks like it's control or
2772 if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
2773 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
2774 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
2775 debug|(?:not|)forwarded|priority|
2776 (?:un|)block|limit|(?:un|)archive|
2777 reassign|retitle|affects|wrongpackage
2778 (?:un|force|)merge|user(?:category|tags?|)
2780 if (not length $paragraph) {
2781 print {$debug} "Found control/pseudo-headers and skiping them\n";
2782 $in_pseudoheaders = 1;
2786 next if $in_pseudoheaders;
2787 $paragraph .= $line ." \n";
2789 print {$debug} ucfirst($cmd)." is going to be '$paragraph'\n";
2790 $summary = $paragraph;
2791 $summary =~ s/[\n\r]/ /g;
2792 if (not length $summary) {
2793 die "Unable to find $cmd message to use";
2795 # trim off a trailing spaces
2796 $summary =~ s/\ *$//;
2799 $summary = $param{$cmd};
2801 for my $data (@data) {
2802 print {$debug} "Going to change $cmd\n";
2803 if (((not defined $summary or not length $summary) and
2804 (not defined $data->{$cmd} or not length $data->{$cmd})) or
2805 $summary eq $data->{$cmd}) {
2806 print {$transcript} "Ignoring request to change the $cmd of bug $param{bug} to the same value\n";
2809 if (length $summary) {
2810 if (length $data->{$cmd}) {
2811 $action = ucfirst($cmd)." replaced with message bug $param{bug} message $summary_msg";
2814 $action = ucfirst($cmd)." recorded from message bug $param{bug} message $summary_msg";
2817 my $old_data = dclone($data);
2818 $data->{$cmd} = $summary;
2819 append_action_to_log(bug => $data->{bug_num},
2821 old_data => $old_data,
2824 __return_append_to_log_options(
2829 if not exists $param{append_log} or $param{append_log};
2830 writebug($data->{bug_num},$data);
2831 print {$transcript} "$action\n";
2833 __end_control(%info);
2841 clone_bug(bug => $ref,
2842 transcript => $transcript,
2843 ($dl > 0 ? (debug => $transcript):()),
2844 requester => $header{from},
2845 request_addr => $controlrequestaddr,
2847 affected_packages => \%affected_packages,
2848 recipients => \%recipients,
2853 print {$transcript} "Failed to clone bug $ref bar: $@";
2856 Clones the given bug.
2858 We currently don't support cloning merged bugs, but this could be
2859 handled by internally unmerging, cloning, then remerging the bugs.
2864 my %param = validate_with(params => \@_,
2865 spec => {bug => {type => SCALAR,
2868 new_bugs => {type => ARRAYREF,
2870 new_clones => {type => HASHREF,
2874 %append_action_options,
2878 __begin_control(%param,
2881 my ($debug,$transcript) =
2882 @info{qw(debug transcript)};
2883 my @data = @{$info{data}};
2884 my @bugs = @{$info{bugs}};
2887 for my $data (@data) {
2888 if (length($data->{mergedwith})) {
2889 die "Bug is marked as being merged with others. Use an existing clone.\n";
2893 die "Not exactly one bug‽ This shouldn't happen.";
2895 my $data = $data[0];
2897 for my $newclone_id (@{$param{new_bugs}}) {
2898 my $new_bug_num = new_bug(copy => $data->{bug_num});
2899 $param{new_clones}{$newclone_id} = $new_bug_num;
2900 $clones{$newclone_id} = $new_bug_num;
2902 my @new_bugs = sort values %clones;
2904 for my $new_bug (@new_bugs) {
2905 # no collapsed ids or the higher collapsed id is not one less
2906 # than the next highest new bug
2907 if (not @collapsed_ids or
2908 $collapsed_ids[-1][1]+1 != $new_bug) {
2909 push @collapsed_ids,[$new_bug,$new_bug];
2912 $collapsed_ids[-1][1] = $new_bug;
2916 for my $ci (@collapsed_ids) {
2917 if ($ci->[0] == $ci->[1]) {
2918 push @collapsed,$ci->[0];
2921 push @collapsed,$ci->[0].'-'.$ci->[1]
2924 my $collapsed_str = english_join(\@collapsed);
2925 $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str;
2926 for my $new_bug (@new_bugs) {
2927 append_action_to_log(bug => $new_bug,
2929 __return_append_to_log_options(
2934 if not exists $param{append_log} or $param{append_log};
2936 append_action_to_log(bug => $data->{bug_num},
2938 __return_append_to_log_options(
2943 if not exists $param{append_log} or $param{append_log};
2944 writebug($data->{bug_num},$data);
2945 print {$transcript} "$action\n";
2946 __end_control(%info);
2947 # bugs that this bug is blocking are also blocked by the new clone(s)
2948 for my $bug (split ' ', $data->{blocks}) {
2949 for my $new_bug (@new_bugs) {
2950 set_blocks(bug => $new_bug,
2953 keys %common_options,
2954 keys %append_action_options),
2958 # bugs that this bug is blocked by are also blocking the new clone(s)
2959 for my $bug (split ' ', $data->{blockedby}) {
2960 for my $new_bug (@new_bugs) {
2961 set_blocks(bug => $bug,
2964 keys %common_options,
2965 keys %append_action_options),
2973 =head1 OWNER FUNCTIONS
2979 transcript => $transcript,
2980 ($dl > 0 ? (debug => $transcript):()),
2981 requester => $header{from},
2982 request_addr => $controlrequestaddr,
2984 recipients => \%recipients,
2990 print {$transcript} "Failed to mark $ref as having an owner: $@";
2993 Handles all setting of the owner field; given an owner of undef or of
2994 no length, indicates that a bug is not owned by anyone.
2999 my %param = validate_with(params => \@_,
3000 spec => {bug => {type => SCALAR,
3003 owner => {type => SCALAR|UNDEF,
3006 %append_action_options,
3010 __begin_control(%param,
3013 my ($debug,$transcript) =
3014 @info{qw(debug transcript)};
3015 my @data = @{$info{data}};
3016 my @bugs = @{$info{bugs}};
3018 for my $data (@data) {
3019 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
3020 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
3021 if (not defined $param{owner} or not length $param{owner}) {
3022 if (not defined $data->{owner} or not length $data->{owner}) {
3023 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
3027 $action = "Removed annotation that $config{bug} was owned by " .
3031 if ($data->{owner} eq $param{owner}) {
3032 print {$transcript} "Ignoring request to set the owner of bug #$data->{bug_num} to the same value\n";
3035 if (length $data->{owner}) {
3036 $action = "Owner changed from $data->{owner} to $param{owner}.";
3039 $action = "Owner recorded as $param{owner}."
3042 my $old_data = dclone($data);
3043 $data->{owner} = $param{owner};
3044 append_action_to_log(bug => $data->{bug_num},
3047 old_data => $old_data,
3049 __return_append_to_log_options(
3054 if not exists $param{append_log} or $param{append_log};
3055 writebug($data->{bug_num},$data);
3056 print {$transcript} "$action\n";
3058 __end_control(%info);
3062 =head1 ARCHIVE FUNCTIONS
3069 bug_archive(bug => $bug_num,
3071 transcript => \$transcript,
3076 transcript("Unable to archive $bug_num\n");
3079 transcript($transcript);
3082 This routine archives a bug
3086 =item bug -- bug number
3088 =item check_archiveable -- check wether a bug is archiveable before
3089 archiving; defaults to 1
3091 =item archive_unarchived -- whether to archive bugs which have not
3092 previously been archived; defaults to 1. [Set to 0 when used from
3095 =item ignore_time -- whether to ignore time constraints when archiving
3096 a bug; defaults to 0.
3103 my %param = validate_with(params => \@_,
3104 spec => {bug => {type => SCALAR,
3107 check_archiveable => {type => BOOLEAN,
3110 archive_unarchived => {type => BOOLEAN,
3113 ignore_time => {type => BOOLEAN,
3117 %append_action_options,
3120 my %info = __begin_control(%param,
3121 command => 'archive',
3123 my ($debug,$transcript) = @info{qw(debug transcript)};
3124 my @data = @{$info{data}};
3125 my @bugs = @{$info{bugs}};
3126 my $action = "$config{bug} archived.";
3127 if ($param{check_archiveable} and
3128 not bug_archiveable(bug=>$param{bug},
3129 ignore_time => $param{ignore_time},
3131 print {$transcript} "Bug $param{bug} cannot be archived\n";
3132 die "Bug $param{bug} cannot be archived";
3134 if (not $param{archive_unarchived} and
3135 not exists $data[0]{unarchived}
3137 print {$transcript} "$param{bug} has not been archived previously\n";
3138 die "$param{bug} has not been archived previously";
3140 add_recipients(recipients => $param{recipients},
3143 transcript => $transcript,
3145 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3146 for my $bug (@bugs) {
3147 if ($param{check_archiveable}) {
3148 die "Bug $bug cannot be archived (but $param{bug} can?)"
3149 unless bug_archiveable(bug=>$bug,
3150 ignore_time => $param{ignore_time},
3154 # If we get here, we can archive/remove this bug
3155 print {$debug} "$param{bug} removing\n";
3156 for my $bug (@bugs) {
3157 #print "$param{bug} removing $bug\n" if $debug;
3158 my $dir = get_hashname($bug);
3159 # First indicate that this bug is being archived
3160 append_action_to_log(bug => $bug,
3162 command => 'archive',
3163 # we didn't actually change the data
3164 # when we archived, so we don't pass
3165 # a real new_data or old_data
3168 __return_append_to_log_options(
3173 if not exists $param{append_log} or $param{append_log};
3174 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
3175 if ($config{save_old_bugs}) {
3176 mkpath("$config{spool_dir}/archive/$dir");
3177 foreach my $file (@files_to_remove) {
3178 link("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3179 copy("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3180 # we need to bail out here if things have
3181 # gone horribly wrong to avoid removing a
3183 die "Unable to link or copy $config{spool_dir}/db-h/$dir/$file to $config{spool_dir}/archive/$dir/$file; $!";
3186 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
3188 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
3189 print {$debug} "deleted $bug (from $param{bug})\n";
3191 bughook_archive(@bugs);
3192 __end_control(%info);
3195 =head2 bug_unarchive
3199 bug_unarchive(bug => $bug_num,
3201 transcript => \$transcript,
3206 transcript("Unable to archive bug: $bug_num");
3208 transcript($transcript);
3210 This routine unarchives a bug
3215 my %param = validate_with(params => \@_,
3216 spec => {bug => {type => SCALAR,
3220 %append_action_options,
3224 my %info = __begin_control(%param,
3226 command=>'unarchive');
3227 my ($debug,$transcript) =
3228 @info{qw(debug transcript)};
3229 my @data = @{$info{data}};
3230 my @bugs = @{$info{bugs}};
3231 my $action = "$config{bug} unarchived.";
3232 my @files_to_remove;
3233 for my $bug (@bugs) {
3234 print {$debug} "$param{bug} removing $bug\n";
3235 my $dir = get_hashname($bug);
3236 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
3237 mkpath("archive/$dir");
3238 foreach my $file (@files_to_copy) {
3239 # die'ing here sucks
3240 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3241 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3242 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
3244 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
3245 print {$transcript} "Unarchived $config{bug} $bug\n";
3247 unlink(@files_to_remove) or die "Unable to unlink bugs";
3248 # Indicate that this bug has been archived previously
3249 for my $bug (@bugs) {
3250 my $newdata = readbug($bug);
3251 my $old_data = dclone($newdata);
3252 if (not defined $newdata) {
3253 print {$transcript} "$config{bug} $bug disappeared!\n";
3254 die "Bug $bug disappeared!";
3256 $newdata->{unarchived} = time;
3257 append_action_to_log(bug => $bug,
3259 command => 'unarchive',
3260 new_data => $newdata,
3261 old_data => $old_data,
3262 __return_append_to_log_options(
3267 if not exists $param{append_log} or $param{append_log};
3268 writebug($bug,$newdata);
3270 __end_control(%info);
3273 =head2 append_action_to_log
3275 append_action_to_log
3277 This should probably be moved to Debbugs::Log; have to think that out
3282 sub append_action_to_log{
3283 my %param = validate_with(params => \@_,
3284 spec => {bug => {type => SCALAR,
3287 new_data => {type => HASHREF,
3290 old_data => {type => HASHREF,
3293 command => {type => SCALAR,
3296 action => {type => SCALAR,
3298 requester => {type => SCALAR,
3301 request_addr => {type => SCALAR,
3304 location => {type => SCALAR,
3307 message => {type => SCALAR|ARRAYREF,
3310 recips => {type => SCALAR|ARRAYREF,
3313 desc => {type => SCALAR,
3316 get_lock => {type => BOOLEAN,
3319 locks => {type => HASHREF,
3323 # append_action_options here
3324 # because some of these
3325 # options aren't actually
3326 # optional, even though the
3327 # original function doesn't
3331 # Fix this to use $param{location}
3332 my $log_location = buglog($param{bug});
3333 die "Unable to find .log for $param{bug}"
3334 if not defined $log_location;
3335 if ($param{get_lock}) {
3336 filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
3340 my $logfh = IO::File->new(">>$log_location") or
3341 die "Unable to open $log_location for appending: $!";
3342 # determine difference between old and new
3344 if (exists $param{old_data} and exists $param{new_data}) {
3345 my $old_data = dclone($param{old_data});
3346 my $new_data = dclone($param{new_data});
3347 for my $key (keys %{$old_data}) {
3348 if (not exists $Debbugs::Status::fields{$key}) {
3349 delete $old_data->{$key};
3352 next unless exists $new_data->{$key};
3353 next unless defined $new_data->{$key};
3354 if (not defined $old_data->{$key}) {
3355 delete $old_data->{$key};
3358 if (ref($new_data->{$key}) and
3359 ref($old_data->{$key}) and
3360 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3361 local $Storable::canonical = 1;
3362 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3363 delete $new_data->{$key};
3364 delete $old_data->{$key};
3367 elsif ($new_data->{$key} eq $old_data->{$key}) {
3368 delete $new_data->{$key};
3369 delete $old_data->{$key};
3372 for my $key (keys %{$new_data}) {
3373 if (not exists $Debbugs::Status::fields{$key}) {
3374 delete $new_data->{$key};
3377 next unless exists $old_data->{$key};
3378 next unless defined $old_data->{$key};
3379 if (not defined $new_data->{$key} or
3380 not exists $Debbugs::Status::fields{$key}) {
3381 delete $new_data->{$key};
3384 if (ref($new_data->{$key}) and
3385 ref($old_data->{$key}) and
3386 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3387 local $Storable::canonical = 1;
3388 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3389 delete $new_data->{$key};
3390 delete $old_data->{$key};
3393 elsif ($new_data->{$key} eq $old_data->{$key}) {
3394 delete $new_data->{$key};
3395 delete $old_data->{$key};
3398 $data_diff .= "<!-- new_data:\n";
3400 for my $key (keys %{$new_data}) {
3401 if (not exists $Debbugs::Status::fields{$key}) {
3402 warn "No such field $key";
3405 $nd{$key} = $new_data->{$key};
3406 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n";
3408 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)]));
3409 $data_diff .= "-->\n";
3410 $data_diff .= "<!-- old_data:\n";
3412 for my $key (keys %{$old_data}) {
3413 if (not exists $Debbugs::Status::fields{$key}) {
3414 warn "No such field $key";
3417 $od{$key} = $old_data->{$key};
3418 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $old_data->{$key}")."\n";
3420 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%od)],[qw(old_data)]));
3421 $data_diff .= "-->\n";
3424 (exists $param{command} ?
3425 "<!-- command:".html_escape(encode_utf8($param{command}))." -->\n":""
3427 (length $param{requester} ?
3428 "<!-- requester: ".html_escape(encode_utf8($param{requester}))." -->\n":""
3430 (length $param{request_addr} ?
3431 "<!-- request_addr: ".html_escape(encode_utf8($param{request_addr}))." -->\n":""
3433 "<!-- time:".time()." -->\n",
3435 "<strong>".html_escape(encode_utf8($param{action}))."</strong>\n");
3436 if (length $param{requester}) {
3437 $msg .= "Request was from <code>".html_escape(encode_utf8($param{requester}))."</code>\n";
3439 if (length $param{request_addr}) {
3440 $msg .= "to <code>".html_escape(encode_utf8($param{request_addr}))."</code>";
3442 if (length $param{desc}) {
3443 $msg .= ":<br>\n".encode_utf8($param{desc})."\n";
3448 push @records, {type => 'html',
3452 if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
3453 push @records, {type => exists $param{recips}?'recips':'incoming-recv',
3454 exists $param{recips}?(recips => [make_list($param{recips})]):(),
3455 text => join('',make_list($param{message})),
3458 write_log_records(logfh=>$logfh,
3459 records => \@records,
3461 close $logfh or die "Unable to close $log_location: $!";
3462 if ($param{get_lock}) {
3463 unfilelock(exists $param{locks}?$param{locks}:());
3471 =head1 PRIVATE FUNCTIONS
3473 =head2 __handle_affected_packages
3475 __handle_affected_packages(affected_packages => {},
3483 sub __handle_affected_packages{
3484 my %param = validate_with(params => \@_,
3485 spec => {%common_options,
3486 data => {type => ARRAYREF|HASHREF
3491 for my $data (make_list($param{data})) {
3492 next unless exists $data->{package} and defined $data->{package};
3493 my @packages = split /\s*,\s*/,$data->{package};
3494 @{$param{affected_packages}}{@packages} = (1) x @packages;
3498 =head2 __handle_debug_transcript
3500 my ($debug,$transcript) = __handle_debug_transcript(%param);
3502 Returns a debug and transcript filehandle
3507 sub __handle_debug_transcript{
3508 my %param = validate_with(params => \@_,
3509 spec => {%common_options},
3512 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
3513 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3514 return ($debug,$transcript);
3521 Produces a small bit of bug information to kick out to the transcript
3528 next unless defined $data and exists $data->{bug_num};
3529 $return .= "Bug #".($data->{bug_num}||'').
3530 ((defined $data->{done} and length $data->{done})?
3531 " {Done: $data->{done}}":''
3533 " [".($data->{package}||'(no package)'). "] ".
3534 ($data->{subject}||'(no subject)')."\n";
3540 =head2 __internal_request
3542 __internal_request()
3543 __internal_request($level)
3545 Returns true if the caller of the function calling __internal_request
3546 belongs to __PACKAGE__
3548 This allows us to be magical, and don't bother to print bug info if
3549 the second caller is from this package, amongst other things.
3551 An optional level is allowed, which increments the number of levels to
3552 check by the given value. [This is basically for use by internal
3553 functions like __begin_control which are always called by
3558 sub __internal_request{
3560 $l = 0 if not defined $l;
3561 if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
3567 sub __return_append_to_log_options{
3569 my $action = $param{action} if exists $param{action};
3570 if (not exists $param{requester}) {
3571 $param{requester} = $config{control_internal_requester};
3573 if (not exists $param{request_addr}) {
3574 $param{request_addr} = $config{control_internal_request_addr};
3576 if (not exists $param{message}) {
3577 my $date = rfc822_date();
3578 $param{message} = fill_in_template(template => 'mail/fake_control_message',
3579 variables => {request_addr => $param{request_addr},
3580 requester => $param{requester},
3586 if (not defined $action) {
3587 carp "Undefined action!";
3588 $action = "unknown action";
3590 return (action => $action,
3591 hash_slice(%param,keys %append_action_options),
3595 =head2 __begin_control
3597 my %info = __begin_control(%param,
3599 command=>'unarchive');
3600 my ($debug,$transcript) = @info{qw(debug transcript)};
3601 my @data = @{$info{data}};
3602 my @bugs = @{$info{bugs}};
3605 Starts the process of modifying a bug; handles all of the generic
3606 things that almost every control request needs
3608 Returns a hash containing
3612 =item new_locks -- number of new locks taken out by this call
3614 =item debug -- the debug file handle
3616 =item transcript -- the transcript file handle
3618 =item data -- an arrayref containing the data of the bugs
3619 corresponding to this request
3621 =item bugs -- an arrayref containing the bug numbers of the bugs
3622 corresponding to this request
3630 sub __begin_control {
3631 my %param = validate_with(params => \@_,
3632 spec => {bug => {type => SCALAR,
3635 archived => {type => BOOLEAN,
3638 command => {type => SCALAR,
3646 my ($debug,$transcript) = __handle_debug_transcript(@_);
3647 print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
3648 # print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
3649 $lockhash = $param{locks} if exists $param{locks};
3651 my $old_die = $SIG{__DIE__};
3652 $SIG{__DIE__} = *sig_die{CODE};
3654 ($new_locks, @data) =
3655 lock_read_all_merged_bugs(bug => $param{bug},
3656 $param{archived}?(location => 'archive'):(),
3657 exists $param{locks} ? (locks => $param{locks}):(),
3659 $locks += $new_locks;
3661 die "Unable to read any bugs successfully.";
3663 if (not $param{archived}) {
3664 for my $data (@data) {
3665 if ($data->{archived}) {
3666 die "Not altering archived bugs; see unarchive.";
3670 if (not check_limit(data => \@data,
3671 exists $param{limit}?(limit => $param{limit}):(),
3672 transcript => $transcript,
3674 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
3677 __handle_affected_packages(%param,data => \@data);
3678 print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
3679 print {$debug} "$param{bug} read $locks locks\n";
3680 if (not @data or not defined $data[0]) {
3681 print {$transcript} "No bug found for $param{bug}\n";
3682 die "No bug found for $param{bug}";
3685 add_recipients(data => \@data,
3686 recipients => $param{recipients},
3687 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
3689 (__internal_request()?(transcript => $transcript):()),
3692 print {$debug} "$param{bug} read done\n";
3693 my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
3694 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3695 return (data => \@data,
3697 old_die => $old_die,
3698 new_locks => $new_locks,
3700 transcript => $transcript,
3702 exists $param{locks}?(locks => $param{locks}):(),
3706 =head2 __end_control
3708 __end_control(%info);
3710 Handles tearing down from a control request
3716 if (exists $info{new_locks} and $info{new_locks} > 0) {
3717 print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
3718 for (1..$info{new_locks}) {
3719 unfilelock(exists $info{locks}?$info{locks}:());
3723 $SIG{__DIE__} = $info{old_die};
3724 if (exists $info{param}{affected_bugs}) {
3725 @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
3727 add_recipients(recipients => $info{param}{recipients},
3728 (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
3729 data => $info{data},
3730 debug => $info{debug},
3731 transcript => $info{transcript},
3733 __handle_affected_packages(%{$info{param}},data=>$info{data});
3739 check_limit(data => \@data, limit => $param{limit});
3742 Checks to make sure that bugs match any limits; each entry of @data
3743 much satisfy the limit.
3745 Returns true if there are no entries in data, or there are no keys in
3746 limit; returns false (0) if there are any entries which do not match.
3748 The limit hashref elements can contain an arrayref of scalars to
3749 match; regexes are also acccepted. At least one of the entries in each
3750 element needs to match the corresponding field in all data for the
3757 my %param = validate_with(params => \@_,
3758 spec => {data => {type => ARRAYREF|HASHREF,
3760 limit => {type => HASHREF|UNDEF,
3762 transcript => {type => SCALARREF|HANDLE,
3767 my @data = make_list($param{data});
3769 not defined $param{limit} or
3770 not keys %{$param{limit}}) {
3773 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3774 my $going_to_fail = 0;
3775 for my $data (@data) {
3776 $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
3777 status => dclone($data),
3779 for my $field (keys %{$param{limit}}) {
3780 next unless exists $param{limit}{$field};
3782 my @data_fields = make_list($data->{$field});
3783 LIMIT: for my $limit (make_list($param{limit}{$field})) {
3784 if (not ref $limit) {
3785 for my $data_field (@data_fields) {
3786 if ($data_field eq $limit) {
3792 elsif (ref($limit) eq 'Regexp') {
3793 for my $data_field (@data_fields) {
3794 if ($data_field =~ $limit) {
3801 warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
3806 print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
3807 "' does not match at least one of ".
3808 join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
3812 return $going_to_fail?0:1;
3820 We override die to specially handle unlocking files in the cases where
3821 we are called via eval. [If we're not called via eval, it doesn't
3827 if ($^S) { # in eval
3829 for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
3836 # =head2 __message_body_template
3838 # message_body_template('mail/ack',{ref=>'foo'});
3840 # Creates a message body using a template
3844 sub __message_body_template{
3845 my ($template,$extra_var) = @_;
3847 my $hole_var = {'&bugurl' =>
3849 'http://'.$config{cgi_domain}.'/'.
3850 Debbugs::CGI::bug_links(bug => $_[0],
3856 my $body = fill_in_template(template => $template,
3857 variables => {config => \%config,
3860 hole_var => $hole_var,
3862 return fill_in_template(template => 'mail/message_body',
3863 variables => {config => \%config,
3867 hole_var => $hole_var,
3871 sub __all_undef_or_equal {
3873 return 1 if @values == 1 or @values == 0;
3874 my $not_def = grep {not defined $_} @values;
3875 if ($not_def == @values) {
3878 if ($not_def > 0 and $not_def != @values) {
3881 my $first_val = shift @values;
3882 for my $val (@values) {
3883 if ($first_val ne $val) {