1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007,2008,2009 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Control;
14 Debbugs::Control -- Routines for modifying the state of bugs
23 This module is an abstraction of a lot of functions which originally
24 were only present in service.in, but as time has gone on needed to be
25 called from elsewhere.
27 All of the public functions take the following options:
31 =item debug -- scalar reference to which debbuging information is
34 =item transcript -- scalar reference to which transcript information
37 =item affected_bugs -- hashref which is updated with bugs affected by
43 Functions which should (probably) append to the .log file take the
48 =item requester -- Email address of the individual who requested the change
50 =item request_addr -- Address to which the request was sent
52 =item request_nn -- Name of queue file which caused this request
54 =item request_msgid -- Message id of message which caused this request
56 =item location -- Optional location; currently ignored but may be
57 supported in the future for updating archived bugs upon archival
59 =item message -- The original message which caused the action to be taken
61 =item append_log -- Whether or not to append information to the log.
65 B<append_log> (for most functions) is a special option. When set to
66 false, no appending to the log is done at all. When it is not present,
67 the above information is faked, and appended to the log file. When it
68 is true, the above options must be present, and their values are used.
71 =head1 GENERAL FUNCTIONS
77 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
78 use Exporter qw(import);
82 $DEBUG = 0 unless defined $DEBUG;
85 %EXPORT_TAGS = (done => [qw(set_done)],
86 submitter => [qw(set_submitter)],
87 severity => [qw(set_severity)],
88 affects => [qw(affects)],
89 summary => [qw(summary)],
90 outlook => [qw(outlook)],
92 title => [qw(set_title)],
93 forward => [qw(set_forwarded)],
94 found => [qw(set_found set_fixed)],
95 fixed => [qw(set_found set_fixed)],
96 package => [qw(set_package)],
97 block => [qw(set_blocks)],
98 merge => [qw(set_merged)],
100 clone => [qw(clone_bug)],
101 archive => [qw(bug_archive bug_unarchive),
103 limit => [qw(check_limit)],
104 log => [qw(append_action_to_log),
108 Exporter::export_ok_tags(keys %EXPORT_TAGS);
109 $EXPORT_TAGS{all} = [@EXPORT_OK];
112 use Debbugs::Config qw(:config);
113 use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions);
115 use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
116 use Debbugs::CGI qw(html_escape);
117 use Debbugs::Log qw(:misc :write);
118 use Debbugs::Recipients qw(:add);
119 use Debbugs::Packages qw(:versions :mapping);
121 use Data::Dumper qw();
122 use Params::Validate qw(validate_with :types);
123 use File::Path qw(mkpath);
124 use File::Copy qw(copy);
127 use Debbugs::Text qw(:templates);
129 use Debbugs::Mail qw(rfc822_date send_mail_message default_headers encode_headers);
130 use Debbugs::MIME qw(create_mime_message);
132 use Mail::RFC822::Address qw();
134 use POSIX qw(strftime);
136 use Storable qw(dclone nfreeze);
137 use List::AllUtils qw(first max);
138 use Encode qw(encode_utf8);
142 # These are a set of options which are common to all of these functions
144 my %common_options = (debug => {type => SCALARREF|HANDLE,
147 transcript => {type => SCALARREF|HANDLE,
150 affected_bugs => {type => HASHREF,
153 affected_packages => {type => HASHREF,
156 recipients => {type => HASHREF,
159 limit => {type => HASHREF,
162 show_bug_info => {type => BOOLEAN,
165 request_subject => {type => SCALAR,
166 default => 'Unknown Subject',
168 request_msgid => {type => SCALAR,
171 request_nn => {type => SCALAR,
174 request_replyto => {type => SCALAR,
177 locks => {type => HASHREF,
183 my %append_action_options =
184 (action => {type => SCALAR,
187 requester => {type => SCALAR,
190 request_addr => {type => SCALAR,
193 location => {type => SCALAR,
196 message => {type => SCALAR|ARRAYREF,
199 append_log => {type => BOOLEAN,
201 depends => [qw(requester request_addr),
205 # locks is both an append_action option, and a common option;
206 # it's ok for it to be in both places.
207 locks => {type => HASHREF,
215 # this is just a generic stub for Debbugs::Control functions.
220 # set_foo(bug => $ref,
221 # transcript => $transcript,
222 # ($dl > 0 ? (debug => $transcript):()),
223 # requester => $header{from},
224 # request_addr => $controlrequestaddr,
226 # affected_packages => \%affected_packages,
227 # recipients => \%recipients,
233 # print {$transcript} "Failed to set foo $ref bar: $@";
241 # my %param = validate_with(params => \@_,
242 # spec => {bug => {type => SCALAR,
243 # regex => qr/^\d+$/,
245 # # specific options here
247 # %append_action_options,
251 # __begin_control(%param,
254 # my ($debug,$transcript) =
255 # @info{qw(debug transcript)};
256 # my @data = @{$info{data}};
257 # my @bugs = @{$info{bugs}};
260 # for my $data (@data) {
261 # append_action_to_log(bug => $data->{bug_num},
263 # __return_append_to_log_options(
268 # if not exists $param{append_log} or $param{append_log};
269 # writebug($data->{bug_num},$data);
270 # print {$transcript} "$action\n";
272 # __end_control(%info);
279 set_block(bug => $ref,
280 transcript => $transcript,
281 ($dl > 0 ? (debug => $transcript):()),
282 requester => $header{from},
283 request_addr => $controlrequestaddr,
285 affected_packages => \%affected_packages,
286 recipients => \%recipients,
292 print {$transcript} "Failed to set blockers of $ref: $@";
295 Alters the set of bugs that block this bug from being fixed
297 This requires altering both this bug (and those it's merged with) as
298 well as the bugs that block this bug from being fixed (and those that
303 =item block -- scalar or arrayref of blocking bugs to set, add or remove
305 =item add -- if true, add blocking bugs
307 =item remove -- if true, remove blocking bugs
314 my %param = validate_with(params => \@_,
315 spec => {bug => {type => SCALAR,
318 # specific options here
319 block => {type => SCALAR|ARRAYREF,
322 add => {type => BOOLEAN,
325 remove => {type => BOOLEAN,
329 %append_action_options,
332 if ($param{add} and $param{remove}) {
333 croak "It's nonsensical to add and remove the same blocking bugs";
335 if (grep {$_ !~ /^\d+$/} make_list($param{block})) {
336 croak "Invalid blocking bug(s):".
337 join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
343 elsif ($param{remove}) {
348 __begin_control(%param,
351 my ($debug,$transcript) =
352 @info{qw(debug transcript)};
353 my @data = @{$info{data}};
354 my @bugs = @{$info{bugs}};
357 # The first bit of this code is ugly, and should be cleaned up.
358 # Its purpose is to populate %removed_blockers and %add_blockers
359 # with all of the bugs that should be added or removed as blockers
360 # of all of the bugs which are merged with $param{bug}
363 for my $blocker (make_list($param{block})) {
364 next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
365 my $data = read_bug(bug=>$blocker,
367 if (defined $data and not $data->{archive}) {
368 $data = split_status_fields($data);
369 $ok_blockers{$blocker} = 1;
371 push @merged_bugs, make_list($data->{mergedwith});
372 @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
375 $bad_blockers{$blocker} = 1;
379 # throw an error if we are setting the blockers and there is a bad
381 if (keys %bad_blockers and $mode eq 'set') {
382 __end_control(%info);
383 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
384 keys %ok_blockers?'':" and no known blocking bug(s)";
386 # if there are no ok blockers and we are not setting the blockers,
388 if (not keys %ok_blockers and $mode ne 'set') {
389 print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
390 if (keys %bad_blockers) {
391 __end_control(%info);
392 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
394 __end_control(%info);
398 my @change_blockers = keys %ok_blockers;
400 my %removed_blockers;
403 my @blockers = map {split ' ', $_->{blockedby}} @data;
405 @blockers{@blockers} = (1) x @blockers;
407 # it is nonsensical for a bug to block itself (or a merged
408 # partner); We currently don't allow removal because we'd possibly
412 @bugs{@bugs} = (1) x @bugs;
413 for my $blocker (@change_blockers) {
414 if ($bugs{$blocker}) {
415 __end_control(%info);
416 croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
419 @blockers = keys %blockers;
421 %removed_blockers = ();
422 for my $blocker (@change_blockers) {
423 next if exists $blockers{$blocker};
424 $blockers{$blocker} = 1;
425 $added_blockers{$blocker} = 1;
428 elsif ($param{remove}) {
429 %added_blockers = ();
430 for my $blocker (@change_blockers) {
431 next if exists $removed_blockers{$blocker};
432 delete $blockers{$blocker};
433 $removed_blockers{$blocker} = 1;
437 @removed_blockers{@blockers} = (1) x @blockers;
439 for my $blocker (@change_blockers) {
440 next if exists $blockers{$blocker};
441 $blockers{$blocker} = 1;
442 if (exists $removed_blockers{$blocker}) {
443 delete $removed_blockers{$blocker};
446 $added_blockers{$blocker} = 1;
450 for my $data (@data) {
451 my $old_data = dclone($data);
452 # remove blockers and/or add new ones as appropriate
453 if ($data->{blockedby} eq '') {
454 print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n";
456 print {$transcript} "$data->{bug_num} was blocked by: $data->{blockedby}\n";
458 if ($data->{blocks} eq '') {
459 print {$transcript} "$data->{bug_num} was not blocking any bugs.\n";
461 print {$transcript} "$data->{bug_num} was blocking: $data->{blocks}\n";
464 push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
465 push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
466 $action = ucfirst(join ('; ',@changed)) if @changed;
468 print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n";
471 $data->{blockedby} = join(' ',keys %blockers);
472 append_action_to_log(bug => $data->{bug_num},
474 old_data => $old_data,
477 __return_append_to_log_options(
482 if not exists $param{append_log} or $param{append_log};
483 writebug($data->{bug_num},$data);
484 print {$transcript} "$action\n";
486 # we do this bit below to avoid code duplication
488 $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
489 $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
491 for my $add_remove (keys %mungable_blocks) {
493 for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
494 next if $munge_blockers{$blocker};
495 my ($temp_locks, @blocking_data) =
496 lock_read_all_merged_bugs(bug => $blocker,
497 ($param{archived}?(location => 'archive'):()),
498 exists $param{locks}?(locks => $param{locks}):(),
500 $locks+= $temp_locks;
501 $new_locks+=$temp_locks;
502 if (not @blocking_data) {
503 for (1..$new_locks) {
504 unfilelock(exists $param{locks}?$param{locks}:());
507 die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
509 for (map {$_->{bug_num}} @blocking_data) {
510 $munge_blockers{$_} = 1;
512 for my $data (@blocking_data) {
513 my $old_data = dclone($data);
515 my @blocks = split ' ', $data->{blocks};
516 @blocks{@blocks} = (1) x @blocks;
518 for my $bug (@bugs) {
519 if ($add_remove eq 'remove') {
520 next unless exists $blocks{$bug};
521 delete $blocks{$bug};
524 next if exists $blocks{$bug};
529 $data->{blocks} = join(' ',sort keys %blocks);
530 my $action = ($add_remove eq 'add'?'Added':'Removed').
531 " indication that bug $data->{bug_num} blocks ".
533 append_action_to_log(bug => $data->{bug_num},
535 old_data => $old_data,
538 __return_append_to_log_options(%param,
542 writebug($data->{bug_num},$data);
544 __handle_affected_packages(%param,data=>\@blocking_data);
545 add_recipients(recipients => $param{recipients},
546 actions_taken => {blocks => 1},
547 data => \@blocking_data,
549 transcript => $transcript,
552 for (1..$new_locks) {
553 unfilelock(exists $param{locks}?$param{locks}:());
558 __end_control(%info);
567 transcript => $transcript,
568 ($dl > 0 ? (debug => $transcript):()),
569 requester => $header{from},
570 request_addr => $controlrequestaddr,
572 affected_packages => \%affected_packages,
573 recipients => \%recipients,
580 print {$transcript} "Failed to set tag on $ref: $@";
584 Sets, adds, or removes the specified tags on a bug
588 =item tag -- scalar or arrayref of tags to set, add or remove
590 =item add -- if true, add tags
592 =item remove -- if true, remove tags
594 =item warn_on_bad_tags -- if true (the default) warn if bad tags are
602 my %param = validate_with(params => \@_,
603 spec => {bug => {type => SCALAR,
606 # specific options here
607 tag => {type => SCALAR|ARRAYREF,
610 add => {type => BOOLEAN,
613 remove => {type => BOOLEAN,
616 warn_on_bad_tags => {type => BOOLEAN,
620 %append_action_options,
623 if ($param{add} and $param{remove}) {
624 croak "It's nonsensical to add and remove the same tags";
628 __begin_control(%param,
631 my $transcript = $info{transcript};
632 my @data = @{$info{data}};
633 my @tags = make_list($param{tag});
634 if (not @tags and ($param{remove} or $param{add})) {
635 if ($param{remove}) {
636 print {$transcript} "Requested to remove no tags; doing nothing.\n";
639 print {$transcript} "Requested to add no tags; doing nothing.\n";
641 __end_control(%info);
644 # first things first, make the versions fully qualified source
646 for my $data (@data) {
647 my $action = 'Did not alter tags';
649 my %tag_removed = ();
650 my @old_tags = split /\,?\s+/, $data->{keywords};
652 @tags{@old_tags} = (1) x @old_tags;
653 my $old_data = dclone($data);
654 if (not $param{add} and not $param{remove}) {
655 $tag_removed{$_} = 1 for @old_tags;
659 for my $tag (@tags) {
660 if (not $param{remove} and
661 not defined first {$_ eq $tag} @{$config{tags}}) {
662 push @bad_tags, $tag;
666 if (not exists $tags{$tag}) {
668 $tag_added{$tag} = 1;
671 elsif ($param{remove}) {
672 if (exists $tags{$tag}) {
674 $tag_removed{$tag} = 1;
678 if (exists $tag_removed{$tag}) {
679 delete $tag_removed{$tag};
682 $tag_added{$tag} = 1;
687 if (@bad_tags and $param{warn_on_bad_tags}) {
688 print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
689 print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
691 $data->{keywords} = join(' ',keys %tags);
694 push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
695 push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
696 $action = ucfirst(join ('; ',@changed)) if @changed;
698 print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
702 append_action_to_log(bug => $data->{bug_num},
705 old_data => $old_data,
707 __return_append_to_log_options(
712 if not exists $param{append_log} or $param{append_log};
713 writebug($data->{bug_num},$data);
714 print {$transcript} "$action\n";
716 __end_control(%info);
724 set_severity(bug => $ref,
725 transcript => $transcript,
726 ($dl > 0 ? (debug => $transcript):()),
727 requester => $header{from},
728 request_addr => $controlrequestaddr,
730 affected_packages => \%affected_packages,
731 recipients => \%recipients,
732 severity => 'normal',
737 print {$transcript} "Failed to set the severity of bug $ref: $@";
740 Sets the severity of a bug. If severity is not passed, is undefined,
741 or has zero length, sets the severity to the default severity.
746 my %param = validate_with(params => \@_,
747 spec => {bug => {type => SCALAR,
750 # specific options here
751 severity => {type => SCALAR|UNDEF,
752 default => $config{default_severity},
755 %append_action_options,
758 if (not defined $param{severity} or
759 not length $param{severity}
761 $param{severity} = $config{default_severity};
764 # check validity of new severity
765 if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) {
766 die "Severity '$param{severity}' is not a valid severity level";
769 __begin_control(%param,
770 command => 'severity'
772 my $transcript = $info{transcript};
773 my @data = @{$info{data}};
776 for my $data (@data) {
777 if (not defined $data->{severity}) {
778 $data->{severity} = $param{severity};
779 $action = "Severity set to '$param{severity}'";
782 if ($data->{severity} eq '') {
783 $data->{severity} = $config{default_severity};
785 if ($data->{severity} eq $param{severity}) {
786 print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
789 $action = "Severity set to '$param{severity}' from '$data->{severity}'";
790 $data->{severity} = $param{severity};
792 append_action_to_log(bug => $data->{bug_num},
794 __return_append_to_log_options(
799 if not exists $param{append_log} or $param{append_log};
800 writebug($data->{bug_num},$data);
801 print {$transcript} "$action\n";
803 __end_control(%info);
810 set_done(bug => $ref,
811 transcript => $transcript,
812 ($dl > 0 ? (debug => $transcript):()),
813 requester => $header{from},
814 request_addr => $controlrequestaddr,
816 affected_packages => \%affected_packages,
817 recipients => \%recipients,
822 print {$transcript} "Failed to set foo $ref bar: $@";
830 my %param = validate_with(params => \@_,
831 spec => {bug => {type => SCALAR,
834 reopen => {type => BOOLEAN,
837 submitter => {type => SCALAR,
840 clear_fixed => {type => BOOLEAN,
843 notify_submitter => {type => BOOLEAN,
846 original_report => {type => SCALARREF,
849 done => {type => SCALAR|UNDEF,
853 %append_action_options,
857 if (exists $param{submitter} and
858 not Mail::RFC822::Address::valid($param{submitter})) {
859 die "New submitter address '$param{submitter}' is not a valid e-mail address";
861 if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
862 $param{done} = $param{requester};
864 if (exists $param{done} and
865 (not defined $param{done} or
866 not length $param{done})) {
872 __begin_control(%param,
873 command => $param{reopen}?'reopen':'done',
875 my $transcript = $info{transcript};
876 my @data = @{$info{data}};
879 if ($param{reopen}) {
880 # avoid warning multiple times if there are fixed versions
882 for my $data (@data) {
883 if (not exists $data->{done} or
884 not defined $data->{done} or
885 not length $data->{done}) {
886 print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
887 __end_control(%info);
890 if (@{$data->{fixed_versions}} and $warn_fixed) {
891 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
892 print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
896 $action = "Bug reopened";
897 for my $data (@data) {
898 my $old_data = dclone($data);
900 append_action_to_log(bug => $data->{bug_num},
903 old_data => $old_data,
905 __return_append_to_log_options(
910 if not exists $param{append_log} or $param{append_log};
911 writebug($data->{bug_num},$data);
913 print {$transcript} "$action\n";
914 __end_control(%info);
915 if (exists $param{submitter}) {
916 set_submitter(bug => $param{bug},
917 submitter => $param{submitter},
919 keys %common_options,
920 keys %append_action_options)
923 # clear the fixed revisions
924 if ($param{clear_fixed}) {
925 set_fixed(fixed => [],
929 keys %common_options,
930 keys %append_action_options),
935 my %submitter_notified;
936 my $orig_report_set = 0;
937 for my $data (@data) {
938 if (exists $data->{done} and
939 defined $data->{done} and
940 length $data->{done}) {
941 print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n";
942 __end_control(%info);
946 for my $data (@data) {
947 my $old_data = dclone($data);
948 my $hash = get_hashname($data->{bug_num});
949 my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or
950 die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!";
954 $orig_report= <$report_fh>;
957 if (not $orig_report_set and defined $orig_report and
958 length $orig_report and
959 exists $param{original_report}){
960 ${$param{original_report}} = $orig_report;
961 $orig_report_set = 1;
964 $action = "Marked $config{bug} as done";
966 # set done to the requester
967 $data->{done} = exists $param{done}?$param{done}:$param{requester};
968 append_action_to_log(bug => $data->{bug_num},
971 old_data => $old_data,
973 __return_append_to_log_options(
978 if not exists $param{append_log} or $param{append_log};
979 writebug($data->{bug_num},$data);
980 print {$transcript} "$action\n";
981 # get the original report
982 if ($param{notify_submitter}) {
983 my $submitter_message;
984 if(not exists $submitter_notified{$data->{originator}}) {
986 create_mime_message([default_headers(queue_file => $param{request_nn},
988 msgid => $param{request_msgid},
989 msgtype => 'notifdone',
990 pr_msg => 'they-closed',
992 [To => $data->{submitter},
993 Subject => "$config{ubug}#$data->{bug_num} ".
994 "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
998 __message_body_template('mail/process_your_bug_done',
1000 replyto => (exists $param{request_replyto} ?
1001 $param{request_replyto} :
1002 $param{requester} || 'Unknown'),
1003 markedby => $param{requester},
1004 subject => $param{request_subject},
1005 messageid => $param{request_msgid},
1008 [join('',make_list($param{message})),$orig_report]
1010 send_mail_message(message => $submitter_message,
1011 recipients => $old_data->{submitter},
1013 $submitter_notified{$data->{originator}} = $submitter_message;
1016 $submitter_message = $submitter_notified{$data->{originator}};
1018 append_action_to_log(bug => $data->{bug_num},
1019 action => "Notification sent",
1021 request_addr => $data->{originator},
1022 desc => "$config{bug} acknowledged by developer.",
1023 recips => [$data->{originator}],
1024 message => $submitter_message,
1029 __end_control(%info);
1030 if (exists $param{fixed}) {
1031 set_fixed(fixed => $param{fixed},
1035 keys %common_options,
1036 keys %append_action_options
1044 =head2 set_submitter
1047 set_submitter(bug => $ref,
1048 transcript => $transcript,
1049 ($dl > 0 ? (debug => $transcript):()),
1050 requester => $header{from},
1051 request_addr => $controlrequestaddr,
1053 affected_packages => \%affected_packages,
1054 recipients => \%recipients,
1055 submitter => $new_submitter,
1056 notify_submitter => 1,
1061 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1064 Sets the submitter of a bug. If notify_submitter is true (the
1065 default), notifies the old submitter of a bug on changes
1070 my %param = validate_with(params => \@_,
1071 spec => {bug => {type => SCALAR,
1074 # specific options here
1075 submitter => {type => SCALAR,
1077 notify_submitter => {type => BOOLEAN,
1081 %append_action_options,
1084 if (not Mail::RFC822::Address::valid($param{submitter})) {
1085 die "New submitter address $param{submitter} is not a valid e-mail address";
1088 __begin_control(%param,
1089 command => 'submitter'
1091 my ($debug,$transcript) =
1092 @info{qw(debug transcript)};
1093 my @data = @{$info{data}};
1095 # here we only concern ourselves with the first of the merged bugs
1096 for my $data ($data[0]) {
1097 my $notify_old_submitter = 0;
1098 my $old_data = dclone($data);
1099 print {$debug} "Going to change bug submitter\n";
1100 if (((not defined $param{submitter} or not length $param{submitter}) and
1101 (not defined $data->{originator} or not length $data->{originator})) or
1102 (defined $param{submitter} and defined $data->{originator} and
1103 $param{submitter} eq $data->{originator})) {
1104 print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
1108 if (defined $data->{originator} and length($data->{originator})) {
1109 $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'.";
1110 $notify_old_submitter = 1;
1113 $action= "Set $config{bug} submitter to '$param{submitter}'.";
1115 $data->{originator} = $param{submitter};
1117 append_action_to_log(bug => $data->{bug_num},
1118 command => 'submitter',
1120 old_data => $old_data,
1122 __return_append_to_log_options(
1127 if not exists $param{append_log} or $param{append_log};
1128 writebug($data->{bug_num},$data);
1129 print {$transcript} "$action\n";
1130 # notify old submitter
1131 if ($notify_old_submitter and $param{notify_submitter}) {
1132 send_mail_message(message =>
1133 create_mime_message([default_headers(queue_file => $param{request_nn},
1135 msgid => $param{request_msgid},
1137 pr_msg => 'submitter-changed',
1139 [To => $old_data->{submitter},
1140 Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
1144 __message_body_template('mail/submitter_changed',
1145 {old_data => $old_data,
1147 replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
1151 recipients => $old_data->{submitter},
1155 __end_control(%info);
1160 =head2 set_forwarded
1163 set_forwarded(bug => $ref,
1164 transcript => $transcript,
1165 ($dl > 0 ? (debug => $transcript):()),
1166 requester => $header{from},
1167 request_addr => $controlrequestaddr,
1169 affected_packages => \%affected_packages,
1170 recipients => \%recipients,
1171 forwarded => $forward_to,
1176 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1179 Sets the location to which a bug is forwarded. Given an undef
1180 forwarded, unsets forwarded.
1186 my %param = validate_with(params => \@_,
1187 spec => {bug => {type => SCALAR,
1190 # specific options here
1191 forwarded => {type => SCALAR|UNDEF,
1194 %append_action_options,
1197 if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
1198 die "Non-printable characters are not allowed in the forwarded field";
1200 $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded};
1202 __begin_control(%param,
1203 command => 'forwarded'
1205 my ($debug,$transcript) =
1206 @info{qw(debug transcript)};
1207 my @data = @{$info{data}};
1209 for my $data (@data) {
1210 my $old_data = dclone($data);
1211 print {$debug} "Going to change bug forwarded\n";
1212 if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or
1213 (not defined $param{forwarded} and
1214 defined $data->{forwarded} and not length $data->{forwarded})) {
1215 print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n";
1219 if (not defined $param{forwarded}) {
1220 $action= "Unset $config{bug} forwarded-to-address";
1222 elsif (defined $data->{forwarded} and length($data->{forwarded})) {
1223 $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'.";
1226 $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
1228 $data->{forwarded} = $param{forwarded};
1230 append_action_to_log(bug => $data->{bug_num},
1231 command => 'forwarded',
1233 old_data => $old_data,
1235 __return_append_to_log_options(
1240 if not exists $param{append_log} or $param{append_log};
1241 writebug($data->{bug_num},$data);
1242 print {$transcript} "$action\n";
1244 __end_control(%info);
1253 set_title(bug => $ref,
1254 transcript => $transcript,
1255 ($dl > 0 ? (debug => $transcript):()),
1256 requester => $header{from},
1257 request_addr => $controlrequestaddr,
1259 affected_packages => \%affected_packages,
1260 recipients => \%recipients,
1261 title => $new_title,
1266 print {$transcript} "Failed to set the title of $ref: $@";
1269 Sets the title of a specific bug
1275 my %param = validate_with(params => \@_,
1276 spec => {bug => {type => SCALAR,
1279 # specific options here
1280 title => {type => SCALAR,
1283 %append_action_options,
1286 if ($param{title} =~ /[^[:print:]]/) {
1287 die "Non-printable characters are not allowed in bug titles";
1290 my %info = __begin_control(%param,
1293 my ($debug,$transcript) =
1294 @info{qw(debug transcript)};
1295 my @data = @{$info{data}};
1297 for my $data (@data) {
1298 my $old_data = dclone($data);
1299 print {$debug} "Going to change bug title\n";
1300 if (defined $data->{subject} and length($data->{subject}) and
1301 $data->{subject} eq $param{title}) {
1302 print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
1306 if (defined $data->{subject} and length($data->{subject})) {
1307 $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'.";
1309 $action= "Set $config{bug} title to '$param{title}'.";
1311 $data->{subject} = $param{title};
1313 append_action_to_log(bug => $data->{bug_num},
1316 old_data => $old_data,
1318 __return_append_to_log_options(
1323 if not exists $param{append_log} or $param{append_log};
1324 writebug($data->{bug_num},$data);
1325 print {$transcript} "$action\n";
1327 __end_control(%info);
1334 set_package(bug => $ref,
1335 transcript => $transcript,
1336 ($dl > 0 ? (debug => $transcript):()),
1337 requester => $header{from},
1338 request_addr => $controlrequestaddr,
1340 affected_packages => \%affected_packages,
1341 recipients => \%recipients,
1342 package => $new_package,
1348 print {$transcript} "Failed to assign or reassign $ref to a package: $@";
1351 Indicates that a bug is in a particular package. If is_source is true,
1352 indicates that the package is a source package. [Internally, this
1353 causes src: to be prepended to the package name.]
1355 The default for is_source is 0. As a special case, if the package
1356 starts with 'src:', it is assumed to be a source package and is_source
1359 The package option must match the package_name_re regex.
1364 my %param = validate_with(params => \@_,
1365 spec => {bug => {type => SCALAR,
1368 # specific options here
1369 package => {type => SCALAR|ARRAYREF,
1371 is_source => {type => BOOLEAN,
1375 %append_action_options,
1378 my @new_packages = map {splitpackages($_)} make_list($param{package});
1379 if (grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages) {
1380 croak "Invalid package name '".
1381 join(',',grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages).
1384 my %info = __begin_control(%param,
1385 command => 'package',
1387 my ($debug,$transcript) =
1388 @info{qw(debug transcript)};
1389 my @data = @{$info{data}};
1390 # clean up the new package
1394 ($temp =~ s/^src:// or
1395 $param{is_source}) ? 'src:'.$temp:$temp;
1399 my $package_reassigned = 0;
1400 for my $data (@data) {
1401 my $old_data = dclone($data);
1402 print {$debug} "Going to change assigned package\n";
1403 if (defined $data->{package} and length($data->{package}) and
1404 $data->{package} eq $new_package) {
1405 print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
1409 if (defined $data->{package} and length($data->{package})) {
1410 $package_reassigned = 1;
1411 $action= "$config{bug} reassigned from package '$data->{package}'".
1412 " to '$new_package'.";
1414 $action= "$config{bug} assigned to package '$new_package'.";
1416 $data->{package} = $new_package;
1418 append_action_to_log(bug => $data->{bug_num},
1419 command => 'package',
1421 old_data => $old_data,
1423 __return_append_to_log_options(
1428 if not exists $param{append_log} or $param{append_log};
1429 writebug($data->{bug_num},$data);
1430 print {$transcript} "$action\n";
1432 __end_control(%info);
1433 # Only clear the fixed/found versions if the package has been
1435 if ($package_reassigned) {
1436 my @params_for_found_fixed =
1437 map {exists $param{$_}?($_,$param{$_}):()}
1439 keys %common_options,
1440 keys %append_action_options,
1442 set_found(found => [],
1443 @params_for_found_fixed,
1445 set_fixed(fixed => [],
1446 @params_for_found_fixed,
1454 set_found(bug => $ref,
1455 transcript => $transcript,
1456 ($dl > 0 ? (debug => $transcript):()),
1457 requester => $header{from},
1458 request_addr => $controlrequestaddr,
1460 affected_packages => \%affected_packages,
1461 recipients => \%recipients,
1468 print {$transcript} "Failed to set found on $ref: $@";
1472 Sets, adds, or removes the specified found versions of a package
1474 If the version list is empty, and the bug is currently not "done",
1475 causes the done field to be cleared.
1477 If any of the versions added to found are greater than any version in
1478 which the bug is fixed (or when the bug is found and there are no
1479 fixed versions) the done field is cleared.
1484 my %param = validate_with(params => \@_,
1485 spec => {bug => {type => SCALAR,
1488 # specific options here
1489 found => {type => SCALAR|ARRAYREF,
1492 add => {type => BOOLEAN,
1495 remove => {type => BOOLEAN,
1499 %append_action_options,
1502 if ($param{add} and $param{remove}) {
1503 croak "It's nonsensical to add and remove the same versions";
1507 __begin_control(%param,
1510 my ($debug,$transcript) =
1511 @info{qw(debug transcript)};
1512 my @data = @{$info{data}};
1514 for my $version (make_list($param{found})) {
1515 next unless defined $version;
1516 $versions{$version} =
1517 [make_source_versions(package => [splitpackages($data[0]{package})],
1518 warnings => $transcript,
1521 versions => $version,
1524 # This is really ugly, but it's what we have to do
1525 if (not @{$versions{$version}}) {
1526 print {$transcript} "Unable to make a source version for version '$version'\n";
1529 if (not keys %versions and ($param{remove} or $param{add})) {
1530 if ($param{remove}) {
1531 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1534 print {$transcript} "Requested to add no versions; doing nothing.\n";
1536 __end_control(%info);
1539 # first things first, make the versions fully qualified source
1541 for my $data (@data) {
1542 # The 'done' field gets a bit weird with version tracking,
1543 # because a bug may be closed by multiple people in different
1544 # branches. Until we have something more flexible, we set it
1545 # every time a bug is fixed, and clear it when a bug is found
1546 # in a version greater than any version in which the bug is
1547 # fixed or when a bug is found and there is no fixed version
1548 my $action = 'Did not alter found versions';
1549 my %found_added = ();
1550 my %found_removed = ();
1551 my %fixed_removed = ();
1553 my $old_data = dclone($data);
1554 if (not $param{add} and not $param{remove}) {
1555 $found_removed{$_} = 1 for @{$data->{found_versions}};
1556 $data->{found_versions} = [];
1559 @found_versions{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1561 @fixed_versions{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1562 for my $version (keys %versions) {
1564 my @svers = @{$versions{$version}};
1568 elsif (not grep {$version eq $_} @svers) {
1569 # The $version was not equal to one of the source
1570 # versions, so it's probably unqualified (or just
1571 # wrong). Delete it, and use the source versions
1573 if (exists $found_versions{$version}) {
1574 delete $found_versions{$version};
1575 $found_removed{$version} = 1;
1578 for my $sver (@svers) {
1579 if (not exists $found_versions{$sver}) {
1580 $found_versions{$sver} = 1;
1581 $found_added{$sver} = 1;
1583 # if the found we are adding matches any fixed
1584 # versions, remove them
1585 my @temp = grep m{(^|/)\Q$sver\E$}, keys %fixed_versions;
1586 delete $fixed_versions{$_} for @temp;
1587 $fixed_removed{$_} = 1 for @temp;
1590 # We only care about reopening the bug if the bug is
1592 if (defined $data->{done} and length $data->{done}) {
1593 my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
1595 # determine if we need to reopen
1596 my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
1597 keys %fixed_versions);
1598 if (not @fixed_order or
1599 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1605 elsif ($param{remove}) {
1606 # in the case of removal, we only concern ourself with
1607 # the version passed, not the source version it maps
1609 my @temp = grep m{(?:^|/)\Q$version\E$}, keys %found_versions;
1610 delete $found_versions{$_} for @temp;
1611 $found_removed{$_} = 1 for @temp;
1614 # set the keys to exactly these values
1615 my @svers = @{$versions{$version}};
1619 for my $sver (@svers) {
1620 if (not exists $found_versions{$sver}) {
1621 $found_versions{$sver} = 1;
1622 if (exists $found_removed{$sver}) {
1623 delete $found_removed{$sver};
1626 $found_added{$sver} = 1;
1633 $data->{found_versions} = [keys %found_versions];
1634 $data->{fixed_versions} = [keys %fixed_versions];
1637 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1638 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1639 # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
1640 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1641 $action = ucfirst(join ('; ',@changed)) if @changed;
1643 $action .= " and reopened"
1645 if (not $reopened and not @changed) {
1646 print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
1650 append_action_to_log(bug => $data->{bug_num},
1653 old_data => $old_data,
1655 __return_append_to_log_options(
1660 if not exists $param{append_log} or $param{append_log};
1661 writebug($data->{bug_num},$data);
1662 print {$transcript} "$action\n";
1664 __end_control(%info);
1670 set_fixed(bug => $ref,
1671 transcript => $transcript,
1672 ($dl > 0 ? (debug => $transcript):()),
1673 requester => $header{from},
1674 request_addr => $controlrequestaddr,
1676 affected_packages => \%affected_packages,
1677 recipients => \%recipients,
1685 print {$transcript} "Failed to set fixed on $ref: $@";
1689 Sets, adds, or removes the specified fixed versions of a package
1691 If the fixed versions are empty (or end up being empty after this
1692 call) or the greatest fixed version is less than the greatest found
1693 version and the reopen option is true, the bug is reopened.
1695 This function is also called by the reopen function, which causes all
1696 of the fixed versions to be cleared.
1701 my %param = validate_with(params => \@_,
1702 spec => {bug => {type => SCALAR,
1705 # specific options here
1706 fixed => {type => SCALAR|ARRAYREF,
1709 add => {type => BOOLEAN,
1712 remove => {type => BOOLEAN,
1715 reopen => {type => BOOLEAN,
1719 %append_action_options,
1722 if ($param{add} and $param{remove}) {
1723 croak "It's nonsensical to add and remove the same versions";
1726 __begin_control(%param,
1729 my ($debug,$transcript) =
1730 @info{qw(debug transcript)};
1731 my @data = @{$info{data}};
1733 for my $version (make_list($param{fixed})) {
1734 next unless defined $version;
1735 $versions{$version} =
1736 [make_source_versions(package => [splitpackages($data[0]{package})],
1737 warnings => $transcript,
1740 versions => $version,
1743 # This is really ugly, but it's what we have to do
1744 if (not @{$versions{$version}}) {
1745 print {$transcript} "Unable to make a source version for version '$version'\n";
1748 if (not keys %versions and ($param{remove} or $param{add})) {
1749 if ($param{remove}) {
1750 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1753 print {$transcript} "Requested to add no versions; doing nothing.\n";
1755 __end_control(%info);
1758 # first things first, make the versions fully qualified source
1760 for my $data (@data) {
1761 my $old_data = dclone($data);
1762 # The 'done' field gets a bit weird with version tracking,
1763 # because a bug may be closed by multiple people in different
1764 # branches. Until we have something more flexible, we set it
1765 # every time a bug is fixed, and clear it when a bug is found
1766 # in a version greater than any version in which the bug is
1767 # fixed or when a bug is found and there is no fixed version
1768 my $action = 'Did not alter fixed versions';
1769 my %found_added = ();
1770 my %found_removed = ();
1771 my %fixed_added = ();
1772 my %fixed_removed = ();
1774 if (not $param{add} and not $param{remove}) {
1775 $fixed_removed{$_} = 1 for @{$data->{fixed_versions}};
1776 $data->{fixed_versions} = [];
1779 @found_versions{@{$data->{found_versions}||[]}} = (1) x @{$data->{found_versions}||[]};
1781 @fixed_versions{@{$data->{fixed_versions}||[]}} = (1) x @{$data->{fixed_versions}||[]};
1782 for my $version (keys %versions) {
1784 my @svers = @{$versions{$version}};
1789 if (exists $fixed_versions{$version}) {
1790 $fixed_removed{$version} = 1;
1791 delete $fixed_versions{$version};
1794 for my $sver (@svers) {
1795 if (not exists $fixed_versions{$sver}) {
1796 $fixed_versions{$sver} = 1;
1797 $fixed_added{$sver} = 1;
1801 elsif ($param{remove}) {
1802 # in the case of removal, we only concern ourself with
1803 # the version passed, not the source version it maps
1805 my @temp = grep m{(?:^|\/)\Q$version\E$}, keys %fixed_versions;
1806 delete $fixed_versions{$_} for @temp;
1807 $fixed_removed{$_} = 1 for @temp;
1810 # set the keys to exactly these values
1811 my @svers = @{$versions{$version}};
1815 for my $sver (@svers) {
1816 if (not exists $fixed_versions{$sver}) {
1817 $fixed_versions{$sver} = 1;
1818 if (exists $fixed_removed{$sver}) {
1819 delete $fixed_removed{$sver};
1822 $fixed_added{$sver} = 1;
1829 $data->{found_versions} = [keys %found_versions];
1830 $data->{fixed_versions} = [keys %fixed_versions];
1832 # If we're supposed to consider reopening, reopen if the
1833 # fixed versions are empty or the greatest found version
1834 # is greater than the greatest fixed version
1835 if ($param{reopen} and defined $data->{done}
1836 and length $data->{done}) {
1837 my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1838 map {m{([^/]+)$}; $1;} @{$data->{found_versions}};
1839 # determine if we need to reopen
1840 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1841 map {m{([^/]+)$}; $1;} @{$data->{fixed_versions}};
1842 if (not @fixed_order or
1843 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1850 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1851 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1852 push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
1853 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1854 $action = ucfirst(join ('; ',@changed)) if @changed;
1856 $action .= " and reopened"
1858 if (not $reopened and not @changed) {
1859 print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
1863 append_action_to_log(bug => $data->{bug_num},
1866 old_data => $old_data,
1868 __return_append_to_log_options(
1873 if not exists $param{append_log} or $param{append_log};
1874 writebug($data->{bug_num},$data);
1875 print {$transcript} "$action\n";
1877 __end_control(%info);
1884 set_merged(bug => $ref,
1885 transcript => $transcript,
1886 ($dl > 0 ? (debug => $transcript):()),
1887 requester => $header{from},
1888 request_addr => $controlrequestaddr,
1890 affected_packages => \%affected_packages,
1891 recipients => \%recipients,
1892 merge_with => 12345,
1895 allow_reassign => 1,
1896 reassign_same_source_only => 1,
1901 print {$transcript} "Failed to set merged on $ref: $@";
1905 Sets, adds, or removes the specified merged bugs of a bug
1907 By default, requires
1912 my %param = validate_with(params => \@_,
1913 spec => {bug => {type => SCALAR,
1916 # specific options here
1917 merge_with => {type => ARRAYREF|SCALAR,
1920 remove => {type => BOOLEAN,
1923 force => {type => BOOLEAN,
1926 masterbug => {type => BOOLEAN,
1929 allow_reassign => {type => BOOLEAN,
1932 reassign_different_sources => {type => BOOLEAN,
1936 %append_action_options,
1939 my @merging = exists $param{merge_with} ? make_list($param{merge_with}):();
1941 @merging{@merging} = (1) x @merging;
1942 if (grep {$_ !~ /^\d+$/} @merging) {
1943 croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging);
1945 $param{locks} = {} if not exists $param{locks};
1947 __begin_control(%param,
1950 my ($debug,$transcript) =
1951 @info{qw(debug transcript)};
1952 if (not @merging and exists $param{merge_with}) {
1953 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
1954 __end_control(%info);
1957 my @data = @{$info{data}};
1960 for my $data (@data) {
1961 $data{$data->{bug_num}} = $data;
1962 my @merged_bugs = split / /, $data->{mergedwith};
1963 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
1967 if (not exists $param{merge_with}) {
1968 delete $merged_bugs{$param{bug}};
1969 if (not keys %merged_bugs) {
1970 print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
1971 __end_control(%info);
1974 my $action = "Disconnected #$param{bug} from all other report(s).";
1975 for my $data (@data) {
1976 my $old_data = dclone($data);
1977 if ($data->{bug_num} == $param{bug}) {
1978 $data->{mergedwith} = '';
1981 $data->{mergedwith} =
1984 grep {$_ != $data->{bug_num}}
1987 append_action_to_log(bug => $data->{bug_num},
1990 old_data => $old_data,
1992 __return_append_to_log_options(%param,
1996 if not exists $param{append_log} or $param{append_log};
1997 writebug($data->{bug_num},$data);
1999 print {$transcript} "$action\n";
2000 __end_control(%info);
2003 # lock and load all of the bugs we need
2004 my ($data,$n_locks) =
2005 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2007 locks => $param{locks},
2010 $new_locks += $n_locks;
2012 @data = values %data;
2013 if (not check_limit(data => [@data],
2014 exists $param{limit}?(limit => $param{limit}):(),
2015 transcript => $transcript,
2017 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
2019 for my $data (@data) {
2020 $data{$data->{bug_num}} = $data;
2021 $merged_bugs{$data->{bug_num}} = 1;
2022 my @merged_bugs = split / /, $data->{mergedwith};
2023 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
2024 if (exists $param{affected_bugs}) {
2025 $param{affected_bugs}{$data->{bug_num}} = 1;
2028 __handle_affected_packages(%param,data => [@data]);
2029 my %bug_info_shown; # which bugs have had information shown
2030 $bug_info_shown{$param{bug}} = 1;
2031 add_recipients(data => [@data],
2032 recipients => $param{recipients},
2033 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
2035 (__internal_request()?(transcript => $transcript):()),
2038 # Figure out what the ideal state is for the bug,
2039 my ($merge_status,$bugs_to_merge) =
2040 __calculate_merge_status(\@data,\%data,$param{bug});
2041 # find out if we actually have any bugs to merge
2042 if (not $bugs_to_merge) {
2043 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
2044 for (1..$new_locks) {
2045 unfilelock($param{locks});
2048 __end_control(%info);
2051 # see what changes need to be made to merge the bugs
2052 # check to make sure that the set of changes we need to make is allowed
2053 my ($disallowed_changes,$changes) =
2054 __calculate_merge_changes(\@data,$merge_status,\%param);
2055 # at this point, stop if there are disallowed changes, otherwise
2056 # make the allowed changes, and then reread the bugs in question
2057 # to get the new data, then recaculate the merges; repeat
2058 # reloading and recalculating until we try too many times or there
2059 # are no changes to make.
2062 # we will allow at most 4 times through this; more than 1
2063 # shouldn't really happen.
2065 while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) {
2066 if ($attempts > 1) {
2067 print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n";
2069 if (@{$disallowed_changes}) {
2070 # figure out the problems
2071 print {$transcript} "Unable to merge bugs because:\n";
2072 for my $change (@{$disallowed_changes}) {
2073 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2075 if ($attempts > 0) {
2076 __end_control(%info);
2077 croak "Some bugs were altered while attempting to merge";
2080 __end_control(%info);
2081 croak "Did not alter merged bugs";
2084 my @bugs_to_change = keys %{$changes};
2085 for my $change_bug (@bugs_to_change) {
2086 next unless exists $changes->{$change_bug};
2087 $bug_changed{$change_bug}++;
2088 print {$transcript} __bug_info($data{$change_bug}) if
2089 $param{show_bug_info} and not __internal_request(1);
2090 $bug_info_shown{$change_bug} = 1;
2091 __allow_relocking($param{locks},[keys %data]);
2093 for my $change (@{$changes->{$change_bug}}) {
2094 if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
2095 my %target_blockedby;
2096 @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
2097 my %unhandled_targets = %target_blockedby;
2098 for my $key (split / /,$change->{orig_value}) {
2099 delete $unhandled_targets{$key};
2100 next if exists $target_blockedby{$key};
2101 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2102 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2105 keys %common_options,
2106 keys %append_action_options),
2109 for my $key (keys %unhandled_targets) {
2110 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2111 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2114 keys %common_options,
2115 keys %append_action_options),
2120 $change->{function}->(bug => $change->{bug},
2121 $change->{key}, $change->{func_value},
2122 exists $change->{options}?@{$change->{options}}:(),
2124 keys %common_options,
2125 keys %append_action_options),
2131 __disallow_relocking($param{locks});
2132 __end_control(%info);
2133 croak "Failure while trying to adjust bugs, please report this as a bug: $@";
2135 __disallow_relocking($param{locks});
2136 my ($data,$n_locks) =
2137 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2139 locks => $param{locks},
2143 $new_locks += $n_locks;
2146 @data = values %data;
2147 ($merge_status,$bugs_to_merge) =
2148 __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
2149 ($disallowed_changes,$changes) =
2150 __calculate_merge_changes(\@data,$merge_status,\%param);
2151 $attempts = max(values %bug_changed);
2154 if ($param{show_bug_info} and not __internal_request(1)) {
2155 for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) {
2156 next if $bug_info_shown{$data->{bug_num}};
2157 print {$transcript} __bug_info($data);
2160 if (keys %{$changes} or @{$disallowed_changes}) {
2161 print {$transcript} "After four attempts, the following changes were unable to be made:\n";
2162 for (1..$new_locks) {
2163 unfilelock($param{locks});
2166 __end_control(%info);
2167 for my $change ((map {@{$_}} values %{$changes}), @{$disallowed_changes}) {
2168 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2170 die "Unable to modify bugs so they could be merged";
2174 # finally, we can merge the bugs
2175 my $action = "Merged ".join(' ',sort { $a <=> $b } keys %merged_bugs);
2176 for my $data (@data) {
2177 my $old_data = dclone($data);
2178 $data->{mergedwith} =
2181 grep {$_ != $data->{bug_num}}
2183 append_action_to_log(bug => $data->{bug_num},
2186 old_data => $old_data,
2188 __return_append_to_log_options(%param,
2192 if not exists $param{append_log} or $param{append_log};
2193 writebug($data->{bug_num},$data);
2195 print {$transcript} "$action\n";
2196 # unlock the extra locks that we got earlier
2197 for (1..$new_locks) {
2198 unfilelock($param{locks});
2201 __end_control(%info);
2204 sub __allow_relocking{
2205 my ($locks,$bugs) = @_;
2207 my @locks = (@{$bugs},'merge');
2208 for my $lock (@locks) {
2209 my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
2210 next unless @lockfiles;
2211 $locks->{relockable}{$lockfiles[0]} = 0;
2215 sub __disallow_relocking{
2217 delete $locks->{relockable};
2220 sub __lock_and_load_merged_bugs{
2222 validate_with(params => \@_,
2224 {bugs_to_load => {type => ARRAYREF,
2225 default => sub {[]},
2227 data => {type => HASHREF|ARRAYREF,
2229 locks => {type => HASHREF,
2230 default => sub {{};},
2232 reload_all => {type => BOOLEAN,
2235 debug => {type => HANDLE,
2241 if (ref($param{data}) eq 'ARRAY') {
2242 for my $data (@{$param{data}}) {
2243 $data{$data->{bug_num}} = dclone($data);
2247 %data = %{dclone($param{data})};
2249 my @bugs_to_load = @{$param{bugs_to_load}};
2250 if ($param{reload_all}) {
2251 push @bugs_to_load, keys %data;
2254 @temp{@bugs_to_load} = (1) x @bugs_to_load;
2255 @bugs_to_load = keys %temp;
2256 my %loaded_this_time;
2258 while ($bug_to_load = shift @bugs_to_load) {
2259 if (not $param{reload_all}) {
2260 next if exists $data{$bug_to_load};
2263 next if $loaded_this_time{$bug_to_load};
2266 if ($param{reload_all}) {
2267 if (exists $data{$bug_to_load}) {
2272 read_bug(bug => $bug_to_load,
2274 locks => $param{locks},
2276 die "Unable to load bug $bug_to_load";
2277 print {$param{debug}} "read bug $bug_to_load\n";
2278 $data{$data->{bug_num}} = $data;
2279 $new_locks += $lock_bug;
2280 $loaded_this_time{$data->{bug_num}} = 1;
2282 grep {not exists $data{$_}}
2283 split / /,$data->{mergedwith};
2285 return (\%data,$new_locks);
2289 sub __calculate_merge_status{
2290 my ($data_a,$data_h,$master_bug,$merge_status) = @_;
2291 my %merge_status = %{$merge_status // {}};
2293 my $bugs_to_merge = 0;
2294 for my $data (@{$data_a}) {
2295 # check to see if this bug is unmerged in the set
2296 if (not length $data->{mergedwith} or
2297 grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) {
2298 $merged_bugs{$data->{bug_num}} = 1;
2302 for my $data (@{$data_a}) {
2303 # the master_bug is the bug that every other bug is made to
2304 # look like. However, if merge is set, tags, fixed and found
2306 if ($data->{bug_num} == $master_bug) {
2307 for (qw(package forwarded severity done owner summary outlook affects)) {
2308 $merge_status{$_} = $data->{$_}
2310 # bugs which are in the newly merged set and are also
2311 # blocks/blockedby must be removed before merging
2312 for (qw(blocks blockedby)) {
2314 join(' ',grep {not exists $merged_bugs{$_}}
2315 split / /,$data->{$_});
2318 if (defined $merge_status) {
2319 next unless $data->{bug_num} == $master_bug;
2321 $merge_status{tag} = {} if not exists $merge_status{tag};
2322 for my $tag (split /\s+/, $data->{keywords}) {
2323 $merge_status{tag}{$tag} = 1;
2325 $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}});
2326 for (qw(fixed found)) {
2327 @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
2330 # if there is a non-source qualified version with a corresponding
2331 # source qualified version, we only want to merge the source
2332 # qualified version(s)
2333 for (qw(fixed found)) {
2334 my @unqualified_versions = grep {m{/}?0:1} keys %{$merge_status{"${_}_versions"}};
2335 for my $unqualified_version (@unqualified_versions) {
2336 if (grep {m{/\Q$unqualified_version\E}} keys %{$merge_status{"${_}_versions"}}) {
2337 delete $merge_status{"${_}_versions"}{$unqualified_version};
2341 return (\%merge_status,$bugs_to_merge);
2346 sub __calculate_merge_changes{
2347 my ($datas,$merge_status,$param) = @_;
2349 my @disallowed_changes;
2350 for my $data (@{$datas}) {
2351 # things that can be forced
2353 # * func is the function to set the new value
2355 # * key is the key of the function to set the value,
2357 # * modify_value is a function which is called to modify the new
2358 # value so that the function will accept it
2360 # * options is an ARRAYREF of options to pass to the function
2362 # * allowed is a BOOLEAN which controls whether this setting
2363 # is allowed to be different by default.
2364 my %force_functions =
2365 (forwarded => {func => \&set_forwarded,
2369 severity => {func => \&set_severity,
2373 blocks => {func => \&set_blocks,
2374 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2378 blockedby => {func => \&set_blocks,
2379 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2383 done => {func => \&set_done,
2387 owner => {func => \&owner,
2391 summary => {func => \&summary,
2395 outlook => {func => \&outlook,
2399 affects => {func => \&affects,
2403 package => {func => \&set_package,
2407 keywords => {func => \&set_tag,
2409 modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]},
2412 fixed_versions => {func => \&set_fixed,
2414 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2417 found_versions => {func => \&set_found,
2419 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2423 for my $field (qw(forwarded severity blocks blockedby done owner summary outlook affects package fixed_versions found_versions keywords)) {
2424 # if the ideal bug already has the field set properly, we
2426 if ($field eq 'keywords'){
2427 next if join(' ',sort split /\s+/,$data->{keywords}) eq
2428 join(' ',sort keys %{$merge_status->{tag}});
2430 elsif ($field =~ /^(?:fixed|found)_versions$/) {
2431 next if join(' ', sort @{$data->{$field}}) eq
2432 join(' ',sort keys %{$merge_status->{$field}});
2434 elsif ($field eq 'done') {
2435 # for done, we only care if the bug is done or not
2436 # done, not the value it's set to.
2437 if (defined $merge_status->{$field} and length $merge_status->{$field} and
2438 defined $data->{$field} and length $data->{$field}) {
2441 elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
2442 (not defined $data->{$field} or not length $data->{$field})
2447 elsif ($merge_status->{$field} eq $data->{$field}) {
2452 bug => $data->{bug_num},
2453 orig_value => $data->{$field},
2455 (exists $force_functions{$field}{modify_value} ?
2456 $force_functions{$field}{modify_value}->($merge_status->{$field}):
2457 $merge_status->{$field}),
2458 value => $merge_status->{$field},
2459 function => $force_functions{$field}{func},
2460 key => $force_functions{$field}{key},
2461 options => $force_functions{$field}{options},
2462 allowed => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
2464 $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
2465 $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
2466 if ($param->{force} or $change->{allowed}) {
2467 if ($field ne 'package' or $change->{allowed}) {
2468 push @{$changes{$data->{bug_num}}},$change;
2471 if ($param->{allow_reassign}) {
2472 if ($param->{reassign_different_sources}) {
2473 push @{$changes{$data->{bug_num}}},$change;
2476 # allow reassigning if binary_to_source returns at
2477 # least one of the same source packages
2478 my @merge_status_source =
2479 binary_to_source(package => $merge_status->{package},
2482 my @other_bug_source =
2483 binary_to_source(package => $data->{package},
2486 my %merge_status_sources;
2487 @merge_status_sources{@merge_status_source} =
2488 (1) x @merge_status_source;
2489 if (grep {$merge_status_sources{$_}} @other_bug_source) {
2490 push @{$changes{$data->{bug_num}}},$change;
2495 push @disallowed_changes,$change;
2497 # blocks and blocked by are weird; we have to go through and
2498 # set blocks to the other half of the merged bugs
2500 return (\@disallowed_changes,\%changes);
2506 affects(bug => $ref,
2507 transcript => $transcript,
2508 ($dl > 0 ? (debug => $transcript):()),
2509 requester => $header{from},
2510 request_addr => $controlrequestaddr,
2512 affected_packages => \%affected_packages,
2513 recipients => \%recipients,
2521 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
2524 This marks a bug as affecting packages which the bug is not actually
2525 in. This should only be used in cases where fixing the bug instantly
2526 resolves the problem in the other packages.
2528 By default, the packages are set to the list of packages passed.
2529 However, if you pass add => 1 or remove => 1, the list of packages
2530 passed are added or removed from the affects list, respectively.
2535 my %param = validate_with(params => \@_,
2536 spec => {bug => {type => SCALAR,
2539 # specific options here
2540 package => {type => SCALAR|ARRAYREF|UNDEF,
2543 add => {type => BOOLEAN,
2546 remove => {type => BOOLEAN,
2550 %append_action_options,
2553 if ($param{add} and $param{remove}) {
2554 croak "Asking to both add and remove affects is nonsensical";
2556 if (not defined $param{package}) {
2557 $param{package} = [];
2560 __begin_control(%param,
2561 command => 'affects'
2563 my ($debug,$transcript) =
2564 @info{qw(debug transcript)};
2565 my @data = @{$info{data}};
2567 for my $data (@data) {
2569 print {$debug} "Going to change affects\n";
2570 my @packages = splitpackages($data->{affects});
2572 @packages{@packages} = (1) x @packages;
2575 for my $package (make_list($param{package})) {
2576 next unless defined $package and length $package;
2577 if (not $packages{$package}) {
2578 $packages{$package} = 1;
2579 push @added,$package;
2583 $action = "Added indication that $data->{bug_num} affects ".
2584 english_join(\@added);
2587 elsif ($param{remove}) {
2589 for my $package (make_list($param{package})) {
2590 if ($packages{$package}) {
2591 next unless defined $package and length $package;
2592 delete $packages{$package};
2593 push @removed,$package;
2596 $action = "Removed indication that $data->{bug_num} affects " .
2597 english_join(\@removed);
2600 my %added_packages = ();
2601 my %removed_packages = %packages;
2603 for my $package (make_list($param{package})) {
2604 next unless defined $package and length $package;
2605 $packages{$package} = 1;
2606 delete $removed_packages{$package};
2607 $added_packages{$package} = 1;
2609 if (keys %removed_packages) {
2610 $action = "Removed indication that $data->{bug_num} affects ".
2611 english_join([keys %removed_packages]);
2612 $action .= "\n" if keys %added_packages;
2614 if (keys %added_packages) {
2615 $action .= "Added indication that $data->{bug_num} affects " .
2616 english_join([keys %added_packages]);
2619 if (not length $action) {
2620 print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
2623 my $old_data = dclone($data);
2624 $data->{affects} = join(',',keys %packages);
2625 append_action_to_log(bug => $data->{bug_num},
2627 command => 'affects',
2629 old_data => $old_data,
2630 __return_append_to_log_options(
2635 if not exists $param{append_log} or $param{append_log};
2636 writebug($data->{bug_num},$data);
2637 print {$transcript} "$action\n";
2639 __end_control(%info);
2643 =head1 SUMMARY FUNCTIONS
2648 summary(bug => $ref,
2649 transcript => $transcript,
2650 ($dl > 0 ? (debug => $transcript):()),
2651 requester => $header{from},
2652 request_addr => $controlrequestaddr,
2654 affected_packages => \%affected_packages,
2655 recipients => \%recipients,
2661 print {$transcript} "Failed to mark $ref with summary foo: $@";
2664 Handles all setting of summary fields
2666 If summary is undef, unsets the summary
2668 If summary is 0 or -1, sets the summary to the first paragraph contained in
2671 If summary is a positive integer, sets the summary to the message specified.
2673 Otherwise, sets summary to the value passed.
2679 # outlook and summary are exactly the same, basically
2680 return _summary('summary',@_);
2683 =head1 OUTLOOK FUNCTIONS
2688 outlook(bug => $ref,
2689 transcript => $transcript,
2690 ($dl > 0 ? (debug => $transcript):()),
2691 requester => $header{from},
2692 request_addr => $controlrequestaddr,
2694 affected_packages => \%affected_packages,
2695 recipients => \%recipients,
2701 print {$transcript} "Failed to mark $ref with outlook foo: $@";
2704 Handles all setting of outlook fields
2706 If outlook is undef, unsets the outlook
2708 If outlook is 0, sets the outlook to the first paragraph contained in
2711 If outlook is a positive integer, sets the outlook to the message specified.
2713 Otherwise, sets outlook to the value passed.
2719 return _summary('outlook',@_);
2723 my ($cmd,@params) = @_;
2724 my %param = validate_with(params => \@params,
2725 spec => {bug => {type => SCALAR,
2728 # specific options here
2729 $cmd , {type => SCALAR|UNDEF,
2733 %append_action_options,
2737 __begin_control(%param,
2740 my ($debug,$transcript) =
2741 @info{qw(debug transcript)};
2742 my @data = @{$info{data}};
2743 # figure out the log that we're going to use
2745 my $summary_msg = '';
2747 if (not defined $param{$cmd}) {
2749 print {$debug} "Removing $cmd fields\n";
2750 $action = "Removed $cmd";
2752 elsif ($param{$cmd} =~ /^-?\d+$/) {
2754 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
2755 if ($param{$cmd} == 0 or $param{$cmd} == -1) {
2756 $log = $param{message};
2757 $summary_msg = @records + 1;
2760 if (($param{$cmd} - 1 ) > $#records) {
2761 die "Message number '$param{$cmd}' exceeds the maximum message '$#records'";
2763 my $record = $records[($param{$cmd} - 1 )];
2764 if ($record->{type} !~ /incoming-recv|recips/) {
2765 die "Message number '$param{$cmd}' is a invalid message type '$record->{type}'";
2767 $summary_msg = $param{$cmd};
2768 $log = [$record->{text}];
2770 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
2771 my $body = $p_o->{body};
2772 my $in_pseudoheaders = 0;
2774 # walk through body until we get non-blank lines
2775 for my $line (@{$body}) {
2776 if ($line =~ /^\s*$/) {
2777 if (length $paragraph) {
2778 if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
2784 $in_pseudoheaders = 0;
2787 # skip a paragraph if it looks like it's control or
2789 if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity|Control)\:\s+\S}xi or #pseudo headers
2790 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
2791 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
2792 debug|(?:not|)forwarded|priority|
2793 (?:un|)block|limit|(?:un|)archive|
2794 reassign|retitle|affects|wrongpackage
2795 (?:un|force|)merge|user(?:category|tags?|)
2797 if (not length $paragraph) {
2798 print {$debug} "Found control/pseudo-headers and skiping them\n";
2799 $in_pseudoheaders = 1;
2803 next if $in_pseudoheaders;
2804 $paragraph .= $line ." \n";
2806 print {$debug} ucfirst($cmd)." is going to be '$paragraph'\n";
2807 $summary = $paragraph;
2808 $summary =~ s/[\n\r]/ /g;
2809 if (not length $summary) {
2810 die "Unable to find $cmd message to use";
2812 # trim off a trailing spaces
2813 $summary =~ s/\ *$//;
2816 $summary = $param{$cmd};
2818 for my $data (@data) {
2819 print {$debug} "Going to change $cmd\n";
2820 if (((not defined $summary or not length $summary) and
2821 (not defined $data->{$cmd} or not length $data->{$cmd})) or
2822 $summary eq $data->{$cmd}) {
2823 print {$transcript} "Ignoring request to change the $cmd of bug $param{bug} to the same value\n";
2826 if (length $summary) {
2827 if (length $data->{$cmd}) {
2828 $action = ucfirst($cmd)." replaced with message bug $param{bug} message $summary_msg";
2831 $action = ucfirst($cmd)." recorded from message bug $param{bug} message $summary_msg";
2834 my $old_data = dclone($data);
2835 $data->{$cmd} = $summary;
2836 append_action_to_log(bug => $data->{bug_num},
2838 old_data => $old_data,
2841 __return_append_to_log_options(
2846 if not exists $param{append_log} or $param{append_log};
2847 writebug($data->{bug_num},$data);
2848 print {$transcript} "$action\n";
2850 __end_control(%info);
2858 clone_bug(bug => $ref,
2859 transcript => $transcript,
2860 ($dl > 0 ? (debug => $transcript):()),
2861 requester => $header{from},
2862 request_addr => $controlrequestaddr,
2864 affected_packages => \%affected_packages,
2865 recipients => \%recipients,
2870 print {$transcript} "Failed to clone bug $ref bar: $@";
2873 Clones the given bug.
2875 We currently don't support cloning merged bugs, but this could be
2876 handled by internally unmerging, cloning, then remerging the bugs.
2881 my %param = validate_with(params => \@_,
2882 spec => {bug => {type => SCALAR,
2885 new_bugs => {type => ARRAYREF,
2887 new_clones => {type => HASHREF,
2891 %append_action_options,
2895 __begin_control(%param,
2898 my $transcript = $info{transcript};
2899 my @data = @{$info{data}};
2902 for my $data (@data) {
2903 if (length($data->{mergedwith})) {
2904 die "Bug is marked as being merged with others. Use an existing clone.\n";
2908 die "Not exactly one bug‽ This shouldn't happen.";
2910 my $data = $data[0];
2912 for my $newclone_id (@{$param{new_bugs}}) {
2913 my $new_bug_num = new_bug(copy => $data->{bug_num});
2914 $param{new_clones}{$newclone_id} = $new_bug_num;
2915 $clones{$newclone_id} = $new_bug_num;
2917 my @new_bugs = sort values %clones;
2919 for my $new_bug (@new_bugs) {
2920 # no collapsed ids or the higher collapsed id is not one less
2921 # than the next highest new bug
2922 if (not @collapsed_ids or
2923 $collapsed_ids[-1][1]+1 != $new_bug) {
2924 push @collapsed_ids,[$new_bug,$new_bug];
2927 $collapsed_ids[-1][1] = $new_bug;
2931 for my $ci (@collapsed_ids) {
2932 if ($ci->[0] == $ci->[1]) {
2933 push @collapsed,$ci->[0];
2936 push @collapsed,$ci->[0].'-'.$ci->[1]
2939 my $collapsed_str = english_join(\@collapsed);
2940 $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str;
2941 for my $new_bug (@new_bugs) {
2942 append_action_to_log(bug => $new_bug,
2944 __return_append_to_log_options(
2949 if not exists $param{append_log} or $param{append_log};
2951 append_action_to_log(bug => $data->{bug_num},
2953 __return_append_to_log_options(
2958 if not exists $param{append_log} or $param{append_log};
2959 writebug($data->{bug_num},$data);
2960 print {$transcript} "$action\n";
2961 __end_control(%info);
2962 # bugs that this bug is blocking are also blocked by the new clone(s)
2963 for my $bug (split ' ', $data->{blocks}) {
2964 for my $new_bug (@new_bugs) {
2965 set_blocks(bug => $bug,
2969 keys %common_options,
2970 keys %append_action_options),
2974 # bugs that are blocking this bug are also blocking the new clone(s)
2975 for my $bug (split ' ', $data->{blockedby}) {
2976 for my $new_bug (@new_bugs) {
2977 set_blocks(bug => $new_bug,
2981 keys %common_options,
2982 keys %append_action_options),
2990 =head1 OWNER FUNCTIONS
2996 transcript => $transcript,
2997 ($dl > 0 ? (debug => $transcript):()),
2998 requester => $header{from},
2999 request_addr => $controlrequestaddr,
3001 recipients => \%recipients,
3007 print {$transcript} "Failed to mark $ref as having an owner: $@";
3010 Handles all setting of the owner field; given an owner of undef or of
3011 no length, indicates that a bug is not owned by anyone.
3016 my %param = validate_with(params => \@_,
3017 spec => {bug => {type => SCALAR,
3020 owner => {type => SCALAR|UNDEF,
3023 %append_action_options,
3027 __begin_control(%param,
3030 my ($debug,$transcript) =
3031 @info{qw(debug transcript)};
3032 my @data = @{$info{data}};
3034 for my $data (@data) {
3035 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
3036 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
3037 if (not defined $param{owner} or not length $param{owner}) {
3038 if (not defined $data->{owner} or not length $data->{owner}) {
3039 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
3043 $action = "Removed annotation that $config{bug} was owned by " .
3047 if ($data->{owner} eq $param{owner}) {
3048 print {$transcript} "Ignoring request to set the owner of bug #$data->{bug_num} to the same value\n";
3051 if (length $data->{owner}) {
3052 $action = "Owner changed from $data->{owner} to $param{owner}.";
3055 $action = "Owner recorded as $param{owner}."
3058 my $old_data = dclone($data);
3059 $data->{owner} = $param{owner};
3060 append_action_to_log(bug => $data->{bug_num},
3063 old_data => $old_data,
3065 __return_append_to_log_options(
3070 if not exists $param{append_log} or $param{append_log};
3071 writebug($data->{bug_num},$data);
3072 print {$transcript} "$action\n";
3074 __end_control(%info);
3078 =head1 ARCHIVE FUNCTIONS
3085 bug_archive(bug => $bug_num,
3087 transcript => \$transcript,
3092 transcript("Unable to archive $bug_num\n");
3095 transcript($transcript);
3098 This routine archives a bug
3102 =item bug -- bug number
3104 =item check_archiveable -- check wether a bug is archiveable before
3105 archiving; defaults to 1
3107 =item archive_unarchived -- whether to archive bugs which have not
3108 previously been archived; defaults to 1. [Set to 0 when used from
3111 =item ignore_time -- whether to ignore time constraints when archiving
3112 a bug; defaults to 0.
3119 my %param = validate_with(params => \@_,
3120 spec => {bug => {type => SCALAR,
3123 check_archiveable => {type => BOOLEAN,
3126 archive_unarchived => {type => BOOLEAN,
3129 ignore_time => {type => BOOLEAN,
3133 %append_action_options,
3136 my %info = __begin_control(%param,
3137 command => 'archive',
3139 my ($debug,$transcript) = @info{qw(debug transcript)};
3140 my @data = @{$info{data}};
3141 my @bugs = @{$info{bugs}};
3142 my $action = "$config{bug} archived.";
3143 if ($param{check_archiveable} and
3144 not bug_archiveable(bug=>$param{bug},
3145 ignore_time => $param{ignore_time},
3147 print {$transcript} "Bug $param{bug} cannot be archived\n";
3148 die "Bug $param{bug} cannot be archived";
3150 if (not $param{archive_unarchived} and
3151 not exists $data[0]{unarchived}
3153 print {$transcript} "$param{bug} has not been archived previously\n";
3154 die "$param{bug} has not been archived previously";
3156 add_recipients(recipients => $param{recipients},
3159 transcript => $transcript,
3161 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3162 for my $bug (@bugs) {
3163 if ($param{check_archiveable}) {
3164 die "Bug $bug cannot be archived (but $param{bug} can?)"
3165 unless bug_archiveable(bug=>$bug,
3166 ignore_time => $param{ignore_time},
3170 # If we get here, we can archive/remove this bug
3171 print {$debug} "$param{bug} removing\n";
3172 for my $bug (@bugs) {
3173 #print "$param{bug} removing $bug\n" if $debug;
3174 my $dir = get_hashname($bug);
3175 # First indicate that this bug is being archived
3176 append_action_to_log(bug => $bug,
3178 command => 'archive',
3179 # we didn't actually change the data
3180 # when we archived, so we don't pass
3181 # a real new_data or old_data
3184 __return_append_to_log_options(
3189 if not exists $param{append_log} or $param{append_log};
3190 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
3191 if ($config{save_old_bugs}) {
3192 mkpath("$config{spool_dir}/archive/$dir");
3193 foreach my $file (@files_to_remove) {
3194 link("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3195 copy("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3196 # we need to bail out here if things have
3197 # gone horribly wrong to avoid removing a
3199 die "Unable to link or copy $config{spool_dir}/db-h/$dir/$file to $config{spool_dir}/archive/$dir/$file; $!";
3202 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
3204 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
3205 print {$debug} "deleted $bug (from $param{bug})\n";
3207 bughook_archive(@bugs);
3208 __end_control(%info);
3211 =head2 bug_unarchive
3215 bug_unarchive(bug => $bug_num,
3217 transcript => \$transcript,
3222 transcript("Unable to archive bug: $bug_num");
3224 transcript($transcript);
3226 This routine unarchives a bug
3231 my %param = validate_with(params => \@_,
3232 spec => {bug => {type => SCALAR,
3236 %append_action_options,
3240 my %info = __begin_control(%param,
3242 command=>'unarchive');
3243 my ($debug,$transcript) =
3244 @info{qw(debug transcript)};
3245 my @bugs = @{$info{bugs}};
3246 my $action = "$config{bug} unarchived.";
3247 my @files_to_remove;
3248 for my $bug (@bugs) {
3249 print {$debug} "$param{bug} removing $bug\n";
3250 my $dir = get_hashname($bug);
3251 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
3252 mkpath("archive/$dir");
3253 foreach my $file (@files_to_copy) {
3254 # die'ing here sucks
3255 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3256 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3257 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
3259 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
3260 print {$transcript} "Unarchived $config{bug} $bug\n";
3262 unlink(@files_to_remove) or die "Unable to unlink bugs";
3263 # Indicate that this bug has been archived previously
3264 for my $bug (@bugs) {
3265 my $newdata = readbug($bug);
3266 my $old_data = dclone($newdata);
3267 if (not defined $newdata) {
3268 print {$transcript} "$config{bug} $bug disappeared!\n";
3269 die "Bug $bug disappeared!";
3271 $newdata->{unarchived} = time;
3272 append_action_to_log(bug => $bug,
3274 command => 'unarchive',
3275 new_data => $newdata,
3276 old_data => $old_data,
3277 __return_append_to_log_options(
3282 if not exists $param{append_log} or $param{append_log};
3283 writebug($bug,$newdata);
3285 __end_control(%info);
3288 =head2 append_action_to_log
3290 append_action_to_log
3292 This should probably be moved to Debbugs::Log; have to think that out
3297 sub append_action_to_log{
3298 my %param = validate_with(params => \@_,
3299 spec => {bug => {type => SCALAR,
3302 new_data => {type => HASHREF,
3305 old_data => {type => HASHREF,
3308 command => {type => SCALAR,
3311 action => {type => SCALAR,
3313 requester => {type => SCALAR,
3316 request_addr => {type => SCALAR,
3319 location => {type => SCALAR,
3322 message => {type => SCALAR|ARRAYREF,
3325 recips => {type => SCALAR|ARRAYREF,
3328 desc => {type => SCALAR,
3331 get_lock => {type => BOOLEAN,
3334 locks => {type => HASHREF,
3338 # append_action_options here
3339 # because some of these
3340 # options aren't actually
3341 # optional, even though the
3342 # original function doesn't
3346 # Fix this to use $param{location}
3347 my $log_location = buglog($param{bug});
3348 die "Unable to find .log for $param{bug}"
3349 if not defined $log_location;
3350 if ($param{get_lock}) {
3351 filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
3355 my $logfh = IO::File->new(">>$log_location") or
3356 die "Unable to open $log_location for appending: $!";
3357 # determine difference between old and new
3359 if (exists $param{old_data} and exists $param{new_data}) {
3360 my $old_data = dclone($param{old_data});
3361 my $new_data = dclone($param{new_data});
3362 for my $key (keys %{$old_data}) {
3363 if (not exists $Debbugs::Status::fields{$key}) {
3364 delete $old_data->{$key};
3367 next unless exists $new_data->{$key};
3368 next unless defined $new_data->{$key};
3369 if (not defined $old_data->{$key}) {
3370 delete $old_data->{$key};
3373 if (ref($new_data->{$key}) and
3374 ref($old_data->{$key}) and
3375 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3376 local $Storable::canonical = 1;
3377 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3378 delete $new_data->{$key};
3379 delete $old_data->{$key};
3382 elsif ($new_data->{$key} eq $old_data->{$key}) {
3383 delete $new_data->{$key};
3384 delete $old_data->{$key};
3387 for my $key (keys %{$new_data}) {
3388 if (not exists $Debbugs::Status::fields{$key}) {
3389 delete $new_data->{$key};
3392 next unless exists $old_data->{$key};
3393 next unless defined $old_data->{$key};
3394 if (not defined $new_data->{$key} or
3395 not exists $Debbugs::Status::fields{$key}) {
3396 delete $new_data->{$key};
3399 if (ref($new_data->{$key}) and
3400 ref($old_data->{$key}) and
3401 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3402 local $Storable::canonical = 1;
3403 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3404 delete $new_data->{$key};
3405 delete $old_data->{$key};
3408 elsif ($new_data->{$key} eq $old_data->{$key}) {
3409 delete $new_data->{$key};
3410 delete $old_data->{$key};
3413 $data_diff .= "<!-- new_data:\n";
3415 for my $key (keys %{$new_data}) {
3416 if (not exists $Debbugs::Status::fields{$key}) {
3417 warn "No such field $key";
3420 $nd{$key} = $new_data->{$key};
3421 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n";
3423 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)]));
3424 $data_diff .= "-->\n";
3425 $data_diff .= "<!-- old_data:\n";
3427 for my $key (keys %{$old_data}) {
3428 if (not exists $Debbugs::Status::fields{$key}) {
3429 warn "No such field $key";
3432 $od{$key} = $old_data->{$key};
3433 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $old_data->{$key}")."\n";
3435 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%od)],[qw(old_data)]));
3436 $data_diff .= "-->\n";
3439 (exists $param{command} ?
3440 "<!-- command:".html_escape(encode_utf8_safely($param{command}))." -->\n":""
3442 (length $param{requester} ?
3443 "<!-- requester: ".html_escape(encode_utf8_safely($param{requester}))." -->\n":""
3445 (length $param{request_addr} ?
3446 "<!-- request_addr: ".html_escape(encode_utf8_safely($param{request_addr}))." -->\n":""
3448 "<!-- time:".time()." -->\n",
3450 "<strong>".html_escape(encode_utf8_safely($param{action}))."</strong>\n");
3451 if (length $param{requester}) {
3452 $msg .= "Request was from <code>".html_escape(encode_utf8_safely($param{requester}))."</code>\n";
3454 if (length $param{request_addr}) {
3455 $msg .= "to <code>".html_escape(encode_utf8_safely($param{request_addr}))."</code>";
3457 if (length $param{desc}) {
3458 $msg .= ":<br>\n".encode_utf8_safely($param{desc})."\n";
3463 push @records, {type => 'html',
3467 if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
3468 push @records, {type => exists $param{recips}?'recips':'incoming-recv',
3469 exists $param{recips}?(recips => [map {encode_utf8_safely($_)} make_list($param{recips})]):(),
3470 text => join('',make_list($param{message})),
3473 write_log_records(logfh=>$logfh,
3474 records => \@records,
3476 close $logfh or die "Unable to close $log_location: $!";
3477 if ($param{get_lock}) {
3478 unfilelock(exists $param{locks}?$param{locks}:());
3486 =head1 PRIVATE FUNCTIONS
3488 =head2 __handle_affected_packages
3490 __handle_affected_packages(affected_packages => {},
3498 sub __handle_affected_packages{
3499 my %param = validate_with(params => \@_,
3500 spec => {%common_options,
3501 data => {type => ARRAYREF|HASHREF
3506 for my $data (make_list($param{data})) {
3507 next unless exists $data->{package} and defined $data->{package};
3508 my @packages = split /\s*,\s*/,$data->{package};
3509 @{$param{affected_packages}}{@packages} = (1) x @packages;
3513 =head2 __handle_debug_transcript
3515 my ($debug,$transcript) = __handle_debug_transcript(%param);
3517 Returns a debug and transcript filehandle
3522 sub __handle_debug_transcript{
3523 my %param = validate_with(params => \@_,
3524 spec => {%common_options},
3527 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
3528 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3529 return ($debug,$transcript);
3536 Produces a small bit of bug information to kick out to the transcript
3543 next unless defined $data and exists $data->{bug_num};
3544 $return .= "Bug #".($data->{bug_num}||'').
3545 ((defined $data->{done} and length $data->{done})?
3546 " {Done: $data->{done}}":''
3548 " [".($data->{package}||'(no package)'). "] ".
3549 ($data->{subject}||'(no subject)')."\n";
3555 =head2 __internal_request
3557 __internal_request()
3558 __internal_request($level)
3560 Returns true if the caller of the function calling __internal_request
3561 belongs to __PACKAGE__
3563 This allows us to be magical, and don't bother to print bug info if
3564 the second caller is from this package, amongst other things.
3566 An optional level is allowed, which increments the number of levels to
3567 check by the given value. [This is basically for use by internal
3568 functions like __begin_control which are always called by
3573 sub __internal_request{
3575 $l = 0 if not defined $l;
3576 if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
3582 sub __return_append_to_log_options{
3584 my $action = $param{action} if exists $param{action};
3585 if (not exists $param{requester}) {
3586 $param{requester} = $config{control_internal_requester};
3588 if (not exists $param{request_addr}) {
3589 $param{request_addr} = $config{control_internal_request_addr};
3591 if (not exists $param{message}) {
3592 my $date = rfc822_date();
3594 encode_headers(fill_in_template(template => 'mail/fake_control_message',
3595 variables => {request_addr => $param{request_addr},
3596 requester => $param{requester},
3602 if (not defined $action) {
3603 carp "Undefined action!";
3604 $action = "unknown action";
3606 return (action => $action,
3607 hash_slice(%param,keys %append_action_options),
3611 =head2 __begin_control
3613 my %info = __begin_control(%param,
3615 command=>'unarchive');
3616 my ($debug,$transcript) = @info{qw(debug transcript)};
3617 my @data = @{$info{data}};
3618 my @bugs = @{$info{bugs}};
3621 Starts the process of modifying a bug; handles all of the generic
3622 things that almost every control request needs
3624 Returns a hash containing
3628 =item new_locks -- number of new locks taken out by this call
3630 =item debug -- the debug file handle
3632 =item transcript -- the transcript file handle
3634 =item data -- an arrayref containing the data of the bugs
3635 corresponding to this request
3637 =item bugs -- an arrayref containing the bug numbers of the bugs
3638 corresponding to this request
3646 sub __begin_control {
3647 my %param = validate_with(params => \@_,
3648 spec => {bug => {type => SCALAR,
3651 archived => {type => BOOLEAN,
3654 command => {type => SCALAR,
3662 my ($debug,$transcript) = __handle_debug_transcript(@_);
3663 print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
3664 # print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
3665 $lockhash = $param{locks} if exists $param{locks};
3667 my $old_die = $SIG{__DIE__};
3668 $SIG{__DIE__} = *sig_die{CODE};
3670 ($new_locks, @data) =
3671 lock_read_all_merged_bugs(bug => $param{bug},
3672 $param{archived}?(location => 'archive'):(),
3673 exists $param{locks} ? (locks => $param{locks}):(),
3675 $locks += $new_locks;
3677 die "Unable to read any bugs successfully.";
3679 if (not $param{archived}) {
3680 for my $data (@data) {
3681 if ($data->{archived}) {
3682 die "Not altering archived bugs; see unarchive.";
3686 if (not check_limit(data => \@data,
3687 exists $param{limit}?(limit => $param{limit}):(),
3688 transcript => $transcript,
3690 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
3693 __handle_affected_packages(%param,data => \@data);
3694 print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
3695 print {$debug} "$param{bug} read $locks locks\n";
3696 if (not @data or not defined $data[0]) {
3697 print {$transcript} "No bug found for $param{bug}\n";
3698 die "No bug found for $param{bug}";
3701 add_recipients(data => \@data,
3702 recipients => $param{recipients},
3703 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
3705 (__internal_request()?(transcript => $transcript):()),
3708 print {$debug} "$param{bug} read done\n";
3709 my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
3710 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3711 return (data => \@data,
3713 old_die => $old_die,
3714 new_locks => $new_locks,
3716 transcript => $transcript,
3718 exists $param{locks}?(locks => $param{locks}):(),
3722 =head2 __end_control
3724 __end_control(%info);
3726 Handles tearing down from a control request
3732 if (exists $info{new_locks} and $info{new_locks} > 0) {
3733 print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
3734 for (1..$info{new_locks}) {
3735 unfilelock(exists $info{locks}?$info{locks}:());
3739 $SIG{__DIE__} = $info{old_die};
3740 if (exists $info{param}{affected_bugs}) {
3741 @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
3743 add_recipients(recipients => $info{param}{recipients},
3744 (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
3745 data => $info{data},
3746 debug => $info{debug},
3747 transcript => $info{transcript},
3749 __handle_affected_packages(%{$info{param}},data=>$info{data});
3755 check_limit(data => \@data, limit => $param{limit});
3758 Checks to make sure that bugs match any limits; each entry of @data
3759 much satisfy the limit.
3761 Returns true if there are no entries in data, or there are no keys in
3762 limit; returns false (0) if there are any entries which do not match.
3764 The limit hashref elements can contain an arrayref of scalars to
3765 match; regexes are also acccepted. At least one of the entries in each
3766 element needs to match the corresponding field in all data for the
3773 my %param = validate_with(params => \@_,
3774 spec => {data => {type => ARRAYREF|HASHREF,
3776 limit => {type => HASHREF|UNDEF,
3778 transcript => {type => SCALARREF|HANDLE,
3783 my @data = make_list($param{data});
3785 not defined $param{limit} or
3786 not keys %{$param{limit}}) {
3789 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3790 my $going_to_fail = 0;
3791 for my $data (@data) {
3792 $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
3793 status => dclone($data),
3795 for my $field (keys %{$param{limit}}) {
3796 next unless exists $param{limit}{$field};
3798 my @data_fields = make_list($data->{$field});
3799 LIMIT: for my $limit (make_list($param{limit}{$field})) {
3800 if (not ref $limit) {
3801 for my $data_field (@data_fields) {
3802 if ($data_field eq $limit) {
3808 elsif (ref($limit) eq 'Regexp') {
3809 for my $data_field (@data_fields) {
3810 if ($data_field =~ $limit) {
3817 warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
3822 print {$transcript} qq($field: ').join(', ',map{qq("$_")} make_list($data->{$field})).
3823 "' does not match at least one of ".
3824 join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
3828 return $going_to_fail?0:1;
3836 We override die to specially handle unlocking files in the cases where
3837 we are called via eval. [If we're not called via eval, it doesn't
3843 if ($^S) { # in eval
3845 for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
3852 # =head2 __message_body_template
3854 # message_body_template('mail/ack',{ref=>'foo'});
3856 # Creates a message body using a template
3860 sub __message_body_template{
3861 my ($template,$extra_var) = @_;
3863 my $hole_var = {'&bugurl' =>
3865 $config{cgi_domain}.'/'.
3866 Debbugs::CGI::bug_links(bug => $_[0],
3872 my $body = fill_in_template(template => $template,
3873 variables => {config => \%config,
3876 hole_var => $hole_var,
3878 return fill_in_template(template => 'mail/message_body',
3879 variables => {config => \%config,
3883 hole_var => $hole_var,
3887 sub __all_undef_or_equal {
3889 return 1 if @values == 1 or @values == 0;
3890 my $not_def = grep {not defined $_} @values;
3891 if ($not_def == @values) {
3894 if ($not_def > 0 and $not_def != @values) {
3897 my $first_val = shift @values;
3898 for my $val (@values) {
3899 if ($first_val ne $val) {