1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007,2008,2009 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Control;
14 Debbugs::Control -- Routines for modifying the state of bugs
23 This module is an abstraction of a lot of functions which originally
24 were only present in service.in, but as time has gone on needed to be
25 called from elsewhere.
27 All of the public functions take the following options:
31 =item debug -- scalar reference to which debbuging information is
34 =item transcript -- scalar reference to which transcript information
37 =item affected_bugs -- hashref which is updated with bugs affected by
43 Functions which should (probably) append to the .log file take the
48 =item requester -- Email address of the individual who requested the change
50 =item request_addr -- Address to which the request was sent
52 =item request_nn -- Name of queue file which caused this request
54 =item request_msgid -- Message id of message which caused this request
56 =item location -- Optional location; currently ignored but may be
57 supported in the future for updating archived bugs upon archival
59 =item message -- The original message which caused the action to be taken
61 =item append_log -- Whether or not to append information to the log.
65 B<append_log> (for most functions) is a special option. When set to
66 false, no appending to the log is done at all. When it is not present,
67 the above information is faked, and appended to the log file. When it
68 is true, the above options must be present, and their values are used.
71 =head1 GENERAL FUNCTIONS
77 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
78 use base qw(Exporter);
82 $DEBUG = 0 unless defined $DEBUG;
85 %EXPORT_TAGS = (done => [qw(set_done)],
86 submitter => [qw(set_submitter)],
87 severity => [qw(set_severity)],
88 affects => [qw(affects)],
89 summary => [qw(summary)],
90 outlook => [qw(outlook)],
92 title => [qw(set_title)],
93 forward => [qw(set_forwarded)],
94 found => [qw(set_found set_fixed)],
95 fixed => [qw(set_found set_fixed)],
96 package => [qw(set_package)],
97 block => [qw(set_blocks)],
98 merge => [qw(set_merged)],
100 clone => [qw(clone_bug)],
101 archive => [qw(bug_archive bug_unarchive),
103 limit => [qw(check_limit)],
104 log => [qw(append_action_to_log),
108 Exporter::export_ok_tags(keys %EXPORT_TAGS);
109 $EXPORT_TAGS{all} = [@EXPORT_OK];
112 use Debbugs::Config qw(:config);
113 use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions :utf8);
114 use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
115 use Debbugs::CGI qw(html_escape);
116 use Debbugs::Log qw(:misc :write);
117 use Debbugs::Recipients qw(:add);
118 use Debbugs::Packages qw(:versions :mapping);
120 use Data::Dumper qw();
121 use Params::Validate qw(validate_with :types);
122 use File::Path qw(mkpath);
123 use File::Copy qw(copy);
126 use Debbugs::Text qw(:templates);
128 use Debbugs::Mail qw(rfc822_date send_mail_message default_headers);
129 use Debbugs::MIME qw(create_mime_message);
131 use Mail::RFC822::Address qw();
133 use POSIX qw(strftime);
135 use Storable qw(dclone nfreeze);
136 use List::Util qw(first max);
137 use Encode qw(encode_utf8);
141 # These are a set of options which are common to all of these functions
143 my %common_options = (debug => {type => SCALARREF|HANDLE,
146 transcript => {type => SCALARREF|HANDLE,
149 affected_bugs => {type => HASHREF,
152 affected_packages => {type => HASHREF,
155 recipients => {type => HASHREF,
158 limit => {type => HASHREF,
161 show_bug_info => {type => BOOLEAN,
164 request_subject => {type => SCALAR,
165 default => 'Unknown Subject',
167 request_msgid => {type => SCALAR,
170 request_nn => {type => SCALAR,
173 request_replyto => {type => SCALAR,
176 locks => {type => HASHREF,
182 my %append_action_options =
183 (action => {type => SCALAR,
186 requester => {type => SCALAR,
189 request_addr => {type => SCALAR,
192 location => {type => SCALAR,
195 message => {type => SCALAR|ARRAYREF,
198 append_log => {type => BOOLEAN,
200 depends => [qw(requester request_addr),
204 # locks is both an append_action option, and a common option;
205 # it's ok for it to be in both places.
206 locks => {type => HASHREF,
214 # this is just a generic stub for Debbugs::Control functions.
219 # set_foo(bug => $ref,
220 # transcript => $transcript,
221 # ($dl > 0 ? (debug => $transcript):()),
222 # requester => $header{from},
223 # request_addr => $controlrequestaddr,
225 # affected_packages => \%affected_packages,
226 # recipients => \%recipients,
232 # print {$transcript} "Failed to set foo $ref bar: $@";
240 # my %param = validate_with(params => \@_,
241 # spec => {bug => {type => SCALAR,
242 # regex => qr/^\d+$/,
244 # # specific options here
246 # %append_action_options,
250 # __begin_control(%param,
253 # my ($debug,$transcript) =
254 # @info{qw(debug transcript)};
255 # my @data = @{$info{data}};
256 # my @bugs = @{$info{bugs}};
259 # for my $data (@data) {
260 # append_action_to_log(bug => $data->{bug_num},
262 # __return_append_to_log_options(
267 # if not exists $param{append_log} or $param{append_log};
268 # writebug($data->{bug_num},$data);
269 # print {$transcript} "$action\n";
271 # __end_control(%info);
278 set_block(bug => $ref,
279 transcript => $transcript,
280 ($dl > 0 ? (debug => $transcript):()),
281 requester => $header{from},
282 request_addr => $controlrequestaddr,
284 affected_packages => \%affected_packages,
285 recipients => \%recipients,
291 print {$transcript} "Failed to set blockers of $ref: $@";
294 Alters the set of bugs that block this bug from being fixed
296 This requires altering both this bug (and those it's merged with) as
297 well as the bugs that block this bug from being fixed (and those that
302 =item block -- scalar or arrayref of blocking bugs to set, add or remove
304 =item add -- if true, add blocking bugs
306 =item remove -- if true, remove blocking bugs
313 my %param = validate_with(params => \@_,
314 spec => {bug => {type => SCALAR,
317 # specific options here
318 block => {type => SCALAR|ARRAYREF,
321 add => {type => BOOLEAN,
324 remove => {type => BOOLEAN,
328 %append_action_options,
331 if ($param{add} and $param{remove}) {
332 croak "It's nonsensical to add and remove the same blocking bugs";
334 if (grep {$_ !~ /^\d+$/} make_list($param{block})) {
335 croak "Invalid blocking bug(s):".
336 join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
342 elsif ($param{remove}) {
347 __begin_control(%param,
350 my ($debug,$transcript) =
351 @info{qw(debug transcript)};
352 my @data = @{$info{data}};
353 my @bugs = @{$info{bugs}};
356 # The first bit of this code is ugly, and should be cleaned up.
357 # Its purpose is to populate %removed_blockers and %add_blockers
358 # with all of the bugs that should be added or removed as blockers
359 # of all of the bugs which are merged with $param{bug}
362 for my $blocker (make_list($param{block})) {
363 next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
364 my $data = read_bug(bug=>$blocker,
366 if (defined $data and not $data->{archive}) {
367 $data = split_status_fields($data);
368 $ok_blockers{$blocker} = 1;
370 push @merged_bugs, make_list($data->{mergedwith});
371 @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
374 $bad_blockers{$blocker} = 1;
378 # throw an error if we are setting the blockers and there is a bad
380 if (keys %bad_blockers and $mode eq 'set') {
381 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
382 keys %ok_blockers?'':" and no known blocking bug(s)";
384 # if there are no ok blockers and we are not setting the blockers,
386 if (not keys %ok_blockers and $mode ne 'set') {
387 print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
388 if (keys %bad_blockers) {
389 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
391 __end_control(%info);
395 my @change_blockers = keys %ok_blockers;
397 my %removed_blockers;
400 my @blockers = map {split ' ', $_->{blockedby}} @data;
402 @blockers{@blockers} = (1) x @blockers;
404 # it is nonsensical for a bug to block itself (or a merged
405 # partner); We currently don't allow removal because we'd possibly
409 @bugs{@bugs} = (1) x @bugs;
410 for my $blocker (@change_blockers) {
411 if ($bugs{$blocker}) {
412 croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
415 @blockers = keys %blockers;
417 %removed_blockers = ();
418 for my $blocker (@change_blockers) {
419 next if exists $blockers{$blocker};
420 $blockers{$blocker} = 1;
421 $added_blockers{$blocker} = 1;
424 elsif ($param{remove}) {
425 %added_blockers = ();
426 for my $blocker (@change_blockers) {
427 next if exists $removed_blockers{$blocker};
428 delete $blockers{$blocker};
429 $removed_blockers{$blocker} = 1;
433 @removed_blockers{@blockers} = (1) x @blockers;
435 for my $blocker (@change_blockers) {
436 next if exists $blockers{$blocker};
437 $blockers{$blocker} = 1;
438 if (exists $removed_blockers{$blocker}) {
439 delete $removed_blockers{$blocker};
442 $added_blockers{$blocker} = 1;
446 my @new_blockers = keys %blockers;
447 for my $data (@data) {
448 my $old_data = dclone($data);
449 # remove blockers and/or add new ones as appropriate
450 if ($data->{blockedby} eq '') {
451 print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n";
453 print {$transcript} "$data->{bug_num} was blocked by: $data->{blockedby}\n";
455 if ($data->{blocks} eq '') {
456 print {$transcript} "$data->{bug_num} was not blocking any bugs.\n";
458 print {$transcript} "$data->{bug_num} was blocking: $data->{blocks}\n";
461 push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
462 push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
463 $action = ucfirst(join ('; ',@changed)) if @changed;
465 print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n";
468 $data->{blockedby} = join(' ',keys %blockers);
469 append_action_to_log(bug => $data->{bug_num},
471 old_data => $old_data,
474 __return_append_to_log_options(
479 if not exists $param{append_log} or $param{append_log};
480 writebug($data->{bug_num},$data);
481 print {$transcript} "$action\n";
483 # we do this bit below to avoid code duplication
485 $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
486 $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
488 for my $add_remove (keys %mungable_blocks) {
492 for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
493 next if $munge_blockers{$blocker};
494 my ($temp_locks, @blocking_data) =
495 lock_read_all_merged_bugs(bug => $blocker,
496 ($param{archived}?(location => 'archive'):()),
497 exists $param{locks}?(locks => $param{locks}):(),
499 $locks+= $temp_locks;
500 $new_locks+=$temp_locks;
501 if (not @blocking_data) {
502 for (1..$new_locks) {
503 unfilelock(exists $param{locks}?$param{locks}:());
506 die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
508 for (map {$_->{bug_num}} @blocking_data) {
509 $munge_blockers{$_} = 1;
511 for my $data (@blocking_data) {
512 my $old_data = dclone($data);
514 my @blocks = split ' ', $data->{blocks};
515 @blocks{@blocks} = (1) x @blocks;
517 for my $bug (@bugs) {
518 if ($add_remove eq 'remove') {
519 next unless exists $blocks{$bug};
520 delete $blocks{$bug};
523 next if exists $blocks{$bug};
528 $data->{blocks} = join(' ',sort keys %blocks);
529 my $action = ($add_remove eq 'add'?'Added':'Removed').
530 " indication that bug $data->{bug_num} blocks ".
532 append_action_to_log(bug => $data->{bug_num},
534 old_data => $old_data,
537 __return_append_to_log_options(%param,
541 writebug($data->{bug_num},$data);
543 __handle_affected_packages(%param,data=>\@blocking_data);
544 add_recipients(recipients => $param{recipients},
545 actions_taken => {blocks => 1},
546 data => \@blocking_data,
548 transcript => $transcript,
551 for (1..$new_locks) {
552 unfilelock(exists $param{locks}?$param{locks}:());
557 __end_control(%info);
566 transcript => $transcript,
567 ($dl > 0 ? (debug => $transcript):()),
568 requester => $header{from},
569 request_addr => $controlrequestaddr,
571 affected_packages => \%affected_packages,
572 recipients => \%recipients,
579 print {$transcript} "Failed to set tag on $ref: $@";
583 Sets, adds, or removes the specified tags on a bug
587 =item tag -- scalar or arrayref of tags to set, add or remove
589 =item add -- if true, add tags
591 =item remove -- if true, remove tags
593 =item warn_on_bad_tags -- if true (the default) warn if bad tags are
601 my %param = validate_with(params => \@_,
602 spec => {bug => {type => SCALAR,
605 # specific options here
606 tag => {type => SCALAR|ARRAYREF,
609 add => {type => BOOLEAN,
612 remove => {type => BOOLEAN,
615 warn_on_bad_tags => {type => BOOLEAN,
619 %append_action_options,
622 if ($param{add} and $param{remove}) {
623 croak "It's nonsensical to add and remove the same tags";
627 __begin_control(%param,
630 my ($debug,$transcript) =
631 @info{qw(debug transcript)};
632 my @data = @{$info{data}};
633 my @bugs = @{$info{bugs}};
634 my @tags = make_list($param{tag});
635 if (not @tags and ($param{remove} or $param{add})) {
636 if ($param{remove}) {
637 print {$transcript} "Requested to remove no tags; doing nothing.\n";
640 print {$transcript} "Requested to add no tags; doing nothing.\n";
642 __end_control(%info);
645 # first things first, make the versions fully qualified source
647 for my $data (@data) {
648 my $action = 'Did not alter tags';
650 my %tag_removed = ();
651 my %fixed_removed = ();
652 my @old_tags = split /\,?\s+/, $data->{keywords};
654 @tags{@old_tags} = (1) x @old_tags;
656 my $old_data = dclone($data);
657 if (not $param{add} and not $param{remove}) {
658 $tag_removed{$_} = 1 for @old_tags;
662 for my $tag (@tags) {
663 if (not $param{remove} and
664 not defined first {$_ eq $tag} @{$config{tags}}) {
665 push @bad_tags, $tag;
669 if (not exists $tags{$tag}) {
671 $tag_added{$tag} = 1;
674 elsif ($param{remove}) {
675 if (exists $tags{$tag}) {
677 $tag_removed{$tag} = 1;
681 if (exists $tag_removed{$tag}) {
682 delete $tag_removed{$tag};
685 $tag_added{$tag} = 1;
690 if (@bad_tags and $param{warn_on_bad_tags}) {
691 print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
692 print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
694 $data->{keywords} = join(' ',keys %tags);
697 push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
698 push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
699 $action = ucfirst(join ('; ',@changed)) if @changed;
701 print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
705 append_action_to_log(bug => $data->{bug_num},
708 old_data => $old_data,
710 __return_append_to_log_options(
715 if not exists $param{append_log} or $param{append_log};
716 writebug($data->{bug_num},$data);
717 print {$transcript} "$action\n";
719 __end_control(%info);
727 set_severity(bug => $ref,
728 transcript => $transcript,
729 ($dl > 0 ? (debug => $transcript):()),
730 requester => $header{from},
731 request_addr => $controlrequestaddr,
733 affected_packages => \%affected_packages,
734 recipients => \%recipients,
735 severity => 'normal',
740 print {$transcript} "Failed to set the severity of bug $ref: $@";
743 Sets the severity of a bug. If severity is not passed, is undefined,
744 or has zero length, sets the severity to the default severity.
749 my %param = validate_with(params => \@_,
750 spec => {bug => {type => SCALAR,
753 # specific options here
754 severity => {type => SCALAR|UNDEF,
755 default => $config{default_severity},
758 %append_action_options,
761 if (not defined $param{severity} or
762 not length $param{severity}
764 $param{severity} = $config{default_severity};
767 # check validity of new severity
768 if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) {
769 die "Severity '$param{severity}' is not a valid severity level";
772 __begin_control(%param,
773 command => 'severity'
775 my ($debug,$transcript) =
776 @info{qw(debug transcript)};
777 my @data = @{$info{data}};
778 my @bugs = @{$info{bugs}};
781 for my $data (@data) {
782 if (not defined $data->{severity}) {
783 $data->{severity} = $param{severity};
784 $action = "Severity set to '$param{severity}'";
787 if ($data->{severity} eq '') {
788 $data->{severity} = $config{default_severity};
790 if ($data->{severity} eq $param{severity}) {
791 print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
794 $action = "Severity set to '$param{severity}' from '$data->{severity}'";
795 $data->{severity} = $param{severity};
797 append_action_to_log(bug => $data->{bug_num},
799 __return_append_to_log_options(
804 if not exists $param{append_log} or $param{append_log};
805 writebug($data->{bug_num},$data);
806 print {$transcript} "$action\n";
808 __end_control(%info);
815 set_done(bug => $ref,
816 transcript => $transcript,
817 ($dl > 0 ? (debug => $transcript):()),
818 requester => $header{from},
819 request_addr => $controlrequestaddr,
821 affected_packages => \%affected_packages,
822 recipients => \%recipients,
827 print {$transcript} "Failed to set foo $ref bar: $@";
835 my %param = validate_with(params => \@_,
836 spec => {bug => {type => SCALAR,
839 reopen => {type => BOOLEAN,
842 submitter => {type => SCALAR,
845 clear_fixed => {type => BOOLEAN,
848 notify_submitter => {type => BOOLEAN,
851 original_report => {type => SCALARREF,
854 done => {type => SCALAR|UNDEF,
858 %append_action_options,
862 if (exists $param{submitter} and
863 not Mail::RFC822::Address::valid($param{submitter})) {
864 die "New submitter address '$param{submitter}' is not a valid e-mail address";
866 if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
867 $param{done} = $param{requester};
869 if (exists $param{done} and
870 (not defined $param{done} or
871 not length $param{done})) {
877 __begin_control(%param,
878 command => $param{reopen}?'reopen':'done',
880 my ($debug,$transcript) =
881 @info{qw(debug transcript)};
882 my @data = @{$info{data}};
883 my @bugs = @{$info{bugs}};
886 if ($param{reopen}) {
887 # avoid warning multiple times if there are fixed versions
889 for my $data (@data) {
890 if (not exists $data->{done} or
891 not defined $data->{done} or
892 not length $data->{done}) {
893 print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
894 __end_control(%info);
897 if (@{$data->{fixed_versions}} and $warn_fixed) {
898 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
899 print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
903 $action = "Bug reopened";
904 for my $data (@data) {
905 my $old_data = dclone($data);
907 append_action_to_log(bug => $data->{bug_num},
910 old_data => $old_data,
912 __return_append_to_log_options(
917 if not exists $param{append_log} or $param{append_log};
918 writebug($data->{bug_num},$data);
920 print {$transcript} "$action\n";
921 __end_control(%info);
922 if (exists $param{submitter}) {
923 set_submitter(bug => $param{bug},
924 submitter => $param{submitter},
926 keys %common_options,
927 keys %append_action_options)
930 # clear the fixed revisions
931 if ($param{clear_fixed}) {
932 set_fixed(fixed => [],
936 keys %common_options,
937 keys %append_action_options),
942 my %submitter_notified;
943 my $requester_notified = 0;
944 my $orig_report_set = 0;
945 for my $data (@data) {
946 if (exists $data->{done} and
947 defined $data->{done} and
948 length $data->{done}) {
949 print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n";
950 __end_control(%info);
954 for my $data (@data) {
955 my $old_data = dclone($data);
956 my $hash = get_hashname($data->{bug_num});
957 my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or
958 die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!";
962 $orig_report= <$report_fh>;
965 if (not $orig_report_set and defined $orig_report and
966 length $orig_report and
967 exists $param{original_report}){
968 ${$param{original_report}} = $orig_report;
969 $orig_report_set = 1;
972 $action = "Marked $config{bug} as done";
974 # set done to the requester
975 $data->{done} = exists $param{done}?$param{done}:$param{requester};
976 append_action_to_log(bug => $data->{bug_num},
979 old_data => $old_data,
981 __return_append_to_log_options(
986 if not exists $param{append_log} or $param{append_log};
987 writebug($data->{bug_num},$data);
988 print {$transcript} "$action\n";
989 # get the original report
990 if ($param{notify_submitter}) {
991 my $submitter_message;
992 if(not exists $submitter_notified{$data->{originator}}) {
994 create_mime_message([default_headers(queue_file => $param{request_nn},
996 msgid => $param{request_msgid},
997 msgtype => 'notifdone',
998 pr_msg => 'they-closed',
1000 [To => $data->{submitter},
1001 Subject => "$config{ubug}#$data->{bug_num} ".
1002 "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
1006 __message_body_template('mail/process_your_bug_done',
1008 replyto => (exists $param{request_replyto} ?
1009 $param{request_replyto} :
1010 $param{requester} || 'Unknown'),
1011 markedby => $param{requester},
1012 subject => $param{request_subject},
1013 messageid => $param{request_msgid},
1016 [join('',make_list($param{message})),$orig_report]
1018 send_mail_message(message => $submitter_message,
1019 recipients => $old_data->{submitter},
1021 $submitter_notified{$data->{originator}} = $submitter_message;
1024 $submitter_message = $submitter_notified{$data->{originator}};
1026 append_action_to_log(bug => $data->{bug_num},
1027 action => "Notification sent",
1029 request_addr => $data->{originator},
1030 desc => "$config{bug} acknowledged by developer.",
1031 recips => [$data->{originator}],
1032 message => $submitter_message,
1037 __end_control(%info);
1038 if (exists $param{fixed}) {
1039 set_fixed(fixed => $param{fixed},
1043 keys %common_options,
1044 keys %append_action_options
1052 =head2 set_submitter
1055 set_submitter(bug => $ref,
1056 transcript => $transcript,
1057 ($dl > 0 ? (debug => $transcript):()),
1058 requester => $header{from},
1059 request_addr => $controlrequestaddr,
1061 affected_packages => \%affected_packages,
1062 recipients => \%recipients,
1063 submitter => $new_submitter,
1064 notify_submitter => 1,
1069 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1072 Sets the submitter of a bug. If notify_submitter is true (the
1073 default), notifies the old submitter of a bug on changes
1078 my %param = validate_with(params => \@_,
1079 spec => {bug => {type => SCALAR,
1082 # specific options here
1083 submitter => {type => SCALAR,
1085 notify_submitter => {type => BOOLEAN,
1089 %append_action_options,
1092 if (not Mail::RFC822::Address::valid($param{submitter})) {
1093 die "New submitter address $param{submitter} is not a valid e-mail address";
1096 __begin_control(%param,
1097 command => 'submitter'
1099 my ($debug,$transcript) =
1100 @info{qw(debug transcript)};
1101 my @data = @{$info{data}};
1102 my @bugs = @{$info{bugs}};
1104 # here we only concern ourselves with the first of the merged bugs
1105 for my $data ($data[0]) {
1106 my $notify_old_submitter = 0;
1107 my $old_data = dclone($data);
1108 print {$debug} "Going to change bug submitter\n";
1109 if (((not defined $param{submitter} or not length $param{submitter}) and
1110 (not defined $data->{originator} or not length $data->{originator})) or
1111 (defined $param{submitter} and defined $data->{originator} and
1112 $param{submitter} eq $data->{originator})) {
1113 print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
1117 if (defined $data->{originator} and length($data->{originator})) {
1118 $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'";
1119 $notify_old_submitter = 1;
1122 $action= "Set $config{bug} submitter to '$param{submitter}'.";
1124 $data->{originator} = $param{submitter};
1126 append_action_to_log(bug => $data->{bug_num},
1127 command => 'submitter',
1129 old_data => $old_data,
1131 __return_append_to_log_options(
1136 if not exists $param{append_log} or $param{append_log};
1137 writebug($data->{bug_num},$data);
1138 print {$transcript} "$action\n";
1139 # notify old submitter
1140 if ($notify_old_submitter and $param{notify_submitter}) {
1141 send_mail_message(message =>
1142 create_mime_message([default_headers(queue_file => $param{request_nn},
1144 msgid => $param{request_msgid},
1146 pr_msg => 'submitter-changed',
1148 [To => $old_data->{submitter},
1149 Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
1153 __message_body_template('mail/submitter_changed',
1154 {old_data => $old_data,
1156 replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
1160 recipients => $old_data->{submitter},
1164 __end_control(%info);
1169 =head2 set_forwarded
1172 set_forwarded(bug => $ref,
1173 transcript => $transcript,
1174 ($dl > 0 ? (debug => $transcript):()),
1175 requester => $header{from},
1176 request_addr => $controlrequestaddr,
1178 affected_packages => \%affected_packages,
1179 recipients => \%recipients,
1180 forwarded => $forward_to,
1185 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1188 Sets the location to which a bug is forwarded. Given an undef
1189 forwarded, unsets forwarded.
1195 my %param = validate_with(params => \@_,
1196 spec => {bug => {type => SCALAR,
1199 # specific options here
1200 forwarded => {type => SCALAR|UNDEF,
1203 %append_action_options,
1206 if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
1207 die "Non-printable characters are not allowed in the forwarded field";
1209 $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded};
1211 __begin_control(%param,
1212 command => 'forwarded'
1214 my ($debug,$transcript) =
1215 @info{qw(debug transcript)};
1216 my @data = @{$info{data}};
1217 my @bugs = @{$info{bugs}};
1219 for my $data (@data) {
1220 my $old_data = dclone($data);
1221 print {$debug} "Going to change bug forwarded\n";
1222 if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or
1223 (not defined $param{forwarded} and
1224 defined $data->{forwarded} and not length $data->{forwarded})) {
1225 print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n";
1229 if (not defined $param{forwarded}) {
1230 $action= "Unset $config{bug} forwarded-to-address";
1232 elsif (defined $data->{forwarded} and length($data->{forwarded})) {
1233 $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'";
1236 $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
1238 $data->{forwarded} = $param{forwarded};
1240 append_action_to_log(bug => $data->{bug_num},
1241 command => 'forwarded',
1243 old_data => $old_data,
1245 __return_append_to_log_options(
1250 if not exists $param{append_log} or $param{append_log};
1251 writebug($data->{bug_num},$data);
1252 print {$transcript} "$action\n";
1254 __end_control(%info);
1263 set_title(bug => $ref,
1264 transcript => $transcript,
1265 ($dl > 0 ? (debug => $transcript):()),
1266 requester => $header{from},
1267 request_addr => $controlrequestaddr,
1269 affected_packages => \%affected_packages,
1270 recipients => \%recipients,
1271 title => $new_title,
1276 print {$transcript} "Failed to set the title of $ref: $@";
1279 Sets the title of a specific bug
1285 my %param = validate_with(params => \@_,
1286 spec => {bug => {type => SCALAR,
1289 # specific options here
1290 title => {type => SCALAR,
1293 %append_action_options,
1296 if ($param{title} =~ /[^[:print:]]/) {
1297 die "Non-printable characters are not allowed in bug titles";
1300 my %info = __begin_control(%param,
1303 my ($debug,$transcript) =
1304 @info{qw(debug transcript)};
1305 my @data = @{$info{data}};
1306 my @bugs = @{$info{bugs}};
1308 for my $data (@data) {
1309 my $old_data = dclone($data);
1310 print {$debug} "Going to change bug title\n";
1311 if (defined $data->{subject} and length($data->{subject}) and
1312 $data->{subject} eq $param{title}) {
1313 print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
1317 if (defined $data->{subject} and length($data->{subject})) {
1318 $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'";
1320 $action= "Set $config{bug} title to '$param{title}'.";
1322 $data->{subject} = $param{title};
1324 append_action_to_log(bug => $data->{bug_num},
1327 old_data => $old_data,
1329 __return_append_to_log_options(
1334 if not exists $param{append_log} or $param{append_log};
1335 writebug($data->{bug_num},$data);
1336 print {$transcript} "$action\n";
1338 __end_control(%info);
1345 set_package(bug => $ref,
1346 transcript => $transcript,
1347 ($dl > 0 ? (debug => $transcript):()),
1348 requester => $header{from},
1349 request_addr => $controlrequestaddr,
1351 affected_packages => \%affected_packages,
1352 recipients => \%recipients,
1353 package => $new_package,
1359 print {$transcript} "Failed to assign or reassign $ref to a package: $@";
1362 Indicates that a bug is in a particular package. If is_source is true,
1363 indicates that the package is a source package. [Internally, this
1364 causes src: to be prepended to the package name.]
1366 The default for is_source is 0. As a special case, if the package
1367 starts with 'src:', it is assumed to be a source package and is_source
1370 The package option must match the package_name_re regex.
1375 my %param = validate_with(params => \@_,
1376 spec => {bug => {type => SCALAR,
1379 # specific options here
1380 package => {type => SCALAR|ARRAYREF,
1382 is_source => {type => BOOLEAN,
1386 %append_action_options,
1389 my @new_packages = map {splitpackages($_)} make_list($param{package});
1390 if (grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages) {
1391 croak "Invalid package name '".
1392 join(',',grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages).
1395 my %info = __begin_control(%param,
1396 command => 'package',
1398 my ($debug,$transcript) =
1399 @info{qw(debug transcript)};
1400 my @data = @{$info{data}};
1401 my @bugs = @{$info{bugs}};
1402 # clean up the new package
1406 ($temp =~ s/^src:// or
1407 $param{is_source}) ? 'src:'.$temp:$temp;
1411 my $package_reassigned = 0;
1412 for my $data (@data) {
1413 my $old_data = dclone($data);
1414 print {$debug} "Going to change assigned package\n";
1415 if (defined $data->{package} and length($data->{package}) and
1416 $data->{package} eq $new_package) {
1417 print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
1421 if (defined $data->{package} and length($data->{package})) {
1422 $package_reassigned = 1;
1423 $action= "$config{bug} reassigned from package '$data->{package}'".
1424 " to '$new_package'.";
1426 $action= "$config{bug} assigned to package '$new_package'.";
1428 $data->{package} = $new_package;
1430 append_action_to_log(bug => $data->{bug_num},
1431 command => 'package',
1433 old_data => $old_data,
1435 __return_append_to_log_options(
1440 if not exists $param{append_log} or $param{append_log};
1441 writebug($data->{bug_num},$data);
1442 print {$transcript} "$action\n";
1444 __end_control(%info);
1445 # Only clear the fixed/found versions if the package has been
1447 if ($package_reassigned) {
1448 my @params_for_found_fixed =
1449 map {exists $param{$_}?($_,$param{$_}):()}
1451 keys %common_options,
1452 keys %append_action_options,
1454 set_found(found => [],
1455 @params_for_found_fixed,
1457 set_fixed(fixed => [],
1458 @params_for_found_fixed,
1466 set_found(bug => $ref,
1467 transcript => $transcript,
1468 ($dl > 0 ? (debug => $transcript):()),
1469 requester => $header{from},
1470 request_addr => $controlrequestaddr,
1472 affected_packages => \%affected_packages,
1473 recipients => \%recipients,
1480 print {$transcript} "Failed to set found on $ref: $@";
1484 Sets, adds, or removes the specified found versions of a package
1486 If the version list is empty, and the bug is currently not "done",
1487 causes the done field to be cleared.
1489 If any of the versions added to found are greater than any version in
1490 which the bug is fixed (or when the bug is found and there are no
1491 fixed versions) the done field is cleared.
1496 my %param = validate_with(params => \@_,
1497 spec => {bug => {type => SCALAR,
1500 # specific options here
1501 found => {type => SCALAR|ARRAYREF,
1504 add => {type => BOOLEAN,
1507 remove => {type => BOOLEAN,
1511 %append_action_options,
1514 if ($param{add} and $param{remove}) {
1515 croak "It's nonsensical to add and remove the same versions";
1519 __begin_control(%param,
1522 my ($debug,$transcript) =
1523 @info{qw(debug transcript)};
1524 my @data = @{$info{data}};
1525 my @bugs = @{$info{bugs}};
1527 for my $version (make_list($param{found})) {
1528 next unless defined $version;
1529 $versions{$version} =
1530 [make_source_versions(package => [splitpackages($data[0]{package})],
1531 warnings => $transcript,
1534 versions => $version,
1537 # This is really ugly, but it's what we have to do
1538 if (not @{$versions{$version}}) {
1539 print {$transcript} "Unable to make a source version for version '$version'\n";
1542 if (not keys %versions and ($param{remove} or $param{add})) {
1543 if ($param{remove}) {
1544 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1547 print {$transcript} "Requested to add no versions; doing nothing.\n";
1549 __end_control(%info);
1552 # first things first, make the versions fully qualified source
1554 for my $data (@data) {
1555 # The 'done' field gets a bit weird with version tracking,
1556 # because a bug may be closed by multiple people in different
1557 # branches. Until we have something more flexible, we set it
1558 # every time a bug is fixed, and clear it when a bug is found
1559 # in a version greater than any version in which the bug is
1560 # fixed or when a bug is found and there is no fixed version
1561 my $action = 'Did not alter found versions';
1562 my %found_added = ();
1563 my %found_removed = ();
1564 my %fixed_removed = ();
1566 my $old_data = dclone($data);
1567 if (not $param{add} and not $param{remove}) {
1568 $found_removed{$_} = 1 for @{$data->{found_versions}};
1569 $data->{found_versions} = [];
1572 @found_versions{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1574 @fixed_versions{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1575 for my $version (keys %versions) {
1577 my @svers = @{$versions{$version}};
1582 if (exists $found_versions{$version}) {
1583 delete $found_versions{$version};
1584 $found_removed{$version} = 1;
1587 for my $sver (@svers) {
1588 if (not exists $found_versions{$sver}) {
1589 $found_versions{$sver} = 1;
1590 $found_added{$sver} = 1;
1592 # if the found we are adding matches any fixed
1593 # versions, remove them
1594 my @temp = grep m{(^|/)\Q$sver\E$}, keys %fixed_versions;
1595 delete $fixed_versions{$_} for @temp;
1596 $fixed_removed{$_} = 1 for @temp;
1599 # We only care about reopening the bug if the bug is
1601 if (defined $data->{done} and length $data->{done}) {
1602 my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
1604 # determine if we need to reopen
1605 my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
1606 keys %fixed_versions);
1607 if (not @fixed_order or
1608 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1614 elsif ($param{remove}) {
1615 # in the case of removal, we only concern ourself with
1616 # the version passed, not the source version it maps
1618 my @temp = grep m{(?:^|/)\Q$version\E$}, keys %found_versions;
1619 delete $found_versions{$_} for @temp;
1620 $found_removed{$_} = 1 for @temp;
1623 # set the keys to exactly these values
1624 my @svers = @{$versions{$version}};
1628 for my $sver (@svers) {
1629 if (not exists $found_versions{$sver}) {
1630 $found_versions{$sver} = 1;
1631 if (exists $found_removed{$sver}) {
1632 delete $found_removed{$sver};
1635 $found_added{$sver} = 1;
1642 $data->{found_versions} = [keys %found_versions];
1643 $data->{fixed_versions} = [keys %fixed_versions];
1646 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1647 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1648 # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
1649 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1650 $action = ucfirst(join ('; ',@changed)) if @changed;
1652 $action .= " and reopened"
1654 if (not $reopened and not @changed) {
1655 print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
1659 append_action_to_log(bug => $data->{bug_num},
1662 old_data => $old_data,
1664 __return_append_to_log_options(
1669 if not exists $param{append_log} or $param{append_log};
1670 writebug($data->{bug_num},$data);
1671 print {$transcript} "$action\n";
1673 __end_control(%info);
1679 set_fixed(bug => $ref,
1680 transcript => $transcript,
1681 ($dl > 0 ? (debug => $transcript):()),
1682 requester => $header{from},
1683 request_addr => $controlrequestaddr,
1685 affected_packages => \%affected_packages,
1686 recipients => \%recipients,
1694 print {$transcript} "Failed to set fixed on $ref: $@";
1698 Sets, adds, or removes the specified fixed versions of a package
1700 If the fixed versions are empty (or end up being empty after this
1701 call) or the greatest fixed version is less than the greatest found
1702 version and the reopen option is true, the bug is reopened.
1704 This function is also called by the reopen function, which causes all
1705 of the fixed versions to be cleared.
1710 my %param = validate_with(params => \@_,
1711 spec => {bug => {type => SCALAR,
1714 # specific options here
1715 fixed => {type => SCALAR|ARRAYREF,
1718 add => {type => BOOLEAN,
1721 remove => {type => BOOLEAN,
1724 reopen => {type => BOOLEAN,
1728 %append_action_options,
1731 if ($param{add} and $param{remove}) {
1732 croak "It's nonsensical to add and remove the same versions";
1735 __begin_control(%param,
1738 my ($debug,$transcript) =
1739 @info{qw(debug transcript)};
1740 my @data = @{$info{data}};
1741 my @bugs = @{$info{bugs}};
1743 for my $version (make_list($param{fixed})) {
1744 next unless defined $version;
1745 $versions{$version} =
1746 [make_source_versions(package => [splitpackages($data[0]{package})],
1747 warnings => $transcript,
1750 versions => $version,
1753 # This is really ugly, but it's what we have to do
1754 if (not @{$versions{$version}}) {
1755 print {$transcript} "Unable to make a source version for version '$version'\n";
1758 if (not keys %versions and ($param{remove} or $param{add})) {
1759 if ($param{remove}) {
1760 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1763 print {$transcript} "Requested to add no versions; doing nothing.\n";
1765 __end_control(%info);
1768 # first things first, make the versions fully qualified source
1770 for my $data (@data) {
1771 my $old_data = dclone($data);
1772 # The 'done' field gets a bit weird with version tracking,
1773 # because a bug may be closed by multiple people in different
1774 # branches. Until we have something more flexible, we set it
1775 # every time a bug is fixed, and clear it when a bug is found
1776 # in a version greater than any version in which the bug is
1777 # fixed or when a bug is found and there is no fixed version
1778 my $action = 'Did not alter fixed versions';
1779 my %found_added = ();
1780 my %found_removed = ();
1781 my %fixed_added = ();
1782 my %fixed_removed = ();
1784 if (not $param{add} and not $param{remove}) {
1785 $fixed_removed{$_} = 1 for @{$data->{fixed_versions}};
1786 $data->{fixed_versions} = [];
1789 @found_versions{@{$data->{found_versions}||[]}} = (1) x @{$data->{found_versions}||[]};
1791 @fixed_versions{@{$data->{fixed_versions}||[]}} = (1) x @{$data->{fixed_versions}||[]};
1792 for my $version (keys %versions) {
1794 my @svers = @{$versions{$version}};
1799 if (exists $fixed_versions{$version}) {
1800 $fixed_removed{$version} = 1;
1801 delete $fixed_versions{$version};
1804 for my $sver (@svers) {
1805 if (not exists $fixed_versions{$sver}) {
1806 $fixed_versions{$sver} = 1;
1807 $fixed_added{$sver} = 1;
1811 elsif ($param{remove}) {
1812 # in the case of removal, we only concern ourself with
1813 # the version passed, not the source version it maps
1815 my @temp = grep m{(?:^|\/)\Q$version\E$}, keys %fixed_versions;
1816 delete $fixed_versions{$_} for @temp;
1817 $fixed_removed{$_} = 1 for @temp;
1820 # set the keys to exactly these values
1821 my @svers = @{$versions{$version}};
1825 for my $sver (@svers) {
1826 if (not exists $fixed_versions{$sver}) {
1827 $fixed_versions{$sver} = 1;
1828 if (exists $fixed_removed{$sver}) {
1829 delete $fixed_removed{$sver};
1832 $fixed_added{$sver} = 1;
1839 $data->{found_versions} = [keys %found_versions];
1840 $data->{fixed_versions} = [keys %fixed_versions];
1842 # If we're supposed to consider reopening, reopen if the
1843 # fixed versions are empty or the greatest found version
1844 # is greater than the greatest fixed version
1845 if ($param{reopen} and defined $data->{done}
1846 and length $data->{done}) {
1847 my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1848 map {m{([^/]+)$}; $1;} @{$data->{found_versions}};
1849 # determine if we need to reopen
1850 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1851 map {m{([^/]+)$}; $1;} @{$data->{fixed_versions}};
1852 if (not @fixed_order or
1853 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1860 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1861 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1862 push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
1863 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1864 $action = ucfirst(join ('; ',@changed)) if @changed;
1866 $action .= " and reopened"
1868 if (not $reopened and not @changed) {
1869 print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
1873 append_action_to_log(bug => $data->{bug_num},
1876 old_data => $old_data,
1878 __return_append_to_log_options(
1883 if not exists $param{append_log} or $param{append_log};
1884 writebug($data->{bug_num},$data);
1885 print {$transcript} "$action\n";
1887 __end_control(%info);
1894 set_merged(bug => $ref,
1895 transcript => $transcript,
1896 ($dl > 0 ? (debug => $transcript):()),
1897 requester => $header{from},
1898 request_addr => $controlrequestaddr,
1900 affected_packages => \%affected_packages,
1901 recipients => \%recipients,
1902 merge_with => 12345,
1905 allow_reassign => 1,
1906 reassign_same_source_only => 1,
1911 print {$transcript} "Failed to set merged on $ref: $@";
1915 Sets, adds, or removes the specified merged bugs of a bug
1917 By default, requires
1922 my %param = validate_with(params => \@_,
1923 spec => {bug => {type => SCALAR,
1926 # specific options here
1927 merge_with => {type => ARRAYREF|SCALAR,
1930 remove => {type => BOOLEAN,
1933 force => {type => BOOLEAN,
1936 masterbug => {type => BOOLEAN,
1939 allow_reassign => {type => BOOLEAN,
1942 reassign_different_sources => {type => BOOLEAN,
1946 %append_action_options,
1949 my @merging = exists $param{merge_with} ? make_list($param{merge_with}):();
1951 @merging{@merging} = (1) x @merging;
1952 if (grep {$_ !~ /^\d+$/} @merging) {
1953 croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging);
1955 $param{locks} = {} if not exists $param{locks};
1957 __begin_control(%param,
1960 my ($debug,$transcript) =
1961 @info{qw(debug transcript)};
1962 if (not @merging and exists $param{merge_with}) {
1963 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
1964 __end_control(%info);
1967 my @data = @{$info{data}};
1968 my @bugs = @{$info{bugs}};
1971 for my $data (@data) {
1972 $data{$data->{bug_num}} = $data;
1973 my @merged_bugs = split / /, $data->{mergedwith};
1974 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
1978 if (not exists $param{merge_with}) {
1979 my $ok_to_unmerge = 1;
1980 delete $merged_bugs{$param{bug}};
1981 if (not keys %merged_bugs) {
1982 print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
1983 __end_control(%info);
1986 my $action = "Disconnected #$param{bug} from all other report(s).";
1987 for my $data (@data) {
1988 my $old_data = dclone($data);
1989 if ($data->{bug_num} == $param{bug}) {
1990 $data->{mergedwith} = '';
1993 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
1996 append_action_to_log(bug => $data->{bug_num},
1999 old_data => $old_data,
2001 __return_append_to_log_options(%param,
2005 if not exists $param{append_log} or $param{append_log};
2006 writebug($data->{bug_num},$data);
2008 print {$transcript} "$action\n";
2009 __end_control(%info);
2012 # lock and load all of the bugs we need
2013 my @bugs_to_load = keys %merging;
2016 my ($data,$n_locks) =
2017 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2019 locks => $param{locks},
2022 $new_locks += $n_locks;
2024 @data = values %data;
2025 if (not check_limit(data => [@data],
2026 exists $param{limit}?(limit => $param{limit}):(),
2027 transcript => $transcript,
2029 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
2031 for my $data (@data) {
2032 $data{$data->{bug_num}} = $data;
2033 $merged_bugs{$data->{bug_num}} = 1;
2034 my @merged_bugs = split / /, $data->{mergedwith};
2035 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
2036 if (exists $param{affected_bugs}) {
2037 $param{affected_bugs}{$data->{bug_num}} = 1;
2040 __handle_affected_packages(%param,data => [@data]);
2041 my %bug_info_shown; # which bugs have had information shown
2042 $bug_info_shown{$param{bug}} = 1;
2043 add_recipients(data => [@data],
2044 recipients => $param{recipients},
2045 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
2047 (__internal_request()?(transcript => $transcript):()),
2050 # Figure out what the ideal state is for the bug,
2051 my ($merge_status,$bugs_to_merge) =
2052 __calculate_merge_status(\@data,\%data,$param{bug});
2053 # find out if we actually have any bugs to merge
2054 if (not $bugs_to_merge) {
2055 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
2056 for (1..$new_locks) {
2057 unfilelock($param{locks});
2060 __end_control(%info);
2063 # see what changes need to be made to merge the bugs
2064 # check to make sure that the set of changes we need to make is allowed
2065 my ($disallowed_changes,$changes) =
2066 __calculate_merge_changes(\@data,$merge_status,\%param);
2067 # at this point, stop if there are disallowed changes, otherwise
2068 # make the allowed changes, and then reread the bugs in question
2069 # to get the new data, then recaculate the merges; repeat
2070 # reloading and recalculating until we try too many times or there
2071 # are no changes to make.
2074 # we will allow at most 4 times through this; more than 1
2075 # shouldn't really happen.
2077 while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) {
2078 if ($attempts > 1) {
2079 print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n";
2081 if (@{$disallowed_changes}) {
2082 # figure out the problems
2083 print {$transcript} "Unable to merge bugs because:\n";
2084 for my $change (@{$disallowed_changes}) {
2085 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2087 if ($attempts > 0) {
2088 croak "Some bugs were altered while attempting to merge";
2091 croak "Did not alter merged bugs";
2094 my @bugs_to_change = keys %{$changes};
2095 for my $change_bug (@bugs_to_change) {
2096 next unless exists $changes->{$change_bug};
2097 $bug_changed{$change_bug}++;
2098 print {$transcript} __bug_info($data{$change_bug}) if
2099 $param{show_bug_info} and not __internal_request(1);
2100 $bug_info_shown{$change_bug} = 1;
2101 __allow_relocking($param{locks},[keys %data]);
2102 for my $change (@{$changes->{$change_bug}}) {
2103 if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
2104 my %target_blockedby;
2105 @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
2106 my %unhandled_targets = %target_blockedby;
2107 my @blocks_to_remove;
2108 for my $key (split / /,$change->{orig_value}) {
2109 delete $unhandled_targets{$key};
2110 next if exists $target_blockedby{$key};
2111 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2112 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2115 keys %common_options,
2116 keys %append_action_options),
2119 for my $key (keys %unhandled_targets) {
2120 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2121 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2124 keys %common_options,
2125 keys %append_action_options),
2130 $change->{function}->(bug => $change->{bug},
2131 $change->{key}, $change->{func_value},
2132 exists $change->{options}?@{$change->{options}}:(),
2134 keys %common_options,
2135 keys %append_action_options),
2139 __disallow_relocking($param{locks});
2140 my ($data,$n_locks) =
2141 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2143 locks => $param{locks},
2147 $new_locks += $n_locks;
2150 @data = values %data;
2151 ($merge_status,$bugs_to_merge) =
2152 __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
2153 ($disallowed_changes,$changes) =
2154 __calculate_merge_changes(\@data,$merge_status,\%param);
2155 $attempts = max(values %bug_changed);
2158 if ($param{show_bug_info} and not __internal_request(1)) {
2159 for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) {
2160 next if $bug_info_shown{$data->{bug_num}};
2161 print {$transcript} __bug_info($data);
2164 if (keys %{$changes} or @{$disallowed_changes}) {
2165 print {$transcript} "After four attempts, the following changes were unable to be made:\n";
2166 for (1..$new_locks) {
2167 unfilelock($param{locks});
2170 __end_control(%info);
2171 for my $change ((map {@{$_}} values %{$changes}), @{$disallowed_changes}) {
2172 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2174 die "Unable to modify bugs so they could be merged";
2178 # finally, we can merge the bugs
2179 my $action = "Merged ".join(' ',sort keys %merged_bugs);
2180 for my $data (@data) {
2181 my $old_data = dclone($data);
2182 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
2184 append_action_to_log(bug => $data->{bug_num},
2187 old_data => $old_data,
2189 __return_append_to_log_options(%param,
2193 if not exists $param{append_log} or $param{append_log};
2194 writebug($data->{bug_num},$data);
2196 print {$transcript} "$action\n";
2197 # unlock the extra locks that we got earlier
2198 for (1..$new_locks) {
2199 unfilelock($param{locks});
2202 __end_control(%info);
2205 sub __allow_relocking{
2206 my ($locks,$bugs) = @_;
2208 my @locks = (@{$bugs},'merge');
2209 for my $lock (@locks) {
2210 my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
2211 next unless @lockfiles;
2212 $locks->{relockable}{$lockfiles[0]} = 0;
2216 sub __disallow_relocking{
2218 delete $locks->{relockable};
2221 sub __lock_and_load_merged_bugs{
2223 validate_with(params => \@_,
2225 {bugs_to_load => {type => ARRAYREF,
2226 default => sub {[]},
2228 data => {type => HASHREF|ARRAYREF,
2230 locks => {type => HASHREF,
2231 default => sub {{};},
2233 reload_all => {type => BOOLEAN,
2236 debug => {type => HANDLE,
2242 if (ref($param{data}) eq 'ARRAY') {
2243 for my $data (@{$param{data}}) {
2244 $data{$data->{bug_num}} = dclone($data);
2248 %data = %{dclone($param{data})};
2250 my @bugs_to_load = @{$param{bugs_to_load}};
2251 if ($param{reload_all}) {
2252 push @bugs_to_load, keys %data;
2255 @temp{@bugs_to_load} = (1) x @bugs_to_load;
2256 @bugs_to_load = keys %temp;
2257 my %loaded_this_time;
2259 while ($bug_to_load = shift @bugs_to_load) {
2260 if (not $param{reload_all}) {
2261 next if exists $data{$bug_to_load};
2264 next if $loaded_this_time{$bug_to_load};
2267 if ($param{reload_all}) {
2268 if (exists $data{$bug_to_load}) {
2273 read_bug(bug => $bug_to_load,
2275 locks => $param{locks},
2277 die "Unable to load bug $bug_to_load";
2278 print {$param{debug}} "read bug $bug_to_load\n";
2279 $data{$data->{bug_num}} = $data;
2280 $new_locks += $lock_bug;
2281 $loaded_this_time{$data->{bug_num}} = 1;
2283 grep {not exists $data{$_}}
2284 split / /,$data->{mergedwith};
2286 return (\%data,$new_locks);
2290 sub __calculate_merge_status{
2291 my ($data_a,$data_h,$master_bug,$merge_status) = @_;
2292 my %merge_status = %{$merge_status // {}};
2294 my $bugs_to_merge = 0;
2295 for my $data (@{$data_a}) {
2296 # check to see if this bug is unmerged in the set
2297 if (not length $data->{mergedwith} or
2298 grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) {
2299 $merged_bugs{$data->{bug_num}} = 1;
2302 # the master_bug is the bug that every other bug is made to
2303 # look like. However, if merge is set, tags, fixed and found
2305 if ($data->{bug_num} == $master_bug) {
2306 for (qw(package forwarded severity blocks blockedby done owner summary outlook affects)) {
2307 $merge_status{$_} = $data->{$_}
2310 if (defined $merge_status) {
2311 next unless $data->{bug_num} == $master_bug;
2313 $merge_status{tag} = {} if not exists $merge_status{tag};
2314 for my $tag (split /\s+/, $data->{keywords}) {
2315 $merge_status{tag}{$tag} = 1;
2317 $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}});
2318 for (qw(fixed found)) {
2319 @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
2322 # if there is a non-source qualified version with a corresponding
2323 # source qualified version, we only want to merge the source
2324 # qualified version(s)
2325 for (qw(fixed found)) {
2326 my @unqualified_versions = grep {m{/}?0:1} keys %{$merge_status{"${_}_versions"}};
2327 for my $unqualified_version (@unqualified_versions) {
2328 if (grep {m{/\Q$unqualified_version\E}} keys %{$merge_status{"${_}_versions"}}) {
2329 delete $merge_status{"${_}_versions"}{$unqualified_version};
2333 return (\%merge_status,$bugs_to_merge);
2338 sub __calculate_merge_changes{
2339 my ($datas,$merge_status,$param) = @_;
2341 my @disallowed_changes;
2342 for my $data (@{$datas}) {
2343 # things that can be forced
2345 # * func is the function to set the new value
2347 # * key is the key of the function to set the value,
2349 # * modify_value is a function which is called to modify the new
2350 # value so that the function will accept it
2352 # * options is an ARRAYREF of options to pass to the function
2354 # * allowed is a BOOLEAN which controls whether this setting
2355 # is allowed to be different by default.
2356 my %force_functions =
2357 (forwarded => {func => \&set_forwarded,
2361 severity => {func => \&set_severity,
2365 blocks => {func => \&set_blocks,
2366 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2370 blockedby => {func => \&set_blocks,
2371 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2375 done => {func => \&set_done,
2379 owner => {func => \&owner,
2383 summary => {func => \&summary,
2387 outlook => {func => \&outlook,
2391 affects => {func => \&affects,
2395 package => {func => \&set_package,
2399 keywords => {func => \&set_tag,
2401 modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]},
2404 fixed_versions => {func => \&set_fixed,
2406 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2409 found_versions => {func => \&set_found,
2411 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2415 for my $field (qw(forwarded severity blocks blockedby done owner summary outlook affects package fixed_versions found_versions keywords)) {
2416 # if the ideal bug already has the field set properly, we
2418 if ($field eq 'keywords'){
2419 next if join(' ',sort split /\s+/,$data->{keywords}) eq
2420 join(' ',sort keys %{$merge_status->{tag}});
2422 elsif ($field =~ /^(?:fixed|found)_versions$/) {
2423 next if join(' ', sort @{$data->{$field}}) eq
2424 join(' ',sort keys %{$merge_status->{$field}});
2426 elsif ($field eq 'done') {
2427 # for done, we only care if the bug is done or not
2428 # done, not the value it's set to.
2429 if (defined $merge_status->{$field} and length $merge_status->{$field} and
2430 defined $data->{$field} and length $data->{$field}) {
2433 elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
2434 (not defined $data->{$field} or not length $data->{$field})
2439 elsif ($merge_status->{$field} eq $data->{$field}) {
2444 bug => $data->{bug_num},
2445 orig_value => $data->{$field},
2447 (exists $force_functions{$field}{modify_value} ?
2448 $force_functions{$field}{modify_value}->($merge_status->{$field}):
2449 $merge_status->{$field}),
2450 value => $merge_status->{$field},
2451 function => $force_functions{$field}{func},
2452 key => $force_functions{$field}{key},
2453 options => $force_functions{$field}{options},
2454 allowed => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
2456 $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
2457 $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
2458 if ($param->{force} or $change->{allowed}) {
2459 if ($field ne 'package' or $change->{allowed}) {
2460 push @{$changes{$data->{bug_num}}},$change;
2463 if ($param->{allow_reassign}) {
2464 if ($param->{reassign_different_sources}) {
2465 push @{$changes{$data->{bug_num}}},$change;
2468 # allow reassigning if binary_to_source returns at
2469 # least one of the same source packages
2470 my @merge_status_source =
2471 binary_to_source(package => $merge_status->{package},
2474 my @other_bug_source =
2475 binary_to_source(package => $data->{package},
2478 my %merge_status_sources;
2479 @merge_status_sources{@merge_status_source} =
2480 (1) x @merge_status_source;
2481 if (grep {$merge_status_sources{$_}} @other_bug_source) {
2482 push @{$changes{$data->{bug_num}}},$change;
2487 push @disallowed_changes,$change;
2489 # blocks and blocked by are weird; we have to go through and
2490 # set blocks to the other half of the merged bugs
2492 return (\@disallowed_changes,\%changes);
2498 affects(bug => $ref,
2499 transcript => $transcript,
2500 ($dl > 0 ? (debug => $transcript):()),
2501 requester => $header{from},
2502 request_addr => $controlrequestaddr,
2504 affected_packages => \%affected_packages,
2505 recipients => \%recipients,
2513 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
2516 This marks a bug as affecting packages which the bug is not actually
2517 in. This should only be used in cases where fixing the bug instantly
2518 resolves the problem in the other packages.
2520 By default, the packages are set to the list of packages passed.
2521 However, if you pass add => 1 or remove => 1, the list of packages
2522 passed are added or removed from the affects list, respectively.
2527 my %param = validate_with(params => \@_,
2528 spec => {bug => {type => SCALAR,
2531 # specific options here
2532 package => {type => SCALAR|ARRAYREF|UNDEF,
2535 add => {type => BOOLEAN,
2538 remove => {type => BOOLEAN,
2542 %append_action_options,
2545 if ($param{add} and $param{remove}) {
2546 croak "Asking to both add and remove affects is nonsensical";
2548 if (not defined $param{package}) {
2549 $param{package} = [];
2552 __begin_control(%param,
2553 command => 'affects'
2555 my ($debug,$transcript) =
2556 @info{qw(debug transcript)};
2557 my @data = @{$info{data}};
2558 my @bugs = @{$info{bugs}};
2560 for my $data (@data) {
2562 print {$debug} "Going to change affects\n";
2563 my @packages = splitpackages($data->{affects});
2565 @packages{@packages} = (1) x @packages;
2568 for my $package (make_list($param{package})) {
2569 next unless defined $package and length $package;
2570 if (not $packages{$package}) {
2571 $packages{$package} = 1;
2572 push @added,$package;
2576 $action = "Added indication that $data->{bug_num} affects ".
2577 english_join(\@added);
2580 elsif ($param{remove}) {
2582 for my $package (make_list($param{package})) {
2583 if ($packages{$package}) {
2584 next unless defined $package and length $package;
2585 delete $packages{$package};
2586 push @removed,$package;
2589 $action = "Removed indication that $data->{bug_num} affects " .
2590 english_join(\@removed);
2593 my %added_packages = ();
2594 my %removed_packages = %packages;
2596 for my $package (make_list($param{package})) {
2597 next unless defined $package and length $package;
2598 $packages{$package} = 1;
2599 delete $removed_packages{$package};
2600 $added_packages{$package} = 1;
2602 if (keys %removed_packages) {
2603 $action = "Removed indication that $data->{bug_num} affects ".
2604 english_join([keys %removed_packages]);
2605 $action .= "\n" if keys %added_packages;
2607 if (keys %added_packages) {
2608 $action .= "Added indication that $data->{bug_num} affects " .
2609 english_join([keys %added_packages]);
2612 if (not length $action) {
2613 print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
2616 my $old_data = dclone($data);
2617 $data->{affects} = join(',',keys %packages);
2618 append_action_to_log(bug => $data->{bug_num},
2620 command => 'affects',
2622 old_data => $old_data,
2623 __return_append_to_log_options(
2628 if not exists $param{append_log} or $param{append_log};
2629 writebug($data->{bug_num},$data);
2630 print {$transcript} "$action\n";
2632 __end_control(%info);
2636 =head1 SUMMARY FUNCTIONS
2641 summary(bug => $ref,
2642 transcript => $transcript,
2643 ($dl > 0 ? (debug => $transcript):()),
2644 requester => $header{from},
2645 request_addr => $controlrequestaddr,
2647 affected_packages => \%affected_packages,
2648 recipients => \%recipients,
2654 print {$transcript} "Failed to mark $ref with summary foo: $@";
2657 Handles all setting of summary fields
2659 If summary is undef, unsets the summary
2661 If summary is 0, sets the summary to the first paragraph contained in
2664 If summary is a positive integer, sets the summary to the message specified.
2666 Otherwise, sets summary to the value passed.
2672 # outlook and summary are exactly the same, basically
2673 return _summary('summary',@_);
2676 =head1 OUTLOOK FUNCTIONS
2681 outlook(bug => $ref,
2682 transcript => $transcript,
2683 ($dl > 0 ? (debug => $transcript):()),
2684 requester => $header{from},
2685 request_addr => $controlrequestaddr,
2687 affected_packages => \%affected_packages,
2688 recipients => \%recipients,
2694 print {$transcript} "Failed to mark $ref with outlook foo: $@";
2697 Handles all setting of outlook fields
2699 If outlook is undef, unsets the outlook
2701 If outlook is 0, sets the outlook to the first paragraph contained in
2704 If outlook is a positive integer, sets the outlook to the message specified.
2706 Otherwise, sets outlook to the value passed.
2712 return _summary('outlook',@_);
2716 my ($cmd,@params) = @_;
2717 my %param = validate_with(params => \@params,
2718 spec => {bug => {type => SCALAR,
2721 # specific options here
2722 $cmd , {type => SCALAR|UNDEF,
2726 %append_action_options,
2730 __begin_control(%param,
2733 my ($debug,$transcript) =
2734 @info{qw(debug transcript)};
2735 my @data = @{$info{data}};
2736 my @bugs = @{$info{bugs}};
2737 # figure out the log that we're going to use
2739 my $summary_msg = '';
2741 if (not defined $param{$cmd}) {
2743 print {$debug} "Removing $cmd fields\n";
2744 $action = "Removed $cmd";
2746 elsif ($param{$cmd} =~ /^\d+$/) {
2748 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
2749 if ($param{$cmd} == 0) {
2750 $log = $param{message};
2751 $summary_msg = @records + 1;
2754 if (($param{$cmd} - 1 ) > $#records) {
2755 die "Message number '$param{$cmd}' exceeds the maximum message '$#records'";
2757 my $record = $records[($param{$cmd} - 1 )];
2758 if ($record->{type} !~ /incoming-recv|recips/) {
2759 die "Message number '$param{$cmd}' is a invalid message type '$record->{type}'";
2761 $summary_msg = $param{$cmd};
2762 $log = [$record->{text}];
2764 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
2765 my $body = $p_o->{body};
2766 my $in_pseudoheaders = 0;
2768 # walk through body until we get non-blank lines
2769 for my $line (@{$body}) {
2770 if ($line =~ /^\s*$/) {
2771 if (length $paragraph) {
2772 if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
2778 $in_pseudoheaders = 0;
2781 # skip a paragraph if it looks like it's control or
2783 if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
2784 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
2785 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
2786 debug|(?:not|)forwarded|priority|
2787 (?:un|)block|limit|(?:un|)archive|
2788 reassign|retitle|affects|wrongpackage
2789 (?:un|force|)merge|user(?:category|tags?|)
2791 if (not length $paragraph) {
2792 print {$debug} "Found control/pseudo-headers and skiping them\n";
2793 $in_pseudoheaders = 1;
2797 next if $in_pseudoheaders;
2798 $paragraph .= $line ." \n";
2800 print {$debug} ucfirst($cmd)." is going to be '$paragraph'\n";
2801 $summary = $paragraph;
2802 $summary =~ s/[\n\r]/ /g;
2803 if (not length $summary) {
2804 die "Unable to find $cmd message to use";
2806 # trim off a trailing spaces
2807 $summary =~ s/\ *$//;
2810 $summary = $param{$cmd};
2812 for my $data (@data) {
2813 print {$debug} "Going to change $cmd\n";
2814 if (((not defined $summary or not length $summary) and
2815 (not defined $data->{$cmd} or not length $data->{$cmd})) or
2816 $summary eq $data->{$cmd}) {
2817 print {$transcript} "Ignoring request to change the $cmd of bug $param{bug} to the same value\n";
2820 if (length $summary) {
2821 if (length $data->{$cmd}) {
2822 $action = ucfirst($cmd)." replaced with message bug $param{bug} message $summary_msg";
2825 $action = ucfirst($cmd)." recorded from message bug $param{bug} message $summary_msg";
2828 my $old_data = dclone($data);
2829 $data->{$cmd} = $summary;
2830 append_action_to_log(bug => $data->{bug_num},
2832 old_data => $old_data,
2835 __return_append_to_log_options(
2840 if not exists $param{append_log} or $param{append_log};
2841 writebug($data->{bug_num},$data);
2842 print {$transcript} "$action\n";
2844 __end_control(%info);
2852 clone_bug(bug => $ref,
2853 transcript => $transcript,
2854 ($dl > 0 ? (debug => $transcript):()),
2855 requester => $header{from},
2856 request_addr => $controlrequestaddr,
2858 affected_packages => \%affected_packages,
2859 recipients => \%recipients,
2864 print {$transcript} "Failed to clone bug $ref bar: $@";
2867 Clones the given bug.
2869 We currently don't support cloning merged bugs, but this could be
2870 handled by internally unmerging, cloning, then remerging the bugs.
2875 my %param = validate_with(params => \@_,
2876 spec => {bug => {type => SCALAR,
2879 new_bugs => {type => ARRAYREF,
2881 new_clones => {type => HASHREF,
2885 %append_action_options,
2889 __begin_control(%param,
2892 my ($debug,$transcript) =
2893 @info{qw(debug transcript)};
2894 my @data = @{$info{data}};
2895 my @bugs = @{$info{bugs}};
2898 for my $data (@data) {
2899 if (length($data->{mergedwith})) {
2900 die "Bug is marked as being merged with others. Use an existing clone.\n";
2904 die "Not exactly one bug‽ This shouldn't happen.";
2906 my $data = $data[0];
2908 for my $newclone_id (@{$param{new_bugs}}) {
2909 my $new_bug_num = new_bug(copy => $data->{bug_num});
2910 $param{new_clones}{$newclone_id} = $new_bug_num;
2911 $clones{$newclone_id} = $new_bug_num;
2913 my @new_bugs = sort values %clones;
2915 for my $new_bug (@new_bugs) {
2916 # no collapsed ids or the higher collapsed id is not one less
2917 # than the next highest new bug
2918 if (not @collapsed_ids or
2919 $collapsed_ids[-1][1]+1 != $new_bug) {
2920 push @collapsed_ids,[$new_bug,$new_bug];
2923 $collapsed_ids[-1][1] = $new_bug;
2927 for my $ci (@collapsed_ids) {
2928 if ($ci->[0] == $ci->[1]) {
2929 push @collapsed,$ci->[0];
2932 push @collapsed,$ci->[0].'-'.$ci->[1]
2935 my $collapsed_str = english_join(\@collapsed);
2936 $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str;
2937 for my $new_bug (@new_bugs) {
2938 append_action_to_log(bug => $new_bug,
2940 __return_append_to_log_options(
2945 if not exists $param{append_log} or $param{append_log};
2947 append_action_to_log(bug => $data->{bug_num},
2949 __return_append_to_log_options(
2954 if not exists $param{append_log} or $param{append_log};
2955 writebug($data->{bug_num},$data);
2956 print {$transcript} "$action\n";
2957 __end_control(%info);
2958 # bugs that this bug is blocking are also blocked by the new clone(s)
2959 for my $bug (split ' ', $data->{blocks}) {
2960 for my $new_bug (@new_bugs) {
2961 set_blocks(bug => $new_bug,
2964 keys %common_options,
2965 keys %append_action_options),
2969 # bugs that this bug is blocked by are also blocking the new clone(s)
2970 for my $bug (split ' ', $data->{blockedby}) {
2971 for my $new_bug (@new_bugs) {
2972 set_blocks(bug => $bug,
2975 keys %common_options,
2976 keys %append_action_options),
2984 =head1 OWNER FUNCTIONS
2990 transcript => $transcript,
2991 ($dl > 0 ? (debug => $transcript):()),
2992 requester => $header{from},
2993 request_addr => $controlrequestaddr,
2995 recipients => \%recipients,
3001 print {$transcript} "Failed to mark $ref as having an owner: $@";
3004 Handles all setting of the owner field; given an owner of undef or of
3005 no length, indicates that a bug is not owned by anyone.
3010 my %param = validate_with(params => \@_,
3011 spec => {bug => {type => SCALAR,
3014 owner => {type => SCALAR|UNDEF,
3017 %append_action_options,
3021 __begin_control(%param,
3024 my ($debug,$transcript) =
3025 @info{qw(debug transcript)};
3026 my @data = @{$info{data}};
3027 my @bugs = @{$info{bugs}};
3029 for my $data (@data) {
3030 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
3031 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
3032 if (not defined $param{owner} or not length $param{owner}) {
3033 if (not defined $data->{owner} or not length $data->{owner}) {
3034 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
3038 $action = "Removed annotation that $config{bug} was owned by " .
3042 if ($data->{owner} eq $param{owner}) {
3043 print {$transcript} "Ignoring request to set the owner of bug #$data->{bug_num} to the same value\n";
3046 if (length $data->{owner}) {
3047 $action = "Owner changed from $data->{owner} to $param{owner}.";
3050 $action = "Owner recorded as $param{owner}."
3053 my $old_data = dclone($data);
3054 $data->{owner} = $param{owner};
3055 append_action_to_log(bug => $data->{bug_num},
3058 old_data => $old_data,
3060 __return_append_to_log_options(
3065 if not exists $param{append_log} or $param{append_log};
3066 writebug($data->{bug_num},$data);
3067 print {$transcript} "$action\n";
3069 __end_control(%info);
3073 =head1 ARCHIVE FUNCTIONS
3080 bug_archive(bug => $bug_num,
3082 transcript => \$transcript,
3087 transcript("Unable to archive $bug_num\n");
3090 transcript($transcript);
3093 This routine archives a bug
3097 =item bug -- bug number
3099 =item check_archiveable -- check wether a bug is archiveable before
3100 archiving; defaults to 1
3102 =item archive_unarchived -- whether to archive bugs which have not
3103 previously been archived; defaults to 1. [Set to 0 when used from
3106 =item ignore_time -- whether to ignore time constraints when archiving
3107 a bug; defaults to 0.
3114 my %param = validate_with(params => \@_,
3115 spec => {bug => {type => SCALAR,
3118 check_archiveable => {type => BOOLEAN,
3121 archive_unarchived => {type => BOOLEAN,
3124 ignore_time => {type => BOOLEAN,
3128 %append_action_options,
3131 my %info = __begin_control(%param,
3132 command => 'archive',
3134 my ($debug,$transcript) = @info{qw(debug transcript)};
3135 my @data = @{$info{data}};
3136 my @bugs = @{$info{bugs}};
3137 my $action = "$config{bug} archived.";
3138 if ($param{check_archiveable} and
3139 not bug_archiveable(bug=>$param{bug},
3140 ignore_time => $param{ignore_time},
3142 print {$transcript} "Bug $param{bug} cannot be archived\n";
3143 die "Bug $param{bug} cannot be archived";
3145 if (not $param{archive_unarchived} and
3146 not exists $data[0]{unarchived}
3148 print {$transcript} "$param{bug} has not been archived previously\n";
3149 die "$param{bug} has not been archived previously";
3151 add_recipients(recipients => $param{recipients},
3154 transcript => $transcript,
3156 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3157 for my $bug (@bugs) {
3158 if ($param{check_archiveable}) {
3159 die "Bug $bug cannot be archived (but $param{bug} can?)"
3160 unless bug_archiveable(bug=>$bug,
3161 ignore_time => $param{ignore_time},
3165 # If we get here, we can archive/remove this bug
3166 print {$debug} "$param{bug} removing\n";
3167 for my $bug (@bugs) {
3168 #print "$param{bug} removing $bug\n" if $debug;
3169 my $dir = get_hashname($bug);
3170 # First indicate that this bug is being archived
3171 append_action_to_log(bug => $bug,
3173 command => 'archive',
3174 # we didn't actually change the data
3175 # when we archived, so we don't pass
3176 # a real new_data or old_data
3179 __return_append_to_log_options(
3184 if not exists $param{append_log} or $param{append_log};
3185 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
3186 if ($config{save_old_bugs}) {
3187 mkpath("$config{spool_dir}/archive/$dir");
3188 foreach my $file (@files_to_remove) {
3189 link("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3190 copy("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3191 # we need to bail out here if things have
3192 # gone horribly wrong to avoid removing a
3194 die "Unable to link or copy $config{spool_dir}/db-h/$dir/$file to $config{spool_dir}/archive/$dir/$file; $!";
3197 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
3199 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
3200 print {$debug} "deleted $bug (from $param{bug})\n";
3202 bughook_archive(@bugs);
3203 __end_control(%info);
3206 =head2 bug_unarchive
3210 bug_unarchive(bug => $bug_num,
3212 transcript => \$transcript,
3217 transcript("Unable to archive bug: $bug_num");
3219 transcript($transcript);
3221 This routine unarchives a bug
3226 my %param = validate_with(params => \@_,
3227 spec => {bug => {type => SCALAR,
3231 %append_action_options,
3235 my %info = __begin_control(%param,
3237 command=>'unarchive');
3238 my ($debug,$transcript) =
3239 @info{qw(debug transcript)};
3240 my @data = @{$info{data}};
3241 my @bugs = @{$info{bugs}};
3242 my $action = "$config{bug} unarchived.";
3243 my @files_to_remove;
3244 for my $bug (@bugs) {
3245 print {$debug} "$param{bug} removing $bug\n";
3246 my $dir = get_hashname($bug);
3247 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
3248 mkpath("archive/$dir");
3249 foreach my $file (@files_to_copy) {
3250 # die'ing here sucks
3251 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3252 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3253 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
3255 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
3256 print {$transcript} "Unarchived $config{bug} $bug\n";
3258 unlink(@files_to_remove) or die "Unable to unlink bugs";
3259 # Indicate that this bug has been archived previously
3260 for my $bug (@bugs) {
3261 my $newdata = readbug($bug);
3262 my $old_data = dclone($newdata);
3263 if (not defined $newdata) {
3264 print {$transcript} "$config{bug} $bug disappeared!\n";
3265 die "Bug $bug disappeared!";
3267 $newdata->{unarchived} = time;
3268 append_action_to_log(bug => $bug,
3270 command => 'unarchive',
3271 new_data => $newdata,
3272 old_data => $old_data,
3273 __return_append_to_log_options(
3278 if not exists $param{append_log} or $param{append_log};
3279 writebug($bug,$newdata);
3281 __end_control(%info);
3284 =head2 append_action_to_log
3286 append_action_to_log
3288 This should probably be moved to Debbugs::Log; have to think that out
3293 sub append_action_to_log{
3294 my %param = validate_with(params => \@_,
3295 spec => {bug => {type => SCALAR,
3298 new_data => {type => HASHREF,
3301 old_data => {type => HASHREF,
3304 command => {type => SCALAR,
3307 action => {type => SCALAR,
3309 requester => {type => SCALAR,
3312 request_addr => {type => SCALAR,
3315 location => {type => SCALAR,
3318 message => {type => SCALAR|ARRAYREF,
3321 recips => {type => SCALAR|ARRAYREF,
3324 desc => {type => SCALAR,
3327 get_lock => {type => BOOLEAN,
3330 locks => {type => HASHREF,
3334 # append_action_options here
3335 # because some of these
3336 # options aren't actually
3337 # optional, even though the
3338 # original function doesn't
3342 # Fix this to use $param{location}
3343 my $log_location = buglog($param{bug});
3344 die "Unable to find .log for $param{bug}"
3345 if not defined $log_location;
3346 if ($param{get_lock}) {
3347 filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
3351 my $logfh = IO::File->new(">>$log_location") or
3352 die "Unable to open $log_location for appending: $!";
3353 # determine difference between old and new
3355 if (exists $param{old_data} and exists $param{new_data}) {
3356 my $old_data = dclone($param{old_data});
3357 my $new_data = dclone($param{new_data});
3358 for my $key (keys %{$old_data}) {
3359 if (not exists $Debbugs::Status::fields{$key}) {
3360 delete $old_data->{$key};
3363 next unless exists $new_data->{$key};
3364 next unless defined $new_data->{$key};
3365 if (not defined $old_data->{$key}) {
3366 delete $old_data->{$key};
3369 if (ref($new_data->{$key}) and
3370 ref($old_data->{$key}) and
3371 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3372 local $Storable::canonical = 1;
3373 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3374 delete $new_data->{$key};
3375 delete $old_data->{$key};
3378 elsif ($new_data->{$key} eq $old_data->{$key}) {
3379 delete $new_data->{$key};
3380 delete $old_data->{$key};
3383 for my $key (keys %{$new_data}) {
3384 if (not exists $Debbugs::Status::fields{$key}) {
3385 delete $new_data->{$key};
3388 next unless exists $old_data->{$key};
3389 next unless defined $old_data->{$key};
3390 if (not defined $new_data->{$key} or
3391 not exists $Debbugs::Status::fields{$key}) {
3392 delete $new_data->{$key};
3395 if (ref($new_data->{$key}) and
3396 ref($old_data->{$key}) and
3397 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3398 local $Storable::canonical = 1;
3399 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3400 delete $new_data->{$key};
3401 delete $old_data->{$key};
3404 elsif ($new_data->{$key} eq $old_data->{$key}) {
3405 delete $new_data->{$key};
3406 delete $old_data->{$key};
3409 $data_diff .= "<!-- new_data:\n";
3411 for my $key (keys %{$new_data}) {
3412 if (not exists $Debbugs::Status::fields{$key}) {
3413 warn "No such field $key";
3416 $nd{$key} = $new_data->{$key};
3417 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n";
3419 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)]));
3420 $data_diff .= "-->\n";
3421 $data_diff .= "<!-- old_data:\n";
3423 for my $key (keys %{$old_data}) {
3424 if (not exists $Debbugs::Status::fields{$key}) {
3425 warn "No such field $key";
3428 $od{$key} = $old_data->{$key};
3429 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $old_data->{$key}")."\n";
3431 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%od)],[qw(old_data)]));
3432 $data_diff .= "-->\n";
3435 (exists $param{command} ?
3436 "<!-- command:".html_escape(encode_utf8($param{command}))." -->\n":""
3438 (length $param{requester} ?
3439 "<!-- requester: ".html_escape(encode_utf8($param{requester}))." -->\n":""
3441 (length $param{request_addr} ?
3442 "<!-- request_addr: ".html_escape(encode_utf8($param{request_addr}))." -->\n":""
3444 "<!-- time:".time()." -->\n",
3446 "<strong>".html_escape(encode_utf8($param{action}))."</strong>\n");
3447 if (length $param{requester}) {
3448 $msg .= "Request was from <code>".html_escape(encode_utf8($param{requester}))."</code>\n";
3450 if (length $param{request_addr}) {
3451 $msg .= "to <code>".html_escape(encode_utf8($param{request_addr}))."</code>";
3453 if (length $param{desc}) {
3454 $msg .= ":<br>\n".encode_utf8($param{desc})."\n";
3459 push @records, {type => 'html',
3463 if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
3464 push @records, {type => exists $param{recips}?'recips':'incoming-recv',
3465 exists $param{recips}?(recips => [make_list($param{recips})]):(),
3466 text => join('',make_list($param{message})),
3469 write_log_records(logfh=>$logfh,
3470 records => \@records,
3472 close $logfh or die "Unable to close $log_location: $!";
3473 if ($param{get_lock}) {
3474 unfilelock(exists $param{locks}?$param{locks}:());
3482 =head1 PRIVATE FUNCTIONS
3484 =head2 __handle_affected_packages
3486 __handle_affected_packages(affected_packages => {},
3494 sub __handle_affected_packages{
3495 my %param = validate_with(params => \@_,
3496 spec => {%common_options,
3497 data => {type => ARRAYREF|HASHREF
3502 for my $data (make_list($param{data})) {
3503 next unless exists $data->{package} and defined $data->{package};
3504 my @packages = split /\s*,\s*/,$data->{package};
3505 @{$param{affected_packages}}{@packages} = (1) x @packages;
3509 =head2 __handle_debug_transcript
3511 my ($debug,$transcript) = __handle_debug_transcript(%param);
3513 Returns a debug and transcript filehandle
3518 sub __handle_debug_transcript{
3519 my %param = validate_with(params => \@_,
3520 spec => {%common_options},
3523 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
3524 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3525 return ($debug,$transcript);
3532 Produces a small bit of bug information to kick out to the transcript
3539 next unless defined $data and exists $data->{bug_num};
3540 $return .= "Bug #".($data->{bug_num}||'').
3541 ((defined $data->{done} and length $data->{done})?
3542 " {Done: $data->{done}}":''
3544 " [".($data->{package}||'(no package)'). "] ".
3545 ($data->{subject}||'(no subject)')."\n";
3551 =head2 __internal_request
3553 __internal_request()
3554 __internal_request($level)
3556 Returns true if the caller of the function calling __internal_request
3557 belongs to __PACKAGE__
3559 This allows us to be magical, and don't bother to print bug info if
3560 the second caller is from this package, amongst other things.
3562 An optional level is allowed, which increments the number of levels to
3563 check by the given value. [This is basically for use by internal
3564 functions like __begin_control which are always called by
3569 sub __internal_request{
3571 $l = 0 if not defined $l;
3572 if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
3578 sub __return_append_to_log_options{
3580 my $action = $param{action} if exists $param{action};
3581 if (not exists $param{requester}) {
3582 $param{requester} = $config{control_internal_requester};
3584 if (not exists $param{request_addr}) {
3585 $param{request_addr} = $config{control_internal_request_addr};
3587 if (not exists $param{message}) {
3588 my $date = rfc822_date();
3589 $param{message} = fill_in_template(template => 'mail/fake_control_message',
3590 variables => {request_addr => $param{request_addr},
3591 requester => $param{requester},
3597 if (not defined $action) {
3598 carp "Undefined action!";
3599 $action = "unknown action";
3601 return (action => $action,
3602 hash_slice(%param,keys %append_action_options),
3606 =head2 __begin_control
3608 my %info = __begin_control(%param,
3610 command=>'unarchive');
3611 my ($debug,$transcript) = @info{qw(debug transcript)};
3612 my @data = @{$info{data}};
3613 my @bugs = @{$info{bugs}};
3616 Starts the process of modifying a bug; handles all of the generic
3617 things that almost every control request needs
3619 Returns a hash containing
3623 =item new_locks -- number of new locks taken out by this call
3625 =item debug -- the debug file handle
3627 =item transcript -- the transcript file handle
3629 =item data -- an arrayref containing the data of the bugs
3630 corresponding to this request
3632 =item bugs -- an arrayref containing the bug numbers of the bugs
3633 corresponding to this request
3641 sub __begin_control {
3642 my %param = validate_with(params => \@_,
3643 spec => {bug => {type => SCALAR,
3646 archived => {type => BOOLEAN,
3649 command => {type => SCALAR,
3657 my ($debug,$transcript) = __handle_debug_transcript(@_);
3658 print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
3659 # print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
3660 $lockhash = $param{locks} if exists $param{locks};
3662 my $old_die = $SIG{__DIE__};
3663 $SIG{__DIE__} = *sig_die{CODE};
3665 ($new_locks, @data) =
3666 lock_read_all_merged_bugs(bug => $param{bug},
3667 $param{archived}?(location => 'archive'):(),
3668 exists $param{locks} ? (locks => $param{locks}):(),
3670 $locks += $new_locks;
3672 die "Unable to read any bugs successfully.";
3674 if (not $param{archived}) {
3675 for my $data (@data) {
3676 if ($data->{archived}) {
3677 die "Not altering archived bugs; see unarchive.";
3681 if (not check_limit(data => \@data,
3682 exists $param{limit}?(limit => $param{limit}):(),
3683 transcript => $transcript,
3685 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
3688 __handle_affected_packages(%param,data => \@data);
3689 print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
3690 print {$debug} "$param{bug} read $locks locks\n";
3691 if (not @data or not defined $data[0]) {
3692 print {$transcript} "No bug found for $param{bug}\n";
3693 die "No bug found for $param{bug}";
3696 add_recipients(data => \@data,
3697 recipients => $param{recipients},
3698 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
3700 (__internal_request()?(transcript => $transcript):()),
3703 print {$debug} "$param{bug} read done\n";
3704 my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
3705 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3706 return (data => \@data,
3708 old_die => $old_die,
3709 new_locks => $new_locks,
3711 transcript => $transcript,
3713 exists $param{locks}?(locks => $param{locks}):(),
3717 =head2 __end_control
3719 __end_control(%info);
3721 Handles tearing down from a control request
3727 if (exists $info{new_locks} and $info{new_locks} > 0) {
3728 print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
3729 for (1..$info{new_locks}) {
3730 unfilelock(exists $info{locks}?$info{locks}:());
3734 $SIG{__DIE__} = $info{old_die};
3735 if (exists $info{param}{affected_bugs}) {
3736 @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
3738 add_recipients(recipients => $info{param}{recipients},
3739 (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
3740 data => $info{data},
3741 debug => $info{debug},
3742 transcript => $info{transcript},
3744 __handle_affected_packages(%{$info{param}},data=>$info{data});
3750 check_limit(data => \@data, limit => $param{limit});
3753 Checks to make sure that bugs match any limits; each entry of @data
3754 much satisfy the limit.
3756 Returns true if there are no entries in data, or there are no keys in
3757 limit; returns false (0) if there are any entries which do not match.
3759 The limit hashref elements can contain an arrayref of scalars to
3760 match; regexes are also acccepted. At least one of the entries in each
3761 element needs to match the corresponding field in all data for the
3768 my %param = validate_with(params => \@_,
3769 spec => {data => {type => ARRAYREF|HASHREF,
3771 limit => {type => HASHREF|UNDEF,
3773 transcript => {type => SCALARREF|HANDLE,
3778 my @data = make_list($param{data});
3780 not defined $param{limit} or
3781 not keys %{$param{limit}}) {
3784 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3785 my $going_to_fail = 0;
3786 for my $data (@data) {
3787 $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
3788 status => dclone($data),
3790 for my $field (keys %{$param{limit}}) {
3791 next unless exists $param{limit}{$field};
3793 my @data_fields = make_list($data->{$field});
3794 LIMIT: for my $limit (make_list($param{limit}{$field})) {
3795 if (not ref $limit) {
3796 for my $data_field (@data_fields) {
3797 if ($data_field eq $limit) {
3803 elsif (ref($limit) eq 'Regexp') {
3804 for my $data_field (@data_fields) {
3805 if ($data_field =~ $limit) {
3812 warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
3817 print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
3818 "' does not match at least one of ".
3819 join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
3823 return $going_to_fail?0:1;
3831 We override die to specially handle unlocking files in the cases where
3832 we are called via eval. [If we're not called via eval, it doesn't
3838 if ($^S) { # in eval
3840 for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
3847 # =head2 __message_body_template
3849 # message_body_template('mail/ack',{ref=>'foo'});
3851 # Creates a message body using a template
3855 sub __message_body_template{
3856 my ($template,$extra_var) = @_;
3858 my $hole_var = {'&bugurl' =>
3860 'http://'.$config{cgi_domain}.'/'.
3861 Debbugs::CGI::bug_links(bug => $_[0],
3867 my $body = fill_in_template(template => $template,
3868 variables => {config => \%config,
3871 hole_var => $hole_var,
3873 return fill_in_template(template => 'mail/message_body',
3874 variables => {config => \%config,
3878 hole_var => $hole_var,
3882 sub __all_undef_or_equal {
3884 return 1 if @values == 1 or @values == 0;
3885 my $not_def = grep {not defined $_} @values;
3886 if ($not_def == @values) {
3889 if ($not_def > 0 and $not_def != @values) {
3892 my $first_val = shift @values;
3893 for my $val (@values) {
3894 if ($first_val ne $val) {