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 __end_control(%info);
383 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
384 keys %ok_blockers?'':" and no known blocking bug(s)";
386 # if there are no ok blockers and we are not setting the blockers,
388 if (not keys %ok_blockers and $mode ne 'set') {
389 print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
390 if (keys %bad_blockers) {
391 __end_control(%info);
392 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
394 __end_control(%info);
398 my @change_blockers = keys %ok_blockers;
400 my %removed_blockers;
403 my @blockers = map {split ' ', $_->{blockedby}} @data;
405 @blockers{@blockers} = (1) x @blockers;
407 # it is nonsensical for a bug to block itself (or a merged
408 # partner); We currently don't allow removal because we'd possibly
412 @bugs{@bugs} = (1) x @bugs;
413 for my $blocker (@change_blockers) {
414 if ($bugs{$blocker}) {
415 __end_control(%info);
416 croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
419 @blockers = keys %blockers;
421 %removed_blockers = ();
422 for my $blocker (@change_blockers) {
423 next if exists $blockers{$blocker};
424 $blockers{$blocker} = 1;
425 $added_blockers{$blocker} = 1;
428 elsif ($param{remove}) {
429 %added_blockers = ();
430 for my $blocker (@change_blockers) {
431 next if exists $removed_blockers{$blocker};
432 delete $blockers{$blocker};
433 $removed_blockers{$blocker} = 1;
437 @removed_blockers{@blockers} = (1) x @blockers;
439 for my $blocker (@change_blockers) {
440 next if exists $blockers{$blocker};
441 $blockers{$blocker} = 1;
442 if (exists $removed_blockers{$blocker}) {
443 delete $removed_blockers{$blocker};
446 $added_blockers{$blocker} = 1;
450 for my $data (@data) {
451 my $old_data = dclone($data);
452 # remove blockers and/or add new ones as appropriate
453 if ($data->{blockedby} eq '') {
454 print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n";
456 print {$transcript} "$data->{bug_num} was blocked by: $data->{blockedby}\n";
458 if ($data->{blocks} eq '') {
459 print {$transcript} "$data->{bug_num} was not blocking any bugs.\n";
461 print {$transcript} "$data->{bug_num} was blocking: $data->{blocks}\n";
464 push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
465 push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
466 $action = ucfirst(join ('; ',@changed)) if @changed;
468 print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n";
471 $data->{blockedby} = join(' ',keys %blockers);
472 append_action_to_log(bug => $data->{bug_num},
474 old_data => $old_data,
477 __return_append_to_log_options(
482 if not exists $param{append_log} or $param{append_log};
483 writebug($data->{bug_num},$data);
484 print {$transcript} "$action\n";
486 # we do this bit below to avoid code duplication
488 $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
489 $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
491 for my $add_remove (keys %mungable_blocks) {
493 for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
494 next if $munge_blockers{$blocker};
495 my ($temp_locks, @blocking_data) =
496 lock_read_all_merged_bugs(bug => $blocker,
497 ($param{archived}?(location => 'archive'):()),
498 exists $param{locks}?(locks => $param{locks}):(),
500 $locks+= $temp_locks;
501 $new_locks+=$temp_locks;
502 if (not @blocking_data) {
503 for (1..$new_locks) {
504 unfilelock(exists $param{locks}?$param{locks}:());
507 die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
509 for (map {$_->{bug_num}} @blocking_data) {
510 $munge_blockers{$_} = 1;
512 for my $data (@blocking_data) {
513 my $old_data = dclone($data);
515 my @blocks = split ' ', $data->{blocks};
516 @blocks{@blocks} = (1) x @blocks;
518 for my $bug (@bugs) {
519 if ($add_remove eq 'remove') {
520 next unless exists $blocks{$bug};
521 delete $blocks{$bug};
524 next if exists $blocks{$bug};
529 $data->{blocks} = join(' ',sort keys %blocks);
530 my $action = ($add_remove eq 'add'?'Added':'Removed').
531 " indication that bug $data->{bug_num} blocks ".
533 append_action_to_log(bug => $data->{bug_num},
535 old_data => $old_data,
538 __return_append_to_log_options(%param,
542 writebug($data->{bug_num},$data);
544 __handle_affected_packages(%param,data=>\@blocking_data);
545 add_recipients(recipients => $param{recipients},
546 actions_taken => {blocks => 1},
547 data => \@blocking_data,
549 transcript => $transcript,
552 for (1..$new_locks) {
553 unfilelock(exists $param{locks}?$param{locks}:());
558 __end_control(%info);
567 transcript => $transcript,
568 ($dl > 0 ? (debug => $transcript):()),
569 requester => $header{from},
570 request_addr => $controlrequestaddr,
572 affected_packages => \%affected_packages,
573 recipients => \%recipients,
580 print {$transcript} "Failed to set tag on $ref: $@";
584 Sets, adds, or removes the specified tags on a bug
588 =item tag -- scalar or arrayref of tags to set, add or remove
590 =item add -- if true, add tags
592 =item remove -- if true, remove tags
594 =item warn_on_bad_tags -- if true (the default) warn if bad tags are
602 my %param = validate_with(params => \@_,
603 spec => {bug => {type => SCALAR,
606 # specific options here
607 tag => {type => SCALAR|ARRAYREF,
610 add => {type => BOOLEAN,
613 remove => {type => BOOLEAN,
616 warn_on_bad_tags => {type => BOOLEAN,
620 %append_action_options,
623 if ($param{add} and $param{remove}) {
624 croak "It's nonsensical to add and remove the same tags";
628 __begin_control(%param,
631 my $transcript = $info{transcript};
632 my @data = @{$info{data}};
633 my @tags = make_list($param{tag});
634 if (not @tags and ($param{remove} or $param{add})) {
635 if ($param{remove}) {
636 print {$transcript} "Requested to remove no tags; doing nothing.\n";
639 print {$transcript} "Requested to add no tags; doing nothing.\n";
641 __end_control(%info);
644 # first things first, make the versions fully qualified source
646 for my $data (@data) {
647 my $action = 'Did not alter tags';
649 my %tag_removed = ();
650 my @old_tags = split /\,?\s+/, $data->{keywords};
652 @tags{@old_tags} = (1) x @old_tags;
653 my $old_data = dclone($data);
654 if (not $param{add} and not $param{remove}) {
655 $tag_removed{$_} = 1 for @old_tags;
659 for my $tag (@tags) {
660 if (not $param{remove} and
661 not defined first {$_ eq $tag} @{$config{tags}}) {
662 push @bad_tags, $tag;
666 if (not exists $tags{$tag}) {
668 $tag_added{$tag} = 1;
671 elsif ($param{remove}) {
672 if (exists $tags{$tag}) {
674 $tag_removed{$tag} = 1;
678 if (exists $tag_removed{$tag}) {
679 delete $tag_removed{$tag};
682 $tag_added{$tag} = 1;
687 if (@bad_tags and $param{warn_on_bad_tags}) {
688 print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
689 print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
691 $data->{keywords} = join(' ',keys %tags);
694 push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
695 push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
696 $action = ucfirst(join ('; ',@changed)) if @changed;
698 print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
702 append_action_to_log(bug => $data->{bug_num},
705 old_data => $old_data,
707 __return_append_to_log_options(
712 if not exists $param{append_log} or $param{append_log};
713 writebug($data->{bug_num},$data);
714 print {$transcript} "$action\n";
716 __end_control(%info);
724 set_severity(bug => $ref,
725 transcript => $transcript,
726 ($dl > 0 ? (debug => $transcript):()),
727 requester => $header{from},
728 request_addr => $controlrequestaddr,
730 affected_packages => \%affected_packages,
731 recipients => \%recipients,
732 severity => 'normal',
737 print {$transcript} "Failed to set the severity of bug $ref: $@";
740 Sets the severity of a bug. If severity is not passed, is undefined,
741 or has zero length, sets the severity to the default severity.
746 my %param = validate_with(params => \@_,
747 spec => {bug => {type => SCALAR,
750 # specific options here
751 severity => {type => SCALAR|UNDEF,
752 default => $config{default_severity},
755 %append_action_options,
758 if (not defined $param{severity} or
759 not length $param{severity}
761 $param{severity} = $config{default_severity};
764 # check validity of new severity
765 if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) {
766 die "Severity '$param{severity}' is not a valid severity level";
769 __begin_control(%param,
770 command => 'severity'
772 my $transcript = $info{transcript};
773 my @data = @{$info{data}};
776 for my $data (@data) {
777 if (not defined $data->{severity}) {
778 $data->{severity} = $param{severity};
779 $action = "Severity set to '$param{severity}'";
782 if ($data->{severity} eq '') {
783 $data->{severity} = $config{default_severity};
785 if ($data->{severity} eq $param{severity}) {
786 print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
789 $action = "Severity set to '$param{severity}' from '$data->{severity}'";
790 $data->{severity} = $param{severity};
792 append_action_to_log(bug => $data->{bug_num},
794 __return_append_to_log_options(
799 if not exists $param{append_log} or $param{append_log};
800 writebug($data->{bug_num},$data);
801 print {$transcript} "$action\n";
803 __end_control(%info);
810 set_done(bug => $ref,
811 transcript => $transcript,
812 ($dl > 0 ? (debug => $transcript):()),
813 requester => $header{from},
814 request_addr => $controlrequestaddr,
816 affected_packages => \%affected_packages,
817 recipients => \%recipients,
822 print {$transcript} "Failed to set foo $ref bar: $@";
830 my %param = validate_with(params => \@_,
831 spec => {bug => {type => SCALAR,
834 reopen => {type => BOOLEAN,
837 submitter => {type => SCALAR,
840 clear_fixed => {type => BOOLEAN,
843 notify_submitter => {type => BOOLEAN,
846 original_report => {type => SCALARREF,
849 done => {type => SCALAR|UNDEF,
853 %append_action_options,
857 if (exists $param{submitter} and
858 not Mail::RFC822::Address::valid($param{submitter})) {
859 die "New submitter address '$param{submitter}' is not a valid e-mail address";
861 if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
862 $param{done} = $param{requester};
864 if (exists $param{done} and
865 (not defined $param{done} or
866 not length $param{done})) {
872 __begin_control(%param,
873 command => $param{reopen}?'reopen':'done',
875 my $transcript = $info{transcript};
876 my @data = @{$info{data}};
879 if ($param{reopen}) {
880 # avoid warning multiple times if there are fixed versions
882 for my $data (@data) {
883 if (not exists $data->{done} or
884 not defined $data->{done} or
885 not length $data->{done}) {
886 print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
887 __end_control(%info);
890 if (@{$data->{fixed_versions}} and $warn_fixed) {
891 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
892 print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
896 $action = "Bug reopened";
897 for my $data (@data) {
898 my $old_data = dclone($data);
900 append_action_to_log(bug => $data->{bug_num},
903 old_data => $old_data,
905 __return_append_to_log_options(
910 if not exists $param{append_log} or $param{append_log};
911 writebug($data->{bug_num},$data);
913 print {$transcript} "$action\n";
914 __end_control(%info);
915 if (exists $param{submitter}) {
916 set_submitter(bug => $param{bug},
917 submitter => $param{submitter},
919 keys %common_options,
920 keys %append_action_options)
923 # clear the fixed revisions
924 if ($param{clear_fixed}) {
925 set_fixed(fixed => [],
929 keys %common_options,
930 keys %append_action_options),
935 my %submitter_notified;
936 my $orig_report_set = 0;
937 for my $data (@data) {
938 if (exists $data->{done} and
939 defined $data->{done} and
940 length $data->{done}) {
941 print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n";
942 __end_control(%info);
946 for my $data (@data) {
947 my $old_data = dclone($data);
948 my $hash = get_hashname($data->{bug_num});
949 my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or
950 die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!";
954 $orig_report= <$report_fh>;
957 if (not $orig_report_set and defined $orig_report and
958 length $orig_report and
959 exists $param{original_report}){
960 ${$param{original_report}} = $orig_report;
961 $orig_report_set = 1;
964 $action = "Marked $config{bug} as done";
966 # set done to the requester
967 $data->{done} = exists $param{done}?$param{done}:$param{requester};
968 append_action_to_log(bug => $data->{bug_num},
971 old_data => $old_data,
973 __return_append_to_log_options(
978 if not exists $param{append_log} or $param{append_log};
979 writebug($data->{bug_num},$data);
980 print {$transcript} "$action\n";
981 # get the original report
982 if ($param{notify_submitter}) {
983 my $submitter_message;
984 if(not exists $submitter_notified{$data->{originator}}) {
986 create_mime_message([default_headers(queue_file => $param{request_nn},
988 msgid => $param{request_msgid},
989 msgtype => 'notifdone',
990 pr_msg => 'they-closed',
992 [To => $data->{submitter},
993 Subject => "$config{ubug}#$data->{bug_num} ".
994 "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
998 __message_body_template('mail/process_your_bug_done',
1000 replyto => (exists $param{request_replyto} ?
1001 $param{request_replyto} :
1002 $param{requester} || 'Unknown'),
1003 markedby => $param{requester},
1004 subject => $param{request_subject},
1005 messageid => $param{request_msgid},
1008 [join('',make_list($param{message})),$orig_report]
1010 send_mail_message(message => $submitter_message,
1011 recipients => $old_data->{submitter},
1013 $submitter_notified{$data->{originator}} = $submitter_message;
1016 $submitter_message = $submitter_notified{$data->{originator}};
1018 append_action_to_log(bug => $data->{bug_num},
1019 action => "Notification sent",
1021 request_addr => $data->{originator},
1022 desc => "$config{bug} acknowledged by developer.",
1023 recips => [$data->{originator}],
1024 message => $submitter_message,
1029 __end_control(%info);
1030 if (exists $param{fixed}) {
1031 set_fixed(fixed => $param{fixed},
1035 keys %common_options,
1036 keys %append_action_options
1044 =head2 set_submitter
1047 set_submitter(bug => $ref,
1048 transcript => $transcript,
1049 ($dl > 0 ? (debug => $transcript):()),
1050 requester => $header{from},
1051 request_addr => $controlrequestaddr,
1053 affected_packages => \%affected_packages,
1054 recipients => \%recipients,
1055 submitter => $new_submitter,
1056 notify_submitter => 1,
1061 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1064 Sets the submitter of a bug. If notify_submitter is true (the
1065 default), notifies the old submitter of a bug on changes
1070 my %param = validate_with(params => \@_,
1071 spec => {bug => {type => SCALAR,
1074 # specific options here
1075 submitter => {type => SCALAR,
1077 notify_submitter => {type => BOOLEAN,
1081 %append_action_options,
1084 if (not Mail::RFC822::Address::valid($param{submitter})) {
1085 die "New submitter address $param{submitter} is not a valid e-mail address";
1088 __begin_control(%param,
1089 command => 'submitter'
1091 my ($debug,$transcript) =
1092 @info{qw(debug transcript)};
1093 my @data = @{$info{data}};
1095 # here we only concern ourselves with the first of the merged bugs
1096 for my $data ($data[0]) {
1097 my $notify_old_submitter = 0;
1098 my $old_data = dclone($data);
1099 print {$debug} "Going to change bug submitter\n";
1100 if (((not defined $param{submitter} or not length $param{submitter}) and
1101 (not defined $data->{originator} or not length $data->{originator})) or
1102 (defined $param{submitter} and defined $data->{originator} and
1103 $param{submitter} eq $data->{originator})) {
1104 print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
1108 if (defined $data->{originator} and length($data->{originator})) {
1109 $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'.";
1110 $notify_old_submitter = 1;
1113 $action= "Set $config{bug} submitter to '$param{submitter}'.";
1115 $data->{originator} = $param{submitter};
1117 append_action_to_log(bug => $data->{bug_num},
1118 command => 'submitter',
1120 old_data => $old_data,
1122 __return_append_to_log_options(
1127 if not exists $param{append_log} or $param{append_log};
1128 writebug($data->{bug_num},$data);
1129 print {$transcript} "$action\n";
1130 # notify old submitter
1131 if ($notify_old_submitter and $param{notify_submitter}) {
1132 send_mail_message(message =>
1133 create_mime_message([default_headers(queue_file => $param{request_nn},
1135 msgid => $param{request_msgid},
1137 pr_msg => 'submitter-changed',
1139 [To => $old_data->{submitter},
1140 Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
1144 __message_body_template('mail/submitter_changed',
1145 {old_data => $old_data,
1147 replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
1151 recipients => $old_data->{submitter},
1155 __end_control(%info);
1160 =head2 set_forwarded
1163 set_forwarded(bug => $ref,
1164 transcript => $transcript,
1165 ($dl > 0 ? (debug => $transcript):()),
1166 requester => $header{from},
1167 request_addr => $controlrequestaddr,
1169 affected_packages => \%affected_packages,
1170 recipients => \%recipients,
1171 forwarded => $forward_to,
1176 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1179 Sets the location to which a bug is forwarded. Given an undef
1180 forwarded, unsets forwarded.
1186 my %param = validate_with(params => \@_,
1187 spec => {bug => {type => SCALAR,
1190 # specific options here
1191 forwarded => {type => SCALAR|UNDEF,
1194 %append_action_options,
1197 if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
1198 die "Non-printable characters are not allowed in the forwarded field";
1200 $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded};
1202 __begin_control(%param,
1203 command => 'forwarded'
1205 my ($debug,$transcript) =
1206 @info{qw(debug transcript)};
1207 my @data = @{$info{data}};
1209 for my $data (@data) {
1210 my $old_data = dclone($data);
1211 print {$debug} "Going to change bug forwarded\n";
1212 if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or
1213 (not defined $param{forwarded} and
1214 defined $data->{forwarded} and not length $data->{forwarded})) {
1215 print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n";
1219 if (not defined $param{forwarded}) {
1220 $action= "Unset $config{bug} forwarded-to-address";
1222 elsif (defined $data->{forwarded} and length($data->{forwarded})) {
1223 $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'.";
1226 $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
1228 $data->{forwarded} = $param{forwarded};
1230 append_action_to_log(bug => $data->{bug_num},
1231 command => 'forwarded',
1233 old_data => $old_data,
1235 __return_append_to_log_options(
1240 if not exists $param{append_log} or $param{append_log};
1241 writebug($data->{bug_num},$data);
1242 print {$transcript} "$action\n";
1244 __end_control(%info);
1253 set_title(bug => $ref,
1254 transcript => $transcript,
1255 ($dl > 0 ? (debug => $transcript):()),
1256 requester => $header{from},
1257 request_addr => $controlrequestaddr,
1259 affected_packages => \%affected_packages,
1260 recipients => \%recipients,
1261 title => $new_title,
1266 print {$transcript} "Failed to set the title of $ref: $@";
1269 Sets the title of a specific bug
1275 my %param = validate_with(params => \@_,
1276 spec => {bug => {type => SCALAR,
1279 # specific options here
1280 title => {type => SCALAR,
1283 %append_action_options,
1286 if ($param{title} =~ /[^[:print:]]/) {
1287 die "Non-printable characters are not allowed in bug titles";
1290 my %info = __begin_control(%param,
1293 my ($debug,$transcript) =
1294 @info{qw(debug transcript)};
1295 my @data = @{$info{data}};
1297 for my $data (@data) {
1298 my $old_data = dclone($data);
1299 print {$debug} "Going to change bug title\n";
1300 if (defined $data->{subject} and length($data->{subject}) and
1301 $data->{subject} eq $param{title}) {
1302 print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
1306 if (defined $data->{subject} and length($data->{subject})) {
1307 $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'.";
1309 $action= "Set $config{bug} title to '$param{title}'.";
1311 $data->{subject} = $param{title};
1313 append_action_to_log(bug => $data->{bug_num},
1316 old_data => $old_data,
1318 __return_append_to_log_options(
1323 if not exists $param{append_log} or $param{append_log};
1324 writebug($data->{bug_num},$data);
1325 print {$transcript} "$action\n";
1327 __end_control(%info);
1334 set_package(bug => $ref,
1335 transcript => $transcript,
1336 ($dl > 0 ? (debug => $transcript):()),
1337 requester => $header{from},
1338 request_addr => $controlrequestaddr,
1340 affected_packages => \%affected_packages,
1341 recipients => \%recipients,
1342 package => $new_package,
1348 print {$transcript} "Failed to assign or reassign $ref to a package: $@";
1351 Indicates that a bug is in a particular package. If is_source is true,
1352 indicates that the package is a source package. [Internally, this
1353 causes src: to be prepended to the package name.]
1355 The default for is_source is 0. As a special case, if the package
1356 starts with 'src:', it is assumed to be a source package and is_source
1359 The package option must match the package_name_re regex.
1364 my %param = validate_with(params => \@_,
1365 spec => {bug => {type => SCALAR,
1368 # specific options here
1369 package => {type => SCALAR|ARRAYREF,
1371 is_source => {type => BOOLEAN,
1375 %append_action_options,
1378 my @new_packages = map {splitpackages($_)} make_list($param{package});
1379 if (grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages) {
1380 croak "Invalid package name '".
1381 join(',',grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages).
1384 my %info = __begin_control(%param,
1385 command => 'package',
1387 my ($debug,$transcript) =
1388 @info{qw(debug transcript)};
1389 my @data = @{$info{data}};
1390 # clean up the new package
1394 ($temp =~ s/^src:// or
1395 $param{is_source}) ? 'src:'.$temp:$temp;
1399 my $package_reassigned = 0;
1400 for my $data (@data) {
1401 my $old_data = dclone($data);
1402 print {$debug} "Going to change assigned package\n";
1403 if (defined $data->{package} and length($data->{package}) and
1404 $data->{package} eq $new_package) {
1405 print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
1409 if (defined $data->{package} and length($data->{package})) {
1410 $package_reassigned = 1;
1411 $action= "$config{bug} reassigned from package '$data->{package}'".
1412 " to '$new_package'.";
1414 $action= "$config{bug} assigned to package '$new_package'.";
1416 $data->{package} = $new_package;
1418 append_action_to_log(bug => $data->{bug_num},
1419 command => 'package',
1421 old_data => $old_data,
1423 __return_append_to_log_options(
1428 if not exists $param{append_log} or $param{append_log};
1429 writebug($data->{bug_num},$data);
1430 print {$transcript} "$action\n";
1432 __end_control(%info);
1433 # Only clear the fixed/found versions if the package has been
1435 if ($package_reassigned) {
1436 my @params_for_found_fixed =
1437 map {exists $param{$_}?($_,$param{$_}):()}
1439 keys %common_options,
1440 keys %append_action_options,
1442 set_found(found => [],
1443 @params_for_found_fixed,
1445 set_fixed(fixed => [],
1446 @params_for_found_fixed,
1454 set_found(bug => $ref,
1455 transcript => $transcript,
1456 ($dl > 0 ? (debug => $transcript):()),
1457 requester => $header{from},
1458 request_addr => $controlrequestaddr,
1460 affected_packages => \%affected_packages,
1461 recipients => \%recipients,
1468 print {$transcript} "Failed to set found on $ref: $@";
1472 Sets, adds, or removes the specified found versions of a package
1474 If the version list is empty, and the bug is currently not "done",
1475 causes the done field to be cleared.
1477 If any of the versions added to found are greater than any version in
1478 which the bug is fixed (or when the bug is found and there are no
1479 fixed versions) the done field is cleared.
1484 my %param = validate_with(params => \@_,
1485 spec => {bug => {type => SCALAR,
1488 # specific options here
1489 found => {type => SCALAR|ARRAYREF,
1492 add => {type => BOOLEAN,
1495 remove => {type => BOOLEAN,
1499 %append_action_options,
1502 if ($param{add} and $param{remove}) {
1503 croak "It's nonsensical to add and remove the same versions";
1507 __begin_control(%param,
1510 my ($debug,$transcript) =
1511 @info{qw(debug transcript)};
1512 my @data = @{$info{data}};
1514 for my $version (make_list($param{found})) {
1515 next unless defined $version;
1516 $versions{$version} =
1517 [make_source_versions(package => [splitpackages($data[0]{package})],
1518 warnings => $transcript,
1521 versions => $version,
1524 # This is really ugly, but it's what we have to do
1525 if (not @{$versions{$version}}) {
1526 print {$transcript} "Unable to make a source version for version '$version'\n";
1529 if (not keys %versions and ($param{remove} or $param{add})) {
1530 if ($param{remove}) {
1531 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1534 print {$transcript} "Requested to add no versions; doing nothing.\n";
1536 __end_control(%info);
1539 # first things first, make the versions fully qualified source
1541 for my $data (@data) {
1542 # The 'done' field gets a bit weird with version tracking,
1543 # because a bug may be closed by multiple people in different
1544 # branches. Until we have something more flexible, we set it
1545 # every time a bug is fixed, and clear it when a bug is found
1546 # in a version greater than any version in which the bug is
1547 # fixed or when a bug is found and there is no fixed version
1548 my $action = 'Did not alter found versions';
1549 my %found_added = ();
1550 my %found_removed = ();
1551 my %fixed_removed = ();
1553 my $old_data = dclone($data);
1554 if (not $param{add} and not $param{remove}) {
1555 $found_removed{$_} = 1 for @{$data->{found_versions}};
1556 $data->{found_versions} = [];
1559 @found_versions{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1561 @fixed_versions{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1562 for my $version (keys %versions) {
1564 my @svers = @{$versions{$version}};
1568 elsif (not grep {$version eq $_} @svers) {
1569 # The $version was not equal to one of the source
1570 # versions, so it's probably unqualified (or just
1571 # wrong). Delete it, and use the source versions
1573 if (exists $found_versions{$version}) {
1574 delete $found_versions{$version};
1575 $found_removed{$version} = 1;
1578 for my $sver (@svers) {
1579 if (not exists $found_versions{$sver}) {
1580 $found_versions{$sver} = 1;
1581 $found_added{$sver} = 1;
1583 # if the found we are adding matches any fixed
1584 # versions, remove them
1585 my @temp = grep m{(^|/)\Q$sver\E$}, keys %fixed_versions;
1586 delete $fixed_versions{$_} for @temp;
1587 $fixed_removed{$_} = 1 for @temp;
1590 # We only care about reopening the bug if the bug is
1592 if (defined $data->{done} and length $data->{done}) {
1593 my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
1595 # determine if we need to reopen
1596 my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
1597 keys %fixed_versions);
1598 if (not @fixed_order or
1599 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1605 elsif ($param{remove}) {
1606 # in the case of removal, we only concern ourself with
1607 # the version passed, not the source version it maps
1609 my @temp = grep m{(?:^|/)\Q$version\E$}, keys %found_versions;
1610 delete $found_versions{$_} for @temp;
1611 $found_removed{$_} = 1 for @temp;
1614 # set the keys to exactly these values
1615 my @svers = @{$versions{$version}};
1619 for my $sver (@svers) {
1620 if (not exists $found_versions{$sver}) {
1621 $found_versions{$sver} = 1;
1622 if (exists $found_removed{$sver}) {
1623 delete $found_removed{$sver};
1626 $found_added{$sver} = 1;
1633 $data->{found_versions} = [keys %found_versions];
1634 $data->{fixed_versions} = [keys %fixed_versions];
1637 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1638 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1639 # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
1640 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1641 $action = ucfirst(join ('; ',@changed)) if @changed;
1643 $action .= " and reopened"
1645 if (not $reopened and not @changed) {
1646 print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
1650 append_action_to_log(bug => $data->{bug_num},
1653 old_data => $old_data,
1655 __return_append_to_log_options(
1660 if not exists $param{append_log} or $param{append_log};
1661 writebug($data->{bug_num},$data);
1662 print {$transcript} "$action\n";
1664 __end_control(%info);
1670 set_fixed(bug => $ref,
1671 transcript => $transcript,
1672 ($dl > 0 ? (debug => $transcript):()),
1673 requester => $header{from},
1674 request_addr => $controlrequestaddr,
1676 affected_packages => \%affected_packages,
1677 recipients => \%recipients,
1685 print {$transcript} "Failed to set fixed on $ref: $@";
1689 Sets, adds, or removes the specified fixed versions of a package
1691 If the fixed versions are empty (or end up being empty after this
1692 call) or the greatest fixed version is less than the greatest found
1693 version and the reopen option is true, the bug is reopened.
1695 This function is also called by the reopen function, which causes all
1696 of the fixed versions to be cleared.
1701 my %param = validate_with(params => \@_,
1702 spec => {bug => {type => SCALAR,
1705 # specific options here
1706 fixed => {type => SCALAR|ARRAYREF,
1709 add => {type => BOOLEAN,
1712 remove => {type => BOOLEAN,
1715 reopen => {type => BOOLEAN,
1719 %append_action_options,
1722 if ($param{add} and $param{remove}) {
1723 croak "It's nonsensical to add and remove the same versions";
1726 __begin_control(%param,
1729 my ($debug,$transcript) =
1730 @info{qw(debug transcript)};
1731 my @data = @{$info{data}};
1733 for my $version (make_list($param{fixed})) {
1734 next unless defined $version;
1735 $versions{$version} =
1736 [make_source_versions(package => [splitpackages($data[0]{package})],
1737 warnings => $transcript,
1740 versions => $version,
1743 # This is really ugly, but it's what we have to do
1744 if (not @{$versions{$version}}) {
1745 print {$transcript} "Unable to make a source version for version '$version'\n";
1748 if (not keys %versions and ($param{remove} or $param{add})) {
1749 if ($param{remove}) {
1750 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1753 print {$transcript} "Requested to add no versions; doing nothing.\n";
1755 __end_control(%info);
1758 # first things first, make the versions fully qualified source
1760 for my $data (@data) {
1761 my $old_data = dclone($data);
1762 # The 'done' field gets a bit weird with version tracking,
1763 # because a bug may be closed by multiple people in different
1764 # branches. Until we have something more flexible, we set it
1765 # every time a bug is fixed, and clear it when a bug is found
1766 # in a version greater than any version in which the bug is
1767 # fixed or when a bug is found and there is no fixed version
1768 my $action = 'Did not alter fixed versions';
1769 my %found_added = ();
1770 my %found_removed = ();
1771 my %fixed_added = ();
1772 my %fixed_removed = ();
1774 if (not $param{add} and not $param{remove}) {
1775 $fixed_removed{$_} = 1 for @{$data->{fixed_versions}};
1776 $data->{fixed_versions} = [];
1779 @found_versions{@{$data->{found_versions}||[]}} = (1) x @{$data->{found_versions}||[]};
1781 @fixed_versions{@{$data->{fixed_versions}||[]}} = (1) x @{$data->{fixed_versions}||[]};
1782 for my $version (keys %versions) {
1784 my @svers = @{$versions{$version}};
1789 if (exists $fixed_versions{$version}) {
1790 $fixed_removed{$version} = 1;
1791 delete $fixed_versions{$version};
1794 for my $sver (@svers) {
1795 if (not exists $fixed_versions{$sver}) {
1796 $fixed_versions{$sver} = 1;
1797 $fixed_added{$sver} = 1;
1801 elsif ($param{remove}) {
1802 # in the case of removal, we only concern ourself with
1803 # the version passed, not the source version it maps
1805 my @temp = grep m{(?:^|\/)\Q$version\E$}, keys %fixed_versions;
1806 delete $fixed_versions{$_} for @temp;
1807 $fixed_removed{$_} = 1 for @temp;
1810 # set the keys to exactly these values
1811 my @svers = @{$versions{$version}};
1815 for my $sver (@svers) {
1816 if (not exists $fixed_versions{$sver}) {
1817 $fixed_versions{$sver} = 1;
1818 if (exists $fixed_removed{$sver}) {
1819 delete $fixed_removed{$sver};
1822 $fixed_added{$sver} = 1;
1829 $data->{found_versions} = [keys %found_versions];
1830 $data->{fixed_versions} = [keys %fixed_versions];
1832 # If we're supposed to consider reopening, reopen if the
1833 # fixed versions are empty or the greatest found version
1834 # is greater than the greatest fixed version
1835 if ($param{reopen} and defined $data->{done}
1836 and length $data->{done}) {
1837 my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1838 map {m{([^/]+)$}; $1;} @{$data->{found_versions}};
1839 # determine if we need to reopen
1840 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1841 map {m{([^/]+)$}; $1;} @{$data->{fixed_versions}};
1842 if (not @fixed_order or
1843 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1850 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1851 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1852 push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
1853 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1854 $action = ucfirst(join ('; ',@changed)) if @changed;
1856 $action .= " and reopened"
1858 if (not $reopened and not @changed) {
1859 print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
1863 append_action_to_log(bug => $data->{bug_num},
1866 old_data => $old_data,
1868 __return_append_to_log_options(
1873 if not exists $param{append_log} or $param{append_log};
1874 writebug($data->{bug_num},$data);
1875 print {$transcript} "$action\n";
1877 __end_control(%info);
1884 set_merged(bug => $ref,
1885 transcript => $transcript,
1886 ($dl > 0 ? (debug => $transcript):()),
1887 requester => $header{from},
1888 request_addr => $controlrequestaddr,
1890 affected_packages => \%affected_packages,
1891 recipients => \%recipients,
1892 merge_with => 12345,
1895 allow_reassign => 1,
1896 reassign_same_source_only => 1,
1901 print {$transcript} "Failed to set merged on $ref: $@";
1905 Sets, adds, or removes the specified merged bugs of a bug
1907 By default, requires
1912 my %param = validate_with(params => \@_,
1913 spec => {bug => {type => SCALAR,
1916 # specific options here
1917 merge_with => {type => ARRAYREF|SCALAR,
1920 remove => {type => BOOLEAN,
1923 force => {type => BOOLEAN,
1926 masterbug => {type => BOOLEAN,
1929 allow_reassign => {type => BOOLEAN,
1932 reassign_different_sources => {type => BOOLEAN,
1936 %append_action_options,
1939 my @merging = exists $param{merge_with} ? make_list($param{merge_with}):();
1941 @merging{@merging} = (1) x @merging;
1942 if (grep {$_ !~ /^\d+$/} @merging) {
1943 croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging);
1945 $param{locks} = {} if not exists $param{locks};
1947 __begin_control(%param,
1950 my ($debug,$transcript) =
1951 @info{qw(debug transcript)};
1952 if (not @merging and exists $param{merge_with}) {
1953 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
1954 __end_control(%info);
1957 my @data = @{$info{data}};
1960 for my $data (@data) {
1961 $data{$data->{bug_num}} = $data;
1962 my @merged_bugs = split / /, $data->{mergedwith};
1963 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
1967 if (not exists $param{merge_with}) {
1968 delete $merged_bugs{$param{bug}};
1969 if (not keys %merged_bugs) {
1970 print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
1971 __end_control(%info);
1974 my $action = "Disconnected #$param{bug} from all other report(s).";
1975 for my $data (@data) {
1976 my $old_data = dclone($data);
1977 if ($data->{bug_num} == $param{bug}) {
1978 $data->{mergedwith} = '';
1981 $data->{mergedwith} =
1984 grep {$_ != $data->{bug_num}}
1987 append_action_to_log(bug => $data->{bug_num},
1990 old_data => $old_data,
1992 __return_append_to_log_options(%param,
1996 if not exists $param{append_log} or $param{append_log};
1997 writebug($data->{bug_num},$data);
1999 print {$transcript} "$action\n";
2000 __end_control(%info);
2003 # lock and load all of the bugs we need
2004 my ($data,$n_locks) =
2005 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2007 locks => $param{locks},
2010 $new_locks += $n_locks;
2012 @data = values %data;
2013 if (not check_limit(data => [@data],
2014 exists $param{limit}?(limit => $param{limit}):(),
2015 transcript => $transcript,
2017 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
2019 for my $data (@data) {
2020 $data{$data->{bug_num}} = $data;
2021 $merged_bugs{$data->{bug_num}} = 1;
2022 my @merged_bugs = split / /, $data->{mergedwith};
2023 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
2024 if (exists $param{affected_bugs}) {
2025 $param{affected_bugs}{$data->{bug_num}} = 1;
2028 __handle_affected_packages(%param,data => [@data]);
2029 my %bug_info_shown; # which bugs have had information shown
2030 $bug_info_shown{$param{bug}} = 1;
2031 add_recipients(data => [@data],
2032 recipients => $param{recipients},
2033 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
2035 (__internal_request()?(transcript => $transcript):()),
2038 # Figure out what the ideal state is for the bug,
2039 my ($merge_status,$bugs_to_merge) =
2040 __calculate_merge_status(\@data,\%data,$param{bug});
2041 # find out if we actually have any bugs to merge
2042 if (not $bugs_to_merge) {
2043 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
2044 for (1..$new_locks) {
2045 unfilelock($param{locks});
2048 __end_control(%info);
2051 # see what changes need to be made to merge the bugs
2052 # check to make sure that the set of changes we need to make is allowed
2053 my ($disallowed_changes,$changes) =
2054 __calculate_merge_changes(\@data,$merge_status,\%param);
2055 # at this point, stop if there are disallowed changes, otherwise
2056 # make the allowed changes, and then reread the bugs in question
2057 # to get the new data, then recaculate the merges; repeat
2058 # reloading and recalculating until we try too many times or there
2059 # are no changes to make.
2062 # we will allow at most 4 times through this; more than 1
2063 # shouldn't really happen.
2065 while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) {
2066 if ($attempts > 1) {
2067 print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n";
2069 if (@{$disallowed_changes}) {
2070 # figure out the problems
2071 print {$transcript} "Unable to merge bugs because:\n";
2072 for my $change (@{$disallowed_changes}) {
2073 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2075 if ($attempts > 0) {
2076 __end_control(%info);
2077 croak "Some bugs were altered while attempting to merge";
2080 __end_control(%info);
2081 croak "Did not alter merged bugs";
2084 my @bugs_to_change = keys %{$changes};
2085 for my $change_bug (@bugs_to_change) {
2086 next unless exists $changes->{$change_bug};
2087 $bug_changed{$change_bug}++;
2088 print {$transcript} __bug_info($data{$change_bug}) if
2089 $param{show_bug_info} and not __internal_request(1);
2090 $bug_info_shown{$change_bug} = 1;
2091 __allow_relocking($param{locks},[keys %data]);
2093 for my $change (@{$changes->{$change_bug}}) {
2094 if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
2095 my %target_blockedby;
2096 @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
2097 my %unhandled_targets = %target_blockedby;
2098 for my $key (split / /,$change->{orig_value}) {
2099 delete $unhandled_targets{$key};
2100 next if exists $target_blockedby{$key};
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),
2109 for my $key (keys %unhandled_targets) {
2110 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2111 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2114 keys %common_options,
2115 keys %append_action_options),
2120 $change->{function}->(bug => $change->{bug},
2121 $change->{key}, $change->{func_value},
2122 exists $change->{options}?@{$change->{options}}:(),
2124 keys %common_options,
2125 keys %append_action_options),
2131 __disallow_relocking($param{locks});
2132 __end_control(%info);
2133 croak "Failure while trying to adjust bugs, please report this as a bug: $@";
2135 __disallow_relocking($param{locks});
2136 my ($data,$n_locks) =
2137 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2139 locks => $param{locks},
2143 $new_locks += $n_locks;
2146 @data = values %data;
2147 ($merge_status,$bugs_to_merge) =
2148 __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
2149 ($disallowed_changes,$changes) =
2150 __calculate_merge_changes(\@data,$merge_status,\%param);
2151 $attempts = max(values %bug_changed);
2154 if ($param{show_bug_info} and not __internal_request(1)) {
2155 for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) {
2156 next if $bug_info_shown{$data->{bug_num}};
2157 print {$transcript} __bug_info($data);
2160 if (keys %{$changes} or @{$disallowed_changes}) {
2161 print {$transcript} "After four attempts, the following changes were unable to be made:\n";
2162 for (1..$new_locks) {
2163 unfilelock($param{locks});
2166 __end_control(%info);
2167 for my $change ((map {@{$_}} values %{$changes}), @{$disallowed_changes}) {
2168 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2170 die "Unable to modify bugs so they could be merged";
2174 # finally, we can merge the bugs
2175 my $action = "Merged ".join(' ',sort { $a <=> $b } keys %merged_bugs);
2176 for my $data (@data) {
2177 my $old_data = dclone($data);
2178 $data->{mergedwith} =
2181 grep {$_ != $data->{bug_num}}
2183 append_action_to_log(bug => $data->{bug_num},
2186 old_data => $old_data,
2188 __return_append_to_log_options(%param,
2192 if not exists $param{append_log} or $param{append_log};
2193 writebug($data->{bug_num},$data);
2195 print {$transcript} "$action\n";
2196 # unlock the extra locks that we got earlier
2197 for (1..$new_locks) {
2198 unfilelock($param{locks});
2201 __end_control(%info);
2204 sub __allow_relocking{
2205 my ($locks,$bugs) = @_;
2207 my @locks = (@{$bugs},'merge');
2208 for my $lock (@locks) {
2209 my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
2210 next unless @lockfiles;
2211 $locks->{relockable}{$lockfiles[0]} = 0;
2215 sub __disallow_relocking{
2217 delete $locks->{relockable};
2220 sub __lock_and_load_merged_bugs{
2222 validate_with(params => \@_,
2224 {bugs_to_load => {type => ARRAYREF,
2225 default => sub {[]},
2227 data => {type => HASHREF|ARRAYREF,
2229 locks => {type => HASHREF,
2230 default => sub {{};},
2232 reload_all => {type => BOOLEAN,
2235 debug => {type => HANDLE,
2241 if (ref($param{data}) eq 'ARRAY') {
2242 for my $data (@{$param{data}}) {
2243 $data{$data->{bug_num}} = dclone($data);
2247 %data = %{dclone($param{data})};
2249 my @bugs_to_load = @{$param{bugs_to_load}};
2250 if ($param{reload_all}) {
2251 push @bugs_to_load, keys %data;
2254 @temp{@bugs_to_load} = (1) x @bugs_to_load;
2255 @bugs_to_load = keys %temp;
2256 my %loaded_this_time;
2258 while ($bug_to_load = shift @bugs_to_load) {
2259 if (not $param{reload_all}) {
2260 next if exists $data{$bug_to_load};
2263 next if $loaded_this_time{$bug_to_load};
2266 if ($param{reload_all}) {
2267 if (exists $data{$bug_to_load}) {
2272 read_bug(bug => $bug_to_load,
2274 locks => $param{locks},
2276 die "Unable to load bug $bug_to_load";
2277 print {$param{debug}} "read bug $bug_to_load\n";
2278 $data{$data->{bug_num}} = $data;
2279 $new_locks += $lock_bug;
2280 $loaded_this_time{$data->{bug_num}} = 1;
2282 grep {not exists $data{$_}}
2283 split / /,$data->{mergedwith};
2285 return (\%data,$new_locks);
2289 sub __calculate_merge_status{
2290 my ($data_a,$data_h,$master_bug,$merge_status) = @_;
2291 my %merge_status = %{$merge_status // {}};
2293 my $bugs_to_merge = 0;
2294 for my $data (@{$data_a}) {
2295 # check to see if this bug is unmerged in the set
2296 if (not length $data->{mergedwith} or
2297 grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) {
2298 $merged_bugs{$data->{bug_num}} = 1;
2301 # the master_bug is the bug that every other bug is made to
2302 # look like. However, if merge is set, tags, fixed and found
2304 if ($data->{bug_num} == $master_bug) {
2305 for (qw(package forwarded severity blocks blockedby done owner summary outlook affects)) {
2306 $merge_status{$_} = $data->{$_}
2309 if (defined $merge_status) {
2310 next unless $data->{bug_num} == $master_bug;
2312 $merge_status{tag} = {} if not exists $merge_status{tag};
2313 for my $tag (split /\s+/, $data->{keywords}) {
2314 $merge_status{tag}{$tag} = 1;
2316 $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}});
2317 for (qw(fixed found)) {
2318 @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
2321 # if there is a non-source qualified version with a corresponding
2322 # source qualified version, we only want to merge the source
2323 # qualified version(s)
2324 for (qw(fixed found)) {
2325 my @unqualified_versions = grep {m{/}?0:1} keys %{$merge_status{"${_}_versions"}};
2326 for my $unqualified_version (@unqualified_versions) {
2327 if (grep {m{/\Q$unqualified_version\E}} keys %{$merge_status{"${_}_versions"}}) {
2328 delete $merge_status{"${_}_versions"}{$unqualified_version};
2332 return (\%merge_status,$bugs_to_merge);
2337 sub __calculate_merge_changes{
2338 my ($datas,$merge_status,$param) = @_;
2340 my @disallowed_changes;
2341 for my $data (@{$datas}) {
2342 # things that can be forced
2344 # * func is the function to set the new value
2346 # * key is the key of the function to set the value,
2348 # * modify_value is a function which is called to modify the new
2349 # value so that the function will accept it
2351 # * options is an ARRAYREF of options to pass to the function
2353 # * allowed is a BOOLEAN which controls whether this setting
2354 # is allowed to be different by default.
2355 my %force_functions =
2356 (forwarded => {func => \&set_forwarded,
2360 severity => {func => \&set_severity,
2364 blocks => {func => \&set_blocks,
2365 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2369 blockedby => {func => \&set_blocks,
2370 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2374 done => {func => \&set_done,
2378 owner => {func => \&owner,
2382 summary => {func => \&summary,
2386 outlook => {func => \&outlook,
2390 affects => {func => \&affects,
2394 package => {func => \&set_package,
2398 keywords => {func => \&set_tag,
2400 modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]},
2403 fixed_versions => {func => \&set_fixed,
2405 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2408 found_versions => {func => \&set_found,
2410 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2414 for my $field (qw(forwarded severity blocks blockedby done owner summary outlook affects package fixed_versions found_versions keywords)) {
2415 # if the ideal bug already has the field set properly, we
2417 if ($field eq 'keywords'){
2418 next if join(' ',sort split /\s+/,$data->{keywords}) eq
2419 join(' ',sort keys %{$merge_status->{tag}});
2421 elsif ($field =~ /^(?:fixed|found)_versions$/) {
2422 next if join(' ', sort @{$data->{$field}}) eq
2423 join(' ',sort keys %{$merge_status->{$field}});
2425 elsif ($field eq 'done') {
2426 # for done, we only care if the bug is done or not
2427 # done, not the value it's set to.
2428 if (defined $merge_status->{$field} and length $merge_status->{$field} and
2429 defined $data->{$field} and length $data->{$field}) {
2432 elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
2433 (not defined $data->{$field} or not length $data->{$field})
2438 elsif ($merge_status->{$field} eq $data->{$field}) {
2443 bug => $data->{bug_num},
2444 orig_value => $data->{$field},
2446 (exists $force_functions{$field}{modify_value} ?
2447 $force_functions{$field}{modify_value}->($merge_status->{$field}):
2448 $merge_status->{$field}),
2449 value => $merge_status->{$field},
2450 function => $force_functions{$field}{func},
2451 key => $force_functions{$field}{key},
2452 options => $force_functions{$field}{options},
2453 allowed => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
2455 $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
2456 $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
2457 if ($param->{force} or $change->{allowed}) {
2458 if ($field ne 'package' or $change->{allowed}) {
2459 push @{$changes{$data->{bug_num}}},$change;
2462 if ($param->{allow_reassign}) {
2463 if ($param->{reassign_different_sources}) {
2464 push @{$changes{$data->{bug_num}}},$change;
2467 # allow reassigning if binary_to_source returns at
2468 # least one of the same source packages
2469 my @merge_status_source =
2470 binary_to_source(package => $merge_status->{package},
2473 my @other_bug_source =
2474 binary_to_source(package => $data->{package},
2477 my %merge_status_sources;
2478 @merge_status_sources{@merge_status_source} =
2479 (1) x @merge_status_source;
2480 if (grep {$merge_status_sources{$_}} @other_bug_source) {
2481 push @{$changes{$data->{bug_num}}},$change;
2486 push @disallowed_changes,$change;
2488 # blocks and blocked by are weird; we have to go through and
2489 # set blocks to the other half of the merged bugs
2491 return (\@disallowed_changes,\%changes);
2497 affects(bug => $ref,
2498 transcript => $transcript,
2499 ($dl > 0 ? (debug => $transcript):()),
2500 requester => $header{from},
2501 request_addr => $controlrequestaddr,
2503 affected_packages => \%affected_packages,
2504 recipients => \%recipients,
2512 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
2515 This marks a bug as affecting packages which the bug is not actually
2516 in. This should only be used in cases where fixing the bug instantly
2517 resolves the problem in the other packages.
2519 By default, the packages are set to the list of packages passed.
2520 However, if you pass add => 1 or remove => 1, the list of packages
2521 passed are added or removed from the affects list, respectively.
2526 my %param = validate_with(params => \@_,
2527 spec => {bug => {type => SCALAR,
2530 # specific options here
2531 package => {type => SCALAR|ARRAYREF|UNDEF,
2534 add => {type => BOOLEAN,
2537 remove => {type => BOOLEAN,
2541 %append_action_options,
2544 if ($param{add} and $param{remove}) {
2545 croak "Asking to both add and remove affects is nonsensical";
2547 if (not defined $param{package}) {
2548 $param{package} = [];
2551 __begin_control(%param,
2552 command => 'affects'
2554 my ($debug,$transcript) =
2555 @info{qw(debug transcript)};
2556 my @data = @{$info{data}};
2558 for my $data (@data) {
2560 print {$debug} "Going to change affects\n";
2561 my @packages = splitpackages($data->{affects});
2563 @packages{@packages} = (1) x @packages;
2566 for my $package (make_list($param{package})) {
2567 next unless defined $package and length $package;
2568 if (not $packages{$package}) {
2569 $packages{$package} = 1;
2570 push @added,$package;
2574 $action = "Added indication that $data->{bug_num} affects ".
2575 english_join(\@added);
2578 elsif ($param{remove}) {
2580 for my $package (make_list($param{package})) {
2581 if ($packages{$package}) {
2582 next unless defined $package and length $package;
2583 delete $packages{$package};
2584 push @removed,$package;
2587 $action = "Removed indication that $data->{bug_num} affects " .
2588 english_join(\@removed);
2591 my %added_packages = ();
2592 my %removed_packages = %packages;
2594 for my $package (make_list($param{package})) {
2595 next unless defined $package and length $package;
2596 $packages{$package} = 1;
2597 delete $removed_packages{$package};
2598 $added_packages{$package} = 1;
2600 if (keys %removed_packages) {
2601 $action = "Removed indication that $data->{bug_num} affects ".
2602 english_join([keys %removed_packages]);
2603 $action .= "\n" if keys %added_packages;
2605 if (keys %added_packages) {
2606 $action .= "Added indication that $data->{bug_num} affects " .
2607 english_join([keys %added_packages]);
2610 if (not length $action) {
2611 print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
2614 my $old_data = dclone($data);
2615 $data->{affects} = join(',',keys %packages);
2616 append_action_to_log(bug => $data->{bug_num},
2618 command => 'affects',
2620 old_data => $old_data,
2621 __return_append_to_log_options(
2626 if not exists $param{append_log} or $param{append_log};
2627 writebug($data->{bug_num},$data);
2628 print {$transcript} "$action\n";
2630 __end_control(%info);
2634 =head1 SUMMARY FUNCTIONS
2639 summary(bug => $ref,
2640 transcript => $transcript,
2641 ($dl > 0 ? (debug => $transcript):()),
2642 requester => $header{from},
2643 request_addr => $controlrequestaddr,
2645 affected_packages => \%affected_packages,
2646 recipients => \%recipients,
2652 print {$transcript} "Failed to mark $ref with summary foo: $@";
2655 Handles all setting of summary fields
2657 If summary is undef, unsets the summary
2659 If summary is 0 or -1, sets the summary to the first paragraph contained in
2662 If summary is a positive integer, sets the summary to the message specified.
2664 Otherwise, sets summary to the value passed.
2670 # outlook and summary are exactly the same, basically
2671 return _summary('summary',@_);
2674 =head1 OUTLOOK FUNCTIONS
2679 outlook(bug => $ref,
2680 transcript => $transcript,
2681 ($dl > 0 ? (debug => $transcript):()),
2682 requester => $header{from},
2683 request_addr => $controlrequestaddr,
2685 affected_packages => \%affected_packages,
2686 recipients => \%recipients,
2692 print {$transcript} "Failed to mark $ref with outlook foo: $@";
2695 Handles all setting of outlook fields
2697 If outlook is undef, unsets the outlook
2699 If outlook is 0, sets the outlook to the first paragraph contained in
2702 If outlook is a positive integer, sets the outlook to the message specified.
2704 Otherwise, sets outlook to the value passed.
2710 return _summary('outlook',@_);
2714 my ($cmd,@params) = @_;
2715 my %param = validate_with(params => \@params,
2716 spec => {bug => {type => SCALAR,
2719 # specific options here
2720 $cmd , {type => SCALAR|UNDEF,
2724 %append_action_options,
2728 __begin_control(%param,
2731 my ($debug,$transcript) =
2732 @info{qw(debug transcript)};
2733 my @data = @{$info{data}};
2734 # figure out the log that we're going to use
2736 my $summary_msg = '';
2738 if (not defined $param{$cmd}) {
2740 print {$debug} "Removing $cmd fields\n";
2741 $action = "Removed $cmd";
2743 elsif ($param{$cmd} =~ /^-?\d+$/) {
2745 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
2746 if ($param{$cmd} == 0 or $param{$cmd} == -1) {
2747 $log = $param{message};
2748 $summary_msg = @records + 1;
2751 if (($param{$cmd} - 1 ) > $#records) {
2752 die "Message number '$param{$cmd}' exceeds the maximum message '$#records'";
2754 my $record = $records[($param{$cmd} - 1 )];
2755 if ($record->{type} !~ /incoming-recv|recips/) {
2756 die "Message number '$param{$cmd}' is a invalid message type '$record->{type}'";
2758 $summary_msg = $param{$cmd};
2759 $log = [$record->{text}];
2761 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
2762 my $body = $p_o->{body};
2763 my $in_pseudoheaders = 0;
2765 # walk through body until we get non-blank lines
2766 for my $line (@{$body}) {
2767 if ($line =~ /^\s*$/) {
2768 if (length $paragraph) {
2769 if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
2775 $in_pseudoheaders = 0;
2778 # skip a paragraph if it looks like it's control or
2780 if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity|Control)\:\s+\S}xi or #pseudo headers
2781 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
2782 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
2783 debug|(?:not|)forwarded|priority|
2784 (?:un|)block|limit|(?:un|)archive|
2785 reassign|retitle|affects|wrongpackage
2786 (?:un|force|)merge|user(?:category|tags?|)
2788 if (not length $paragraph) {
2789 print {$debug} "Found control/pseudo-headers and skiping them\n";
2790 $in_pseudoheaders = 1;
2794 next if $in_pseudoheaders;
2795 $paragraph .= $line ." \n";
2797 print {$debug} ucfirst($cmd)." is going to be '$paragraph'\n";
2798 $summary = $paragraph;
2799 $summary =~ s/[\n\r]/ /g;
2800 if (not length $summary) {
2801 die "Unable to find $cmd message to use";
2803 # trim off a trailing spaces
2804 $summary =~ s/\ *$//;
2807 $summary = $param{$cmd};
2809 for my $data (@data) {
2810 print {$debug} "Going to change $cmd\n";
2811 if (((not defined $summary or not length $summary) and
2812 (not defined $data->{$cmd} or not length $data->{$cmd})) or
2813 $summary eq $data->{$cmd}) {
2814 print {$transcript} "Ignoring request to change the $cmd of bug $param{bug} to the same value\n";
2817 if (length $summary) {
2818 if (length $data->{$cmd}) {
2819 $action = ucfirst($cmd)." replaced with message bug $param{bug} message $summary_msg";
2822 $action = ucfirst($cmd)." recorded from message bug $param{bug} message $summary_msg";
2825 my $old_data = dclone($data);
2826 $data->{$cmd} = $summary;
2827 append_action_to_log(bug => $data->{bug_num},
2829 old_data => $old_data,
2832 __return_append_to_log_options(
2837 if not exists $param{append_log} or $param{append_log};
2838 writebug($data->{bug_num},$data);
2839 print {$transcript} "$action\n";
2841 __end_control(%info);
2849 clone_bug(bug => $ref,
2850 transcript => $transcript,
2851 ($dl > 0 ? (debug => $transcript):()),
2852 requester => $header{from},
2853 request_addr => $controlrequestaddr,
2855 affected_packages => \%affected_packages,
2856 recipients => \%recipients,
2861 print {$transcript} "Failed to clone bug $ref bar: $@";
2864 Clones the given bug.
2866 We currently don't support cloning merged bugs, but this could be
2867 handled by internally unmerging, cloning, then remerging the bugs.
2872 my %param = validate_with(params => \@_,
2873 spec => {bug => {type => SCALAR,
2876 new_bugs => {type => ARRAYREF,
2878 new_clones => {type => HASHREF,
2882 %append_action_options,
2886 __begin_control(%param,
2889 my $transcript = $info{transcript};
2890 my @data = @{$info{data}};
2893 for my $data (@data) {
2894 if (length($data->{mergedwith})) {
2895 die "Bug is marked as being merged with others. Use an existing clone.\n";
2899 die "Not exactly one bug‽ This shouldn't happen.";
2901 my $data = $data[0];
2903 for my $newclone_id (@{$param{new_bugs}}) {
2904 my $new_bug_num = new_bug(copy => $data->{bug_num});
2905 $param{new_clones}{$newclone_id} = $new_bug_num;
2906 $clones{$newclone_id} = $new_bug_num;
2908 my @new_bugs = sort values %clones;
2910 for my $new_bug (@new_bugs) {
2911 # no collapsed ids or the higher collapsed id is not one less
2912 # than the next highest new bug
2913 if (not @collapsed_ids or
2914 $collapsed_ids[-1][1]+1 != $new_bug) {
2915 push @collapsed_ids,[$new_bug,$new_bug];
2918 $collapsed_ids[-1][1] = $new_bug;
2922 for my $ci (@collapsed_ids) {
2923 if ($ci->[0] == $ci->[1]) {
2924 push @collapsed,$ci->[0];
2927 push @collapsed,$ci->[0].'-'.$ci->[1]
2930 my $collapsed_str = english_join(\@collapsed);
2931 $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str;
2932 for my $new_bug (@new_bugs) {
2933 append_action_to_log(bug => $new_bug,
2935 __return_append_to_log_options(
2940 if not exists $param{append_log} or $param{append_log};
2942 append_action_to_log(bug => $data->{bug_num},
2944 __return_append_to_log_options(
2949 if not exists $param{append_log} or $param{append_log};
2950 writebug($data->{bug_num},$data);
2951 print {$transcript} "$action\n";
2952 __end_control(%info);
2953 # bugs that this bug is blocking are also blocked by the new clone(s)
2954 for my $bug (split ' ', $data->{blocks}) {
2955 for my $new_bug (@new_bugs) {
2956 set_blocks(bug => $bug,
2960 keys %common_options,
2961 keys %append_action_options),
2965 # bugs that are blocking this bug are also blocking the new clone(s)
2966 for my $bug (split ' ', $data->{blockedby}) {
2967 for my $new_bug (@new_bugs) {
2968 set_blocks(bug => $new_bug,
2972 keys %common_options,
2973 keys %append_action_options),
2981 =head1 OWNER FUNCTIONS
2987 transcript => $transcript,
2988 ($dl > 0 ? (debug => $transcript):()),
2989 requester => $header{from},
2990 request_addr => $controlrequestaddr,
2992 recipients => \%recipients,
2998 print {$transcript} "Failed to mark $ref as having an owner: $@";
3001 Handles all setting of the owner field; given an owner of undef or of
3002 no length, indicates that a bug is not owned by anyone.
3007 my %param = validate_with(params => \@_,
3008 spec => {bug => {type => SCALAR,
3011 owner => {type => SCALAR|UNDEF,
3014 %append_action_options,
3018 __begin_control(%param,
3021 my ($debug,$transcript) =
3022 @info{qw(debug transcript)};
3023 my @data = @{$info{data}};
3025 for my $data (@data) {
3026 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
3027 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
3028 if (not defined $param{owner} or not length $param{owner}) {
3029 if (not defined $data->{owner} or not length $data->{owner}) {
3030 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
3034 $action = "Removed annotation that $config{bug} was owned by " .
3038 if ($data->{owner} eq $param{owner}) {
3039 print {$transcript} "Ignoring request to set the owner of bug #$data->{bug_num} to the same value\n";
3042 if (length $data->{owner}) {
3043 $action = "Owner changed from $data->{owner} to $param{owner}.";
3046 $action = "Owner recorded as $param{owner}."
3049 my $old_data = dclone($data);
3050 $data->{owner} = $param{owner};
3051 append_action_to_log(bug => $data->{bug_num},
3054 old_data => $old_data,
3056 __return_append_to_log_options(
3061 if not exists $param{append_log} or $param{append_log};
3062 writebug($data->{bug_num},$data);
3063 print {$transcript} "$action\n";
3065 __end_control(%info);
3069 =head1 ARCHIVE FUNCTIONS
3076 bug_archive(bug => $bug_num,
3078 transcript => \$transcript,
3083 transcript("Unable to archive $bug_num\n");
3086 transcript($transcript);
3089 This routine archives a bug
3093 =item bug -- bug number
3095 =item check_archiveable -- check wether a bug is archiveable before
3096 archiving; defaults to 1
3098 =item archive_unarchived -- whether to archive bugs which have not
3099 previously been archived; defaults to 1. [Set to 0 when used from
3102 =item ignore_time -- whether to ignore time constraints when archiving
3103 a bug; defaults to 0.
3110 my %param = validate_with(params => \@_,
3111 spec => {bug => {type => SCALAR,
3114 check_archiveable => {type => BOOLEAN,
3117 archive_unarchived => {type => BOOLEAN,
3120 ignore_time => {type => BOOLEAN,
3124 %append_action_options,
3127 my %info = __begin_control(%param,
3128 command => 'archive',
3130 my ($debug,$transcript) = @info{qw(debug transcript)};
3131 my @data = @{$info{data}};
3132 my @bugs = @{$info{bugs}};
3133 my $action = "$config{bug} archived.";
3134 if ($param{check_archiveable} and
3135 not bug_archiveable(bug=>$param{bug},
3136 ignore_time => $param{ignore_time},
3138 print {$transcript} "Bug $param{bug} cannot be archived\n";
3139 die "Bug $param{bug} cannot be archived";
3141 if (not $param{archive_unarchived} and
3142 not exists $data[0]{unarchived}
3144 print {$transcript} "$param{bug} has not been archived previously\n";
3145 die "$param{bug} has not been archived previously";
3147 add_recipients(recipients => $param{recipients},
3150 transcript => $transcript,
3152 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3153 for my $bug (@bugs) {
3154 if ($param{check_archiveable}) {
3155 die "Bug $bug cannot be archived (but $param{bug} can?)"
3156 unless bug_archiveable(bug=>$bug,
3157 ignore_time => $param{ignore_time},
3161 # If we get here, we can archive/remove this bug
3162 print {$debug} "$param{bug} removing\n";
3163 for my $bug (@bugs) {
3164 #print "$param{bug} removing $bug\n" if $debug;
3165 my $dir = get_hashname($bug);
3166 # First indicate that this bug is being archived
3167 append_action_to_log(bug => $bug,
3169 command => 'archive',
3170 # we didn't actually change the data
3171 # when we archived, so we don't pass
3172 # a real new_data or old_data
3175 __return_append_to_log_options(
3180 if not exists $param{append_log} or $param{append_log};
3181 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
3182 if ($config{save_old_bugs}) {
3183 mkpath("$config{spool_dir}/archive/$dir");
3184 foreach my $file (@files_to_remove) {
3185 link("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3186 copy("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3187 # we need to bail out here if things have
3188 # gone horribly wrong to avoid removing a
3190 die "Unable to link or copy $config{spool_dir}/db-h/$dir/$file to $config{spool_dir}/archive/$dir/$file; $!";
3193 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
3195 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
3196 print {$debug} "deleted $bug (from $param{bug})\n";
3198 bughook_archive(@bugs);
3199 __end_control(%info);
3202 =head2 bug_unarchive
3206 bug_unarchive(bug => $bug_num,
3208 transcript => \$transcript,
3213 transcript("Unable to archive bug: $bug_num");
3215 transcript($transcript);
3217 This routine unarchives a bug
3222 my %param = validate_with(params => \@_,
3223 spec => {bug => {type => SCALAR,
3227 %append_action_options,
3231 my %info = __begin_control(%param,
3233 command=>'unarchive');
3234 my ($debug,$transcript) =
3235 @info{qw(debug transcript)};
3236 my @bugs = @{$info{bugs}};
3237 my $action = "$config{bug} unarchived.";
3238 my @files_to_remove;
3239 for my $bug (@bugs) {
3240 print {$debug} "$param{bug} removing $bug\n";
3241 my $dir = get_hashname($bug);
3242 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
3243 mkpath("archive/$dir");
3244 foreach my $file (@files_to_copy) {
3245 # die'ing here sucks
3246 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3247 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3248 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
3250 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
3251 print {$transcript} "Unarchived $config{bug} $bug\n";
3253 unlink(@files_to_remove) or die "Unable to unlink bugs";
3254 # Indicate that this bug has been archived previously
3255 for my $bug (@bugs) {
3256 my $newdata = readbug($bug);
3257 my $old_data = dclone($newdata);
3258 if (not defined $newdata) {
3259 print {$transcript} "$config{bug} $bug disappeared!\n";
3260 die "Bug $bug disappeared!";
3262 $newdata->{unarchived} = time;
3263 append_action_to_log(bug => $bug,
3265 command => 'unarchive',
3266 new_data => $newdata,
3267 old_data => $old_data,
3268 __return_append_to_log_options(
3273 if not exists $param{append_log} or $param{append_log};
3274 writebug($bug,$newdata);
3276 __end_control(%info);
3279 =head2 append_action_to_log
3281 append_action_to_log
3283 This should probably be moved to Debbugs::Log; have to think that out
3288 sub append_action_to_log{
3289 my %param = validate_with(params => \@_,
3290 spec => {bug => {type => SCALAR,
3293 new_data => {type => HASHREF,
3296 old_data => {type => HASHREF,
3299 command => {type => SCALAR,
3302 action => {type => SCALAR,
3304 requester => {type => SCALAR,
3307 request_addr => {type => SCALAR,
3310 location => {type => SCALAR,
3313 message => {type => SCALAR|ARRAYREF,
3316 recips => {type => SCALAR|ARRAYREF,
3319 desc => {type => SCALAR,
3322 get_lock => {type => BOOLEAN,
3325 locks => {type => HASHREF,
3329 # append_action_options here
3330 # because some of these
3331 # options aren't actually
3332 # optional, even though the
3333 # original function doesn't
3337 # Fix this to use $param{location}
3338 my $log_location = buglog($param{bug});
3339 die "Unable to find .log for $param{bug}"
3340 if not defined $log_location;
3341 if ($param{get_lock}) {
3342 filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
3346 my $logfh = IO::File->new(">>$log_location") or
3347 die "Unable to open $log_location for appending: $!";
3348 # determine difference between old and new
3350 if (exists $param{old_data} and exists $param{new_data}) {
3351 my $old_data = dclone($param{old_data});
3352 my $new_data = dclone($param{new_data});
3353 for my $key (keys %{$old_data}) {
3354 if (not exists $Debbugs::Status::fields{$key}) {
3355 delete $old_data->{$key};
3358 next unless exists $new_data->{$key};
3359 next unless defined $new_data->{$key};
3360 if (not defined $old_data->{$key}) {
3361 delete $old_data->{$key};
3364 if (ref($new_data->{$key}) and
3365 ref($old_data->{$key}) and
3366 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3367 local $Storable::canonical = 1;
3368 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3369 delete $new_data->{$key};
3370 delete $old_data->{$key};
3373 elsif ($new_data->{$key} eq $old_data->{$key}) {
3374 delete $new_data->{$key};
3375 delete $old_data->{$key};
3378 for my $key (keys %{$new_data}) {
3379 if (not exists $Debbugs::Status::fields{$key}) {
3380 delete $new_data->{$key};
3383 next unless exists $old_data->{$key};
3384 next unless defined $old_data->{$key};
3385 if (not defined $new_data->{$key} or
3386 not exists $Debbugs::Status::fields{$key}) {
3387 delete $new_data->{$key};
3390 if (ref($new_data->{$key}) and
3391 ref($old_data->{$key}) and
3392 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3393 local $Storable::canonical = 1;
3394 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3395 delete $new_data->{$key};
3396 delete $old_data->{$key};
3399 elsif ($new_data->{$key} eq $old_data->{$key}) {
3400 delete $new_data->{$key};
3401 delete $old_data->{$key};
3404 $data_diff .= "<!-- new_data:\n";
3406 for my $key (keys %{$new_data}) {
3407 if (not exists $Debbugs::Status::fields{$key}) {
3408 warn "No such field $key";
3411 $nd{$key} = $new_data->{$key};
3412 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n";
3414 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)]));
3415 $data_diff .= "-->\n";
3416 $data_diff .= "<!-- old_data:\n";
3418 for my $key (keys %{$old_data}) {
3419 if (not exists $Debbugs::Status::fields{$key}) {
3420 warn "No such field $key";
3423 $od{$key} = $old_data->{$key};
3424 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $old_data->{$key}")."\n";
3426 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%od)],[qw(old_data)]));
3427 $data_diff .= "-->\n";
3430 (exists $param{command} ?
3431 "<!-- command:".html_escape(encode_utf8_safely($param{command}))." -->\n":""
3433 (length $param{requester} ?
3434 "<!-- requester: ".html_escape(encode_utf8_safely($param{requester}))." -->\n":""
3436 (length $param{request_addr} ?
3437 "<!-- request_addr: ".html_escape(encode_utf8_safely($param{request_addr}))." -->\n":""
3439 "<!-- time:".time()." -->\n",
3441 "<strong>".html_escape(encode_utf8_safely($param{action}))."</strong>\n");
3442 if (length $param{requester}) {
3443 $msg .= "Request was from <code>".html_escape(encode_utf8_safely($param{requester}))."</code>\n";
3445 if (length $param{request_addr}) {
3446 $msg .= "to <code>".html_escape(encode_utf8_safely($param{request_addr}))."</code>";
3448 if (length $param{desc}) {
3449 $msg .= ":<br>\n".encode_utf8_safely($param{desc})."\n";
3454 push @records, {type => 'html',
3458 if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
3459 push @records, {type => exists $param{recips}?'recips':'incoming-recv',
3460 exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(),
3461 text => join('',make_list($param{message})),
3464 write_log_records(logfh=>$logfh,
3465 records => \@records,
3467 close $logfh or die "Unable to close $log_location: $!";
3468 if ($param{get_lock}) {
3469 unfilelock(exists $param{locks}?$param{locks}:());
3477 =head1 PRIVATE FUNCTIONS
3479 =head2 __handle_affected_packages
3481 __handle_affected_packages(affected_packages => {},
3489 sub __handle_affected_packages{
3490 my %param = validate_with(params => \@_,
3491 spec => {%common_options,
3492 data => {type => ARRAYREF|HASHREF
3497 for my $data (make_list($param{data})) {
3498 next unless exists $data->{package} and defined $data->{package};
3499 my @packages = split /\s*,\s*/,$data->{package};
3500 @{$param{affected_packages}}{@packages} = (1) x @packages;
3504 =head2 __handle_debug_transcript
3506 my ($debug,$transcript) = __handle_debug_transcript(%param);
3508 Returns a debug and transcript filehandle
3513 sub __handle_debug_transcript{
3514 my %param = validate_with(params => \@_,
3515 spec => {%common_options},
3518 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
3519 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3520 return ($debug,$transcript);
3527 Produces a small bit of bug information to kick out to the transcript
3534 next unless defined $data and exists $data->{bug_num};
3535 $return .= "Bug #".($data->{bug_num}||'').
3536 ((defined $data->{done} and length $data->{done})?
3537 " {Done: $data->{done}}":''
3539 " [".($data->{package}||'(no package)'). "] ".
3540 ($data->{subject}||'(no subject)')."\n";
3546 =head2 __internal_request
3548 __internal_request()
3549 __internal_request($level)
3551 Returns true if the caller of the function calling __internal_request
3552 belongs to __PACKAGE__
3554 This allows us to be magical, and don't bother to print bug info if
3555 the second caller is from this package, amongst other things.
3557 An optional level is allowed, which increments the number of levels to
3558 check by the given value. [This is basically for use by internal
3559 functions like __begin_control which are always called by
3564 sub __internal_request{
3566 $l = 0 if not defined $l;
3567 if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
3573 sub __return_append_to_log_options{
3575 my $action = $param{action} if exists $param{action};
3576 if (not exists $param{requester}) {
3577 $param{requester} = $config{control_internal_requester};
3579 if (not exists $param{request_addr}) {
3580 $param{request_addr} = $config{control_internal_request_addr};
3582 if (not exists $param{message}) {
3583 my $date = rfc822_date();
3585 encode_headers(fill_in_template(template => 'mail/fake_control_message',
3586 variables => {request_addr => $param{request_addr},
3587 requester => $param{requester},
3593 if (not defined $action) {
3594 carp "Undefined action!";
3595 $action = "unknown action";
3597 return (action => $action,
3598 hash_slice(%param,keys %append_action_options),
3602 =head2 __begin_control
3604 my %info = __begin_control(%param,
3606 command=>'unarchive');
3607 my ($debug,$transcript) = @info{qw(debug transcript)};
3608 my @data = @{$info{data}};
3609 my @bugs = @{$info{bugs}};
3612 Starts the process of modifying a bug; handles all of the generic
3613 things that almost every control request needs
3615 Returns a hash containing
3619 =item new_locks -- number of new locks taken out by this call
3621 =item debug -- the debug file handle
3623 =item transcript -- the transcript file handle
3625 =item data -- an arrayref containing the data of the bugs
3626 corresponding to this request
3628 =item bugs -- an arrayref containing the bug numbers of the bugs
3629 corresponding to this request
3637 sub __begin_control {
3638 my %param = validate_with(params => \@_,
3639 spec => {bug => {type => SCALAR,
3642 archived => {type => BOOLEAN,
3645 command => {type => SCALAR,
3653 my ($debug,$transcript) = __handle_debug_transcript(@_);
3654 print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
3655 # print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
3656 $lockhash = $param{locks} if exists $param{locks};
3658 my $old_die = $SIG{__DIE__};
3659 $SIG{__DIE__} = *sig_die{CODE};
3661 ($new_locks, @data) =
3662 lock_read_all_merged_bugs(bug => $param{bug},
3663 $param{archived}?(location => 'archive'):(),
3664 exists $param{locks} ? (locks => $param{locks}):(),
3666 $locks += $new_locks;
3668 die "Unable to read any bugs successfully.";
3670 if (not $param{archived}) {
3671 for my $data (@data) {
3672 if ($data->{archived}) {
3673 die "Not altering archived bugs; see unarchive.";
3677 if (not check_limit(data => \@data,
3678 exists $param{limit}?(limit => $param{limit}):(),
3679 transcript => $transcript,
3681 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
3684 __handle_affected_packages(%param,data => \@data);
3685 print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
3686 print {$debug} "$param{bug} read $locks locks\n";
3687 if (not @data or not defined $data[0]) {
3688 print {$transcript} "No bug found for $param{bug}\n";
3689 die "No bug found for $param{bug}";
3692 add_recipients(data => \@data,
3693 recipients => $param{recipients},
3694 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
3696 (__internal_request()?(transcript => $transcript):()),
3699 print {$debug} "$param{bug} read done\n";
3700 my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
3701 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3702 return (data => \@data,
3704 old_die => $old_die,
3705 new_locks => $new_locks,
3707 transcript => $transcript,
3709 exists $param{locks}?(locks => $param{locks}):(),
3713 =head2 __end_control
3715 __end_control(%info);
3717 Handles tearing down from a control request
3723 if (exists $info{new_locks} and $info{new_locks} > 0) {
3724 print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
3725 for (1..$info{new_locks}) {
3726 unfilelock(exists $info{locks}?$info{locks}:());
3730 $SIG{__DIE__} = $info{old_die};
3731 if (exists $info{param}{affected_bugs}) {
3732 @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
3734 add_recipients(recipients => $info{param}{recipients},
3735 (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
3736 data => $info{data},
3737 debug => $info{debug},
3738 transcript => $info{transcript},
3740 __handle_affected_packages(%{$info{param}},data=>$info{data});
3746 check_limit(data => \@data, limit => $param{limit});
3749 Checks to make sure that bugs match any limits; each entry of @data
3750 much satisfy the limit.
3752 Returns true if there are no entries in data, or there are no keys in
3753 limit; returns false (0) if there are any entries which do not match.
3755 The limit hashref elements can contain an arrayref of scalars to
3756 match; regexes are also acccepted. At least one of the entries in each
3757 element needs to match the corresponding field in all data for the
3764 my %param = validate_with(params => \@_,
3765 spec => {data => {type => ARRAYREF|HASHREF,
3767 limit => {type => HASHREF|UNDEF,
3769 transcript => {type => SCALARREF|HANDLE,
3774 my @data = make_list($param{data});
3776 not defined $param{limit} or
3777 not keys %{$param{limit}}) {
3780 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3781 my $going_to_fail = 0;
3782 for my $data (@data) {
3783 $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
3784 status => dclone($data),
3786 for my $field (keys %{$param{limit}}) {
3787 next unless exists $param{limit}{$field};
3789 my @data_fields = make_list($data->{$field});
3790 LIMIT: for my $limit (make_list($param{limit}{$field})) {
3791 if (not ref $limit) {
3792 for my $data_field (@data_fields) {
3793 if ($data_field eq $limit) {
3799 elsif (ref($limit) eq 'Regexp') {
3800 for my $data_field (@data_fields) {
3801 if ($data_field =~ $limit) {
3808 warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
3813 print {$transcript} qq($field: ').join(', ',map{qq("$_")} make_list($data->{$field})).
3814 "' does not match at least one of ".
3815 join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
3819 return $going_to_fail?0:1;
3827 We override die to specially handle unlocking files in the cases where
3828 we are called via eval. [If we're not called via eval, it doesn't
3834 if ($^S) { # in eval
3836 for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
3843 # =head2 __message_body_template
3845 # message_body_template('mail/ack',{ref=>'foo'});
3847 # Creates a message body using a template
3851 sub __message_body_template{
3852 my ($template,$extra_var) = @_;
3854 my $hole_var = {'&bugurl' =>
3856 $config{cgi_domain}.'/'.
3857 Debbugs::CGI::bug_links(bug => $_[0],
3863 my $body = fill_in_template(template => $template,
3864 variables => {config => \%config,
3867 hole_var => $hole_var,
3869 return fill_in_template(template => 'mail/message_body',
3870 variables => {config => \%config,
3874 hole_var => $hole_var,
3878 sub __all_undef_or_equal {
3880 return 1 if @values == 1 or @values == 0;
3881 my $not_def = grep {not defined $_} @values;
3882 if ($not_def == @values) {
3885 if ($not_def > 0 and $not_def != @values) {
3888 my $first_val = shift @values;
3889 for my $val (@values) {
3890 if ($first_val ne $val) {