#
# [Other people have contributed to this file; their copyrights should
# go here too.]
-# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
+# Copyright 2007,2008,2009 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Control;
=item request_addr -- Address to which the request was sent
+=item request_nn -- Name of queue file which caused this request
+
+=item request_msgid -- Message id of message which caused this request
+
=item location -- Optional location; currently ignored but may be
supported in the future for updating archived bugs upon archival
$DEBUG = 0 unless defined $DEBUG;
@EXPORT = ();
- %EXPORT_TAGS = (affects => [qw(affects)],
+ %EXPORT_TAGS = (reopen => [qw(reopen)],
+ submitter => [qw(set_submitter)],
+ severity => [qw(set_severity)],
+ affects => [qw(affects)],
summary => [qw(summary)],
owner => [qw(owner)],
title => [qw(set_title)],
found => [qw(set_found set_fixed)],
fixed => [qw(set_found set_fixed)],
package => [qw(set_package)],
+ block => [qw(set_blocks)],
+ tag => [qw(set_tag)],
archive => [qw(bug_archive bug_unarchive),
],
log => [qw(append_action_to_log),
use Debbugs::Config qw(:config);
use Debbugs::Common qw(:lock buglog :misc get_hashname);
-use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages);
+use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields);
use Debbugs::CGI qw(html_escape);
use Debbugs::Log qw(:misc);
use Debbugs::Recipients qw(:add);
use Debbugs::Text qw(:templates);
-use Debbugs::Mail qw(rfc822_date);
+use Debbugs::Mail qw(rfc822_date send_mail_message default_headers);
+use Debbugs::MIME qw(create_mime_message);
use Mail::RFC822::Address qw();
use POSIX qw(strftime);
use Storable qw(dclone nfreeze);
+use List::Util qw(first);
use Carp;
show_bug_info => {type => BOOLEAN,
default => 1,
},
+ request_subject => {type => SCALAR,
+ default => 'Unknown Subject',
+ },
+ request_msgid => {type => SCALAR,
+ default => '',
+ },
+ request_nn => {type => SCALAR,
+ optional => 1,
+ },
+ request_replyto => {type => SCALAR,
+ optional => 1,
+ },
);
#
# =cut
#
-## sub set_foo {
-## my %param = validate_with(params => \@_,
-## spec => {bug => {type => SCALAR,
-## regex => qr/^\d+$/,
-## },
-## # specific options here
-## %common_options,
-## %append_action_options,
-## },
-## );
-## my %info =
-## __begin_control(%param,
-## command => 'foo'
-## );
-## my ($new_locks,$debug,$transcript) =
-## @info{qw(new_locks debug transcript)};
-## my @data = @{$info{data}};
-## my @bugs = @{$info{bugs}};
-##
-## for my $data (@data) {
-## append_action_to_log(bug => $data->{bug_num},
-## get_lock => 0,
-## __return_append_to_log_options(
-## %param,
-## action => $action,
-## ),
-## )
-## if not exists $param{append_log} or $param{append_log};
-## writebug($data->{bug_num},$data);
-## print {$transcript} "$action\n";
-## }
-## __end_control(\%info);
-## }
+# sub set_foo {
+# my %param = validate_with(params => \@_,
+# spec => {bug => {type => SCALAR,
+# regex => qr/^\d+$/,
+# },
+# # specific options here
+# %common_options,
+# %append_action_options,
+# },
+# );
+# my %info =
+# __begin_control(%param,
+# command => 'foo'
+# );
+# my ($debug,$transcript) =
+# @info{qw(debug transcript)};
+# my @data = @{$info{data}};
+# my @bugs = @{$info{bugs}};
+#
+# my $action = '';
+# for my $data (@data) {
+# append_action_to_log(bug => $data->{bug_num},
+# get_lock => 0,
+# __return_append_to_log_options(
+# %param,
+# action => $action,
+# ),
+# )
+# if not exists $param{append_log} or $param{append_log};
+# writebug($data->{bug_num},$data);
+# print {$transcript} "$action\n";
+# }
+# __end_control(%info);
+# }
+
+
+=head2 set_blocks
+
+ eval {
+ set_block(bug => $ref,
+ transcript => $transcript,
+ ($dl > 0 ? (debug => $transcript):()),
+ requester => $header{from},
+ request_addr => $controlrequestaddr,
+ message => \@log,
+ affected_packages => \%affected_packages,
+ recipients => \%recipients,
+ block => [],
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to set blockers of $ref: $@";
+ }
+
+Alters the set of bugs that block this bug from being fixed
+
+This requires altering both this bug (and those it's merged with) as
+well as the bugs that block this bug from being fixed (and those that
+it's merged with)
+
+=over
+
+=item block -- scalar or arrayref of blocking bugs to set, add or remove
+
+=item add -- if true, add blocking bugs
+
+=item remove -- if true, remove blocking bugs
+
+=back
+
+=cut
+
+sub set_blocks {
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ # specific options here
+ block => {type => SCALAR|ARRAYREF,
+ default => [],
+ },
+ add => {type => BOOLEAN,
+ default => 0,
+ },
+ remove => {type => BOOLEAN,
+ default => 0,
+ },
+ %common_options,
+ %append_action_options,
+ },
+ );
+ if ($param{add} and $param{remove}) {
+ croak "It's nonsensical to add and remove the same blocking bugs";
+ }
+ if (grep {$_ !~ /^\d+$/} make_list($param{block})) {
+ croak "Invalid blocking bug(s):".
+ join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
+ }
+ my $mode = 'set';
+ if (exists $param{add}) {
+ $mode = 'add';
+ }
+ elsif (exists $param{remove}) {
+ $mode = 'remove';
+ }
+
+ my %info =
+ __begin_control(%param,
+ command => 'blocks'
+ );
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
+ my @data = @{$info{data}};
+ my @bugs = @{$info{bugs}};
+
+
+ # The first bit of this code is ugly, and should be cleaned up.
+ # Its purpose is to populate %removed_blockers and %add_blockers
+ # with all of the bugs that should be added or removed as blockers
+ # of all of the bugs which are merged with $param{bug}
+ my %ok_blockers;
+ my %bad_blockers;
+ for my $blocker (make_list($param{block})) {
+ next if $ok_blockers{$blocker} or $bad_blockers{$blocker};
+ my $data = read_bug(bug=>$blocker,
+ );
+ if (defined $data and not $data->{archive}) {
+ $data = split_status_fields($data);
+ $ok_blockers{$blocker} = 1;
+ my @merged_bugs;
+ push @merged_bugs, make_list($data->{mergedwith});
+ $ok_blockers{@merged_bugs} = (1) x @merged_bugs if @merged_bugs;
+ }
+ else {
+ $bad_blockers{$blocker} = 1;
+ }
+ }
+
+ # throw an error if we are setting the blockers and there is a bad
+ # blocker
+ if (keys %bad_blockers and $mode eq 'set') {
+ croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers).
+ keys %ok_blockers?'':" and no known blocking bug(s)";
+ }
+ # if there are no ok blockers and we are not setting the blockers,
+ # there's an error.
+ if (not keys %ok_blockers and $mode ne 'set') {
+ print {$transcript} "No valid blocking bug(s) given; not doing anything\n";
+ if (keys %bad_blockers) {
+ croak "Unknown blocking bug(s):".join(', ',keys %bad_blockers);
+ }
+ __end_control(%info);
+ return;
+ }
+
+ my @change_blockers = keys %ok_blockers;
+
+ my %removed_blockers;
+ my %added_blockers;
+ my $action = '';
+ my @blockers = map {split ' ', $_->{blockedby}} @data;
+ my %blockers;
+ @blockers{@blockers} = (1) x @blockers;
+
+ # it is nonsensical for a bug to block itself (or a merged
+ # partner); We currently don't allow removal because we'd possibly
+ # deadlock
+
+ my %bugs;
+ @bugs{@bugs} = (1) x @bugs;
+ for my $blocker (@change_blockers) {
+ if ($bugs{$blocker}) {
+ croak "It is nonsensical for a bug to block itself (or a merged partner): $blocker";
+ }
+ }
+ @blockers = keys %blockers;
+ if ($param{add}) {
+ %removed_blockers = ();
+ for my $blocker (@change_blockers) {
+ next if exists $blockers{$blocker};
+ $blockers{$blocker} = 1;
+ $added_blockers{$blocker} = 1;
+ }
+ }
+ elsif ($param{remove}) {
+ %added_blockers = ();
+ for my $blocker (@change_blockers) {
+ next if exists $removed_blockers{$blocker};
+ delete $blockers{$blocker};
+ $removed_blockers{$blocker} = 1;
+ }
+ }
+ else {
+ @removed_blockers{@blockers} = (1) x @blockers;
+ %blockers = ();
+ for my $blocker (@change_blockers) {
+ next if exists $blockers{$blocker};
+ $blockers{$blocker} = 1;
+ if (exists $removed_blockers{$blocker}) {
+ delete $removed_blockers{$blocker};
+ }
+ else {
+ $added_blockers{$blocker} = 1;
+ }
+ }
+ }
+ my @new_blockers = keys %blockers;
+ for my $data (@data) {
+ my $old_data = dclone($data);
+ # remove blockers and/or add new ones as appropriate
+ if ($data->{blockedby} eq '') {
+ print {$transcript} "Was not blocked by any bugs.\n";
+ } else {
+ print {$transcript} "Was blocked by: $data->{blockedby}\n";
+ }
+ my @changed;
+ push @changed, 'added blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %added_blockers]) if keys %added_blockers;
+ push @changed, 'removed blocking bug(s) of '.$data->{bug_num}.': '.english_join([keys %removed_blockers]) if keys %removed_blockers;
+ $action = ucfirst(join ('; ',@changed)) if @changed;
+ if (not @changed) {
+ print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"
+ unless __internal_request();
+ next;
+ }
+ $data->{blockedby} = join(' ',keys %blockers);
+ append_action_to_log(bug => $data->{bug_num},
+ command => 'block',
+ old_data => $old_data,
+ new_data => $data,
+ get_lock => 0,
+ __return_append_to_log_options(
+ %param,
+ action => $action,
+ ),
+ )
+ if not exists $param{append_log} or $param{append_log};
+ writebug($data->{bug_num},$data);
+ print {$transcript} "$action\n";
+ }
+ # we do this bit below to avoid code duplication
+ my %mungable_blocks;
+ $mungable_blocks{remove} = \%removed_blockers if keys %removed_blockers;
+ $mungable_blocks{add} = \%added_blockers if keys %added_blockers;
+ for my $add_remove (keys %mungable_blocks) {
+ my @munge_blockers;
+ my %munge_blockers;
+ my $block_locks = 0;
+ for my $blocker (keys %{$mungable_blocks{$add_remove}}) {
+ next if $munge_blockers{$blocker};
+ my ($new_locks, @blocking_data) =
+ lock_read_all_merged_bugs($blocker,
+ ($param{archived}?'archive':()));
+ if (not @blocking_data) {
+ unfilelock() for $new_locks;
+ die "Unable to get file lock while trying to $add_remove blocker '$blocker'";
+ }
+ for (map {$_->{bug_num}} @blocking_data) {
+ $munge_blockers{$_} = 1;
+ }
+ for my $data (@blocking_data) {
+ my $old_data = dclone($data);
+ my %blocks;
+ my @blocks = split ' ', $data->{blocks};
+ @blocks{@blocks} = (1) x @blocks;
+ @blocks = ();
+ for my $bug (@bugs) {
+ if ($add_remove eq 'remove') {
+ next unless exists $blocks{$bug};
+ delete $blocks{$bug};
+ }
+ else {
+ next if exists $blocks{$bug};
+ $blocks{$bug} = 1;
+ }
+ push @blocks, $bug;
+ }
+ $data->{blocks} = join(' ',sort keys %blocks);
+ my $action = ($add_remove eq 'add'?'Added':'Removed').
+ " indication that bug $data->{bug_num} blocks".
+ join(',',@blocks);
+ append_action_to_log(bug => $data->{bug_num},
+ command => 'block',
+ old_data => $old_data,
+ new_data => $data,
+ get_lock => 0,
+ __return_append_to_log_options(%param,
+ action => $action
+ )
+ );
+ }
+ __handle_affected_packages(%param,data=>\@blocking_data);
+ add_recipients(recipients => $param{recipients},
+ actions_taken => {blocks => 1},
+ data => \@blocking_data,
+ debug => $debug,
+ transcript => $transcript,
+ );
+
+ unfilelock() for $new_locks;
+ }
+ }
+ __end_control(%info);
+}
+
+
+
+=head2 set_tag
+
+ eval {
+ set_tag(bug => $ref,
+ transcript => $transcript,
+ ($dl > 0 ? (debug => $transcript):()),
+ requester => $header{from},
+ request_addr => $controlrequestaddr,
+ message => \@log,
+ affected_packages => \%affected_packages,
+ recipients => \%recipients,
+ tag => [],
+ add => 1,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to set tag on $ref: $@";
+ }
+
+
+Sets, adds, or removes the specified tags on a bug
+
+=over
+
+=item tag -- scalar or arrayref of tags to set, add or remove
+
+=item add -- if true, add tags
+
+=item remove -- if true, remove tags
+
+=item warn_on_bad_tags -- if true (the default) warn if bad tags are
+passed.
+
+=back
+
+=cut
+
+sub set_tag {
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ # specific options here
+ tag => {type => SCALAR|ARRAYREF,
+ default => [],
+ },
+ add => {type => BOOLEAN,
+ default => 0,
+ },
+ remove => {type => BOOLEAN,
+ default => 0,
+ },
+ warn_on_bad_tags => {type => BOOLEAN,
+ default => 1,
+ },
+ %common_options,
+ %append_action_options,
+ },
+ );
+ if ($param{add} and $param{remove}) {
+ croak "It's nonsensical to add and remove the same tags";
+ }
+
+ my %info =
+ __begin_control(%param,
+ command => 'tag'
+ );
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
+ my @data = @{$info{data}};
+ my @bugs = @{$info{bugs}};
+ my @tags = make_list($param{tag});
+ if (not @tags and ($param{remove} or $param{add})) {
+ if ($param{remove}) {
+ print {$transcript} "Requested to remove no tags; doing nothing.\n";
+ }
+ else {
+ print {$transcript} "Requested to add no tags; doing nothing.\n";
+ }
+ __end_control(%info);
+ return;
+ }
+ # first things first, make the versions fully qualified source
+ # versions
+ for my $data (@data) {
+ my $action = 'Did not alter tags';
+ my %tag_added = ();
+ my %tag_removed = ();
+ my %fixed_removed = ();
+ my @old_tags = split /\,\s*/, $data->{keywords};
+ my %tags;
+ @tags{@old_tags} = (1) x @old_tags;
+ my $reopened = 0;
+ my $old_data = dclone($data);
+ if (not $param{add} and not $param{remove}) {
+ $tag_removed{$_} = 1 for @old_tags;
+ %tags = ();
+ }
+ my @bad_tags = ();
+ for my $tag (@tags) {
+ if (not $param{remove} and
+ not defined first {$_ eq $tag} @{$config{tags}}) {
+ push @bad_tags, $tag;
+ next;
+ }
+ if ($param{add}) {
+ if (not exists $tags{$tag}) {
+ $tags{$tag} = 1;
+ $tag_added{$tag} = 1;
+ }
+ }
+ elsif ($param{remove}) {
+ if (exists $tags{$tag}) {
+ delete $tags{$tag};
+ $tag_removed{$tag} = 1;
+ }
+ }
+ else {
+ if (exists $tag_removed{$tag}) {
+ delete $tag_removed{$tag};
+ }
+ else {
+ $tag_added{$tag} = 1;
+ }
+ $tags{$tag} = 1;
+ }
+ }
+ if (@bad_tags and $param{warn_on_bad_tags}) {
+ print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
+ print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
+ }
+ $data->{keywords} = join(', ',keys %tags); # double check this
+
+ my @changed;
+ push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
+ push @changed, 'removed tag(s) '.english_join([keys %tag_removed]) if keys %tag_removed;
+ $action = ucfirst(join ('; ',@changed)) if @changed;
+ if (not @changed) {
+ print {$transcript} "Ignoring request to alter tags of bug #$data->{bug_num} to the same tags previously set\n"
+ unless __internal_request();
+ next;
+ }
+ $action .= '.';
+ append_action_to_log(bug => $data->{bug_num},
+ get_lock => 0,
+ command => 'tag',
+ old_data => $old_data,
+ new_data => $data,
+ __return_append_to_log_options(
+ %param,
+ action => $action,
+ ),
+ )
+ if not exists $param{append_log} or $param{append_log};
+ writebug($data->{bug_num},$data);
+ print {$transcript} "$action\n";
+ }
+ __end_control(%info);
+}
+
+
+
+=head2 set_severity
+
+ eval {
+ set_severity(bug => $ref,
+ transcript => $transcript,
+ ($dl > 0 ? (debug => $transcript):()),
+ requester => $header{from},
+ request_addr => $controlrequestaddr,
+ message => \@log,
+ affected_packages => \%affected_packages,
+ recipients => \%recipients,
+ severity => 'normal',
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to set the severity of bug $ref: $@";
+ }
+
+Sets the severity of a bug. If severity is not passed, is undefined,
+or has zero length, sets the severity to the defafult severity.
+
+=cut
+
+sub set_severity {
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ # specific options here
+ severity => {type => SCALAR|UNDEF,
+ default => $config{default_severity},
+ },
+ %common_options,
+ %append_action_options,
+ },
+ );
+ if (not defined $param{severity} or
+ not length $param{severity}
+ ) {
+ $param{severity} = $config{default_severity};
+ }
+
+ # check validity of new severity
+ if (not defined first {$_ eq $param{severity}} (@{$config{severity_list}},$config{default_severity})) {
+ die "Severity '$param{severity}' is not a valid severity level";
+ }
+ my %info =
+ __begin_control(%param,
+ command => 'severity'
+ );
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
+ my @data = @{$info{data}};
+ my @bugs = @{$info{bugs}};
+
+ my $action = '';
+ for my $data (@data) {
+ if (not defined $data->{severity}) {
+ $data->{severity} = $param{severity};
+ $action = "Severity set to '$param{severity}'\n";
+ }
+ else {
+ if ($data->{severity} eq '') {
+ $data->{severity} = $config{default_severity};
+ }
+ if ($data->{severity} eq $param{severity}) {
+ print {$transcript} "Ignoring request to change severity of $config{bug} $data->{bug_num} to the same value.\n";
+ next;
+ }
+ $action = "Severity set to '$param{severity}' from '$data->{severity}'\n";
+ $data->{severity} = $param{severity};
+ }
+ append_action_to_log(bug => $data->{bug_num},
+ get_lock => 0,
+ __return_append_to_log_options(
+ %param,
+ action => $action,
+ ),
+ )
+ if not exists $param{append_log} or $param{append_log};
+ writebug($data->{bug_num},$data);
+ print {$transcript} "$action\n";
+ }
+ __end_control(%info);
+}
+
+
+=head2 reopen
+
+ eval {
+ set_foo(bug => $ref,
+ transcript => $transcript,
+ ($dl > 0 ? (debug => $transcript):()),
+ requester => $header{from},
+ request_addr => $controlrequestaddr,
+ message => \@log,
+ affected_packages => \%affected_packages,
+ recipients => \%recipients,
+ summary => undef,
+ );
+ };
+ if ($@) {
+ $errors++;
+ print {$transcript} "Failed to set foo $ref bar: $@";
+ }
+
+Foo frobinates
+
+=cut
+
+sub reopen {
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ # specific options here
+ submitter => {type => SCALAR|UNDEF,
+ default => undef,
+ },
+ %common_options,
+ %append_action_options,
+ },
+ );
+
+ $param{submitter} = undef if defined $param{submitter} and
+ not length $param{submitter};
+
+ if (defined $param{submitter} and
+ not Mail::RFC822::Address::valid($param{submitter})) {
+ die "New submitter address $param{submitter} is not a valid e-mail address";
+ }
+
+ my %info =
+ __begin_control(%param,
+ command => 'reopen'
+ );
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
+ my @data = @{$info{data}};
+ my @bugs = @{$info{bugs}};
+ my $action ='';
+
+ my $warn_fixed = 1; # avoid warning multiple times if there are
+ # fixed versions
+ my @change_submitter = ();
+ my @bugs_to_reopen = ();
+ for my $data (@data) {
+ if (not exists $data->{done} or
+ not defined $data->{done} or
+ not length $data->{done}) {
+ print {$transcript} "Bug $data->{bug_num} is not marked as done; doing nothing.\n";
+ __end_control(%info);
+ return;
+ }
+ if (@{$data->{fixed_versions}} and $warn_fixed) {
+ print {$transcript} "'reopen' may be inappropriate when a bug has been closed with a version;\n";
+ print {$transcript} "you may need to use 'found' to remove fixed versions.\n";
+ $warn_fixed = 0;
+ }
+ if (defined $param{submitter} and length $param{submitter}
+ and $data->{originator} ne $param{submitter}) {
+ push @change_submitter,$data->{bug_num};
+ }
+ }
+ __end_control(%info);
+ my @params_for_subcalls =
+ map {exists $param{$_}?($_,$param{$_}):()}
+ (keys %common_options,
+ keys %append_action_options,
+ );
+
+ for my $bug (@change_submitter) {
+ set_submitter(bug=>$bug,
+ submitter => $param{submitter},
+ @params_for_subcalls,
+ );
+ }
+ set_fixed(fixed => [],
+ bug => $param{bug},
+ reopen => 1,
+ );
+}
+
=head2 set_submitter
__begin_control(%param,
command => 'submitter'
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my $action = '';
# here we only concern ourselves with the first of the merged bugs
for my $data ($data[0]) {
+ my $notify_old_submitter = 0;
my $old_data = dclone($data);
print {$debug} "Going to change bug submitter\n";
if (((not defined $param{submitter} or not length $param{submitter}) and
- (not defined $data->{submitter} or not length $data->{submitter})) or
- $param{submitter} eq $data->{submitter}) {
+ (not defined $data->{originator} or not length $data->{originator})) or
+ (defined $param{submitter} and defined $data->{originator} and
+ $param{submitter} eq $data->{originator})) {
print {$transcript} "Ignoring request to change the submitter of bug#$data->{bug_num} to the same value\n"
unless __internal_request();
next;
}
else {
- if (defined $data->{submitter} and length($data->{submitter})) {
- $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{submitter}'";
+ if (defined $data->{originator} and length($data->{originator})) {
+ $action= "Changed $config{bug} submitter to '$param{submitter}' from '$data->{originator}'";
+ $notify_old_submitter = 1;
}
else {
$action= "Set $config{bug} submitter to '$param{submitter}'.";
}
- $data->{submitter} = $param{submitter};
+ $data->{originator} = $param{submitter};
}
append_action_to_log(bug => $data->{bug_num},
- command => 'set_submitter',
+ command => 'submitter',
new_data => $data,
old_data => $old_data,
get_lock => 0,
if not exists $param{append_log} or $param{append_log};
writebug($data->{bug_num},$data);
print {$transcript} "$action\n";
+ # notify old submitter
+ if ($notify_old_submitter and $param{notify_submitter}) {
+ send_mail_message(message =>
+ create_mime_message([default_headers(queue_file => $param{request_nn},
+ data => $data,
+ msgid => $param{request_msgid},
+ msgtype => 'ack',
+ pr_msg => 'submitter-changed',
+ headers =>
+ [To => $old_data->{submitter},
+ Subject => "$config{ubug}#$data->{bug_num} submitter addressed changed ($param{request_subject})",
+ ],
+ )
+ ],
+ __message_body_template('mail/submitter_changed',
+ {old_data => $old_data,
+ data => $data,
+ replyto => exists $param{header}{'reply-to'} ? $param{request_replyto} : $param{requester} || 'Unknown',
+ config => \%config,
+ })
+ ),
+ recipients => $old_data->{submitter},
+ );
+ }
}
__end_control(%info);
}
__begin_control(%param,
command => 'forwarded'
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my $action = '';
$data->{forwarded} = $param{forwarded};
}
append_action_to_log(bug => $data->{bug_num},
- command => 'set_forwarded',
+ command => 'forwarded',
new_data => $data,
old_data => $old_data,
get_lock => 0,
$data->{subject} = $param{title};
}
append_action_to_log(bug => $data->{bug_num},
- command => 'set_title',
+ command => 'title',
new_data => $data,
old_data => $old_data,
get_lock => 0,
my %info = __begin_control(%param,
command => 'package',
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
# clean up the new package
$data->{package} = $new_package;
}
append_action_to_log(bug => $data->{bug_num},
- command => 'set_package',
+ command => 'package',
new_data => $data,
old_data => $old_data,
get_lock => 0,
__begin_control(%param,
command => 'found'
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my %versions;
$action .= '.';
append_action_to_log(bug => $data->{bug_num},
get_lock => 0,
- command => 'set_found',
+ command => 'found',
old_data => $old_data,
new_data => $data,
__return_append_to_log_options(
}
-Sets, adds, or removes the specified found versions of a package
+Sets, adds, or removes the specified fixed versions of a package
-If the version list is empty, and the bug is currently not "done",
-causes the done field to be cleared.
+If the fixed versions are empty (or end up being empty after this
+call) or the greatest fixed version is less than the greatest found
+version and the reopen option is true, the bug is reopened.
-If any of the versions added to found are greater than any version in
-which the bug is fixed (or when the bug is found and there are no
-fixed versions) the done field is cleared.
+This function is also called by the reopen function, which causes all
+of the fixed versions to be cleared.
=cut
__begin_control(%param,
command => 'fixed'
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my %versions;
}
$action .= '.';
append_action_to_log(bug => $data->{bug_num},
- command => 'set_fixed',
+ command => 'fixed',
new_data => $data,
old_data => $old_data,
get_lock => 0,
__begin_control(%param,
command => 'affects'
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my $action = '';
}
if (keys %added_packages) {
$action .= "Added indication that $data->{bug_num} affects " .
- english_join([%added_packages]);
+ english_join([keys %added_packages]);
}
}
if (not length $action) {
__begin_control(%param,
command => 'summary'
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
# figure out the log that we're going to use
__begin_control(%param,
command => 'owner',
);
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my $action = '';
my %info = __begin_control(%param,
command => 'archive',
);
- my ($new_locks,$debug,$transcript) = @info{qw(data debug transcript)};
+ my ($debug,$transcript) = @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my $action = "$config{bug} archived.";
my %info = __begin_control(%param,
archived=>1,
command=>'unarchive');
- my ($new_locks,$debug,$transcript) =
- @info{qw(new_locks debug transcript)};
+ my ($debug,$transcript) =
+ @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
my $action = "$config{bug} unarchived.";
sub __internal_request{
my ($l) = @_;
$l = 0 if not defined $l;
- if (defined +(caller(2+$l))[0] and +(caller(2+$l))[0] eq __PACKAGE__) {
+ if (defined((caller(1+$l))[0]) and (caller(1+$l))[0] eq __PACKAGE__) {
return 1;
}
return 0;
my %info = __begin_control(%param,
archived=>1,
command=>'unarchive');
- my ($new_locks,$debug,$transcript) = @info{qw(new_locksa debug transcript)};
+ my ($debug,$transcript) = @info{qw(debug transcript)};
my @data = @{$info{data}};
my @bugs = @{$info{bugs}};
if (not @data) {
die "Unable to read any bugs successfully.";
}
- ###
- # XXX check the limit at this point, and die if it is exceeded.
- # This is currently not done
- ###
+ if (not $param{archived}) {
+ for my $data (@data) {
+ if ($data->{archived}) {
+ die "Not altering archived bugs; see unarchive.";
+ }
+ }
+ }
+ if (not __check_limit(data => \@data,
+ exists $param{limit}?(limit => $param{limit}):(),
+ )) {
+ die "limit failed for bugs: ".join(', ',map {$_->{bug_num}} @data);
+ }
+
__handle_affected_packages(%param,data => \@data);
print {$transcript} __bug_info(@data) if $param{show_bug_info} and not __internal_request(1);
print {$debug} "$param{bug} read $locks locks\n";
recipients => $param{recipients},
(exists $param{command}?(actions_taken => {$param{command} => 1}):()),
debug => $debug,
- transcript => $transcript,
+ (__internal_request()?(transcript => $transcript):()),
);
print {$debug} "$param{bug} read done\n";
@{$info{param}{bugs_affected}}{@{$info{bugs}}} = (1) x @{$info{bugs}};
}
add_recipients(recipients => $info{param}{recipients},
- (exists $info{param}{command}?(actions_taken => {$info{param}{command} => 1}):()),
+ (exists $info{param}{command}?(actions_taken => {$info{param}{command} , 1}):()),
data => $info{data},
debug => $info{debug},
transcript => $info{transcript},
}
+=head2 __check_limit
+
+ __check_limit(data => \@data, limit => $param{limit});
+
+
+Checks to make sure that bugs match any limits; each entry of @data
+much satisfy the limit.
+
+Returns true if there are no entries in data, or there are no keys in
+limit; returns false (0) if there are any entries which do not match.
+
+The limit hashref elements can contain an arrayref of scalars to
+match; regexes are also acccepted. At least one of the entries in each
+element needs to match the corresponding field in all data for the
+limit to succeed.
+
+=cut
+
+
+sub __check_limit{
+ my %param = validate_with(params => \@_,
+ spec => {data => {type => ARRAYREF|SCALAR,
+ },
+ limit => {type => HASHREF|UNDEF,
+ },
+ },
+ );
+ my @data = make_list($param{data});
+ if (not @data or
+ not defined $param{limit} or
+ not keys %{$param{limit}}) {
+ return 1;
+ }
+ for my $data (@data) {
+ for my $field (keys %{$param{limit}}) {
+ next unless exists $param{limit}{$field};
+ my $match = 0;
+ for my $limit (make_list($param{limit}{$field})) {
+ if (not ref $limit) {
+ if ($data->{$field} eq $limit) {
+ $match = 1;
+ last;
+ }
+ }
+ elsif (ref($limit) eq 'Regexp') {
+ if ($data->{$field} =~ $limit) {
+ $match = 1;
+ last;
+ }
+ }
+ else {
+ warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
+ }
+ }
+ if (not $match) {
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+
=head2 die
sig_die "foo"
}
+# =head2 __message_body_template
+#
+# message_body_template('mail/ack',{ref=>'foo'});
+#
+# Creates a message body using a template
+#
+# =cut
+
+sub __message_body_template{
+ my ($template,$extra_var) = @_;
+ $extra_var ||={};
+ my $hole_var = {'&bugurl' =>
+ sub{"$_[0]: ".
+ 'http://'.$config{cgi_domain}.'/'.
+ Debbugs::CGI::bug_url($_[0]);
+ }
+ };
+
+ my $body = fill_in_template(template => $template,
+ variables => {config => \%config,
+ %{$extra_var},
+ },
+ hole_var => $hole_var,
+ );
+ return fill_in_template(template => 'mail/message_body',
+ variables => {config => \%config,
+ %{$extra_var},
+ body => $body,
+ },
+ hole_var => $hole_var,
+ );
+}
+
+
1;
__END__
projects / debbugs.git / blobdiff