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 Exporter qw(import);
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);
115 use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
116 use Debbugs::CGI qw(html_escape);
117 use Debbugs::Log qw(:misc :write);
118 use Debbugs::Recipients qw(:add);
119 use Debbugs::Packages qw(:versions :mapping);
121 use Data::Dumper qw();
122 use Params::Validate qw(validate_with :types);
123 use File::Path qw(mkpath);
124 use File::Copy qw(copy);
127 use Debbugs::Text qw(:templates);
129 use Debbugs::Mail qw(rfc822_date send_mail_message default_headers encode_headers);
130 use Debbugs::MIME qw(create_mime_message);
132 use Mail::RFC822::Address qw();
134 use POSIX qw(strftime);
136 use Storable qw(dclone nfreeze);
137 use List::AllUtils qw(first max);
138 use Encode qw(encode_utf8);
142 # These are a set of options which are common to all of these functions
144 my %common_options = (debug => {type => SCALARREF|HANDLE,
147 transcript => {type => SCALARREF|HANDLE,
150 affected_bugs => {type => HASHREF,
153 affected_packages => {type => HASHREF,
156 recipients => {type => HASHREF,
159 limit => {type => HASHREF,
162 show_bug_info => {type => BOOLEAN,
165 request_subject => {type => SCALAR,
166 default => 'Unknown Subject',
168 request_msgid => {type => SCALAR,
171 request_nn => {type => SCALAR,
174 request_replyto => {type => SCALAR,
177 locks => {type => HASHREF,
183 my %append_action_options =
184 (action => {type => SCALAR,
187 requester => {type => SCALAR,
190 request_addr => {type => SCALAR,
193 location => {type => SCALAR,
196 message => {type => SCALAR|ARRAYREF,
199 append_log => {type => BOOLEAN,
201 depends => [qw(requester request_addr),
205 # locks is both an append_action option, and a common option;
206 # it's ok for it to be in both places.
207 locks => {type => HASHREF,
215 # this is just a generic stub for Debbugs::Control functions.
220 # set_foo(bug => $ref,
221 # transcript => $transcript,
222 # ($dl > 0 ? (debug => $transcript):()),
223 # requester => $header{from},
224 # request_addr => $controlrequestaddr,
226 # affected_packages => \%affected_packages,
227 # recipients => \%recipients,
233 # print {$transcript} "Failed to set foo $ref bar: $@";
241 # my %param = validate_with(params => \@_,
242 # spec => {bug => {type => SCALAR,
243 # regex => qr/^\d+$/,
245 # # specific options here
247 # %append_action_options,
251 # __begin_control(%param,
254 # my ($debug,$transcript) =
255 # @info{qw(debug transcript)};
256 # my @data = @{$info{data}};
257 # my @bugs = @{$info{bugs}};
260 # for my $data (@data) {
261 # append_action_to_log(bug => $data->{bug_num},
263 # __return_append_to_log_options(
268 # if not exists $param{append_log} or $param{append_log};
269 # writebug($data->{bug_num},$data);
270 # print {$transcript} "$action\n";
272 # __end_control(%info);
279 set_block(bug => $ref,
280 transcript => $transcript,
281 ($dl > 0 ? (debug => $transcript):()),
282 requester => $header{from},
283 request_addr => $controlrequestaddr,
285 affected_packages => \%affected_packages,
286 recipients => \%recipients,
292 print {$transcript} "Failed to set blockers of $ref: $@";
295 Alters the set of bugs that block this bug from being fixed
297 This requires altering both this bug (and those it's merged with) as
298 well as the bugs that block this bug from being fixed (and those that
303 =item block -- scalar or arrayref of blocking bugs to set, add or remove
305 =item add -- if true, add blocking bugs
307 =item remove -- if true, remove blocking bugs
314 my %param = validate_with(params => \@_,
315 spec => {bug => {type => SCALAR,
318 # specific options here
319 block => {type => SCALAR|ARRAYREF,
322 add => {type => BOOLEAN,
325 remove => {type => BOOLEAN,
329 %append_action_options,
332 if ($param{add} and $param{remove}) {
333 croak "It's nonsensical to add and remove the same blocking bugs";
335 if (grep {$_ !~ /^\d+$/} make_list($param{block})) {
336 croak "Invalid blocking bug(s):".
337 join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
343 elsif ($param{remove}) {
348 __begin_control(%param,
351 my ($debug,$transcript) =
352 @info{qw(debug transcript)};
353 my @data = @{$info{data}};
354 my @bugs = @{$info{bugs}};
357 # The first bit of this code is ugly, and should be cleaned up.
358 # Its purpose is to populate %removed_blockers and %add_blockers
359 # with all of the bugs that should be added or removed as blockers
360 # of all of the bugs which are merged with $param{bug}
363 for my $blocker (make_list($param{block})) {
364 next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
365 my $data = read_bug(bug=>$blocker,
367 if (defined $data and not $data->{archive}) {
368 $data = split_status_fields($data);
369 $ok_blockers{$blocker} = 1;
371 push @merged_bugs, make_list($data->{mergedwith});
372 @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
375 $bad_blockers{$blocker} = 1;
379 # throw an error if we are setting the blockers and there is a bad
381 if (keys %bad_blockers and $mode eq 'set') {
382 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
383 keys %ok_blockers?'':" and no known blocking bug(s)";
385 # if there are no ok blockers and we are not setting the blockers,
387 if (not keys %ok_blockers and $mode ne 'set') {
388 print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
389 if (keys %bad_blockers) {
390 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
392 __end_control(%info);
396 my @change_blockers = keys %ok_blockers;
398 my %removed_blockers;
401 my @blockers = map {split ' ', $_->{blockedby}} @data;
403 @blockers{@blockers} = (1) x @blockers;
405 # it is nonsensical for a bug to block itself (or a merged
406 # partner); We currently don't allow removal because we'd possibly
410 @bugs{@bugs} = (1) x @bugs;
411 for my $blocker (@change_blockers) {
412 if ($bugs{$blocker}) {
413 croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
416 @blockers = keys %blockers;
418 %removed_blockers = ();
419 for my $blocker (@change_blockers) {
420 next if exists $blockers{$blocker};
421 $blockers{$blocker} = 1;
422 $added_blockers{$blocker} = 1;
425 elsif ($param{remove}) {
426 %added_blockers = ();
427 for my $blocker (@change_blockers) {
428 next if exists $removed_blockers{$blocker};
429 delete $blockers{$blocker};
430 $removed_blockers{$blocker} = 1;
434 @removed_blockers{@blockers} = (1) x @blockers;
436 for my $blocker (@change_blockers) {
437 next if exists $blockers{$blocker};
438 $blockers{$blocker} = 1;
439 if (exists $removed_blockers{$blocker}) {
440 delete $removed_blockers{$blocker};
443 $added_blockers{$blocker} = 1;
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) {
490 for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
491 next if $munge_blockers{$blocker};
492 my ($temp_locks, @blocking_data) =
493 lock_read_all_merged_bugs(bug => $blocker,
494 ($param{archived}?(location => 'archive'):()),
495 exists $param{locks}?(locks => $param{locks}):(),
497 $locks+= $temp_locks;
498 $new_locks+=$temp_locks;
499 if (not @blocking_data) {
500 for (1..$new_locks) {
501 unfilelock(exists $param{locks}?$param{locks}:());
504 die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
506 for (map {$_->{bug_num}} @blocking_data) {
507 $munge_blockers{$_} = 1;
509 for my $data (@blocking_data) {
510 my $old_data = dclone($data);
512 my @blocks = split ' ', $data->{blocks};
513 @blocks{@blocks} = (1) x @blocks;
515 for my $bug (@bugs) {
516 if ($add_remove eq 'remove') {
517 next unless exists $blocks{$bug};
518 delete $blocks{$bug};
521 next if exists $blocks{$bug};
526 $data->{blocks} = join(' ',sort keys %blocks);
527 my $action = ($add_remove eq 'add'?'Added':'Removed').
528 " indication that bug $data->{bug_num} blocks ".
530 append_action_to_log(bug => $data->{bug_num},
532 old_data => $old_data,
535 __return_append_to_log_options(%param,
539 writebug($data->{bug_num},$data);
541 __handle_affected_packages(%param,data=>\@blocking_data);
542 add_recipients(recipients => $param{recipients},
543 actions_taken => {blocks => 1},
544 data => \@blocking_data,
546 transcript => $transcript,
549 for (1..$new_locks) {
550 unfilelock(exists $param{locks}?$param{locks}:());
555 __end_control(%info);
564 transcript => $transcript,
565 ($dl > 0 ? (debug => $transcript):()),
566 requester => $header{from},
567 request_addr => $controlrequestaddr,
569 affected_packages => \%affected_packages,
570 recipients => \%recipients,
577 print {$transcript} "Failed to set tag on $ref: $@";
581 Sets, adds, or removes the specified tags on a bug
585 =item tag -- scalar or arrayref of tags to set, add or remove
587 =item add -- if true, add tags
589 =item remove -- if true, remove tags
591 =item warn_on_bad_tags -- if true (the default) warn if bad tags are
599 my %param = validate_with(params => \@_,
600 spec => {bug => {type => SCALAR,
603 # specific options here
604 tag => {type => SCALAR|ARRAYREF,
607 add => {type => BOOLEAN,
610 remove => {type => BOOLEAN,
613 warn_on_bad_tags => {type => BOOLEAN,
617 %append_action_options,
620 if ($param{add} and $param{remove}) {
621 croak "It's nonsensical to add and remove the same tags";
625 __begin_control(%param,
628 my $transcript = $info{transcript};
629 my @data = @{$info{data}};
630 my @tags = make_list($param{tag});
631 if (not @tags and ($param{remove} or $param{add})) {
632 if ($param{remove}) {
633 print {$transcript} "Requested to remove no tags; doing nothing.\n";
636 print {$transcript} "Requested to add no tags; doing nothing.\n";
638 __end_control(%info);
641 # first things first, make the versions fully qualified source
643 for my $data (@data) {
644 my $action = 'Did not alter tags';
646 my %tag_removed = ();
647 my @old_tags = split /\,?\s+/, $data->{keywords};
649 @tags{@old_tags} = (1) x @old_tags;
650 my $old_data = dclone($data);
651 if (not $param{add} and not $param{remove}) {
652 $tag_removed{$_} = 1 for @old_tags;
656 for my $tag (@tags) {
657 if (not $param{remove} and
658 not defined first {$_ eq $tag} @{$config{tags}}) {
659 push @bad_tags, $tag;
663 if (not exists $tags{$tag}) {
665 $tag_added{$tag} = 1;
668 elsif ($param{remove}) {
669 if (exists $tags{$tag}) {
671 $tag_removed{$tag} = 1;
675 if (exists $tag_removed{$tag}) {
676 delete $tag_removed{$tag};
679 $tag_added{$tag} = 1;
684 if (@bad_tags and $param{warn_on_bad_tags}) {
685 print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
686 print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
688 $data->{keywords} = join(' ',keys %tags);
691 push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
692 push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
693 $action = ucfirst(join ('; ',@changed)) if @changed;
695 print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
699 append_action_to_log(bug => $data->{bug_num},
702 old_data => $old_data,
704 __return_append_to_log_options(
709 if not exists $param{append_log} or $param{append_log};
710 writebug($data->{bug_num},$data);
711 print {$transcript} "$action\n";
713 __end_control(%info);
721 set_severity(bug => $ref,
722 transcript => $transcript,
723 ($dl > 0 ? (debug => $transcript):()),
724 requester => $header{from},
725 request_addr => $controlrequestaddr,
727 affected_packages => \%affected_packages,
728 recipients => \%recipients,
729 severity => 'normal',
734 print {$transcript} "Failed to set the severity of bug $ref: $@";
737 Sets the severity of a bug. If severity is not passed, is undefined,
738 or has zero length, sets the severity to the default severity.
743 my %param = validate_with(params => \@_,
744 spec => {bug => {type => SCALAR,
747 # specific options here
748 severity => {type => SCALAR|UNDEF,
749 default => $config{default_severity},
752 %append_action_options,
755 if (not defined $param{severity} or
756 not length $param{severity}
758 $param{severity} = $config{default_severity};
761 # check validity of new severity
762 if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) {
763 die "Severity '$param{severity}' is not a valid severity level";
766 __begin_control(%param,
767 command => 'severity'
769 my $transcript = $info{transcript};
770 my @data = @{$info{data}};
773 for my $data (@data) {
774 if (not defined $data->{severity}) {
775 $data->{severity} = $param{severity};
776 $action = "Severity set to '$param{severity}'";
779 if ($data->{severity} eq '') {
780 $data->{severity} = $config{default_severity};
782 if ($data->{severity} eq $param{severity}) {
783 print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
786 $action = "Severity set to '$param{severity}' from '$data->{severity}'";
787 $data->{severity} = $param{severity};
789 append_action_to_log(bug => $data->{bug_num},
791 __return_append_to_log_options(
796 if not exists $param{append_log} or $param{append_log};
797 writebug($data->{bug_num},$data);
798 print {$transcript} "$action\n";
800 __end_control(%info);
807 set_done(bug => $ref,
808 transcript => $transcript,
809 ($dl > 0 ? (debug => $transcript):()),
810 requester => $header{from},
811 request_addr => $controlrequestaddr,
813 affected_packages => \%affected_packages,
814 recipients => \%recipients,
819 print {$transcript} "Failed to set foo $ref bar: $@";
827 my %param = validate_with(params => \@_,
828 spec => {bug => {type => SCALAR,
831 reopen => {type => BOOLEAN,
834 submitter => {type => SCALAR,
837 clear_fixed => {type => BOOLEAN,
840 notify_submitter => {type => BOOLEAN,
843 original_report => {type => SCALARREF,
846 done => {type => SCALAR|UNDEF,
850 %append_action_options,
854 if (exists $param{submitter} and
855 not Mail::RFC822::Address::valid($param{submitter})) {
856 die "New submitter address '$param{submitter}' is not a valid e-mail address";
858 if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
859 $param{done} = $param{requester};
861 if (exists $param{done} and
862 (not defined $param{done} or
863 not length $param{done})) {
869 __begin_control(%param,
870 command => $param{reopen}?'reopen':'done',
872 my $transcript = $info{transcript};
873 my @data = @{$info{data}};
876 if ($param{reopen}) {
877 # avoid warning multiple times if there are fixed versions
879 for my $data (@data) {
880 if (not exists $data->{done} or
881 not defined $data->{done} or
882 not length $data->{done}) {
883 print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
884 __end_control(%info);
887 if (@{$data->{fixed_versions}} and $warn_fixed) {
888 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
889 print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
893 $action = "Bug reopened";
894 for my $data (@data) {
895 my $old_data = dclone($data);
897 append_action_to_log(bug => $data->{bug_num},
900 old_data => $old_data,
902 __return_append_to_log_options(
907 if not exists $param{append_log} or $param{append_log};
908 writebug($data->{bug_num},$data);
910 print {$transcript} "$action\n";
911 __end_control(%info);
912 if (exists $param{submitter}) {
913 set_submitter(bug => $param{bug},
914 submitter => $param{submitter},
916 keys %common_options,
917 keys %append_action_options)
920 # clear the fixed revisions
921 if ($param{clear_fixed}) {
922 set_fixed(fixed => [],
926 keys %common_options,
927 keys %append_action_options),
932 my %submitter_notified;
933 my $orig_report_set = 0;
934 for my $data (@data) {
935 if (exists $data->{done} and
936 defined $data->{done} and
937 length $data->{done}) {
938 print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n";
939 __end_control(%info);
943 for my $data (@data) {
944 my $old_data = dclone($data);
945 my $hash = get_hashname($data->{bug_num});
946 my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or
947 die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!";
951 $orig_report= <$report_fh>;
954 if (not $orig_report_set and defined $orig_report and
955 length $orig_report and
956 exists $param{original_report}){
957 ${$param{original_report}} = $orig_report;
958 $orig_report_set = 1;
961 $action = "Marked $config{bug} as done";
963 # set done to the requester
964 $data->{done} = exists $param{done}?$param{done}:$param{requester};
965 append_action_to_log(bug => $data->{bug_num},
968 old_data => $old_data,
970 __return_append_to_log_options(
975 if not exists $param{append_log} or $param{append_log};
976 writebug($data->{bug_num},$data);
977 print {$transcript} "$action\n";
978 # get the original report
979 if ($param{notify_submitter}) {
980 my $submitter_message;
981 if(not exists $submitter_notified{$data->{originator}}) {
983 create_mime_message([default_headers(queue_file => $param{request_nn},
985 msgid => $param{request_msgid},
986 msgtype => 'notifdone',
987 pr_msg => 'they-closed',
989 [To => $data->{submitter},
990 Subject => "$config{ubug}#$data->{bug_num} ".
991 "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
995 __message_body_template('mail/process_your_bug_done',
997 replyto => (exists $param{request_replyto} ?
998 $param{request_replyto} :
999 $param{requester} || 'Unknown'),
1000 markedby => $param{requester},
1001 subject => $param{request_subject},
1002 messageid => $param{request_msgid},
1005 [join('',make_list($param{message})),$orig_report]
1007 send_mail_message(message => $submitter_message,
1008 recipients => $old_data->{submitter},
1010 $submitter_notified{$data->{originator}} = $submitter_message;
1013 $submitter_message = $submitter_notified{$data->{originator}};
1015 append_action_to_log(bug => $data->{bug_num},
1016 action => "Notification sent",
1018 request_addr => $data->{originator},
1019 desc => "$config{bug} acknowledged by developer.",
1020 recips => [$data->{originator}],
1021 message => $submitter_message,
1026 __end_control(%info);
1027 if (exists $param{fixed}) {
1028 set_fixed(fixed => $param{fixed},
1032 keys %common_options,
1033 keys %append_action_options
1041 =head2 set_submitter
1044 set_submitter(bug => $ref,
1045 transcript => $transcript,
1046 ($dl > 0 ? (debug => $transcript):()),
1047 requester => $header{from},
1048 request_addr => $controlrequestaddr,
1050 affected_packages => \%affected_packages,
1051 recipients => \%recipients,
1052 submitter => $new_submitter,
1053 notify_submitter => 1,
1058 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1061 Sets the submitter of a bug. If notify_submitter is true (the
1062 default), notifies the old submitter of a bug on changes
1067 my %param = validate_with(params => \@_,
1068 spec => {bug => {type => SCALAR,
1071 # specific options here
1072 submitter => {type => SCALAR,
1074 notify_submitter => {type => BOOLEAN,
1078 %append_action_options,
1081 if (not Mail::RFC822::Address::valid($param{submitter})) {
1082 die "New submitter address $param{submitter} is not a valid e-mail address";
1085 __begin_control(%param,
1086 command => 'submitter'
1088 my ($debug,$transcript) =
1089 @info{qw(debug transcript)};
1090 my @data = @{$info{data}};
1092 # here we only concern ourselves with the first of the merged bugs
1093 for my $data ($data[0]) {
1094 my $notify_old_submitter = 0;
1095 my $old_data = dclone($data);
1096 print {$debug} "Going to change bug submitter\n";
1097 if (((not defined $param{submitter} or not length $param{submitter}) and
1098 (not defined $data->{originator} or not length $data->{originator})) or
1099 (defined $param{submitter} and defined $data->{originator} and
1100 $param{submitter} eq $data->{originator})) {
1101 print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
1105 if (defined $data->{originator} and length($data->{originator})) {
1106 $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'.";
1107 $notify_old_submitter = 1;
1110 $action= "Set $config{bug} submitter to '$param{submitter}'.";
1112 $data->{originator} = $param{submitter};
1114 append_action_to_log(bug => $data->{bug_num},
1115 command => 'submitter',
1117 old_data => $old_data,
1119 __return_append_to_log_options(
1124 if not exists $param{append_log} or $param{append_log};
1125 writebug($data->{bug_num},$data);
1126 print {$transcript} "$action\n";
1127 # notify old submitter
1128 if ($notify_old_submitter and $param{notify_submitter}) {
1129 send_mail_message(message =>
1130 create_mime_message([default_headers(queue_file => $param{request_nn},
1132 msgid => $param{request_msgid},
1134 pr_msg => 'submitter-changed',
1136 [To => $old_data->{submitter},
1137 Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
1141 __message_body_template('mail/submitter_changed',
1142 {old_data => $old_data,
1144 replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
1148 recipients => $old_data->{submitter},
1152 __end_control(%info);
1157 =head2 set_forwarded
1160 set_forwarded(bug => $ref,
1161 transcript => $transcript,
1162 ($dl > 0 ? (debug => $transcript):()),
1163 requester => $header{from},
1164 request_addr => $controlrequestaddr,
1166 affected_packages => \%affected_packages,
1167 recipients => \%recipients,
1168 forwarded => $forward_to,
1173 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1176 Sets the location to which a bug is forwarded. Given an undef
1177 forwarded, unsets forwarded.
1183 my %param = validate_with(params => \@_,
1184 spec => {bug => {type => SCALAR,
1187 # specific options here
1188 forwarded => {type => SCALAR|UNDEF,
1191 %append_action_options,
1194 if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
1195 die "Non-printable characters are not allowed in the forwarded field";
1197 $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded};
1199 __begin_control(%param,
1200 command => 'forwarded'
1202 my ($debug,$transcript) =
1203 @info{qw(debug transcript)};
1204 my @data = @{$info{data}};
1206 for my $data (@data) {
1207 my $old_data = dclone($data);
1208 print {$debug} "Going to change bug forwarded\n";
1209 if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or
1210 (not defined $param{forwarded} and
1211 defined $data->{forwarded} and not length $data->{forwarded})) {
1212 print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n";
1216 if (not defined $param{forwarded}) {
1217 $action= "Unset $config{bug} forwarded-to-address";
1219 elsif (defined $data->{forwarded} and length($data->{forwarded})) {
1220 $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'.";
1223 $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
1225 $data->{forwarded} = $param{forwarded};
1227 append_action_to_log(bug => $data->{bug_num},
1228 command => 'forwarded',
1230 old_data => $old_data,
1232 __return_append_to_log_options(
1237 if not exists $param{append_log} or $param{append_log};
1238 writebug($data->{bug_num},$data);
1239 print {$transcript} "$action\n";
1241 __end_control(%info);
1250 set_title(bug => $ref,
1251 transcript => $transcript,
1252 ($dl > 0 ? (debug => $transcript):()),
1253 requester => $header{from},
1254 request_addr => $controlrequestaddr,
1256 affected_packages => \%affected_packages,
1257 recipients => \%recipients,
1258 title => $new_title,
1263 print {$transcript} "Failed to set the title of $ref: $@";
1266 Sets the title of a specific bug
1272 my %param = validate_with(params => \@_,
1273 spec => {bug => {type => SCALAR,
1276 # specific options here
1277 title => {type => SCALAR,
1280 %append_action_options,
1283 if ($param{title} =~ /[^[:print:]]/) {
1284 die "Non-printable characters are not allowed in bug titles";
1287 my %info = __begin_control(%param,
1290 my ($debug,$transcript) =
1291 @info{qw(debug transcript)};
1292 my @data = @{$info{data}};
1294 for my $data (@data) {
1295 my $old_data = dclone($data);
1296 print {$debug} "Going to change bug title\n";
1297 if (defined $data->{subject} and length($data->{subject}) and
1298 $data->{subject} eq $param{title}) {
1299 print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
1303 if (defined $data->{subject} and length($data->{subject})) {
1304 $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'.";
1306 $action= "Set $config{bug} title to '$param{title}'.";
1308 $data->{subject} = $param{title};
1310 append_action_to_log(bug => $data->{bug_num},
1313 old_data => $old_data,
1315 __return_append_to_log_options(
1320 if not exists $param{append_log} or $param{append_log};
1321 writebug($data->{bug_num},$data);
1322 print {$transcript} "$action\n";
1324 __end_control(%info);
1331 set_package(bug => $ref,
1332 transcript => $transcript,
1333 ($dl > 0 ? (debug => $transcript):()),
1334 requester => $header{from},
1335 request_addr => $controlrequestaddr,
1337 affected_packages => \%affected_packages,
1338 recipients => \%recipients,
1339 package => $new_package,
1345 print {$transcript} "Failed to assign or reassign $ref to a package: $@";
1348 Indicates that a bug is in a particular package. If is_source is true,
1349 indicates that the package is a source package. [Internally, this
1350 causes src: to be prepended to the package name.]
1352 The default for is_source is 0. As a special case, if the package
1353 starts with 'src:', it is assumed to be a source package and is_source
1356 The package option must match the package_name_re regex.
1361 my %param = validate_with(params => \@_,
1362 spec => {bug => {type => SCALAR,
1365 # specific options here
1366 package => {type => SCALAR|ARRAYREF,
1368 is_source => {type => BOOLEAN,
1372 %append_action_options,
1375 my @new_packages = map {splitpackages($_)} make_list($param{package});
1376 if (grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages) {
1377 croak "Invalid package name '".
1378 join(',',grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages).
1381 my %info = __begin_control(%param,
1382 command => 'package',
1384 my ($debug,$transcript) =
1385 @info{qw(debug transcript)};
1386 my @data = @{$info{data}};
1387 # clean up the new package
1391 ($temp =~ s/^src:// or
1392 $param{is_source}) ? 'src:'.$temp:$temp;
1396 my $package_reassigned = 0;
1397 for my $data (@data) {
1398 my $old_data = dclone($data);
1399 print {$debug} "Going to change assigned package\n";
1400 if (defined $data->{package} and length($data->{package}) and
1401 $data->{package} eq $new_package) {
1402 print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
1406 if (defined $data->{package} and length($data->{package})) {
1407 $package_reassigned = 1;
1408 $action= "$config{bug} reassigned from package '$data->{package}'".
1409 " to '$new_package'.";
1411 $action= "$config{bug} assigned to package '$new_package'.";
1413 $data->{package} = $new_package;
1415 append_action_to_log(bug => $data->{bug_num},
1416 command => 'package',
1418 old_data => $old_data,
1420 __return_append_to_log_options(
1425 if not exists $param{append_log} or $param{append_log};
1426 writebug($data->{bug_num},$data);
1427 print {$transcript} "$action\n";
1429 __end_control(%info);
1430 # Only clear the fixed/found versions if the package has been
1432 if ($package_reassigned) {
1433 my @params_for_found_fixed =
1434 map {exists $param{$_}?($_,$param{$_}):()}
1436 keys %common_options,
1437 keys %append_action_options,
1439 set_found(found => [],
1440 @params_for_found_fixed,
1442 set_fixed(fixed => [],
1443 @params_for_found_fixed,
1451 set_found(bug => $ref,
1452 transcript => $transcript,
1453 ($dl > 0 ? (debug => $transcript):()),
1454 requester => $header{from},
1455 request_addr => $controlrequestaddr,
1457 affected_packages => \%affected_packages,
1458 recipients => \%recipients,
1465 print {$transcript} "Failed to set found on $ref: $@";
1469 Sets, adds, or removes the specified found versions of a package
1471 If the version list is empty, and the bug is currently not "done",
1472 causes the done field to be cleared.
1474 If any of the versions added to found are greater than any version in
1475 which the bug is fixed (or when the bug is found and there are no
1476 fixed versions) the done field is cleared.
1481 my %param = validate_with(params => \@_,
1482 spec => {bug => {type => SCALAR,
1485 # specific options here
1486 found => {type => SCALAR|ARRAYREF,
1489 add => {type => BOOLEAN,
1492 remove => {type => BOOLEAN,
1496 %append_action_options,
1499 if ($param{add} and $param{remove}) {
1500 croak "It's nonsensical to add and remove the same versions";
1504 __begin_control(%param,
1507 my ($debug,$transcript) =
1508 @info{qw(debug transcript)};
1509 my @data = @{$info{data}};
1511 for my $version (make_list($param{found})) {
1512 next unless defined $version;
1513 $versions{$version} =
1514 [make_source_versions(package => [splitpackages($data[0]{package})],
1515 warnings => $transcript,
1518 versions => $version,
1521 # This is really ugly, but it's what we have to do
1522 if (not @{$versions{$version}}) {
1523 print {$transcript} "Unable to make a source version for version '$version'\n";
1526 if (not keys %versions and ($param{remove} or $param{add})) {
1527 if ($param{remove}) {
1528 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1531 print {$transcript} "Requested to add no versions; doing nothing.\n";
1533 __end_control(%info);
1536 # first things first, make the versions fully qualified source
1538 for my $data (@data) {
1539 # The 'done' field gets a bit weird with version tracking,
1540 # because a bug may be closed by multiple people in different
1541 # branches. Until we have something more flexible, we set it
1542 # every time a bug is fixed, and clear it when a bug is found
1543 # in a version greater than any version in which the bug is
1544 # fixed or when a bug is found and there is no fixed version
1545 my $action = 'Did not alter found versions';
1546 my %found_added = ();
1547 my %found_removed = ();
1548 my %fixed_removed = ();
1550 my $old_data = dclone($data);
1551 if (not $param{add} and not $param{remove}) {
1552 $found_removed{$_} = 1 for @{$data->{found_versions}};
1553 $data->{found_versions} = [];
1556 @found_versions{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1558 @fixed_versions{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1559 for my $version (keys %versions) {
1561 my @svers = @{$versions{$version}};
1565 elsif (not grep {$version eq $_} @svers) {
1566 # The $version was not equal to one of the source
1567 # versions, so it's probably unqualified (or just
1568 # wrong). Delete it, and use the source versions
1570 if (exists $found_versions{$version}) {
1571 delete $found_versions{$version};
1572 $found_removed{$version} = 1;
1575 for my $sver (@svers) {
1576 if (not exists $found_versions{$sver}) {
1577 $found_versions{$sver} = 1;
1578 $found_added{$sver} = 1;
1580 # if the found we are adding matches any fixed
1581 # versions, remove them
1582 my @temp = grep m{(^|/)\Q$sver\E$}, keys %fixed_versions;
1583 delete $fixed_versions{$_} for @temp;
1584 $fixed_removed{$_} = 1 for @temp;
1587 # We only care about reopening the bug if the bug is
1589 if (defined $data->{done} and length $data->{done}) {
1590 my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
1592 # determine if we need to reopen
1593 my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
1594 keys %fixed_versions);
1595 if (not @fixed_order or
1596 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1602 elsif ($param{remove}) {
1603 # in the case of removal, we only concern ourself with
1604 # the version passed, not the source version it maps
1606 my @temp = grep m{(?:^|/)\Q$version\E$}, keys %found_versions;
1607 delete $found_versions{$_} for @temp;
1608 $found_removed{$_} = 1 for @temp;
1611 # set the keys to exactly these values
1612 my @svers = @{$versions{$version}};
1616 for my $sver (@svers) {
1617 if (not exists $found_versions{$sver}) {
1618 $found_versions{$sver} = 1;
1619 if (exists $found_removed{$sver}) {
1620 delete $found_removed{$sver};
1623 $found_added{$sver} = 1;
1630 $data->{found_versions} = [keys %found_versions];
1631 $data->{fixed_versions} = [keys %fixed_versions];
1634 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1635 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1636 # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
1637 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1638 $action = ucfirst(join ('; ',@changed)) if @changed;
1640 $action .= " and reopened"
1642 if (not $reopened and not @changed) {
1643 print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
1647 append_action_to_log(bug => $data->{bug_num},
1650 old_data => $old_data,
1652 __return_append_to_log_options(
1657 if not exists $param{append_log} or $param{append_log};
1658 writebug($data->{bug_num},$data);
1659 print {$transcript} "$action\n";
1661 __end_control(%info);
1667 set_fixed(bug => $ref,
1668 transcript => $transcript,
1669 ($dl > 0 ? (debug => $transcript):()),
1670 requester => $header{from},
1671 request_addr => $controlrequestaddr,
1673 affected_packages => \%affected_packages,
1674 recipients => \%recipients,
1682 print {$transcript} "Failed to set fixed on $ref: $@";
1686 Sets, adds, or removes the specified fixed versions of a package
1688 If the fixed versions are empty (or end up being empty after this
1689 call) or the greatest fixed version is less than the greatest found
1690 version and the reopen option is true, the bug is reopened.
1692 This function is also called by the reopen function, which causes all
1693 of the fixed versions to be cleared.
1698 my %param = validate_with(params => \@_,
1699 spec => {bug => {type => SCALAR,
1702 # specific options here
1703 fixed => {type => SCALAR|ARRAYREF,
1706 add => {type => BOOLEAN,
1709 remove => {type => BOOLEAN,
1712 reopen => {type => BOOLEAN,
1716 %append_action_options,
1719 if ($param{add} and $param{remove}) {
1720 croak "It's nonsensical to add and remove the same versions";
1723 __begin_control(%param,
1726 my ($debug,$transcript) =
1727 @info{qw(debug transcript)};
1728 my @data = @{$info{data}};
1730 for my $version (make_list($param{fixed})) {
1731 next unless defined $version;
1732 $versions{$version} =
1733 [make_source_versions(package => [splitpackages($data[0]{package})],
1734 warnings => $transcript,
1737 versions => $version,
1740 # This is really ugly, but it's what we have to do
1741 if (not @{$versions{$version}}) {
1742 print {$transcript} "Unable to make a source version for version '$version'\n";
1745 if (not keys %versions and ($param{remove} or $param{add})) {
1746 if ($param{remove}) {
1747 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1750 print {$transcript} "Requested to add no versions; doing nothing.\n";
1752 __end_control(%info);
1755 # first things first, make the versions fully qualified source
1757 for my $data (@data) {
1758 my $old_data = dclone($data);
1759 # The 'done' field gets a bit weird with version tracking,
1760 # because a bug may be closed by multiple people in different
1761 # branches. Until we have something more flexible, we set it
1762 # every time a bug is fixed, and clear it when a bug is found
1763 # in a version greater than any version in which the bug is
1764 # fixed or when a bug is found and there is no fixed version
1765 my $action = 'Did not alter fixed versions';
1766 my %found_added = ();
1767 my %found_removed = ();
1768 my %fixed_added = ();
1769 my %fixed_removed = ();
1771 if (not $param{add} and not $param{remove}) {
1772 $fixed_removed{$_} = 1 for @{$data->{fixed_versions}};
1773 $data->{fixed_versions} = [];
1776 @found_versions{@{$data->{found_versions}||[]}} = (1) x @{$data->{found_versions}||[]};
1778 @fixed_versions{@{$data->{fixed_versions}||[]}} = (1) x @{$data->{fixed_versions}||[]};
1779 for my $version (keys %versions) {
1781 my @svers = @{$versions{$version}};
1786 if (exists $fixed_versions{$version}) {
1787 $fixed_removed{$version} = 1;
1788 delete $fixed_versions{$version};
1791 for my $sver (@svers) {
1792 if (not exists $fixed_versions{$sver}) {
1793 $fixed_versions{$sver} = 1;
1794 $fixed_added{$sver} = 1;
1798 elsif ($param{remove}) {
1799 # in the case of removal, we only concern ourself with
1800 # the version passed, not the source version it maps
1802 my @temp = grep m{(?:^|\/)\Q$version\E$}, keys %fixed_versions;
1803 delete $fixed_versions{$_} for @temp;
1804 $fixed_removed{$_} = 1 for @temp;
1807 # set the keys to exactly these values
1808 my @svers = @{$versions{$version}};
1812 for my $sver (@svers) {
1813 if (not exists $fixed_versions{$sver}) {
1814 $fixed_versions{$sver} = 1;
1815 if (exists $fixed_removed{$sver}) {
1816 delete $fixed_removed{$sver};
1819 $fixed_added{$sver} = 1;
1826 $data->{found_versions} = [keys %found_versions];
1827 $data->{fixed_versions} = [keys %fixed_versions];
1829 # If we're supposed to consider reopening, reopen if the
1830 # fixed versions are empty or the greatest found version
1831 # is greater than the greatest fixed version
1832 if ($param{reopen} and defined $data->{done}
1833 and length $data->{done}) {
1834 my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1835 map {m{([^/]+)$}; $1;} @{$data->{found_versions}};
1836 # determine if we need to reopen
1837 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1838 map {m{([^/]+)$}; $1;} @{$data->{fixed_versions}};
1839 if (not @fixed_order or
1840 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1847 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1848 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1849 push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
1850 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1851 $action = ucfirst(join ('; ',@changed)) if @changed;
1853 $action .= " and reopened"
1855 if (not $reopened and not @changed) {
1856 print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
1860 append_action_to_log(bug => $data->{bug_num},
1863 old_data => $old_data,
1865 __return_append_to_log_options(
1870 if not exists $param{append_log} or $param{append_log};
1871 writebug($data->{bug_num},$data);
1872 print {$transcript} "$action\n";
1874 __end_control(%info);
1881 set_merged(bug => $ref,
1882 transcript => $transcript,
1883 ($dl > 0 ? (debug => $transcript):()),
1884 requester => $header{from},
1885 request_addr => $controlrequestaddr,
1887 affected_packages => \%affected_packages,
1888 recipients => \%recipients,
1889 merge_with => 12345,
1892 allow_reassign => 1,
1893 reassign_same_source_only => 1,
1898 print {$transcript} "Failed to set merged on $ref: $@";
1902 Sets, adds, or removes the specified merged bugs of a bug
1904 By default, requires
1909 my %param = validate_with(params => \@_,
1910 spec => {bug => {type => SCALAR,
1913 # specific options here
1914 merge_with => {type => ARRAYREF|SCALAR,
1917 remove => {type => BOOLEAN,
1920 force => {type => BOOLEAN,
1923 masterbug => {type => BOOLEAN,
1926 allow_reassign => {type => BOOLEAN,
1929 reassign_different_sources => {type => BOOLEAN,
1933 %append_action_options,
1936 my @merging = exists $param{merge_with} ? make_list($param{merge_with}):();
1938 @merging{@merging} = (1) x @merging;
1939 if (grep {$_ !~ /^\d+$/} @merging) {
1940 croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging);
1942 $param{locks} = {} if not exists $param{locks};
1944 __begin_control(%param,
1947 my ($debug,$transcript) =
1948 @info{qw(debug transcript)};
1949 if (not @merging and exists $param{merge_with}) {
1950 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
1951 __end_control(%info);
1954 my @data = @{$info{data}};
1957 for my $data (@data) {
1958 $data{$data->{bug_num}} = $data;
1959 my @merged_bugs = split / /, $data->{mergedwith};
1960 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
1964 if (not exists $param{merge_with}) {
1965 delete $merged_bugs{$param{bug}};
1966 if (not keys %merged_bugs) {
1967 print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
1968 __end_control(%info);
1971 my $action = "Disconnected #$param{bug} from all other report(s).";
1972 for my $data (@data) {
1973 my $old_data = dclone($data);
1974 if ($data->{bug_num} == $param{bug}) {
1975 $data->{mergedwith} = '';
1978 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
1981 append_action_to_log(bug => $data->{bug_num},
1984 old_data => $old_data,
1986 __return_append_to_log_options(%param,
1990 if not exists $param{append_log} or $param{append_log};
1991 writebug($data->{bug_num},$data);
1993 print {$transcript} "$action\n";
1994 __end_control(%info);
1997 # lock and load all of the bugs we need
1998 my ($data,$n_locks) =
1999 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2001 locks => $param{locks},
2004 $new_locks += $n_locks;
2006 @data = values %data;
2007 if (not check_limit(data => [@data],
2008 exists $param{limit}?(limit => $param{limit}):(),
2009 transcript => $transcript,
2011 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
2013 for my $data (@data) {
2014 $data{$data->{bug_num}} = $data;
2015 $merged_bugs{$data->{bug_num}} = 1;
2016 my @merged_bugs = split / /, $data->{mergedwith};
2017 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
2018 if (exists $param{affected_bugs}) {
2019 $param{affected_bugs}{$data->{bug_num}} = 1;
2022 __handle_affected_packages(%param,data => [@data]);
2023 my %bug_info_shown; # which bugs have had information shown
2024 $bug_info_shown{$param{bug}} = 1;
2025 add_recipients(data => [@data],
2026 recipients => $param{recipients},
2027 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
2029 (__internal_request()?(transcript => $transcript):()),
2032 # Figure out what the ideal state is for the bug,
2033 my ($merge_status,$bugs_to_merge) =
2034 __calculate_merge_status(\@data,\%data,$param{bug});
2035 # find out if we actually have any bugs to merge
2036 if (not $bugs_to_merge) {
2037 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
2038 for (1..$new_locks) {
2039 unfilelock($param{locks});
2042 __end_control(%info);
2045 # see what changes need to be made to merge the bugs
2046 # check to make sure that the set of changes we need to make is allowed
2047 my ($disallowed_changes,$changes) =
2048 __calculate_merge_changes(\@data,$merge_status,\%param);
2049 # at this point, stop if there are disallowed changes, otherwise
2050 # make the allowed changes, and then reread the bugs in question
2051 # to get the new data, then recaculate the merges; repeat
2052 # reloading and recalculating until we try too many times or there
2053 # are no changes to make.
2056 # we will allow at most 4 times through this; more than 1
2057 # shouldn't really happen.
2059 while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) {
2060 if ($attempts > 1) {
2061 print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n";
2063 if (@{$disallowed_changes}) {
2064 # figure out the problems
2065 print {$transcript} "Unable to merge bugs because:\n";
2066 for my $change (@{$disallowed_changes}) {
2067 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2069 if ($attempts > 0) {
2070 croak "Some bugs were altered while attempting to merge";
2073 croak "Did not alter merged bugs";
2076 my @bugs_to_change = keys %{$changes};
2077 for my $change_bug (@bugs_to_change) {
2078 next unless exists $changes->{$change_bug};
2079 $bug_changed{$change_bug}++;
2080 print {$transcript} __bug_info($data{$change_bug}) if
2081 $param{show_bug_info} and not __internal_request(1);
2082 $bug_info_shown{$change_bug} = 1;
2083 __allow_relocking($param{locks},[keys %data]);
2084 for my $change (@{$changes->{$change_bug}}) {
2085 if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
2086 my %target_blockedby;
2087 @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
2088 my %unhandled_targets = %target_blockedby;
2089 for my $key (split / /,$change->{orig_value}) {
2090 delete $unhandled_targets{$key};
2091 next if exists $target_blockedby{$key};
2092 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2093 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2096 keys %common_options,
2097 keys %append_action_options),
2100 for my $key (keys %unhandled_targets) {
2101 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2102 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2105 keys %common_options,
2106 keys %append_action_options),
2111 $change->{function}->(bug => $change->{bug},
2112 $change->{key}, $change->{func_value},
2113 exists $change->{options}?@{$change->{options}}:(),
2115 keys %common_options,
2116 keys %append_action_options),
2120 __disallow_relocking($param{locks});
2121 my ($data,$n_locks) =
2122 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2124 locks => $param{locks},
2128 $new_locks += $n_locks;
2131 @data = values %data;
2132 ($merge_status,$bugs_to_merge) =
2133 __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
2134 ($disallowed_changes,$changes) =
2135 __calculate_merge_changes(\@data,$merge_status,\%param);
2136 $attempts = max(values %bug_changed);
2139 if ($param{show_bug_info} and not __internal_request(1)) {
2140 for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) {
2141 next if $bug_info_shown{$data->{bug_num}};
2142 print {$transcript} __bug_info($data);
2145 if (keys %{$changes} or @{$disallowed_changes}) {
2146 print {$transcript} "After four attempts, the following changes were unable to be made:\n";
2147 for (1..$new_locks) {
2148 unfilelock($param{locks});
2151 __end_control(%info);
2152 for my $change ((map {@{$_}} values %{$changes}), @{$disallowed_changes}) {
2153 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2155 die "Unable to modify bugs so they could be merged";
2159 # finally, we can merge the bugs
2160 my $action = "Merged ".join(' ',sort keys %merged_bugs);
2161 for my $data (@data) {
2162 my $old_data = dclone($data);
2163 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
2165 append_action_to_log(bug => $data->{bug_num},
2168 old_data => $old_data,
2170 __return_append_to_log_options(%param,
2174 if not exists $param{append_log} or $param{append_log};
2175 writebug($data->{bug_num},$data);
2177 print {$transcript} "$action\n";
2178 # unlock the extra locks that we got earlier
2179 for (1..$new_locks) {
2180 unfilelock($param{locks});
2183 __end_control(%info);
2186 sub __allow_relocking{
2187 my ($locks,$bugs) = @_;
2189 my @locks = (@{$bugs},'merge');
2190 for my $lock (@locks) {
2191 my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
2192 next unless @lockfiles;
2193 $locks->{relockable}{$lockfiles[0]} = 0;
2197 sub __disallow_relocking{
2199 delete $locks->{relockable};
2202 sub __lock_and_load_merged_bugs{
2204 validate_with(params => \@_,
2206 {bugs_to_load => {type => ARRAYREF,
2207 default => sub {[]},
2209 data => {type => HASHREF|ARRAYREF,
2211 locks => {type => HASHREF,
2212 default => sub {{};},
2214 reload_all => {type => BOOLEAN,
2217 debug => {type => HANDLE,
2223 if (ref($param{data}) eq 'ARRAY') {
2224 for my $data (@{$param{data}}) {
2225 $data{$data->{bug_num}} = dclone($data);
2229 %data = %{dclone($param{data})};
2231 my @bugs_to_load = @{$param{bugs_to_load}};
2232 if ($param{reload_all}) {
2233 push @bugs_to_load, keys %data;
2236 @temp{@bugs_to_load} = (1) x @bugs_to_load;
2237 @bugs_to_load = keys %temp;
2238 my %loaded_this_time;
2240 while ($bug_to_load = shift @bugs_to_load) {
2241 if (not $param{reload_all}) {
2242 next if exists $data{$bug_to_load};
2245 next if $loaded_this_time{$bug_to_load};
2248 if ($param{reload_all}) {
2249 if (exists $data{$bug_to_load}) {
2254 read_bug(bug => $bug_to_load,
2256 locks => $param{locks},
2258 die "Unable to load bug $bug_to_load";
2259 print {$param{debug}} "read bug $bug_to_load\n";
2260 $data{$data->{bug_num}} = $data;
2261 $new_locks += $lock_bug;
2262 $loaded_this_time{$data->{bug_num}} = 1;
2264 grep {not exists $data{$_}}
2265 split / /,$data->{mergedwith};
2267 return (\%data,$new_locks);
2271 sub __calculate_merge_status{
2272 my ($data_a,$data_h,$master_bug,$merge_status) = @_;
2273 my %merge_status = %{$merge_status // {}};
2275 my $bugs_to_merge = 0;
2276 for my $data (@{$data_a}) {
2277 # check to see if this bug is unmerged in the set
2278 if (not length $data->{mergedwith} or
2279 grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) {
2280 $merged_bugs{$data->{bug_num}} = 1;
2283 # the master_bug is the bug that every other bug is made to
2284 # look like. However, if merge is set, tags, fixed and found
2286 if ($data->{bug_num} == $master_bug) {
2287 for (qw(package forwarded severity blocks blockedby done owner summary outlook affects)) {
2288 $merge_status{$_} = $data->{$_}
2291 if (defined $merge_status) {
2292 next unless $data->{bug_num} == $master_bug;
2294 $merge_status{tag} = {} if not exists $merge_status{tag};
2295 for my $tag (split /\s+/, $data->{keywords}) {
2296 $merge_status{tag}{$tag} = 1;
2298 $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}});
2299 for (qw(fixed found)) {
2300 @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
2303 # if there is a non-source qualified version with a corresponding
2304 # source qualified version, we only want to merge the source
2305 # qualified version(s)
2306 for (qw(fixed found)) {
2307 my @unqualified_versions = grep {m{/}?0:1} keys %{$merge_status{"${_}_versions"}};
2308 for my $unqualified_version (@unqualified_versions) {
2309 if (grep {m{/\Q$unqualified_version\E}} keys %{$merge_status{"${_}_versions"}}) {
2310 delete $merge_status{"${_}_versions"}{$unqualified_version};
2314 return (\%merge_status,$bugs_to_merge);
2319 sub __calculate_merge_changes{
2320 my ($datas,$merge_status,$param) = @_;
2322 my @disallowed_changes;
2323 for my $data (@{$datas}) {
2324 # things that can be forced
2326 # * func is the function to set the new value
2328 # * key is the key of the function to set the value,
2330 # * modify_value is a function which is called to modify the new
2331 # value so that the function will accept it
2333 # * options is an ARRAYREF of options to pass to the function
2335 # * allowed is a BOOLEAN which controls whether this setting
2336 # is allowed to be different by default.
2337 my %force_functions =
2338 (forwarded => {func => \&set_forwarded,
2342 severity => {func => \&set_severity,
2346 blocks => {func => \&set_blocks,
2347 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2351 blockedby => {func => \&set_blocks,
2352 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2356 done => {func => \&set_done,
2360 owner => {func => \&owner,
2364 summary => {func => \&summary,
2368 outlook => {func => \&outlook,
2372 affects => {func => \&affects,
2376 package => {func => \&set_package,
2380 keywords => {func => \&set_tag,
2382 modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]},
2385 fixed_versions => {func => \&set_fixed,
2387 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2390 found_versions => {func => \&set_found,
2392 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2396 for my $field (qw(forwarded severity blocks blockedby done owner summary outlook affects package fixed_versions found_versions keywords)) {
2397 # if the ideal bug already has the field set properly, we
2399 if ($field eq 'keywords'){
2400 next if join(' ',sort split /\s+/,$data->{keywords}) eq
2401 join(' ',sort keys %{$merge_status->{tag}});
2403 elsif ($field =~ /^(?:fixed|found)_versions$/) {
2404 next if join(' ', sort @{$data->{$field}}) eq
2405 join(' ',sort keys %{$merge_status->{$field}});
2407 elsif ($field eq 'done') {
2408 # for done, we only care if the bug is done or not
2409 # done, not the value it's set to.
2410 if (defined $merge_status->{$field} and length $merge_status->{$field} and
2411 defined $data->{$field} and length $data->{$field}) {
2414 elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
2415 (not defined $data->{$field} or not length $data->{$field})
2420 elsif ($merge_status->{$field} eq $data->{$field}) {
2425 bug => $data->{bug_num},
2426 orig_value => $data->{$field},
2428 (exists $force_functions{$field}{modify_value} ?
2429 $force_functions{$field}{modify_value}->($merge_status->{$field}):
2430 $merge_status->{$field}),
2431 value => $merge_status->{$field},
2432 function => $force_functions{$field}{func},
2433 key => $force_functions{$field}{key},
2434 options => $force_functions{$field}{options},
2435 allowed => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
2437 $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
2438 $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
2439 if ($param->{force} or $change->{allowed}) {
2440 if ($field ne 'package' or $change->{allowed}) {
2441 push @{$changes{$data->{bug_num}}},$change;
2444 if ($param->{allow_reassign}) {
2445 if ($param->{reassign_different_sources}) {
2446 push @{$changes{$data->{bug_num}}},$change;
2449 # allow reassigning if binary_to_source returns at
2450 # least one of the same source packages
2451 my @merge_status_source =
2452 binary_to_source(package => $merge_status->{package},
2455 my @other_bug_source =
2456 binary_to_source(package => $data->{package},
2459 my %merge_status_sources;
2460 @merge_status_sources{@merge_status_source} =
2461 (1) x @merge_status_source;
2462 if (grep {$merge_status_sources{$_}} @other_bug_source) {
2463 push @{$changes{$data->{bug_num}}},$change;
2468 push @disallowed_changes,$change;
2470 # blocks and blocked by are weird; we have to go through and
2471 # set blocks to the other half of the merged bugs
2473 return (\@disallowed_changes,\%changes);
2479 affects(bug => $ref,
2480 transcript => $transcript,
2481 ($dl > 0 ? (debug => $transcript):()),
2482 requester => $header{from},
2483 request_addr => $controlrequestaddr,
2485 affected_packages => \%affected_packages,
2486 recipients => \%recipients,
2494 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
2497 This marks a bug as affecting packages which the bug is not actually
2498 in. This should only be used in cases where fixing the bug instantly
2499 resolves the problem in the other packages.
2501 By default, the packages are set to the list of packages passed.
2502 However, if you pass add => 1 or remove => 1, the list of packages
2503 passed are added or removed from the affects list, respectively.
2508 my %param = validate_with(params => \@_,
2509 spec => {bug => {type => SCALAR,
2512 # specific options here
2513 package => {type => SCALAR|ARRAYREF|UNDEF,
2516 add => {type => BOOLEAN,
2519 remove => {type => BOOLEAN,
2523 %append_action_options,
2526 if ($param{add} and $param{remove}) {
2527 croak "Asking to both add and remove affects is nonsensical";
2529 if (not defined $param{package}) {
2530 $param{package} = [];
2533 __begin_control(%param,
2534 command => 'affects'
2536 my ($debug,$transcript) =
2537 @info{qw(debug transcript)};
2538 my @data = @{$info{data}};
2540 for my $data (@data) {
2542 print {$debug} "Going to change affects\n";
2543 my @packages = splitpackages($data->{affects});
2545 @packages{@packages} = (1) x @packages;
2548 for my $package (make_list($param{package})) {
2549 next unless defined $package and length $package;
2550 if (not $packages{$package}) {
2551 $packages{$package} = 1;
2552 push @added,$package;
2556 $action = "Added indication that $data->{bug_num} affects ".
2557 english_join(\@added);
2560 elsif ($param{remove}) {
2562 for my $package (make_list($param{package})) {
2563 if ($packages{$package}) {
2564 next unless defined $package and length $package;
2565 delete $packages{$package};
2566 push @removed,$package;
2569 $action = "Removed indication that $data->{bug_num} affects " .
2570 english_join(\@removed);
2573 my %added_packages = ();
2574 my %removed_packages = %packages;
2576 for my $package (make_list($param{package})) {
2577 next unless defined $package and length $package;
2578 $packages{$package} = 1;
2579 delete $removed_packages{$package};
2580 $added_packages{$package} = 1;
2582 if (keys %removed_packages) {
2583 $action = "Removed indication that $data->{bug_num} affects ".
2584 english_join([keys %removed_packages]);
2585 $action .= "\n" if keys %added_packages;
2587 if (keys %added_packages) {
2588 $action .= "Added indication that $data->{bug_num} affects " .
2589 english_join([keys %added_packages]);
2592 if (not length $action) {
2593 print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
2596 my $old_data = dclone($data);
2597 $data->{affects} = join(',',keys %packages);
2598 append_action_to_log(bug => $data->{bug_num},
2600 command => 'affects',
2602 old_data => $old_data,
2603 __return_append_to_log_options(
2608 if not exists $param{append_log} or $param{append_log};
2609 writebug($data->{bug_num},$data);
2610 print {$transcript} "$action\n";
2612 __end_control(%info);
2616 =head1 SUMMARY FUNCTIONS
2621 summary(bug => $ref,
2622 transcript => $transcript,
2623 ($dl > 0 ? (debug => $transcript):()),
2624 requester => $header{from},
2625 request_addr => $controlrequestaddr,
2627 affected_packages => \%affected_packages,
2628 recipients => \%recipients,
2634 print {$transcript} "Failed to mark $ref with summary foo: $@";
2637 Handles all setting of summary fields
2639 If summary is undef, unsets the summary
2641 If summary is 0 or -1, sets the summary to the first paragraph contained in
2644 If summary is a positive integer, sets the summary to the message specified.
2646 Otherwise, sets summary to the value passed.
2652 # outlook and summary are exactly the same, basically
2653 return _summary('summary',@_);
2656 =head1 OUTLOOK FUNCTIONS
2661 outlook(bug => $ref,
2662 transcript => $transcript,
2663 ($dl > 0 ? (debug => $transcript):()),
2664 requester => $header{from},
2665 request_addr => $controlrequestaddr,
2667 affected_packages => \%affected_packages,
2668 recipients => \%recipients,
2674 print {$transcript} "Failed to mark $ref with outlook foo: $@";
2677 Handles all setting of outlook fields
2679 If outlook is undef, unsets the outlook
2681 If outlook is 0, sets the outlook to the first paragraph contained in
2684 If outlook is a positive integer, sets the outlook to the message specified.
2686 Otherwise, sets outlook to the value passed.
2692 return _summary('outlook',@_);
2696 my ($cmd,@params) = @_;
2697 my %param = validate_with(params => \@params,
2698 spec => {bug => {type => SCALAR,
2701 # specific options here
2702 $cmd , {type => SCALAR|UNDEF,
2706 %append_action_options,
2710 __begin_control(%param,
2713 my ($debug,$transcript) =
2714 @info{qw(debug transcript)};
2715 my @data = @{$info{data}};
2716 # figure out the log that we're going to use
2718 my $summary_msg = '';
2720 if (not defined $param{$cmd}) {
2722 print {$debug} "Removing $cmd fields\n";
2723 $action = "Removed $cmd";
2725 elsif ($param{$cmd} =~ /^-?\d+$/) {
2727 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
2728 if ($param{$cmd} == 0 or $param{$cmd} == -1) {
2729 $log = $param{message};
2730 $summary_msg = @records + 1;
2733 if (($param{$cmd} - 1 ) > $#records) {
2734 die "Message number '$param{$cmd}' exceeds the maximum message '$#records'";
2736 my $record = $records[($param{$cmd} - 1 )];
2737 if ($record->{type} !~ /incoming-recv|recips/) {
2738 die "Message number '$param{$cmd}' is a invalid message type '$record->{type}'";
2740 $summary_msg = $param{$cmd};
2741 $log = [$record->{text}];
2743 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
2744 my $body = $p_o->{body};
2745 my $in_pseudoheaders = 0;
2747 # walk through body until we get non-blank lines
2748 for my $line (@{$body}) {
2749 if ($line =~ /^\s*$/) {
2750 if (length $paragraph) {
2751 if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
2757 $in_pseudoheaders = 0;
2760 # skip a paragraph if it looks like it's control or
2762 if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity|Control)\:\s+\S}xi or #pseudo headers
2763 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
2764 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
2765 debug|(?:not|)forwarded|priority|
2766 (?:un|)block|limit|(?:un|)archive|
2767 reassign|retitle|affects|wrongpackage
2768 (?:un|force|)merge|user(?:category|tags?|)
2770 if (not length $paragraph) {
2771 print {$debug} "Found control/pseudo-headers and skiping them\n";
2772 $in_pseudoheaders = 1;
2776 next if $in_pseudoheaders;
2777 $paragraph .= $line ." \n";
2779 print {$debug} ucfirst($cmd)." is going to be '$paragraph'\n";
2780 $summary = $paragraph;
2781 $summary =~ s/[\n\r]/ /g;
2782 if (not length $summary) {
2783 die "Unable to find $cmd message to use";
2785 # trim off a trailing spaces
2786 $summary =~ s/\ *$//;
2789 $summary = $param{$cmd};
2791 for my $data (@data) {
2792 print {$debug} "Going to change $cmd\n";
2793 if (((not defined $summary or not length $summary) and
2794 (not defined $data->{$cmd} or not length $data->{$cmd})) or
2795 $summary eq $data->{$cmd}) {
2796 print {$transcript} "Ignoring request to change the $cmd of bug $param{bug} to the same value\n";
2799 if (length $summary) {
2800 if (length $data->{$cmd}) {
2801 $action = ucfirst($cmd)." replaced with message bug $param{bug} message $summary_msg";
2804 $action = ucfirst($cmd)." recorded from message bug $param{bug} message $summary_msg";
2807 my $old_data = dclone($data);
2808 $data->{$cmd} = $summary;
2809 append_action_to_log(bug => $data->{bug_num},
2811 old_data => $old_data,
2814 __return_append_to_log_options(
2819 if not exists $param{append_log} or $param{append_log};
2820 writebug($data->{bug_num},$data);
2821 print {$transcript} "$action\n";
2823 __end_control(%info);
2831 clone_bug(bug => $ref,
2832 transcript => $transcript,
2833 ($dl > 0 ? (debug => $transcript):()),
2834 requester => $header{from},
2835 request_addr => $controlrequestaddr,
2837 affected_packages => \%affected_packages,
2838 recipients => \%recipients,
2843 print {$transcript} "Failed to clone bug $ref bar: $@";
2846 Clones the given bug.
2848 We currently don't support cloning merged bugs, but this could be
2849 handled by internally unmerging, cloning, then remerging the bugs.
2854 my %param = validate_with(params => \@_,
2855 spec => {bug => {type => SCALAR,
2858 new_bugs => {type => ARRAYREF,
2860 new_clones => {type => HASHREF,
2864 %append_action_options,
2868 __begin_control(%param,
2871 my $transcript = $info{transcript};
2872 my @data = @{$info{data}};
2875 for my $data (@data) {
2876 if (length($data->{mergedwith})) {
2877 die "Bug is marked as being merged with others. Use an existing clone.\n";
2881 die "Not exactly one bug‽ This shouldn't happen.";
2883 my $data = $data[0];
2885 for my $newclone_id (@{$param{new_bugs}}) {
2886 my $new_bug_num = new_bug(copy => $data->{bug_num});
2887 $param{new_clones}{$newclone_id} = $new_bug_num;
2888 $clones{$newclone_id} = $new_bug_num;
2890 my @new_bugs = sort values %clones;
2892 for my $new_bug (@new_bugs) {
2893 # no collapsed ids or the higher collapsed id is not one less
2894 # than the next highest new bug
2895 if (not @collapsed_ids or
2896 $collapsed_ids[-1][1]+1 != $new_bug) {
2897 push @collapsed_ids,[$new_bug,$new_bug];
2900 $collapsed_ids[-1][1] = $new_bug;
2904 for my $ci (@collapsed_ids) {
2905 if ($ci->[0] == $ci->[1]) {
2906 push @collapsed,$ci->[0];
2909 push @collapsed,$ci->[0].'-'.$ci->[1]
2912 my $collapsed_str = english_join(\@collapsed);
2913 $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str;
2914 for my $new_bug (@new_bugs) {
2915 append_action_to_log(bug => $new_bug,
2917 __return_append_to_log_options(
2922 if not exists $param{append_log} or $param{append_log};
2924 append_action_to_log(bug => $data->{bug_num},
2926 __return_append_to_log_options(
2931 if not exists $param{append_log} or $param{append_log};
2932 writebug($data->{bug_num},$data);
2933 print {$transcript} "$action\n";
2934 __end_control(%info);
2935 # bugs that this bug is blocking are also blocked by the new clone(s)
2936 for my $bug (split ' ', $data->{blocks}) {
2937 for my $new_bug (@new_bugs) {
2938 set_blocks(bug => $bug,
2942 keys %common_options,
2943 keys %append_action_options),
2947 # bugs that are blocking this bug are also blocking the new clone(s)
2948 for my $bug (split ' ', $data->{blockedby}) {
2949 for my $new_bug (@new_bugs) {
2950 set_blocks(bug => $new_bug,
2954 keys %common_options,
2955 keys %append_action_options),
2963 =head1 OWNER FUNCTIONS
2969 transcript => $transcript,
2970 ($dl > 0 ? (debug => $transcript):()),
2971 requester => $header{from},
2972 request_addr => $controlrequestaddr,
2974 recipients => \%recipients,
2980 print {$transcript} "Failed to mark $ref as having an owner: $@";
2983 Handles all setting of the owner field; given an owner of undef or of
2984 no length, indicates that a bug is not owned by anyone.
2989 my %param = validate_with(params => \@_,
2990 spec => {bug => {type => SCALAR,
2993 owner => {type => SCALAR|UNDEF,
2996 %append_action_options,
3000 __begin_control(%param,
3003 my ($debug,$transcript) =
3004 @info{qw(debug transcript)};
3005 my @data = @{$info{data}};
3007 for my $data (@data) {
3008 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
3009 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
3010 if (not defined $param{owner} or not length $param{owner}) {
3011 if (not defined $data->{owner} or not length $data->{owner}) {
3012 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
3016 $action = "Removed annotation that $config{bug} was owned by " .
3020 if ($data->{owner} eq $param{owner}) {
3021 print {$transcript} "Ignoring request to set the owner of bug #$data->{bug_num} to the same value\n";
3024 if (length $data->{owner}) {
3025 $action = "Owner changed from $data->{owner} to $param{owner}.";
3028 $action = "Owner recorded as $param{owner}."
3031 my $old_data = dclone($data);
3032 $data->{owner} = $param{owner};
3033 append_action_to_log(bug => $data->{bug_num},
3036 old_data => $old_data,
3038 __return_append_to_log_options(
3043 if not exists $param{append_log} or $param{append_log};
3044 writebug($data->{bug_num},$data);
3045 print {$transcript} "$action\n";
3047 __end_control(%info);
3051 =head1 ARCHIVE FUNCTIONS
3058 bug_archive(bug => $bug_num,
3060 transcript => \$transcript,
3065 transcript("Unable to archive $bug_num\n");
3068 transcript($transcript);
3071 This routine archives a bug
3075 =item bug -- bug number
3077 =item check_archiveable -- check wether a bug is archiveable before
3078 archiving; defaults to 1
3080 =item archive_unarchived -- whether to archive bugs which have not
3081 previously been archived; defaults to 1. [Set to 0 when used from
3084 =item ignore_time -- whether to ignore time constraints when archiving
3085 a bug; defaults to 0.
3092 my %param = validate_with(params => \@_,
3093 spec => {bug => {type => SCALAR,
3096 check_archiveable => {type => BOOLEAN,
3099 archive_unarchived => {type => BOOLEAN,
3102 ignore_time => {type => BOOLEAN,
3106 %append_action_options,
3109 my %info = __begin_control(%param,
3110 command => 'archive',
3112 my ($debug,$transcript) = @info{qw(debug transcript)};
3113 my @data = @{$info{data}};
3114 my @bugs = @{$info{bugs}};
3115 my $action = "$config{bug} archived.";
3116 if ($param{check_archiveable} and
3117 not bug_archiveable(bug=>$param{bug},
3118 ignore_time => $param{ignore_time},
3120 print {$transcript} "Bug $param{bug} cannot be archived\n";
3121 die "Bug $param{bug} cannot be archived";
3123 if (not $param{archive_unarchived} and
3124 not exists $data[0]{unarchived}
3126 print {$transcript} "$param{bug} has not been archived previously\n";
3127 die "$param{bug} has not been archived previously";
3129 add_recipients(recipients => $param{recipients},
3132 transcript => $transcript,
3134 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3135 for my $bug (@bugs) {
3136 if ($param{check_archiveable}) {
3137 die "Bug $bug cannot be archived (but $param{bug} can?)"
3138 unless bug_archiveable(bug=>$bug,
3139 ignore_time => $param{ignore_time},
3143 # If we get here, we can archive/remove this bug
3144 print {$debug} "$param{bug} removing\n";
3145 for my $bug (@bugs) {
3146 #print "$param{bug} removing $bug\n" if $debug;
3147 my $dir = get_hashname($bug);
3148 # First indicate that this bug is being archived
3149 append_action_to_log(bug => $bug,
3151 command => 'archive',
3152 # we didn't actually change the data
3153 # when we archived, so we don't pass
3154 # a real new_data or old_data
3157 __return_append_to_log_options(
3162 if not exists $param{append_log} or $param{append_log};
3163 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
3164 if ($config{save_old_bugs}) {
3165 mkpath("$config{spool_dir}/archive/$dir");
3166 foreach my $file (@files_to_remove) {
3167 link("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3168 copy("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3169 # we need to bail out here if things have
3170 # gone horribly wrong to avoid removing a
3172 die "Unable to link or copy $config{spool_dir}/db-h/$dir/$file to $config{spool_dir}/archive/$dir/$file; $!";
3175 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
3177 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
3178 print {$debug} "deleted $bug (from $param{bug})\n";
3180 bughook_archive(@bugs);
3181 __end_control(%info);
3184 =head2 bug_unarchive
3188 bug_unarchive(bug => $bug_num,
3190 transcript => \$transcript,
3195 transcript("Unable to archive bug: $bug_num");
3197 transcript($transcript);
3199 This routine unarchives a bug
3204 my %param = validate_with(params => \@_,
3205 spec => {bug => {type => SCALAR,
3209 %append_action_options,
3213 my %info = __begin_control(%param,
3215 command=>'unarchive');
3216 my ($debug,$transcript) =
3217 @info{qw(debug transcript)};
3218 my @bugs = @{$info{bugs}};
3219 my $action = "$config{bug} unarchived.";
3220 my @files_to_remove;
3221 for my $bug (@bugs) {
3222 print {$debug} "$param{bug} removing $bug\n";
3223 my $dir = get_hashname($bug);
3224 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
3225 mkpath("archive/$dir");
3226 foreach my $file (@files_to_copy) {
3227 # die'ing here sucks
3228 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3229 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3230 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
3232 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
3233 print {$transcript} "Unarchived $config{bug} $bug\n";
3235 unlink(@files_to_remove) or die "Unable to unlink bugs";
3236 # Indicate that this bug has been archived previously
3237 for my $bug (@bugs) {
3238 my $newdata = readbug($bug);
3239 my $old_data = dclone($newdata);
3240 if (not defined $newdata) {
3241 print {$transcript} "$config{bug} $bug disappeared!\n";
3242 die "Bug $bug disappeared!";
3244 $newdata->{unarchived} = time;
3245 append_action_to_log(bug => $bug,
3247 command => 'unarchive',
3248 new_data => $newdata,
3249 old_data => $old_data,
3250 __return_append_to_log_options(
3255 if not exists $param{append_log} or $param{append_log};
3256 writebug($bug,$newdata);
3258 __end_control(%info);
3261 =head2 append_action_to_log
3263 append_action_to_log
3265 This should probably be moved to Debbugs::Log; have to think that out
3270 sub append_action_to_log{
3271 my %param = validate_with(params => \@_,
3272 spec => {bug => {type => SCALAR,
3275 new_data => {type => HASHREF,
3278 old_data => {type => HASHREF,
3281 command => {type => SCALAR,
3284 action => {type => SCALAR,
3286 requester => {type => SCALAR,
3289 request_addr => {type => SCALAR,
3292 location => {type => SCALAR,
3295 message => {type => SCALAR|ARRAYREF,
3298 recips => {type => SCALAR|ARRAYREF,
3301 desc => {type => SCALAR,
3304 get_lock => {type => BOOLEAN,
3307 locks => {type => HASHREF,
3311 # append_action_options here
3312 # because some of these
3313 # options aren't actually
3314 # optional, even though the
3315 # original function doesn't
3319 # Fix this to use $param{location}
3320 my $log_location = buglog($param{bug});
3321 die "Unable to find .log for $param{bug}"
3322 if not defined $log_location;
3323 if ($param{get_lock}) {
3324 filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
3328 my $logfh = IO::File->new(">>$log_location") or
3329 die "Unable to open $log_location for appending: $!";
3330 # determine difference between old and new
3332 if (exists $param{old_data} and exists $param{new_data}) {
3333 my $old_data = dclone($param{old_data});
3334 my $new_data = dclone($param{new_data});
3335 for my $key (keys %{$old_data}) {
3336 if (not exists $Debbugs::Status::fields{$key}) {
3337 delete $old_data->{$key};
3340 next unless exists $new_data->{$key};
3341 next unless defined $new_data->{$key};
3342 if (not defined $old_data->{$key}) {
3343 delete $old_data->{$key};
3346 if (ref($new_data->{$key}) and
3347 ref($old_data->{$key}) and
3348 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3349 local $Storable::canonical = 1;
3350 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3351 delete $new_data->{$key};
3352 delete $old_data->{$key};
3355 elsif ($new_data->{$key} eq $old_data->{$key}) {
3356 delete $new_data->{$key};
3357 delete $old_data->{$key};
3360 for my $key (keys %{$new_data}) {
3361 if (not exists $Debbugs::Status::fields{$key}) {
3362 delete $new_data->{$key};
3365 next unless exists $old_data->{$key};
3366 next unless defined $old_data->{$key};
3367 if (not defined $new_data->{$key} or
3368 not exists $Debbugs::Status::fields{$key}) {
3369 delete $new_data->{$key};
3372 if (ref($new_data->{$key}) and
3373 ref($old_data->{$key}) and
3374 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3375 local $Storable::canonical = 1;
3376 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3377 delete $new_data->{$key};
3378 delete $old_data->{$key};
3381 elsif ($new_data->{$key} eq $old_data->{$key}) {
3382 delete $new_data->{$key};
3383 delete $old_data->{$key};
3386 $data_diff .= "<!-- new_data:\n";
3388 for my $key (keys %{$new_data}) {
3389 if (not exists $Debbugs::Status::fields{$key}) {
3390 warn "No such field $key";
3393 $nd{$key} = $new_data->{$key};
3394 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n";
3396 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)]));
3397 $data_diff .= "-->\n";
3398 $data_diff .= "<!-- old_data:\n";
3400 for my $key (keys %{$old_data}) {
3401 if (not exists $Debbugs::Status::fields{$key}) {
3402 warn "No such field $key";
3405 $od{$key} = $old_data->{$key};
3406 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $old_data->{$key}")."\n";
3408 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%od)],[qw(old_data)]));
3409 $data_diff .= "-->\n";
3412 (exists $param{command} ?
3413 "<!-- command:".html_escape(encode_utf8_safely($param{command}))." -->\n":""
3415 (length $param{requester} ?
3416 "<!-- requester: ".html_escape(encode_utf8_safely($param{requester}))." -->\n":""
3418 (length $param{request_addr} ?
3419 "<!-- request_addr: ".html_escape(encode_utf8_safely($param{request_addr}))." -->\n":""
3421 "<!-- time:".time()." -->\n",
3423 "<strong>".html_escape(encode_utf8_safely($param{action}))."</strong>\n");
3424 if (length $param{requester}) {
3425 $msg .= "Request was from <code>".html_escape(encode_utf8_safely($param{requester}))."</code>\n";
3427 if (length $param{request_addr}) {
3428 $msg .= "to <code>".html_escape(encode_utf8_safely($param{request_addr}))."</code>";
3430 if (length $param{desc}) {
3431 $msg .= ":<br>\n".encode_utf8_safely($param{desc})."\n";
3436 push @records, {type => 'html',
3440 if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
3441 push @records, {type => exists $param{recips}?'recips':'incoming-recv',
3442 exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(),
3443 text => join('',make_list($param{message})),
3446 write_log_records(logfh=>$logfh,
3447 records => \@records,
3449 close $logfh or die "Unable to close $log_location: $!";
3450 if ($param{get_lock}) {
3451 unfilelock(exists $param{locks}?$param{locks}:());
3459 =head1 PRIVATE FUNCTIONS
3461 =head2 __handle_affected_packages
3463 __handle_affected_packages(affected_packages => {},
3471 sub __handle_affected_packages{
3472 my %param = validate_with(params => \@_,
3473 spec => {%common_options,
3474 data => {type => ARRAYREF|HASHREF
3479 for my $data (make_list($param{data})) {
3480 next unless exists $data->{package} and defined $data->{package};
3481 my @packages = split /\s*,\s*/,$data->{package};
3482 @{$param{affected_packages}}{@packages} = (1) x @packages;
3486 =head2 __handle_debug_transcript
3488 my ($debug,$transcript) = __handle_debug_transcript(%param);
3490 Returns a debug and transcript filehandle
3495 sub __handle_debug_transcript{
3496 my %param = validate_with(params => \@_,
3497 spec => {%common_options},
3500 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
3501 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3502 return ($debug,$transcript);
3509 Produces a small bit of bug information to kick out to the transcript
3516 next unless defined $data and exists $data->{bug_num};
3517 $return .= "Bug #".($data->{bug_num}||'').
3518 ((defined $data->{done} and length $data->{done})?
3519 " {Done: $data->{done}}":''
3521 " [".($data->{package}||'(no package)'). "] ".
3522 ($data->{subject}||'(no subject)')."\n";
3528 =head2 __internal_request
3530 __internal_request()
3531 __internal_request($level)
3533 Returns true if the caller of the function calling __internal_request
3534 belongs to __PACKAGE__
3536 This allows us to be magical, and don't bother to print bug info if
3537 the second caller is from this package, amongst other things.
3539 An optional level is allowed, which increments the number of levels to
3540 check by the given value. [This is basically for use by internal
3541 functions like __begin_control which are always called by
3546 sub __internal_request{
3548 $l = 0 if not defined $l;
3549 if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
3555 sub __return_append_to_log_options{
3557 my $action = $param{action} if exists $param{action};
3558 if (not exists $param{requester}) {
3559 $param{requester} = $config{control_internal_requester};
3561 if (not exists $param{request_addr}) {
3562 $param{request_addr} = $config{control_internal_request_addr};
3564 if (not exists $param{message}) {
3565 my $date = rfc822_date();
3567 encode_headers(fill_in_template(template => 'mail/fake_control_message',
3568 variables => {request_addr => $param{request_addr},
3569 requester => $param{requester},
3575 if (not defined $action) {
3576 carp "Undefined action!";
3577 $action = "unknown action";
3579 return (action => $action,
3580 hash_slice(%param,keys %append_action_options),
3584 =head2 __begin_control
3586 my %info = __begin_control(%param,
3588 command=>'unarchive');
3589 my ($debug,$transcript) = @info{qw(debug transcript)};
3590 my @data = @{$info{data}};
3591 my @bugs = @{$info{bugs}};
3594 Starts the process of modifying a bug; handles all of the generic
3595 things that almost every control request needs
3597 Returns a hash containing
3601 =item new_locks -- number of new locks taken out by this call
3603 =item debug -- the debug file handle
3605 =item transcript -- the transcript file handle
3607 =item data -- an arrayref containing the data of the bugs
3608 corresponding to this request
3610 =item bugs -- an arrayref containing the bug numbers of the bugs
3611 corresponding to this request
3619 sub __begin_control {
3620 my %param = validate_with(params => \@_,
3621 spec => {bug => {type => SCALAR,
3624 archived => {type => BOOLEAN,
3627 command => {type => SCALAR,
3635 my ($debug,$transcript) = __handle_debug_transcript(@_);
3636 print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
3637 # print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
3638 $lockhash = $param{locks} if exists $param{locks};
3640 my $old_die = $SIG{__DIE__};
3641 $SIG{__DIE__} = *sig_die{CODE};
3643 ($new_locks, @data) =
3644 lock_read_all_merged_bugs(bug => $param{bug},
3645 $param{archived}?(location => 'archive'):(),
3646 exists $param{locks} ? (locks => $param{locks}):(),
3648 $locks += $new_locks;
3650 die "Unable to read any bugs successfully.";
3652 if (not $param{archived}) {
3653 for my $data (@data) {
3654 if ($data->{archived}) {
3655 die "Not altering archived bugs; see unarchive.";
3659 if (not check_limit(data => \@data,
3660 exists $param{limit}?(limit => $param{limit}):(),
3661 transcript => $transcript,
3663 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
3666 __handle_affected_packages(%param,data => \@data);
3667 print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
3668 print {$debug} "$param{bug} read $locks locks\n";
3669 if (not @data or not defined $data[0]) {
3670 print {$transcript} "No bug found for $param{bug}\n";
3671 die "No bug found for $param{bug}";
3674 add_recipients(data => \@data,
3675 recipients => $param{recipients},
3676 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
3678 (__internal_request()?(transcript => $transcript):()),
3681 print {$debug} "$param{bug} read done\n";
3682 my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
3683 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3684 return (data => \@data,
3686 old_die => $old_die,
3687 new_locks => $new_locks,
3689 transcript => $transcript,
3691 exists $param{locks}?(locks => $param{locks}):(),
3695 =head2 __end_control
3697 __end_control(%info);
3699 Handles tearing down from a control request
3705 if (exists $info{new_locks} and $info{new_locks} > 0) {
3706 print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
3707 for (1..$info{new_locks}) {
3708 unfilelock(exists $info{locks}?$info{locks}:());
3712 $SIG{__DIE__} = $info{old_die};
3713 if (exists $info{param}{affected_bugs}) {
3714 @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
3716 add_recipients(recipients => $info{param}{recipients},
3717 (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
3718 data => $info{data},
3719 debug => $info{debug},
3720 transcript => $info{transcript},
3722 __handle_affected_packages(%{$info{param}},data=>$info{data});
3728 check_limit(data => \@data, limit => $param{limit});
3731 Checks to make sure that bugs match any limits; each entry of @data
3732 much satisfy the limit.
3734 Returns true if there are no entries in data, or there are no keys in
3735 limit; returns false (0) if there are any entries which do not match.
3737 The limit hashref elements can contain an arrayref of scalars to
3738 match; regexes are also acccepted. At least one of the entries in each
3739 element needs to match the corresponding field in all data for the
3746 my %param = validate_with(params => \@_,
3747 spec => {data => {type => ARRAYREF|HASHREF,
3749 limit => {type => HASHREF|UNDEF,
3751 transcript => {type => SCALARREF|HANDLE,
3756 my @data = make_list($param{data});
3758 not defined $param{limit} or
3759 not keys %{$param{limit}}) {
3762 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3763 my $going_to_fail = 0;
3764 for my $data (@data) {
3765 $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
3766 status => dclone($data),
3768 for my $field (keys %{$param{limit}}) {
3769 next unless exists $param{limit}{$field};
3771 my @data_fields = make_list($data->{$field});
3772 LIMIT: for my $limit (make_list($param{limit}{$field})) {
3773 if (not ref $limit) {
3774 for my $data_field (@data_fields) {
3775 if ($data_field eq $limit) {
3781 elsif (ref($limit) eq 'Regexp') {
3782 for my $data_field (@data_fields) {
3783 if ($data_field =~ $limit) {
3790 warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
3795 print {$transcript} qq($field: ').join(', ',map{qq("$_")} make_list($data->{$field})).
3796 "' does not match at least one of ".
3797 join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
3801 return $going_to_fail?0:1;
3809 We override die to specially handle unlocking files in the cases where
3810 we are called via eval. [If we're not called via eval, it doesn't
3816 if ($^S) { # in eval
3818 for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
3825 # =head2 __message_body_template
3827 # message_body_template('mail/ack',{ref=>'foo'});
3829 # Creates a message body using a template
3833 sub __message_body_template{
3834 my ($template,$extra_var) = @_;
3836 my $hole_var = {'&bugurl' =>
3838 $config{cgi_domain}.'/'.
3839 Debbugs::CGI::bug_links(bug => $_[0],
3845 my $body = fill_in_template(template => $template,
3846 variables => {config => \%config,
3849 hole_var => $hole_var,
3851 return fill_in_template(template => 'mail/message_body',
3852 variables => {config => \%config,
3856 hole_var => $hole_var,
3860 sub __all_undef_or_equal {
3862 return 1 if @values == 1 or @values == 0;
3863 my $not_def = grep {not defined $_} @values;
3864 if ($not_def == @values) {
3867 if ($not_def > 0 and $not_def != @values) {
3870 my $first_val = shift @values;
3871 for my $val (@values) {
3872 if ($first_val ne $val) {