1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007,2008,2009 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Control;
14 Debbugs::Control -- Routines for modifying the state of bugs
23 This module is an abstraction of a lot of functions which originally
24 were only present in service.in, but as time has gone on needed to be
25 called from elsewhere.
27 All of the public functions take the following options:
31 =item debug -- scalar reference to which debbuging information is
34 =item transcript -- scalar reference to which transcript information
37 =item affected_bugs -- hashref which is updated with bugs affected by
43 Functions which should (probably) append to the .log file take the
48 =item requester -- Email address of the individual who requested the change
50 =item request_addr -- Address to which the request was sent
52 =item request_nn -- Name of queue file which caused this request
54 =item request_msgid -- Message id of message which caused this request
56 =item location -- Optional location; currently ignored but may be
57 supported in the future for updating archived bugs upon archival
59 =item message -- The original message which caused the action to be taken
61 =item append_log -- Whether or not to append information to the log.
65 B<append_log> (for most functions) is a special option. When set to
66 false, no appending to the log is done at all. When it is not present,
67 the above information is faked, and appended to the log file. When it
68 is true, the above options must be present, and their values are used.
71 =head1 GENERAL FUNCTIONS
77 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
78 use base qw(Exporter);
82 $DEBUG = 0 unless defined $DEBUG;
85 %EXPORT_TAGS = (done => [qw(set_done)],
86 submitter => [qw(set_submitter)],
87 severity => [qw(set_severity)],
88 affects => [qw(affects)],
89 summary => [qw(summary)],
91 title => [qw(set_title)],
92 forward => [qw(set_forwarded)],
93 found => [qw(set_found set_fixed)],
94 fixed => [qw(set_found set_fixed)],
95 package => [qw(set_package)],
96 block => [qw(set_blocks)],
97 merge => [qw(set_merged)],
99 clone => [qw(clone_bug)],
100 archive => [qw(bug_archive bug_unarchive),
102 limit => [qw(check_limit)],
103 log => [qw(append_action_to_log),
107 Exporter::export_ok_tags(keys %EXPORT_TAGS);
108 $EXPORT_TAGS{all} = [@EXPORT_OK];
111 use Debbugs::Config qw(:config);
112 use Debbugs::Common qw(:lock buglog :misc get_hashname sort_versions :utf8);
113 use Debbugs::Status qw(bug_archiveable :read :hook writebug new_bug splitpackages split_status_fields get_bug_status);
114 use Debbugs::CGI qw(html_escape);
115 use Debbugs::Log qw(:misc :write);
116 use Debbugs::Recipients qw(:add);
117 use Debbugs::Packages qw(:versions :mapping);
119 use Data::Dumper qw();
120 use Params::Validate qw(validate_with :types);
121 use File::Path qw(mkpath);
122 use File::Copy qw(copy);
125 use Debbugs::Text qw(:templates);
127 use Debbugs::Mail qw(rfc822_date send_mail_message default_headers);
128 use Debbugs::MIME qw(create_mime_message);
130 use Mail::RFC822::Address qw();
132 use POSIX qw(strftime);
134 use Storable qw(dclone nfreeze);
135 use List::Util qw(first max);
136 use Encode qw(encode_utf8);
140 # These are a set of options which are common to all of these functions
142 my %common_options = (debug => {type => SCALARREF|HANDLE,
145 transcript => {type => SCALARREF|HANDLE,
148 affected_bugs => {type => HASHREF,
151 affected_packages => {type => HASHREF,
154 recipients => {type => HASHREF,
157 limit => {type => HASHREF,
160 show_bug_info => {type => BOOLEAN,
163 request_subject => {type => SCALAR,
164 default => 'Unknown Subject',
166 request_msgid => {type => SCALAR,
169 request_nn => {type => SCALAR,
172 request_replyto => {type => SCALAR,
175 locks => {type => HASHREF,
181 my %append_action_options =
182 (action => {type => SCALAR,
185 requester => {type => SCALAR,
188 request_addr => {type => SCALAR,
191 location => {type => SCALAR,
194 message => {type => SCALAR|ARRAYREF,
197 append_log => {type => BOOLEAN,
199 depends => [qw(requester request_addr),
203 # locks is both an append_action option, and a common option;
204 # it's ok for it to be in both places.
205 locks => {type => HASHREF,
213 # this is just a generic stub for Debbugs::Control functions.
218 # set_foo(bug => $ref,
219 # transcript => $transcript,
220 # ($dl > 0 ? (debug => $transcript):()),
221 # requester => $header{from},
222 # request_addr => $controlrequestaddr,
224 # affected_packages => \%affected_packages,
225 # recipients => \%recipients,
231 # print {$transcript} "Failed to set foo $ref bar: $@";
239 # my %param = validate_with(params => \@_,
240 # spec => {bug => {type => SCALAR,
241 # regex => qr/^\d+$/,
243 # # specific options here
245 # %append_action_options,
249 # __begin_control(%param,
252 # my ($debug,$transcript) =
253 # @info{qw(debug transcript)};
254 # my @data = @{$info{data}};
255 # my @bugs = @{$info{bugs}};
258 # for my $data (@data) {
259 # append_action_to_log(bug => $data->{bug_num},
261 # __return_append_to_log_options(
266 # if not exists $param{append_log} or $param{append_log};
267 # writebug($data->{bug_num},$data);
268 # print {$transcript} "$action\n";
270 # __end_control(%info);
277 set_block(bug => $ref,
278 transcript => $transcript,
279 ($dl > 0 ? (debug => $transcript):()),
280 requester => $header{from},
281 request_addr => $controlrequestaddr,
283 affected_packages => \%affected_packages,
284 recipients => \%recipients,
290 print {$transcript} "Failed to set blockers of $ref: $@";
293 Alters the set of bugs that block this bug from being fixed
295 This requires altering both this bug (and those it's merged with) as
296 well as the bugs that block this bug from being fixed (and those that
301 =item block -- scalar or arrayref of blocking bugs to set, add or remove
303 =item add -- if true, add blocking bugs
305 =item remove -- if true, remove blocking bugs
312 my %param = validate_with(params => \@_,
313 spec => {bug => {type => SCALAR,
316 # specific options here
317 block => {type => SCALAR|ARRAYREF,
320 add => {type => BOOLEAN,
323 remove => {type => BOOLEAN,
327 %append_action_options,
330 if ($param{add} and $param{remove}) {
331 croak "It's nonsensical to add and remove the same blocking bugs";
333 if (grep {$_ !~ /^\d+$/} make_list($param{block})) {
334 croak "Invalid blocking bug(s):".
335 join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
341 elsif ($param{remove}) {
346 __begin_control(%param,
349 my ($debug,$transcript) =
350 @info{qw(debug transcript)};
351 my @data = @{$info{data}};
352 my @bugs = @{$info{bugs}};
355 # The first bit of this code is ugly, and should be cleaned up.
356 # Its purpose is to populate %removed_blockers and %add_blockers
357 # with all of the bugs that should be added or removed as blockers
358 # of all of the bugs which are merged with $param{bug}
361 for my $blocker (make_list($param{block})) {
362 next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
363 my $data = read_bug(bug=>$blocker,
365 if (defined $data and not $data->{archive}) {
366 $data = split_status_fields($data);
367 $ok_blockers{$blocker} = 1;
369 push @merged_bugs, make_list($data->{mergedwith});
370 @ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
373 $bad_blockers{$blocker} = 1;
377 # throw an error if we are setting the blockers and there is a bad
379 if (keys %bad_blockers and $mode eq 'set') {
380 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
381 keys %ok_blockers?'':" and no known blocking bug(s)";
383 # if there are no ok blockers and we are not setting the blockers,
385 if (not keys %ok_blockers and $mode ne 'set') {
386 print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
387 if (keys %bad_blockers) {
388 croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
390 __end_control(%info);
394 my @change_blockers = keys %ok_blockers;
396 my %removed_blockers;
399 my @blockers = map {split ' ', $_->{blockedby}} @data;
401 @blockers{@blockers} = (1) x @blockers;
403 # it is nonsensical for a bug to block itself (or a merged
404 # partner); We currently don't allow removal because we'd possibly
408 @bugs{@bugs} = (1) x @bugs;
409 for my $blocker (@change_blockers) {
410 if ($bugs{$blocker}) {
411 croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
414 @blockers = keys %blockers;
416 %removed_blockers = ();
417 for my $blocker (@change_blockers) {
418 next if exists $blockers{$blocker};
419 $blockers{$blocker} = 1;
420 $added_blockers{$blocker} = 1;
423 elsif ($param{remove}) {
424 %added_blockers = ();
425 for my $blocker (@change_blockers) {
426 next if exists $removed_blockers{$blocker};
427 delete $blockers{$blocker};
428 $removed_blockers{$blocker} = 1;
432 @removed_blockers{@blockers} = (1) x @blockers;
434 for my $blocker (@change_blockers) {
435 next if exists $blockers{$blocker};
436 $blockers{$blocker} = 1;
437 if (exists $removed_blockers{$blocker}) {
438 delete $removed_blockers{$blocker};
441 $added_blockers{$blocker} = 1;
445 my @new_blockers = keys %blockers;
446 for my $data (@data) {
447 my $old_data = dclone($data);
448 # remove blockers and/or add new ones as appropriate
449 if ($data->{blockedby} eq '') {
450 print {$transcript} "$data->{bug_num} was not blocked by any bugs.\n";
452 print {$transcript} "$data->{bug_num} was blocked by: $data->{blockedby}\n";
454 if ($data->{blocks} eq '') {
455 print {$transcript} "$data->{bug_num} was not blocking any bugs.\n";
457 print {$transcript} "$data->{bug_num} was blocking: $data->{blocks}\n";
460 push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
461 push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
462 $action = ucfirst(join ('; ',@changed)) if @changed;
464 print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n";
467 $data->{blockedby} = join(' ',keys %blockers);
468 append_action_to_log(bug => $data->{bug_num},
470 old_data => $old_data,
473 __return_append_to_log_options(
478 if not exists $param{append_log} or $param{append_log};
479 writebug($data->{bug_num},$data);
480 print {$transcript} "$action\n";
482 # we do this bit below to avoid code duplication
484 $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
485 $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
487 for my $add_remove (keys %mungable_blocks) {
491 for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
492 next if $munge_blockers{$blocker};
493 my ($temp_locks, @blocking_data) =
494 lock_read_all_merged_bugs(bug => $blocker,
495 ($param{archived}?(location => 'archive'):()),
496 exists $param{locks}?(locks => $param{locks}):(),
498 $locks+= $temp_locks;
499 $new_locks+=$temp_locks;
500 if (not @blocking_data) {
501 for (1..$new_locks) {
502 unfilelock(exists $param{locks}?$param{locks}:());
505 die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
507 for (map {$_->{bug_num}} @blocking_data) {
508 $munge_blockers{$_} = 1;
510 for my $data (@blocking_data) {
511 my $old_data = dclone($data);
513 my @blocks = split ' ', $data->{blocks};
514 @blocks{@blocks} = (1) x @blocks;
516 for my $bug (@bugs) {
517 if ($add_remove eq 'remove') {
518 next unless exists $blocks{$bug};
519 delete $blocks{$bug};
522 next if exists $blocks{$bug};
527 $data->{blocks} = join(' ',sort keys %blocks);
528 my $action = ($add_remove eq 'add'?'Added':'Removed').
529 " indication that bug $data->{bug_num} blocks ".
531 append_action_to_log(bug => $data->{bug_num},
533 old_data => $old_data,
536 __return_append_to_log_options(%param,
540 writebug($data->{bug_num},$data);
542 __handle_affected_packages(%param,data=>\@blocking_data);
543 add_recipients(recipients => $param{recipients},
544 actions_taken => {blocks => 1},
545 data => \@blocking_data,
547 transcript => $transcript,
550 for (1..$new_locks) {
551 unfilelock(exists $param{locks}?$param{locks}:());
556 __end_control(%info);
565 transcript => $transcript,
566 ($dl > 0 ? (debug => $transcript):()),
567 requester => $header{from},
568 request_addr => $controlrequestaddr,
570 affected_packages => \%affected_packages,
571 recipients => \%recipients,
578 print {$transcript} "Failed to set tag on $ref: $@";
582 Sets, adds, or removes the specified tags on a bug
586 =item tag -- scalar or arrayref of tags to set, add or remove
588 =item add -- if true, add tags
590 =item remove -- if true, remove tags
592 =item warn_on_bad_tags -- if true (the default) warn if bad tags are
600 my %param = validate_with(params => \@_,
601 spec => {bug => {type => SCALAR,
604 # specific options here
605 tag => {type => SCALAR|ARRAYREF,
608 add => {type => BOOLEAN,
611 remove => {type => BOOLEAN,
614 warn_on_bad_tags => {type => BOOLEAN,
618 %append_action_options,
621 if ($param{add} and $param{remove}) {
622 croak "It's nonsensical to add and remove the same tags";
626 __begin_control(%param,
629 my ($debug,$transcript) =
630 @info{qw(debug transcript)};
631 my @data = @{$info{data}};
632 my @bugs = @{$info{bugs}};
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 %fixed_removed = ();
651 my @old_tags = split /\,?\s+/, $data->{keywords};
653 @tags{@old_tags} = (1) x @old_tags;
655 my $old_data = dclone($data);
656 if (not $param{add} and not $param{remove}) {
657 $tag_removed{$_} = 1 for @old_tags;
661 for my $tag (@tags) {
662 if (not $param{remove} and
663 not defined first {$_ eq $tag} @{$config{tags}}) {
664 push @bad_tags, $tag;
668 if (not exists $tags{$tag}) {
670 $tag_added{$tag} = 1;
673 elsif ($param{remove}) {
674 if (exists $tags{$tag}) {
676 $tag_removed{$tag} = 1;
680 if (exists $tag_removed{$tag}) {
681 delete $tag_removed{$tag};
684 $tag_added{$tag} = 1;
689 if (@bad_tags and $param{warn_on_bad_tags}) {
690 print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
691 print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
693 $data->{keywords} = join(' ',keys %tags);
696 push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
697 push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
698 $action = ucfirst(join ('; ',@changed)) if @changed;
700 print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n";
704 append_action_to_log(bug => $data->{bug_num},
707 old_data => $old_data,
709 __return_append_to_log_options(
714 if not exists $param{append_log} or $param{append_log};
715 writebug($data->{bug_num},$data);
716 print {$transcript} "$action\n";
718 __end_control(%info);
726 set_severity(bug => $ref,
727 transcript => $transcript,
728 ($dl > 0 ? (debug => $transcript):()),
729 requester => $header{from},
730 request_addr => $controlrequestaddr,
732 affected_packages => \%affected_packages,
733 recipients => \%recipients,
734 severity => 'normal',
739 print {$transcript} "Failed to set the severity of bug $ref: $@";
742 Sets the severity of a bug. If severity is not passed, is undefined,
743 or has zero length, sets the severity to the default severity.
748 my %param = validate_with(params => \@_,
749 spec => {bug => {type => SCALAR,
752 # specific options here
753 severity => {type => SCALAR|UNDEF,
754 default => $config{default_severity},
757 %append_action_options,
760 if (not defined $param{severity} or
761 not length $param{severity}
763 $param{severity} = $config{default_severity};
766 # check validity of new severity
767 if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) {
768 die "Severity '$param{severity}' is not a valid severity level";
771 __begin_control(%param,
772 command => 'severity'
774 my ($debug,$transcript) =
775 @info{qw(debug transcript)};
776 my @data = @{$info{data}};
777 my @bugs = @{$info{bugs}};
780 for my $data (@data) {
781 if (not defined $data->{severity}) {
782 $data->{severity} = $param{severity};
783 $action = "Severity set to '$param{severity}'";
786 if ($data->{severity} eq '') {
787 $data->{severity} = $config{default_severity};
789 if ($data->{severity} eq $param{severity}) {
790 print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
793 $action = "Severity set to '$param{severity}' from '$data->{severity}'";
794 $data->{severity} = $param{severity};
796 append_action_to_log(bug => $data->{bug_num},
798 __return_append_to_log_options(
803 if not exists $param{append_log} or $param{append_log};
804 writebug($data->{bug_num},$data);
805 print {$transcript} "$action\n";
807 __end_control(%info);
814 set_done(bug => $ref,
815 transcript => $transcript,
816 ($dl > 0 ? (debug => $transcript):()),
817 requester => $header{from},
818 request_addr => $controlrequestaddr,
820 affected_packages => \%affected_packages,
821 recipients => \%recipients,
826 print {$transcript} "Failed to set foo $ref bar: $@";
834 my %param = validate_with(params => \@_,
835 spec => {bug => {type => SCALAR,
838 reopen => {type => BOOLEAN,
841 submitter => {type => SCALAR,
844 clear_fixed => {type => BOOLEAN,
847 notify_submitter => {type => BOOLEAN,
850 original_report => {type => SCALARREF,
853 done => {type => SCALAR|UNDEF,
857 %append_action_options,
861 if (exists $param{submitter} and
862 not Mail::RFC822::Address::valid($param{submitter})) {
863 die "New submitter address '$param{submitter}' is not a valid e-mail address";
865 if (exists $param{done} and defined $param{done} and $param{done} eq 1) { #special case this as using the requester address
866 $param{done} = $param{requester};
868 if (exists $param{done} and
869 (not defined $param{done} or
870 not length $param{done})) {
876 __begin_control(%param,
877 command => $param{reopen}?'reopen':'done',
879 my ($debug,$transcript) =
880 @info{qw(debug transcript)};
881 my @data = @{$info{data}};
882 my @bugs = @{$info{bugs}};
885 if ($param{reopen}) {
886 # avoid warning multiple times if there are fixed versions
888 for my $data (@data) {
889 if (not exists $data->{done} or
890 not defined $data->{done} or
891 not length $data->{done}) {
892 print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
893 __end_control(%info);
896 if (@{$data->{fixed_versions}} and $warn_fixed) {
897 print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
898 print {$transcript} "all fixed versions will be cleared, and you may need to re-add them.\n";
902 $action = "Bug reopened";
903 for my $data (@data) {
904 my $old_data = dclone($data);
906 append_action_to_log(bug => $data->{bug_num},
909 old_data => $old_data,
911 __return_append_to_log_options(
916 if not exists $param{append_log} or $param{append_log};
917 writebug($data->{bug_num},$data);
919 print {$transcript} "$action\n";
920 __end_control(%info);
921 if (exists $param{submitter}) {
922 set_submitter(bug => $param{bug},
923 submitter => $param{submitter},
925 keys %common_options,
926 keys %append_action_options)
929 # clear the fixed revisions
930 if ($param{clear_fixed}) {
931 set_fixed(fixed => [],
935 keys %common_options,
936 keys %append_action_options),
941 my %submitter_notified;
942 my $requester_notified = 0;
943 my $orig_report_set = 0;
944 for my $data (@data) {
945 if (exists $data->{done} and
946 defined $data->{done} and
947 length $data->{done}) {
948 print {$transcript} "Bug $data->{bug_num} is already marked as done; not doing anything.\n";
949 __end_control(%info);
953 for my $data (@data) {
954 my $old_data = dclone($data);
955 my $hash = get_hashname($data->{bug_num});
956 my $report_fh = IO::File->new("$config{spool_dir}/db-h/$hash/$data->{bug_num}.report",'r') or
957 die "Unable to open original report $config{spool_dir}/db-h/$hash/$data->{bug_num}.report for reading: $!";
961 $orig_report= <$report_fh>;
964 if (not $orig_report_set and defined $orig_report and
965 length $orig_report and
966 exists $param{original_report}){
967 ${$param{original_report}} = $orig_report;
968 $orig_report_set = 1;
971 $action = "Marked $config{bug} as done";
973 # set done to the requester
974 $data->{done} = exists $param{done}?$param{done}:$param{requester};
975 append_action_to_log(bug => $data->{bug_num},
978 old_data => $old_data,
980 __return_append_to_log_options(
985 if not exists $param{append_log} or $param{append_log};
986 writebug($data->{bug_num},$data);
987 print {$transcript} "$action\n";
988 # get the original report
989 if ($param{notify_submitter}) {
990 my $submitter_message;
991 if(not exists $submitter_notified{$data->{originator}}) {
993 create_mime_message([default_headers(queue_file => $param{request_nn},
995 msgid => $param{request_msgid},
996 msgtype => 'notifdone',
997 pr_msg => 'they-closed',
999 [To => $data->{submitter},
1000 Subject => "$config{ubug}#$data->{bug_num} ".
1001 "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
1005 __message_body_template('mail/process_your_bug_done',
1007 replyto => (exists $param{request_replyto} ?
1008 $param{request_replyto} :
1009 $param{requester} || 'Unknown'),
1010 markedby => $param{requester},
1011 subject => $param{request_subject},
1012 messageid => $param{request_msgid},
1015 [join('',make_list($param{message})),$orig_report]
1017 send_mail_message(message => $submitter_message,
1018 recipients => $old_data->{submitter},
1020 $submitter_notified{$data->{originator}} = $submitter_message;
1023 $submitter_message = $submitter_notified{$data->{originator}};
1025 append_action_to_log(bug => $data->{bug_num},
1026 action => "Notification sent",
1028 request_addr => $data->{originator},
1029 desc => "$config{bug} acknowledged by developer.",
1030 recips => [$data->{originator}],
1031 message => $submitter_message,
1036 __end_control(%info);
1037 if (exists $param{fixed}) {
1038 set_fixed(fixed => $param{fixed},
1042 keys %common_options,
1043 keys %append_action_options
1051 =head2 set_submitter
1054 set_submitter(bug => $ref,
1055 transcript => $transcript,
1056 ($dl > 0 ? (debug => $transcript):()),
1057 requester => $header{from},
1058 request_addr => $controlrequestaddr,
1060 affected_packages => \%affected_packages,
1061 recipients => \%recipients,
1062 submitter => $new_submitter,
1063 notify_submitter => 1,
1068 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1071 Sets the submitter of a bug. If notify_submitter is true (the
1072 default), notifies the old submitter of a bug on changes
1077 my %param = validate_with(params => \@_,
1078 spec => {bug => {type => SCALAR,
1081 # specific options here
1082 submitter => {type => SCALAR,
1084 notify_submitter => {type => BOOLEAN,
1088 %append_action_options,
1091 if (not Mail::RFC822::Address::valid($param{submitter})) {
1092 die "New submitter address $param{submitter} is not a valid e-mail address";
1095 __begin_control(%param,
1096 command => 'submitter'
1098 my ($debug,$transcript) =
1099 @info{qw(debug transcript)};
1100 my @data = @{$info{data}};
1101 my @bugs = @{$info{bugs}};
1103 # here we only concern ourselves with the first of the merged bugs
1104 for my $data ($data[0]) {
1105 my $notify_old_submitter = 0;
1106 my $old_data = dclone($data);
1107 print {$debug} "Going to change bug submitter\n";
1108 if (((not defined $param{submitter} or not length $param{submitter}) and
1109 (not defined $data->{originator} or not length $data->{originator})) or
1110 (defined $param{submitter} and defined $data->{originator} and
1111 $param{submitter} eq $data->{originator})) {
1112 print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n";
1116 if (defined $data->{originator} and length($data->{originator})) {
1117 $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'";
1118 $notify_old_submitter = 1;
1121 $action= "Set $config{bug} submitter to '$param{submitter}'.";
1123 $data->{originator} = $param{submitter};
1125 append_action_to_log(bug => $data->{bug_num},
1126 command => 'submitter',
1128 old_data => $old_data,
1130 __return_append_to_log_options(
1135 if not exists $param{append_log} or $param{append_log};
1136 writebug($data->{bug_num},$data);
1137 print {$transcript} "$action\n";
1138 # notify old submitter
1139 if ($notify_old_submitter and $param{notify_submitter}) {
1140 send_mail_message(message =>
1141 create_mime_message([default_headers(queue_file => $param{request_nn},
1143 msgid => $param{request_msgid},
1145 pr_msg => 'submitter-changed',
1147 [To => $old_data->{submitter},
1148 Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
1152 __message_body_template('mail/submitter_changed',
1153 {old_data => $old_data,
1155 replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
1159 recipients => $old_data->{submitter},
1163 __end_control(%info);
1168 =head2 set_forwarded
1171 set_forwarded(bug => $ref,
1172 transcript => $transcript,
1173 ($dl > 0 ? (debug => $transcript):()),
1174 requester => $header{from},
1175 request_addr => $controlrequestaddr,
1177 affected_packages => \%affected_packages,
1178 recipients => \%recipients,
1179 forwarded => $forward_to,
1184 print {$transcript} "Failed to set the forwarded-to-address of $ref: $@";
1187 Sets the location to which a bug is forwarded. Given an undef
1188 forwarded, unsets forwarded.
1194 my %param = validate_with(params => \@_,
1195 spec => {bug => {type => SCALAR,
1198 # specific options here
1199 forwarded => {type => SCALAR|UNDEF,
1202 %append_action_options,
1205 if (defined $param{forwarded} and $param{forwarded} =~ /[^[:print:]]/) {
1206 die "Non-printable characters are not allowed in the forwarded field";
1208 $param{forwarded} = undef if defined $param{forwarded} and not length $param{forwarded};
1210 __begin_control(%param,
1211 command => 'forwarded'
1213 my ($debug,$transcript) =
1214 @info{qw(debug transcript)};
1215 my @data = @{$info{data}};
1216 my @bugs = @{$info{bugs}};
1218 for my $data (@data) {
1219 my $old_data = dclone($data);
1220 print {$debug} "Going to change bug forwarded\n";
1221 if (__all_undef_or_equal($param{forwarded},$data->{forwarded}) or
1222 (not defined $param{forwarded} and
1223 defined $data->{forwarded} and not length $data->{forwarded})) {
1224 print {$transcript} "Ignoring request to change the forwarded-to-address of bug#$data->{bug_num} to the same value\n";
1228 if (not defined $param{forwarded}) {
1229 $action= "Unset $config{bug} forwarded-to-address";
1231 elsif (defined $data->{forwarded} and length($data->{forwarded})) {
1232 $action= "Changed $config{bug} forwarded-to-address to '$param{forwarded}' from '$data->{forwarded}'";
1235 $action= "Set $config{bug} forwarded-to-address to '$param{forwarded}'.";
1237 $data->{forwarded} = $param{forwarded};
1239 append_action_to_log(bug => $data->{bug_num},
1240 command => 'forwarded',
1242 old_data => $old_data,
1244 __return_append_to_log_options(
1249 if not exists $param{append_log} or $param{append_log};
1250 writebug($data->{bug_num},$data);
1251 print {$transcript} "$action\n";
1253 __end_control(%info);
1262 set_title(bug => $ref,
1263 transcript => $transcript,
1264 ($dl > 0 ? (debug => $transcript):()),
1265 requester => $header{from},
1266 request_addr => $controlrequestaddr,
1268 affected_packages => \%affected_packages,
1269 recipients => \%recipients,
1270 title => $new_title,
1275 print {$transcript} "Failed to set the title of $ref: $@";
1278 Sets the title of a specific bug
1284 my %param = validate_with(params => \@_,
1285 spec => {bug => {type => SCALAR,
1288 # specific options here
1289 title => {type => SCALAR,
1292 %append_action_options,
1295 if ($param{title} =~ /[^[:print:]]/) {
1296 die "Non-printable characters are not allowed in bug titles";
1299 my %info = __begin_control(%param,
1302 my ($debug,$transcript) =
1303 @info{qw(debug transcript)};
1304 my @data = @{$info{data}};
1305 my @bugs = @{$info{bugs}};
1307 for my $data (@data) {
1308 my $old_data = dclone($data);
1309 print {$debug} "Going to change bug title\n";
1310 if (defined $data->{subject} and length($data->{subject}) and
1311 $data->{subject} eq $param{title}) {
1312 print {$transcript} "Ignoring request to change the title of bug#$data->{bug_num} to the same title\n";
1316 if (defined $data->{subject} and length($data->{subject})) {
1317 $action= "Changed $config{bug} title to '$param{title}' from '$data->{subject}'";
1319 $action= "Set $config{bug} title to '$param{title}'.";
1321 $data->{subject} = $param{title};
1323 append_action_to_log(bug => $data->{bug_num},
1326 old_data => $old_data,
1328 __return_append_to_log_options(
1333 if not exists $param{append_log} or $param{append_log};
1334 writebug($data->{bug_num},$data);
1335 print {$transcript} "$action\n";
1337 __end_control(%info);
1344 set_package(bug => $ref,
1345 transcript => $transcript,
1346 ($dl > 0 ? (debug => $transcript):()),
1347 requester => $header{from},
1348 request_addr => $controlrequestaddr,
1350 affected_packages => \%affected_packages,
1351 recipients => \%recipients,
1352 package => $new_package,
1358 print {$transcript} "Failed to assign or reassign $ref to a package: $@";
1361 Indicates that a bug is in a particular package. If is_source is true,
1362 indicates that the package is a source package. [Internally, this
1363 causes src: to be prepended to the package name.]
1365 The default for is_source is 0. As a special case, if the package
1366 starts with 'src:', it is assumed to be a source package and is_source
1369 The package option must match the package_name_re regex.
1374 my %param = validate_with(params => \@_,
1375 spec => {bug => {type => SCALAR,
1378 # specific options here
1379 package => {type => SCALAR|ARRAYREF,
1381 is_source => {type => BOOLEAN,
1385 %append_action_options,
1388 my @new_packages = map {splitpackages($_)} make_list($param{package});
1389 if (grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages) {
1390 croak "Invalid package name '".
1391 join(',',grep {$_ !~ /^(?:src:|)$config{package_name_re}$/} @new_packages).
1394 my %info = __begin_control(%param,
1395 command => 'package',
1397 my ($debug,$transcript) =
1398 @info{qw(debug transcript)};
1399 my @data = @{$info{data}};
1400 my @bugs = @{$info{bugs}};
1401 # clean up the new package
1405 ($temp =~ s/^src:// or
1406 $param{is_source}) ? 'src:'.$temp:$temp;
1410 my $package_reassigned = 0;
1411 for my $data (@data) {
1412 my $old_data = dclone($data);
1413 print {$debug} "Going to change assigned package\n";
1414 if (defined $data->{package} and length($data->{package}) and
1415 $data->{package} eq $new_package) {
1416 print {$transcript} "Ignoring request to reassign bug #$data->{bug_num} to the same package\n";
1420 if (defined $data->{package} and length($data->{package})) {
1421 $package_reassigned = 1;
1422 $action= "$config{bug} reassigned from package '$data->{package}'".
1423 " to '$new_package'.";
1425 $action= "$config{bug} assigned to package '$new_package'.";
1427 $data->{package} = $new_package;
1429 append_action_to_log(bug => $data->{bug_num},
1430 command => 'package',
1432 old_data => $old_data,
1434 __return_append_to_log_options(
1439 if not exists $param{append_log} or $param{append_log};
1440 writebug($data->{bug_num},$data);
1441 print {$transcript} "$action\n";
1443 __end_control(%info);
1444 # Only clear the fixed/found versions if the package has been
1446 if ($package_reassigned) {
1447 my @params_for_found_fixed =
1448 map {exists $param{$_}?($_,$param{$_}):()}
1450 keys %common_options,
1451 keys %append_action_options,
1453 set_found(found => [],
1454 @params_for_found_fixed,
1456 set_fixed(fixed => [],
1457 @params_for_found_fixed,
1465 set_found(bug => $ref,
1466 transcript => $transcript,
1467 ($dl > 0 ? (debug => $transcript):()),
1468 requester => $header{from},
1469 request_addr => $controlrequestaddr,
1471 affected_packages => \%affected_packages,
1472 recipients => \%recipients,
1479 print {$transcript} "Failed to set found on $ref: $@";
1483 Sets, adds, or removes the specified found versions of a package
1485 If the version list is empty, and the bug is currently not "done",
1486 causes the done field to be cleared.
1488 If any of the versions added to found are greater than any version in
1489 which the bug is fixed (or when the bug is found and there are no
1490 fixed versions) the done field is cleared.
1495 my %param = validate_with(params => \@_,
1496 spec => {bug => {type => SCALAR,
1499 # specific options here
1500 found => {type => SCALAR|ARRAYREF,
1503 add => {type => BOOLEAN,
1506 remove => {type => BOOLEAN,
1510 %append_action_options,
1513 if ($param{add} and $param{remove}) {
1514 croak "It's nonsensical to add and remove the same versions";
1518 __begin_control(%param,
1521 my ($debug,$transcript) =
1522 @info{qw(debug transcript)};
1523 my @data = @{$info{data}};
1524 my @bugs = @{$info{bugs}};
1526 for my $version (make_list($param{found})) {
1527 next unless defined $version;
1528 $versions{$version} =
1529 [make_source_versions(package => [splitpackages($data[0]{package})],
1530 warnings => $transcript,
1533 versions => $version,
1536 # This is really ugly, but it's what we have to do
1537 if (not @{$versions{$version}}) {
1538 print {$transcript} "Unable to make a source version for version '$version'\n";
1541 if (not keys %versions and ($param{remove} or $param{add})) {
1542 if ($param{remove}) {
1543 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1546 print {$transcript} "Requested to add no versions; doing nothing.\n";
1548 __end_control(%info);
1551 # first things first, make the versions fully qualified source
1553 for my $data (@data) {
1554 # The 'done' field gets a bit weird with version tracking,
1555 # because a bug may be closed by multiple people in different
1556 # branches. Until we have something more flexible, we set it
1557 # every time a bug is fixed, and clear it when a bug is found
1558 # in a version greater than any version in which the bug is
1559 # fixed or when a bug is found and there is no fixed version
1560 my $action = 'Did not alter found versions';
1561 my %found_added = ();
1562 my %found_removed = ();
1563 my %fixed_removed = ();
1565 my $old_data = dclone($data);
1566 if (not $param{add} and not $param{remove}) {
1567 $found_removed{$_} = 1 for @{$data->{found_versions}};
1568 $data->{found_versions} = [];
1571 @found_versions{@{$data->{found_versions}}} = (1) x @{$data->{found_versions}};
1573 @fixed_versions{@{$data->{fixed_versions}}} = (1) x @{$data->{fixed_versions}};
1574 for my $version (keys %versions) {
1576 my @svers = @{$versions{$version}};
1581 if (exists $found_versions{$version}) {
1582 delete $found_versions{$version};
1583 $found_removed{$version} = 1;
1586 for my $sver (@svers) {
1587 if (not exists $found_versions{$sver}) {
1588 $found_versions{$sver} = 1;
1589 $found_added{$sver} = 1;
1591 # if the found we are adding matches any fixed
1592 # versions, remove them
1593 my @temp = grep m{(^|/)\Q$sver\E}, keys %fixed_versions;
1594 delete $fixed_versions{$_} for @temp;
1595 $fixed_removed{$_} = 1 for @temp;
1598 # We only care about reopening the bug if the bug is
1600 if (defined $data->{done} and length $data->{done}) {
1601 my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
1603 # determine if we need to reopen
1604 my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
1605 keys %fixed_versions);
1606 if (not @fixed_order or
1607 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1613 elsif ($param{remove}) {
1614 # in the case of removal, we only concern ourself with
1615 # the version passed, not the source version it maps
1617 my @temp = grep m{(^|/)\Q$version\E}, keys %found_versions;
1618 delete $found_versions{$_} for @temp;
1619 $found_removed{$_} = 1 for @temp;
1622 # set the keys to exactly these values
1623 my @svers = @{$versions{$version}};
1627 for my $sver (@svers) {
1628 if (not exists $found_versions{$sver}) {
1629 $found_versions{$sver} = 1;
1630 if (exists $found_removed{$sver}) {
1631 delete $found_removed{$sver};
1634 $found_added{$sver} = 1;
1641 $data->{found_versions} = [keys %found_versions];
1642 $data->{fixed_versions} = [keys %fixed_versions];
1645 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1646 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1647 # push @changed, 'marked as fixed in versions '.english_join([keys %fixed_addded]) if keys %fixed_added;
1648 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1649 $action = ucfirst(join ('; ',@changed)) if @changed;
1651 $action .= " and reopened"
1653 if (not $reopened and not @changed) {
1654 print {$transcript} "Ignoring request to alter found versions of bug #$data->{bug_num} to the same values previously set\n";
1658 append_action_to_log(bug => $data->{bug_num},
1661 old_data => $old_data,
1663 __return_append_to_log_options(
1668 if not exists $param{append_log} or $param{append_log};
1669 writebug($data->{bug_num},$data);
1670 print {$transcript} "$action\n";
1672 __end_control(%info);
1678 set_fixed(bug => $ref,
1679 transcript => $transcript,
1680 ($dl > 0 ? (debug => $transcript):()),
1681 requester => $header{from},
1682 request_addr => $controlrequestaddr,
1684 affected_packages => \%affected_packages,
1685 recipients => \%recipients,
1693 print {$transcript} "Failed to set fixed on $ref: $@";
1697 Sets, adds, or removes the specified fixed versions of a package
1699 If the fixed versions are empty (or end up being empty after this
1700 call) or the greatest fixed version is less than the greatest found
1701 version and the reopen option is true, the bug is reopened.
1703 This function is also called by the reopen function, which causes all
1704 of the fixed versions to be cleared.
1709 my %param = validate_with(params => \@_,
1710 spec => {bug => {type => SCALAR,
1713 # specific options here
1714 fixed => {type => SCALAR|ARRAYREF,
1717 add => {type => BOOLEAN,
1720 remove => {type => BOOLEAN,
1723 reopen => {type => BOOLEAN,
1727 %append_action_options,
1730 if ($param{add} and $param{remove}) {
1731 croak "It's nonsensical to add and remove the same versions";
1734 __begin_control(%param,
1737 my ($debug,$transcript) =
1738 @info{qw(debug transcript)};
1739 my @data = @{$info{data}};
1740 my @bugs = @{$info{bugs}};
1742 for my $version (make_list($param{fixed})) {
1743 next unless defined $version;
1744 $versions{$version} =
1745 [make_source_versions(package => [splitpackages($data[0]{package})],
1746 warnings => $transcript,
1749 versions => $version,
1752 # This is really ugly, but it's what we have to do
1753 if (not @{$versions{$version}}) {
1754 print {$transcript} "Unable to make a source version for version '$version'\n";
1757 if (not keys %versions and ($param{remove} or $param{add})) {
1758 if ($param{remove}) {
1759 print {$transcript} "Requested to remove no versions; doing nothing.\n";
1762 print {$transcript} "Requested to add no versions; doing nothing.\n";
1764 __end_control(%info);
1767 # first things first, make the versions fully qualified source
1769 for my $data (@data) {
1770 my $old_data = dclone($data);
1771 # The 'done' field gets a bit weird with version tracking,
1772 # because a bug may be closed by multiple people in different
1773 # branches. Until we have something more flexible, we set it
1774 # every time a bug is fixed, and clear it when a bug is found
1775 # in a version greater than any version in which the bug is
1776 # fixed or when a bug is found and there is no fixed version
1777 my $action = 'Did not alter fixed versions';
1778 my %found_added = ();
1779 my %found_removed = ();
1780 my %fixed_added = ();
1781 my %fixed_removed = ();
1783 if (not $param{add} and not $param{remove}) {
1784 $fixed_removed{$_} = 1 for @{$data->{fixed_versions}};
1785 $data->{fixed_versions} = [];
1788 @found_versions{@{$data->{found_versions}||[]}} = (1) x @{$data->{found_versions}||[]};
1790 @fixed_versions{@{$data->{fixed_versions}||[]}} = (1) x @{$data->{fixed_versions}||[]};
1791 for my $version (keys %versions) {
1793 my @svers = @{$versions{$version}};
1798 if (exists $fixed_versions{$version}) {
1799 $fixed_removed{$version} = 1;
1800 delete $fixed_versions{$version};
1803 for my $sver (@svers) {
1804 if (not exists $fixed_versions{$sver}) {
1805 $fixed_versions{$sver} = 1;
1806 $fixed_added{$sver} = 1;
1810 elsif ($param{remove}) {
1811 # in the case of removal, we only concern ourself with
1812 # the version passed, not the source version it maps
1814 my @temp = grep m{(?:^|\/)\Q$version\E$}, keys %fixed_versions;
1815 delete $fixed_versions{$_} for @temp;
1816 $fixed_removed{$_} = 1 for @temp;
1819 # set the keys to exactly these values
1820 my @svers = @{$versions{$version}};
1824 for my $sver (@svers) {
1825 if (not exists $fixed_versions{$sver}) {
1826 $fixed_versions{$sver} = 1;
1827 if (exists $fixed_removed{$sver}) {
1828 delete $fixed_removed{$sver};
1831 $fixed_added{$sver} = 1;
1838 $data->{found_versions} = [keys %found_versions];
1839 $data->{fixed_versions} = [keys %fixed_versions];
1841 # If we're supposed to consider reopening, reopen if the
1842 # fixed versions are empty or the greatest found version
1843 # is greater than the greatest fixed version
1844 if ($param{reopen} and defined $data->{done}
1845 and length $data->{done}) {
1846 my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1847 map {m{([^/]+)$}; $1;} @{$data->{found_versions}};
1848 # determine if we need to reopen
1849 my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
1850 map {m{([^/]+)$}; $1;} @{$data->{fixed_versions}};
1851 if (not @fixed_order or
1852 (Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
1859 push @changed, 'marked as found in versions '.english_join([keys %found_added]) if keys %found_added;
1860 push @changed, 'no longer marked as found in versions '.english_join([keys %found_removed]) if keys %found_removed;
1861 push @changed, 'marked as fixed in versions '.english_join([keys %fixed_added]) if keys %fixed_added;
1862 push @changed, 'no longer marked as fixed in versions '.english_join([keys %fixed_removed]) if keys %fixed_removed;
1863 $action = ucfirst(join ('; ',@changed)) if @changed;
1865 $action .= " and reopened"
1867 if (not $reopened and not @changed) {
1868 print {$transcript} "Ignoring request to alter fixed versions of bug #$data->{bug_num} to the same values previously set\n";
1872 append_action_to_log(bug => $data->{bug_num},
1875 old_data => $old_data,
1877 __return_append_to_log_options(
1882 if not exists $param{append_log} or $param{append_log};
1883 writebug($data->{bug_num},$data);
1884 print {$transcript} "$action\n";
1886 __end_control(%info);
1893 set_merged(bug => $ref,
1894 transcript => $transcript,
1895 ($dl > 0 ? (debug => $transcript):()),
1896 requester => $header{from},
1897 request_addr => $controlrequestaddr,
1899 affected_packages => \%affected_packages,
1900 recipients => \%recipients,
1901 merge_with => 12345,
1904 allow_reassign => 1,
1905 reassign_same_source_only => 1,
1910 print {$transcript} "Failed to set merged on $ref: $@";
1914 Sets, adds, or removes the specified merged bugs of a bug
1916 By default, requires
1921 my %param = validate_with(params => \@_,
1922 spec => {bug => {type => SCALAR,
1925 # specific options here
1926 merge_with => {type => ARRAYREF|SCALAR,
1929 remove => {type => BOOLEAN,
1932 force => {type => BOOLEAN,
1935 masterbug => {type => BOOLEAN,
1938 allow_reassign => {type => BOOLEAN,
1941 reassign_different_sources => {type => BOOLEAN,
1945 %append_action_options,
1948 my @merging = exists $param{merge_with} ? make_list($param{merge_with}):();
1950 @merging{@merging} = (1) x @merging;
1951 if (grep {$_ !~ /^\d+$/} @merging) {
1952 croak "Requested to merge with a non-numeric bug: ".join(',',map {qq('$_');} @merging);
1954 $param{locks} = {} if not exists $param{locks};
1956 __begin_control(%param,
1959 my ($debug,$transcript) =
1960 @info{qw(debug transcript)};
1961 if (not @merging and exists $param{merge_with}) {
1962 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
1963 __end_control(%info);
1966 my @data = @{$info{data}};
1967 my @bugs = @{$info{bugs}};
1970 for my $data (@data) {
1971 $data{$data->{bug_num}} = $data;
1972 my @merged_bugs = split / /, $data->{mergedwith};
1973 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
1977 if (not exists $param{merge_with}) {
1978 my $ok_to_unmerge = 1;
1979 delete $merged_bugs{$param{bug}};
1980 if (not keys %merged_bugs) {
1981 print {$transcript} "Ignoring request to unmerge a bug which is not merged with any others.\n";
1982 __end_control(%info);
1985 my $action = "Disconnected #$param{bug} from all other report(s).";
1986 for my $data (@data) {
1987 my $old_data = dclone($data);
1988 if ($data->{bug_num} == $param{bug}) {
1989 $data->{mergedwith} = '';
1992 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
1995 append_action_to_log(bug => $data->{bug_num},
1998 old_data => $old_data,
2000 __return_append_to_log_options(%param,
2004 if not exists $param{append_log} or $param{append_log};
2005 writebug($data->{bug_num},$data);
2007 print {$transcript} "$action\n";
2008 __end_control(%info);
2011 # lock and load all of the bugs we need
2012 my @bugs_to_load = keys %merging;
2015 my ($data,$n_locks) =
2016 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2018 locks => $param{locks},
2021 $new_locks += $n_locks;
2023 @data = values %data;
2024 if (not check_limit(data => [@data],
2025 exists $param{limit}?(limit => $param{limit}):(),
2026 transcript => $transcript,
2028 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
2030 for my $data (@data) {
2031 $data{$data->{bug_num}} = $data;
2032 $merged_bugs{$data->{bug_num}} = 1;
2033 my @merged_bugs = split / /, $data->{mergedwith};
2034 @merged_bugs{@merged_bugs} = (1) x @merged_bugs;
2035 if (exists $param{affected_bugs}) {
2036 $param{affected_bugs}{$data->{bug_num}} = 1;
2039 __handle_affected_packages(%param,data => [@data]);
2040 my %bug_info_shown; # which bugs have had information shown
2041 $bug_info_shown{$param{bug}} = 1;
2042 add_recipients(data => [@data],
2043 recipients => $param{recipients},
2044 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
2046 (__internal_request()?(transcript => $transcript):()),
2049 # Figure out what the ideal state is for the bug,
2050 my ($merge_status,$bugs_to_merge) =
2051 __calculate_merge_status(\@data,\%data,$param{bug});
2052 # find out if we actually have any bugs to merge
2053 if (not $bugs_to_merge) {
2054 print {$transcript} "Requested to merge with no additional bugs; not doing anything\n";
2055 for (1..$new_locks) {
2056 unfilelock($param{locks});
2059 __end_control(%info);
2062 # see what changes need to be made to merge the bugs
2063 # check to make sure that the set of changes we need to make is allowed
2064 my ($disallowed_changes,$changes) =
2065 __calculate_merge_changes(\@data,$merge_status,\%param);
2066 # at this point, stop if there are disallowed changes, otherwise
2067 # make the allowed changes, and then reread the bugs in question
2068 # to get the new data, then recaculate the merges; repeat
2069 # reloading and recalculating until we try too many times or there
2070 # are no changes to make.
2073 # we will allow at most 4 times through this; more than 1
2074 # shouldn't really happen.
2076 while ($attempts < 4 and (@{$disallowed_changes} or keys %{$changes})) {
2077 if ($attempts > 1) {
2078 print {$transcript} "Unable to complete merge on previous attempt; trying again (retry: $attempts)\n";
2080 if (@{$disallowed_changes}) {
2081 # figure out the problems
2082 print {$transcript} "Unable to merge bugs because:\n";
2083 for my $change (@{$disallowed_changes}) {
2084 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2086 if ($attempts > 0) {
2087 croak "Some bugs were altered while attempting to merge";
2090 croak "Did not alter merged bugs";
2093 my @bugs_to_change = keys %{$changes};
2094 for my $change_bug (@bugs_to_change) {
2095 next unless exists $changes->{$change_bug};
2096 $bug_changed{$change_bug}++;
2097 print {$transcript} __bug_info($data{$change_bug}) if
2098 $param{show_bug_info} and not __internal_request(1);
2099 $bug_info_shown{$change_bug} = 1;
2100 __allow_relocking($param{locks},[keys %data]);
2101 for my $change (@{$changes->{$change_bug}}) {
2102 if ($change->{field} eq 'blockedby' or $change->{field} eq 'blocks') {
2103 my %target_blockedby;
2104 @target_blockedby{@{$change->{func_value}}} = (1) x @{$change->{func_value}};
2105 my %unhandled_targets = %target_blockedby;
2106 my @blocks_to_remove;
2107 for my $key (split / /,$change->{orig_value}) {
2108 delete $unhandled_targets{$key};
2109 next if exists $target_blockedby{$key};
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),
2118 for my $key (keys %unhandled_targets) {
2119 set_blocks(bug => $change->{field} eq 'blocks' ? $key : $change->{bug},
2120 block => $change->{field} eq 'blocks' ? $change->{bug} : $key,
2123 keys %common_options,
2124 keys %append_action_options),
2129 $change->{function}->(bug => $change->{bug},
2130 $change->{key}, $change->{func_value},
2131 exists $change->{options}?@{$change->{options}}:(),
2133 keys %common_options,
2134 keys %append_action_options),
2138 __disallow_relocking($param{locks});
2139 my ($data,$n_locks) =
2140 __lock_and_load_merged_bugs(bugs_to_load => [keys %merging],
2142 locks => $param{locks},
2146 $new_locks += $n_locks;
2149 @data = values %data;
2150 ($merge_status,$bugs_to_merge) =
2151 __calculate_merge_status(\@data,\%data,$param{bug},$merge_status);
2152 ($disallowed_changes,$changes) =
2153 __calculate_merge_changes(\@data,$merge_status,\%param);
2154 $attempts = max(values %bug_changed);
2157 if ($param{show_bug_info} and not __internal_request(1)) {
2158 for my $data (sort {$a->{bug_num} <=> $b->{bug_num}} @data) {
2159 next if $bug_info_shown{$data->{bug_num}};
2160 print {$transcript} __bug_info($data);
2163 if (keys %{$changes} or @{$disallowed_changes}) {
2164 print {$transcript} "After four attempts, the following changes were unable to be made:\n";
2165 for (1..$new_locks) {
2166 unfilelock($param{locks});
2169 __end_control(%info);
2170 for my $change (values %{$changes}, @{$disallowed_changes}) {
2171 print {$transcript} "$change->{field} of #$change->{bug} is '$change->{text_orig_value}' not '$change->{text_value}'\n";
2173 die "Unable to modify bugs so they could be merged";
2177 # finally, we can merge the bugs
2178 my $action = "Merged ".join(' ',sort keys %merged_bugs);
2179 for my $data (@data) {
2180 my $old_data = dclone($data);
2181 $data->{mergedwith} = join(' ',sort grep {$_ != $data->{bug_num}}
2183 append_action_to_log(bug => $data->{bug_num},
2186 old_data => $old_data,
2188 __return_append_to_log_options(%param,
2192 if not exists $param{append_log} or $param{append_log};
2193 writebug($data->{bug_num},$data);
2195 print {$transcript} "$action\n";
2196 # unlock the extra locks that we got earlier
2197 for (1..$new_locks) {
2198 unfilelock($param{locks});
2201 __end_control(%info);
2204 sub __allow_relocking{
2205 my ($locks,$bugs) = @_;
2207 my @locks = (@{$bugs},'merge');
2208 for my $lock (@locks) {
2209 my @lockfiles = grep {m{/\Q$lock\E$}} keys %{$locks->{locks}};
2210 next unless @lockfiles;
2211 $locks->{relockable}{$lockfiles[0]} = 0;
2215 sub __disallow_relocking{
2217 delete $locks->{relockable};
2220 sub __lock_and_load_merged_bugs{
2222 validate_with(params => \@_,
2224 {bugs_to_load => {type => ARRAYREF,
2225 default => sub {[]},
2227 data => {type => HASHREF|ARRAYREF,
2229 locks => {type => HASHREF,
2230 default => sub {{};},
2232 reload_all => {type => BOOLEAN,
2235 debug => {type => HANDLE,
2241 if (ref($param{data}) eq 'ARRAY') {
2242 for my $data (@{$param{data}}) {
2243 $data{$data->{bug_num}} = dclone($data);
2247 %data = %{dclone($param{data})};
2249 my @bugs_to_load = @{$param{bugs_to_load}};
2250 if ($param{reload_all}) {
2251 push @bugs_to_load, keys %data;
2254 @temp{@bugs_to_load} = (1) x @bugs_to_load;
2255 @bugs_to_load = keys %temp;
2256 my %loaded_this_time;
2258 while ($bug_to_load = shift @bugs_to_load) {
2259 if (not $param{reload_all}) {
2260 next if exists $data{$bug_to_load};
2263 next if $loaded_this_time{$bug_to_load};
2266 if ($param{reload_all}) {
2267 if (exists $data{$bug_to_load}) {
2272 read_bug(bug => $bug_to_load,
2274 locks => $param{locks},
2276 die "Unable to load bug $bug_to_load";
2277 print {$param{debug}} "read bug $bug_to_load\n";
2278 $data{$data->{bug_num}} = $data;
2279 $new_locks += $lock_bug;
2280 $loaded_this_time{$data->{bug_num}} = 1;
2282 grep {not exists $data{$_}}
2283 split / /,$data->{mergedwith};
2285 return (\%data,$new_locks);
2289 sub __calculate_merge_status{
2290 my ($data_a,$data_h,$master_bug,$merge_status) = @_;
2291 my %merge_status = %{$merge_status // {}};
2293 my $bugs_to_merge = 0;
2294 for my $data (@{$data_a}) {
2295 # check to see if this bug is unmerged in the set
2296 if (not length $data->{mergedwith} or
2297 grep {not exists $merged_bugs{$_}} split / /,$data->{mergedwith}) {
2298 $merged_bugs{$data->{bug_num}} = 1;
2301 # the master_bug is the bug that every other bug is made to
2302 # look like. However, if merge is set, tags, fixed and found
2304 if ($data->{bug_num} == $master_bug) {
2305 for (qw(package forwarded severity blocks blockedby done owner summary affects)) {
2306 $merge_status{$_} = $data->{$_}
2309 if (defined $merge_status) {
2310 next unless $data->{bug_num} == $master_bug;
2312 $merge_status{tag} = {} if not exists $merge_status{tag};
2313 for my $tag (split /\s+/, $data->{keywords}) {
2314 $merge_status{tag}{$tag} = 1;
2316 $merge_status{keywords} = join(' ',sort keys %{$merge_status{tag}});
2317 for (qw(fixed found)) {
2318 @{$merge_status{"${_}_versions"}}{@{$data->{"${_}_versions"}}} = (1) x @{$data->{"${_}_versions"}};
2321 return (\%merge_status,$bugs_to_merge);
2326 sub __calculate_merge_changes{
2327 my ($datas,$merge_status,$param) = @_;
2329 my @disallowed_changes;
2330 for my $data (@{$datas}) {
2331 # things that can be forced
2333 # * func is the function to set the new value
2335 # * key is the key of the function to set the value,
2337 # * modify_value is a function which is called to modify the new
2338 # value so that the function will accept it
2340 # * options is an ARRAYREF of options to pass to the function
2342 # * allowed is a BOOLEAN which controls whether this setting
2343 # is allowed to be different by default.
2344 my %force_functions =
2345 (forwarded => {func => \&set_forwarded,
2349 severity => {func => \&set_severity,
2353 blocks => {func => \&set_blocks,
2354 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2358 blockedby => {func => \&set_blocks,
2359 modify_value => sub {defined $_[0]?[split ' ',$_[0]]:[]},
2363 done => {func => \&set_done,
2367 owner => {func => \&owner,
2371 summary => {func => \&summary,
2375 affects => {func => \&affects,
2379 package => {func => \&set_package,
2383 keywords => {func => \&set_tag,
2385 modify_value => sub {defined $_[0]?[sort split /\s+/,$_[0]]:[]},
2388 fixed_versions => {func => \&set_fixed,
2390 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2393 found_versions => {func => \&set_found,
2395 modify_value => sub {(defined $_[0] and ref($_[0]) eq 'HASH')?[sort keys %{$_[0]}]:$_[0]},
2399 for my $field (qw(forwarded severity blocks blockedby done owner summary affects package fixed_versions found_versions keywords)) {
2400 # if the ideal bug already has the field set properly, we
2402 if ($field eq 'keywords'){
2403 next if join(' ',sort split /\s+/,$data->{keywords}) eq
2404 join(' ',sort keys %{$merge_status->{tag}});
2406 elsif ($field =~ /^(?:fixed|found)_versions$/) {
2407 next if join(' ', sort @{$data->{$field}}) eq
2408 join(' ',sort keys %{$merge_status->{$field}});
2410 elsif ($field eq 'done') {
2411 # for done, we only care if the bug is done or not
2412 # done, not the value it's set to.
2413 if (defined $merge_status->{$field} and length $merge_status->{$field} and
2414 defined $data->{$field} and length $data->{$field}) {
2417 elsif ((not defined $merge_status->{$field} or not length $merge_status->{$field}) and
2418 (not defined $data->{$field} or not length $data->{$field})
2423 elsif ($merge_status->{$field} eq $data->{$field}) {
2428 bug => $data->{bug_num},
2429 orig_value => $data->{$field},
2431 (exists $force_functions{$field}{modify_value} ?
2432 $force_functions{$field}{modify_value}->($merge_status->{$field}):
2433 $merge_status->{$field}),
2434 value => $merge_status->{$field},
2435 function => $force_functions{$field}{func},
2436 key => $force_functions{$field}{key},
2437 options => $force_functions{$field}{options},
2438 allowed => exists $force_functions{$field}{allowed} ? $force_functions{$field}{allowed} : 0,
2440 $change->{text_value} = ref($change->{func_value}) eq 'ARRAY'?join(' ',@{$change->{func_value}}):$change->{func_value};
2441 $change->{text_orig_value} = ref($change->{orig_value}) eq 'ARRAY'?join(' ',@{$change->{orig_value}}):$change->{orig_value};
2442 if ($param->{force} or $change->{allowed}) {
2443 if ($field ne 'package' or $change->{allowed}) {
2444 push @{$changes{$data->{bug_num}}},$change;
2447 if ($param->{allow_reassign}) {
2448 if ($param->{reassign_different_sources}) {
2449 push @{$changes{$data->{bug_num}}},$change;
2452 # allow reassigning if binary_to_source returns at
2453 # least one of the same source packages
2454 my @merge_status_source =
2455 binary_to_source(package => $merge_status->{package},
2458 my @other_bug_source =
2459 binary_to_source(package => $data->{package},
2462 my %merge_status_sources;
2463 @merge_status_sources{@merge_status_source} =
2464 (1) x @merge_status_source;
2465 if (grep {$merge_status_sources{$_}} @other_bug_source) {
2466 push @{$changes{$data->{bug_num}}},$change;
2471 push @disallowed_changes,$change;
2473 # blocks and blocked by are weird; we have to go through and
2474 # set blocks to the other half of the merged bugs
2476 return (\@disallowed_changes,\%changes);
2482 affects(bug => $ref,
2483 transcript => $transcript,
2484 ($dl > 0 ? (debug => $transcript):()),
2485 requester => $header{from},
2486 request_addr => $controlrequestaddr,
2488 affected_packages => \%affected_packages,
2489 recipients => \%recipients,
2497 print {$transcript} "Failed to mark $ref as affecting $packages: $@";
2500 This marks a bug as affecting packages which the bug is not actually
2501 in. This should only be used in cases where fixing the bug instantly
2502 resolves the problem in the other packages.
2504 By default, the packages are set to the list of packages passed.
2505 However, if you pass add => 1 or remove => 1, the list of packages
2506 passed are added or removed from the affects list, respectively.
2511 my %param = validate_with(params => \@_,
2512 spec => {bug => {type => SCALAR,
2515 # specific options here
2516 package => {type => SCALAR|ARRAYREF|UNDEF,
2519 add => {type => BOOLEAN,
2522 remove => {type => BOOLEAN,
2526 %append_action_options,
2529 if ($param{add} and $param{remove}) {
2530 croak "Asking to both add and remove affects is nonsensical";
2532 if (not defined $param{package}) {
2533 $param{package} = [];
2536 __begin_control(%param,
2537 command => 'affects'
2539 my ($debug,$transcript) =
2540 @info{qw(debug transcript)};
2541 my @data = @{$info{data}};
2542 my @bugs = @{$info{bugs}};
2544 for my $data (@data) {
2546 print {$debug} "Going to change affects\n";
2547 my @packages = splitpackages($data->{affects});
2549 @packages{@packages} = (1) x @packages;
2552 for my $package (make_list($param{package})) {
2553 next unless defined $package and length $package;
2554 if (not $packages{$package}) {
2555 $packages{$package} = 1;
2556 push @added,$package;
2560 $action = "Added indication that $data->{bug_num} affects ".
2561 english_join(\@added);
2564 elsif ($param{remove}) {
2566 for my $package (make_list($param{package})) {
2567 if ($packages{$package}) {
2568 next unless defined $package and length $package;
2569 delete $packages{$package};
2570 push @removed,$package;
2573 $action = "Removed indication that $data->{bug_num} affects " .
2574 english_join(\@removed);
2577 my %added_packages = ();
2578 my %removed_packages = %packages;
2580 for my $package (make_list($param{package})) {
2581 next unless defined $package and length $package;
2582 $packages{$package} = 1;
2583 delete $removed_packages{$package};
2584 $added_packages{$package} = 1;
2586 if (keys %removed_packages) {
2587 $action = "Removed indication that $data->{bug_num} affects ".
2588 english_join([keys %removed_packages]);
2589 $action .= "\n" if keys %added_packages;
2591 if (keys %added_packages) {
2592 $action .= "Added indication that $data->{bug_num} affects " .
2593 english_join([keys %added_packages]);
2596 if (not length $action) {
2597 print {$transcript} "Ignoring request to set affects of bug $data->{bug_num} to the same value previously set\n";
2600 my $old_data = dclone($data);
2601 $data->{affects} = join(',',keys %packages);
2602 append_action_to_log(bug => $data->{bug_num},
2604 command => 'affects',
2606 old_data => $old_data,
2607 __return_append_to_log_options(
2612 if not exists $param{append_log} or $param{append_log};
2613 writebug($data->{bug_num},$data);
2614 print {$transcript} "$action\n";
2616 __end_control(%info);
2620 =head1 SUMMARY FUNCTIONS
2625 summary(bug => $ref,
2626 transcript => $transcript,
2627 ($dl > 0 ? (debug => $transcript):()),
2628 requester => $header{from},
2629 request_addr => $controlrequestaddr,
2631 affected_packages => \%affected_packages,
2632 recipients => \%recipients,
2638 print {$transcript} "Failed to mark $ref with summary foo: $@";
2641 Handles all setting of summary fields
2643 If summary is undef, unsets the summary
2645 If summary is 0, sets the summary to the first paragraph contained in
2648 If summary is a positive integer, sets the summary to the message specified.
2650 Otherwise, sets summary to the value passed.
2656 my %param = validate_with(params => \@_,
2657 spec => {bug => {type => SCALAR,
2660 # specific options here
2661 summary => {type => SCALAR|UNDEF,
2665 %append_action_options,
2668 # croak "summary must be numeric or undef" if
2669 # defined $param{summary} and not $param{summary} =~ /^\d+/;
2671 __begin_control(%param,
2672 command => 'summary'
2674 my ($debug,$transcript) =
2675 @info{qw(debug transcript)};
2676 my @data = @{$info{data}};
2677 my @bugs = @{$info{bugs}};
2678 # figure out the log that we're going to use
2680 my $summary_msg = '';
2682 if (not defined $param{summary}) {
2684 print {$debug} "Removing summary fields\n";
2685 $action = 'Removed summary';
2687 elsif ($param{summary} =~ /^\d+$/) {
2689 my @records = Debbugs::Log::read_log_records(bug_num => $param{bug});
2690 if ($param{summary} == 0) {
2691 $log = $param{message};
2692 $summary_msg = @records + 1;
2695 if (($param{summary} - 1 ) > $#records) {
2696 die "Message number '$param{summary}' exceeds the maximum message '$#records'";
2698 my $record = $records[($param{summary} - 1 )];
2699 if ($record->{type} !~ /incoming-recv|recips/) {
2700 die "Message number '$param{summary}' is a invalid message type '$record->{type}'";
2702 $summary_msg = $param{summary};
2703 $log = [$record->{text}];
2705 my $p_o = Debbugs::MIME::parse(join('',@{$log}));
2706 my $body = $p_o->{body};
2707 my $in_pseudoheaders = 0;
2709 # walk through body until we get non-blank lines
2710 for my $line (@{$body}) {
2711 if ($line =~ /^\s*$/) {
2712 if (length $paragraph) {
2713 if ($paragraph =~ m/^(?:.+\n\>)+.+\n/x) {
2719 $in_pseudoheaders = 0;
2722 # skip a paragraph if it looks like it's control or
2724 if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
2725 $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
2726 \#|reopen|close|(?:not|)(?:fixed|found)|clone|
2727 debug|(?:not|)forwarded|priority|
2728 (?:un|)block|limit|(?:un|)archive|
2729 reassign|retitle|affects|wrongpackage
2730 (?:un|force|)merge|user(?:category|tags?|)
2732 if (not length $paragraph) {
2733 print {$debug} "Found control/pseudo-headers and skiping them\n";
2734 $in_pseudoheaders = 1;
2738 next if $in_pseudoheaders;
2739 $paragraph .= $line ." \n";
2741 print {$debug} "Summary is going to be '$paragraph'\n";
2742 $summary = $paragraph;
2743 $summary =~ s/[\n\r]/ /g;
2744 if (not length $summary) {
2745 die "Unable to find summary message to use";
2747 # trim off a trailing spaces
2748 $summary =~ s/\ *$//;
2751 $summary = $param{summary};
2753 for my $data (@data) {
2754 print {$debug} "Going to change summary\n";
2755 if (((not defined $summary or not length $summary) and
2756 (not defined $data->{summary} or not length $data->{summary})) or
2757 $summary eq $data->{summary}) {
2758 print {$transcript} "Ignoring request to change the summary of bug $param{bug} to the same value\n";
2761 if (length $summary) {
2762 if (length $data->{summary}) {
2763 $action = "Summary replaced with message bug $param{bug} message $summary_msg";
2766 $action = "Summary recorded from message bug $param{bug} message $summary_msg";
2769 my $old_data = dclone($data);
2770 $data->{summary} = $summary;
2771 append_action_to_log(bug => $data->{bug_num},
2772 command => 'summary',
2773 old_data => $old_data,
2776 __return_append_to_log_options(
2781 if not exists $param{append_log} or $param{append_log};
2782 writebug($data->{bug_num},$data);
2783 print {$transcript} "$action\n";
2785 __end_control(%info);
2793 clone_bug(bug => $ref,
2794 transcript => $transcript,
2795 ($dl > 0 ? (debug => $transcript):()),
2796 requester => $header{from},
2797 request_addr => $controlrequestaddr,
2799 affected_packages => \%affected_packages,
2800 recipients => \%recipients,
2805 print {$transcript} "Failed to clone bug $ref bar: $@";
2808 Clones the given bug.
2810 We currently don't support cloning merged bugs, but this could be
2811 handled by internally unmerging, cloning, then remerging the bugs.
2816 my %param = validate_with(params => \@_,
2817 spec => {bug => {type => SCALAR,
2820 new_bugs => {type => ARRAYREF,
2822 new_clones => {type => HASHREF,
2826 %append_action_options,
2830 __begin_control(%param,
2833 my ($debug,$transcript) =
2834 @info{qw(debug transcript)};
2835 my @data = @{$info{data}};
2836 my @bugs = @{$info{bugs}};
2839 for my $data (@data) {
2840 if (length($data->{mergedwith})) {
2841 die "Bug is marked as being merged with others. Use an existing clone.\n";
2845 die "Not exactly one bug‽ This shouldn't happen.";
2847 my $data = $data[0];
2849 for my $newclone_id (@{$param{new_bugs}}) {
2850 my $new_bug_num = new_bug(copy => $data->{bug_num});
2851 $param{new_clones}{$newclone_id} = $new_bug_num;
2852 $clones{$newclone_id} = $new_bug_num;
2854 my @new_bugs = sort values %clones;
2856 for my $new_bug (@new_bugs) {
2857 # no collapsed ids or the higher collapsed id is not one less
2858 # than the next highest new bug
2859 if (not @collapsed_ids or
2860 $collapsed_ids[-1][1]+1 != $new_bug) {
2861 push @collapsed_ids,[$new_bug,$new_bug];
2864 $collapsed_ids[-1][1] = $new_bug;
2868 for my $ci (@collapsed_ids) {
2869 if ($ci->[0] == $ci->[1]) {
2870 push @collapsed,$ci->[0];
2873 push @collapsed,$ci->[0].'-'.$ci->[1]
2876 my $collapsed_str = english_join(\@collapsed);
2877 $action = "Bug $data->{bug_num} cloned as bug".(@new_bugs > 1?'s':'').' '.$collapsed_str;
2878 for my $new_bug (@new_bugs) {
2879 append_action_to_log(bug => $new_bug,
2881 __return_append_to_log_options(
2886 if not exists $param{append_log} or $param{append_log};
2888 append_action_to_log(bug => $data->{bug_num},
2890 __return_append_to_log_options(
2895 if not exists $param{append_log} or $param{append_log};
2896 writebug($data->{bug_num},$data);
2897 print {$transcript} "$action\n";
2898 __end_control(%info);
2899 # bugs that this bug is blocking are also blocked by the new clone(s)
2900 for my $bug (split ' ', $data->{blocks}) {
2901 for my $new_bug (@new_bugs) {
2902 set_blocks(bug => $new_bug,
2905 keys %common_options,
2906 keys %append_action_options),
2910 # bugs that this bug is blocked by are also blocking the new clone(s)
2911 for my $bug (split ' ', $data->{blockedby}) {
2912 for my $new_bug (@new_bugs) {
2913 set_blocks(bug => $bug,
2916 keys %common_options,
2917 keys %append_action_options),
2925 =head1 OWNER FUNCTIONS
2931 transcript => $transcript,
2932 ($dl > 0 ? (debug => $transcript):()),
2933 requester => $header{from},
2934 request_addr => $controlrequestaddr,
2936 recipients => \%recipients,
2942 print {$transcript} "Failed to mark $ref as having an owner: $@";
2945 Handles all setting of the owner field; given an owner of undef or of
2946 no length, indicates that a bug is not owned by anyone.
2951 my %param = validate_with(params => \@_,
2952 spec => {bug => {type => SCALAR,
2955 owner => {type => SCALAR|UNDEF,
2958 %append_action_options,
2962 __begin_control(%param,
2965 my ($debug,$transcript) =
2966 @info{qw(debug transcript)};
2967 my @data = @{$info{data}};
2968 my @bugs = @{$info{bugs}};
2970 for my $data (@data) {
2971 print {$debug} "Going to change owner to '".(defined $param{owner}?$param{owner}:'(going to unset it)')."'\n";
2972 print {$debug} "Owner is currently '$data->{owner}' for bug $data->{bug_num}\n";
2973 if (not defined $param{owner} or not length $param{owner}) {
2974 if (not defined $data->{owner} or not length $data->{owner}) {
2975 print {$transcript} "Ignoring request to unset the owner of bug #$data->{bug_num} which was not set\n";
2979 $action = "Removed annotation that $config{bug} was owned by " .
2983 if ($data->{owner} eq $param{owner}) {
2984 print {$transcript} "Ignoring request to set the owner of bug #$data->{bug_num} to the same value\n";
2987 if (length $data->{owner}) {
2988 $action = "Owner changed from $data->{owner} to $param{owner}.";
2991 $action = "Owner recorded as $param{owner}."
2994 my $old_data = dclone($data);
2995 $data->{owner} = $param{owner};
2996 append_action_to_log(bug => $data->{bug_num},
2999 old_data => $old_data,
3001 __return_append_to_log_options(
3006 if not exists $param{append_log} or $param{append_log};
3007 writebug($data->{bug_num},$data);
3008 print {$transcript} "$action\n";
3010 __end_control(%info);
3014 =head1 ARCHIVE FUNCTIONS
3021 bug_archive(bug => $bug_num,
3023 transcript => \$transcript,
3028 transcript("Unable to archive $bug_num\n");
3031 transcript($transcript);
3034 This routine archives a bug
3038 =item bug -- bug number
3040 =item check_archiveable -- check wether a bug is archiveable before
3041 archiving; defaults to 1
3043 =item archive_unarchived -- whether to archive bugs which have not
3044 previously been archived; defaults to 1. [Set to 0 when used from
3047 =item ignore_time -- whether to ignore time constraints when archiving
3048 a bug; defaults to 0.
3055 my %param = validate_with(params => \@_,
3056 spec => {bug => {type => SCALAR,
3059 check_archiveable => {type => BOOLEAN,
3062 archive_unarchived => {type => BOOLEAN,
3065 ignore_time => {type => BOOLEAN,
3069 %append_action_options,
3072 my %info = __begin_control(%param,
3073 command => 'archive',
3075 my ($debug,$transcript) = @info{qw(debug transcript)};
3076 my @data = @{$info{data}};
3077 my @bugs = @{$info{bugs}};
3078 my $action = "$config{bug} archived.";
3079 if ($param{check_archiveable} and
3080 not bug_archiveable(bug=>$param{bug},
3081 ignore_time => $param{ignore_time},
3083 print {$transcript} "Bug $param{bug} cannot be archived\n";
3084 die "Bug $param{bug} cannot be archived";
3086 if (not $param{archive_unarchived} and
3087 not exists $data[0]{unarchived}
3089 print {$transcript} "$param{bug} has not been archived previously\n";
3090 die "$param{bug} has not been archived previously";
3092 add_recipients(recipients => $param{recipients},
3095 transcript => $transcript,
3097 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3098 for my $bug (@bugs) {
3099 if ($param{check_archiveable}) {
3100 die "Bug $bug cannot be archived (but $param{bug} can?)"
3101 unless bug_archiveable(bug=>$bug,
3102 ignore_time => $param{ignore_time},
3106 # If we get here, we can archive/remove this bug
3107 print {$debug} "$param{bug} removing\n";
3108 for my $bug (@bugs) {
3109 #print "$param{bug} removing $bug\n" if $debug;
3110 my $dir = get_hashname($bug);
3111 # First indicate that this bug is being archived
3112 append_action_to_log(bug => $bug,
3114 command => 'archive',
3115 # we didn't actually change the data
3116 # when we archived, so we don't pass
3117 # a real new_data or old_data
3120 __return_append_to_log_options(
3125 if not exists $param{append_log} or $param{append_log};
3126 my @files_to_remove = map {s#$config{spool_dir}/db-h/$dir/##; $_} glob("$config{spool_dir}/db-h/$dir/$bug.*");
3127 if ($config{save_old_bugs}) {
3128 mkpath("$config{spool_dir}/archive/$dir");
3129 foreach my $file (@files_to_remove) {
3130 link("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3131 copy("$config{spool_dir}/db-h/$dir/$file", "$config{spool_dir}/archive/$dir/$file") or
3132 # we need to bail out here if things have
3133 # gone horribly wrong to avoid removing a
3135 die "Unable to link or copy $config{spool_dir}/db-h/$dir/$file to $config{spool_dir}/archive/$dir/$file; $!";
3138 print {$transcript} "archived $bug to archive/$dir (from $param{bug})\n";
3140 unlink(map {"$config{spool_dir}/db-h/$dir/$_"} @files_to_remove);
3141 print {$debug} "deleted $bug (from $param{bug})\n";
3143 bughook_archive(@bugs);
3144 __end_control(%info);
3147 =head2 bug_unarchive
3151 bug_unarchive(bug => $bug_num,
3153 transcript => \$transcript,
3158 transcript("Unable to archive bug: $bug_num");
3160 transcript($transcript);
3162 This routine unarchives a bug
3167 my %param = validate_with(params => \@_,
3168 spec => {bug => {type => SCALAR,
3172 %append_action_options,
3176 my %info = __begin_control(%param,
3178 command=>'unarchive');
3179 my ($debug,$transcript) =
3180 @info{qw(debug transcript)};
3181 my @data = @{$info{data}};
3182 my @bugs = @{$info{bugs}};
3183 my $action = "$config{bug} unarchived.";
3184 my @files_to_remove;
3185 for my $bug (@bugs) {
3186 print {$debug} "$param{bug} removing $bug\n";
3187 my $dir = get_hashname($bug);
3188 my @files_to_copy = map {s#$config{spool_dir}/archive/$dir/##; $_} glob("$config{spool_dir}/archive/$dir/$bug.*");
3189 mkpath("archive/$dir");
3190 foreach my $file (@files_to_copy) {
3191 # die'ing here sucks
3192 link( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3193 copy( "$config{spool_dir}/archive/$dir/$file", "$config{spool_dir}/db-h/$dir/$file" ) or
3194 die "Unable to copy $config{spool_dir}/archive/$dir/$file to $config{spool_dir}/db-h/$dir/$file";
3196 push @files_to_remove, map {"$config{spool_dir}/archive/$dir/$_"} @files_to_copy;
3197 print {$transcript} "Unarchived $config{bug} $bug\n";
3199 unlink(@files_to_remove) or die "Unable to unlink bugs";
3200 # Indicate that this bug has been archived previously
3201 for my $bug (@bugs) {
3202 my $newdata = readbug($bug);
3203 my $old_data = dclone($newdata);
3204 if (not defined $newdata) {
3205 print {$transcript} "$config{bug} $bug disappeared!\n";
3206 die "Bug $bug disappeared!";
3208 $newdata->{unarchived} = time;
3209 append_action_to_log(bug => $bug,
3211 command => 'unarchive',
3212 new_data => $newdata,
3213 old_data => $old_data,
3214 __return_append_to_log_options(
3219 if not exists $param{append_log} or $param{append_log};
3220 writebug($bug,$newdata);
3222 __end_control(%info);
3225 =head2 append_action_to_log
3227 append_action_to_log
3229 This should probably be moved to Debbugs::Log; have to think that out
3234 sub append_action_to_log{
3235 my %param = validate_with(params => \@_,
3236 spec => {bug => {type => SCALAR,
3239 new_data => {type => HASHREF,
3242 old_data => {type => HASHREF,
3245 command => {type => SCALAR,
3248 action => {type => SCALAR,
3250 requester => {type => SCALAR,
3253 request_addr => {type => SCALAR,
3256 location => {type => SCALAR,
3259 message => {type => SCALAR|ARRAYREF,
3262 recips => {type => SCALAR|ARRAYREF,
3265 desc => {type => SCALAR,
3268 get_lock => {type => BOOLEAN,
3271 locks => {type => HASHREF,
3275 # append_action_options here
3276 # because some of these
3277 # options aren't actually
3278 # optional, even though the
3279 # original function doesn't
3283 # Fix this to use $param{location}
3284 my $log_location = buglog($param{bug});
3285 die "Unable to find .log for $param{bug}"
3286 if not defined $log_location;
3287 if ($param{get_lock}) {
3288 filelock("lock/$param{bug}",exists $param{locks}?$param{locks}:());
3292 my $logfh = IO::File->new(">>$log_location") or
3293 die "Unable to open $log_location for appending: $!";
3294 # determine difference between old and new
3296 if (exists $param{old_data} and exists $param{new_data}) {
3297 my $old_data = dclone($param{old_data});
3298 my $new_data = dclone($param{new_data});
3299 for my $key (keys %{$old_data}) {
3300 if (not exists $Debbugs::Status::fields{$key}) {
3301 delete $old_data->{$key};
3304 next unless exists $new_data->{$key};
3305 next unless defined $new_data->{$key};
3306 if (not defined $old_data->{$key}) {
3307 delete $old_data->{$key};
3310 if (ref($new_data->{$key}) and
3311 ref($old_data->{$key}) and
3312 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3313 local $Storable::canonical = 1;
3314 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3315 delete $new_data->{$key};
3316 delete $old_data->{$key};
3319 elsif ($new_data->{$key} eq $old_data->{$key}) {
3320 delete $new_data->{$key};
3321 delete $old_data->{$key};
3324 for my $key (keys %{$new_data}) {
3325 if (not exists $Debbugs::Status::fields{$key}) {
3326 delete $new_data->{$key};
3329 next unless exists $old_data->{$key};
3330 next unless defined $old_data->{$key};
3331 if (not defined $new_data->{$key} or
3332 not exists $Debbugs::Status::fields{$key}) {
3333 delete $new_data->{$key};
3336 if (ref($new_data->{$key}) and
3337 ref($old_data->{$key}) and
3338 ref($new_data->{$key}) eq ref($old_data->{$key})) {
3339 local $Storable::canonical = 1;
3340 if (nfreeze($new_data->{$key}) eq nfreeze($old_data->{$key})) {
3341 delete $new_data->{$key};
3342 delete $old_data->{$key};
3345 elsif ($new_data->{$key} eq $old_data->{$key}) {
3346 delete $new_data->{$key};
3347 delete $old_data->{$key};
3350 $data_diff .= "<!-- new_data:\n";
3352 for my $key (keys %{$new_data}) {
3353 if (not exists $Debbugs::Status::fields{$key}) {
3354 warn "No such field $key";
3357 $nd{$key} = $new_data->{$key};
3358 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $new_data->{$key}")."\n";
3360 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%nd)],[qw(new_data)]));
3361 $data_diff .= "-->\n";
3362 $data_diff .= "<!-- old_data:\n";
3364 for my $key (keys %{$old_data}) {
3365 if (not exists $Debbugs::Status::fields{$key}) {
3366 warn "No such field $key";
3369 $od{$key} = $old_data->{$key};
3370 # $data_diff .= html_escape("$Debbugs::Status::fields{$key}: $old_data->{$key}")."\n";
3372 $data_diff .= html_escape(Data::Dumper->Dump([encode_utf8_structure(\%od)],[qw(old_data)]));
3373 $data_diff .= "-->\n";
3376 (exists $param{command} ?
3377 "<!-- command:".html_escape(encode_utf8($param{command}))." -->\n":""
3379 (length $param{requester} ?
3380 "<!-- requester: ".html_escape(encode_utf8($param{requester}))." -->\n":""
3382 (length $param{request_addr} ?
3383 "<!-- request_addr: ".html_escape(encode_utf8($param{request_addr}))." -->\n":""
3385 "<!-- time:".time()." -->\n",
3387 "<strong>".html_escape(encode_utf8($param{action}))."</strong>\n");
3388 if (length $param{requester}) {
3389 $msg .= "Request was from <code>".html_escape(encode_utf8($param{requester}))."</code>\n";
3391 if (length $param{request_addr}) {
3392 $msg .= "to <code>".html_escape(encode_utf8($param{request_addr}))."</code>";
3394 if (length $param{desc}) {
3395 $msg .= ":<br>\n".encode_utf8($param{desc})."\n";
3400 push @records, {type => 'html',
3404 if ((ref($param{message}) and @{$param{message}}) or length($param{message})) {
3405 push @records, {type => exists $param{recips}?'recips':'incoming-recv',
3406 exists $param{recips}?(recips => [make_list($param{recips})]):(),
3407 text => join('',make_list($param{message})),
3410 write_log_records(logfh=>$logfh,
3411 records => \@records,
3413 close $logfh or die "Unable to close $log_location: $!";
3414 if ($param{get_lock}) {
3415 unfilelock(exists $param{locks}?$param{locks}:());
3423 =head1 PRIVATE FUNCTIONS
3425 =head2 __handle_affected_packages
3427 __handle_affected_packages(affected_packages => {},
3435 sub __handle_affected_packages{
3436 my %param = validate_with(params => \@_,
3437 spec => {%common_options,
3438 data => {type => ARRAYREF|HASHREF
3443 for my $data (make_list($param{data})) {
3444 next unless exists $data->{package} and defined $data->{package};
3445 my @packages = split /\s*,\s*/,$data->{package};
3446 @{$param{affected_packages}}{@packages} = (1) x @packages;
3450 =head2 __handle_debug_transcript
3452 my ($debug,$transcript) = __handle_debug_transcript(%param);
3454 Returns a debug and transcript filehandle
3459 sub __handle_debug_transcript{
3460 my %param = validate_with(params => \@_,
3461 spec => {%common_options},
3464 my $debug = globify_scalar(exists $param{debug}?$param{debug}:undef);
3465 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3466 return ($debug,$transcript);
3473 Produces a small bit of bug information to kick out to the transcript
3480 next unless defined $data and exists $data->{bug_num};
3481 $return .= "Bug #".($data->{bug_num}||'').
3482 ((defined $data->{done} and length $data->{done})?
3483 " {Done: $data->{done}}":''
3485 " [".($data->{package}||'(no package)'). "] ".
3486 ($data->{subject}||'(no subject)')."\n";
3492 =head2 __internal_request
3494 __internal_request()
3495 __internal_request($level)
3497 Returns true if the caller of the function calling __internal_request
3498 belongs to __PACKAGE__
3500 This allows us to be magical, and don't bother to print bug info if
3501 the second caller is from this package, amongst other things.
3503 An optional level is allowed, which increments the number of levels to
3504 check by the given value. [This is basically for use by internal
3505 functions like __begin_control which are always called by
3510 sub __internal_request{
3512 $l = 0 if not defined $l;
3513 if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
3519 sub __return_append_to_log_options{
3521 my $action = $param{action} if exists $param{action};
3522 if (not exists $param{requester}) {
3523 $param{requester} = $config{control_internal_requester};
3525 if (not exists $param{request_addr}) {
3526 $param{request_addr} = $config{control_internal_request_addr};
3528 if (not exists $param{message}) {
3529 my $date = rfc822_date();
3530 $param{message} = fill_in_template(template => 'mail/fake_control_message',
3531 variables => {request_addr => $param{request_addr},
3532 requester => $param{requester},
3538 if (not defined $action) {
3539 carp "Undefined action!";
3540 $action = "unknown action";
3542 return (action => $action,
3543 hash_slice(%param,keys %append_action_options),
3547 =head2 __begin_control
3549 my %info = __begin_control(%param,
3551 command=>'unarchive');
3552 my ($debug,$transcript) = @info{qw(debug transcript)};
3553 my @data = @{$info{data}};
3554 my @bugs = @{$info{bugs}};
3557 Starts the process of modifying a bug; handles all of the generic
3558 things that almost every control request needs
3560 Returns a hash containing
3564 =item new_locks -- number of new locks taken out by this call
3566 =item debug -- the debug file handle
3568 =item transcript -- the transcript file handle
3570 =item data -- an arrayref containing the data of the bugs
3571 corresponding to this request
3573 =item bugs -- an arrayref containing the bug numbers of the bugs
3574 corresponding to this request
3582 sub __begin_control {
3583 my %param = validate_with(params => \@_,
3584 spec => {bug => {type => SCALAR,
3587 archived => {type => BOOLEAN,
3590 command => {type => SCALAR,
3598 my ($debug,$transcript) = __handle_debug_transcript(@_);
3599 print {$debug} "considering bug $param{bug} for ".(exists $param{command}?$param{command}:scalar caller())."\n";
3600 # print {$debug} Data::Dumper->Dump([[caller(1)],\%param],[qw(caller param)])."\n";
3601 $lockhash = $param{locks} if exists $param{locks};
3603 my $old_die = $SIG{__DIE__};
3604 $SIG{__DIE__} = *sig_die{CODE};
3606 ($new_locks, @data) =
3607 lock_read_all_merged_bugs(bug => $param{bug},
3608 $param{archived}?(location => 'archive'):(),
3609 exists $param{locks} ? (locks => $param{locks}):(),
3611 $locks += $new_locks;
3613 die "Unable to read any bugs successfully.";
3615 if (not $param{archived}) {
3616 for my $data (@data) {
3617 if ($data->{archived}) {
3618 die "Not altering archived bugs; see unarchive.";
3622 if (not check_limit(data => \@data,
3623 exists $param{limit}?(limit => $param{limit}):(),
3624 transcript => $transcript,
3626 die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
3629 __handle_affected_packages(%param,data => \@data);
3630 print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
3631 print {$debug} "$param{bug} read $locks locks\n";
3632 if (not @data or not defined $data[0]) {
3633 print {$transcript} "No bug found for $param{bug}\n";
3634 die "No bug found for $param{bug}";
3637 add_recipients(data => \@data,
3638 recipients => $param{recipients},
3639 (exists $param{command}?(actions_taken => {$param{command} => 1}):()),
3641 (__internal_request()?(transcript => $transcript):()),
3644 print {$debug} "$param{bug} read done\n";
3645 my @bugs = map {(defined $_ and exists $_->{bug_num} and defined $_->{bug_num})?$_->{bug_num}:()} @data;
3646 print {$debug} "$param{bug} bugs ".join(' ',@bugs)."\n";
3647 return (data => \@data,
3649 old_die => $old_die,
3650 new_locks => $new_locks,
3652 transcript => $transcript,
3654 exists $param{locks}?(locks => $param{locks}):(),
3658 =head2 __end_control
3660 __end_control(%info);
3662 Handles tearing down from a control request
3668 if (exists $info{new_locks} and $info{new_locks} > 0) {
3669 print {$info{debug}} "For bug $info{param}{bug} unlocking $locks locks\n";
3670 for (1..$info{new_locks}) {
3671 unfilelock(exists $info{locks}?$info{locks}:());
3675 $SIG{__DIE__} = $info{old_die};
3676 if (exists $info{param}{affected_bugs}) {
3677 @{$info{param}{affected_bugs}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
3679 add_recipients(recipients => $info{param}{recipients},
3680 (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
3681 data => $info{data},
3682 debug => $info{debug},
3683 transcript => $info{transcript},
3685 __handle_affected_packages(%{$info{param}},data=>$info{data});
3691 check_limit(data => \@data, limit => $param{limit});
3694 Checks to make sure that bugs match any limits; each entry of @data
3695 much satisfy the limit.
3697 Returns true if there are no entries in data, or there are no keys in
3698 limit; returns false (0) if there are any entries which do not match.
3700 The limit hashref elements can contain an arrayref of scalars to
3701 match; regexes are also acccepted. At least one of the entries in each
3702 element needs to match the corresponding field in all data for the
3709 my %param = validate_with(params => \@_,
3710 spec => {data => {type => ARRAYREF|SCALAR,
3712 limit => {type => HASHREF|UNDEF,
3714 transcript => {type => SCALARREF|HANDLE,
3719 my @data = make_list($param{data});
3721 not defined $param{limit} or
3722 not keys %{$param{limit}}) {
3725 my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
3726 my $going_to_fail = 0;
3727 for my $data (@data) {
3728 $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
3729 status => dclone($data),
3731 for my $field (keys %{$param{limit}}) {
3732 next unless exists $param{limit}{$field};
3734 my @data_fields = make_list($data->{$field});
3735 LIMIT: for my $limit (make_list($param{limit}{$field})) {
3736 if (not ref $limit) {
3737 for my $data_field (@data_fields) {
3738 if ($data_field eq $limit) {
3744 elsif (ref($limit) eq 'Regexp') {
3745 for my $data_field (@data_fields) {
3746 if ($data_field =~ $limit) {
3753 warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
3758 print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
3759 "' does not match at least one of ".
3760 join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
3764 return $going_to_fail?0:1;
3772 We override die to specially handle unlocking files in the cases where
3773 we are called via eval. [If we're not called via eval, it doesn't
3779 if ($^S) { # in eval
3781 for (1..$locks) { unfilelock(defined $lockhash?$lockhash:()); }
3788 # =head2 __message_body_template
3790 # message_body_template('mail/ack',{ref=>'foo'});
3792 # Creates a message body using a template
3796 sub __message_body_template{
3797 my ($template,$extra_var) = @_;
3799 my $hole_var = {'&bugurl' =>
3801 'http://'.$config{cgi_domain}.'/'.
3802 Debbugs::CGI::bug_url($_[0]);
3806 my $body = fill_in_template(template => $template,
3807 variables => {config => \%config,
3810 hole_var => $hole_var,
3812 return fill_in_template(template => 'mail/message_body',
3813 variables => {config => \%config,
3817 hole_var => $hole_var,
3821 sub __all_undef_or_equal {
3823 return 1 if @values == 1 or @values == 0;
3824 my $not_def = grep {not defined $_} @values;
3825 if ($not_def == @values) {
3828 if ($not_def > 0 and $not_def != @values) {
3831 my $first_val = shift @values;
3832 for my $val (@values) {
3833 if ($first_val ne $val) {