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::Common qw(:lock buglog :misc get_hashname sort_versions);
+use Debbugs::Status qw(bug_archiveable :read :hook writebug splitpackages split_status_fields get_bug_status);
use Debbugs::CGI qw(html_escape);
use Debbugs::Log qw(:misc);
use Debbugs::Recipients qw(:add);
join(', ',grep {$_ !~ /^\d+$/} make_list($param{block}));
}
my $mode = 'set';
- if (exists $param{add}) {
+ if ($param{add}) {
$mode = 'add';
}
- elsif (exists $param{remove}) {
+ elsif ($param{remove}) {
$mode = 'remove';
}
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, split(' ',$data->{mergedwith}) if length $data->{mergedwith};
- $ok_blockers{@merged_bugs} = (1) x @merged_bugs if @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;
print {$transcript} "Was blocked by: $data->{blockedby}\n";
}
my @changed;
- push @changed, 'added blocking bug(s) '.english_join([keys %added_blockers]) if keys %added_blockers;
- push @changed, 'removed blocking bug(s) '.english_join([keys %removed_blockers]) if keys %removed_blockers;
+ 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"
+ print {$transcript} "Ignoring request to alter blocking bugs of bug #$data->{bug_num} to the same blocks previously set\n"
unless __internal_request();
next;
}
for my $data (@blocking_data) {
my $old_data = dclone($data);
my %blocks;
- %blocks = split ' ', $data->{blocks};
- 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};
}
$data->{blocks} = join(' ',sort keys %blocks);
my $action = ($add_remove eq 'add'?'Added':'Removed').
- " indication that bug $data->{bug_num} blocks".
+ " indication that bug $data->{bug_num} blocks ".
join(',',@blocks);
append_action_to_log(bug => $data->{bug_num},
command => 'block',
action => $action
)
);
+ writebug($data->{bug_num},$data);
}
__handle_affected_packages(%param,data=>\@blocking_data);
add_recipients(recipients => $param{recipients},
my %tag_added = ();
my %tag_removed = ();
my %fixed_removed = ();
- my @old_tags = split /\,\s*/, $data->{tags};
+ my @old_tags = split /\,?\s+/, $data->{keywords};
my %tags;
@tags{@old_tags} = (1) x @old_tags;
my $reopened = 0;
print {$transcript} "Unknown tag(s): ".join(', ',@bad_tags).".\n";
print {$transcript} "These tags are recognized: ".join(', ',@{$config{tags}}).".\n";
}
- $data->{tags} = join(', ',keys %tags); # double check this
+ $data->{keywords} = join(' ',keys %tags);
my @changed;
push @changed, 'added tag(s) '.english_join([keys %tag_added]) if keys %tag_added;
# We only care about reopening the bug if the bug is
# not done
if (defined $data->{done} and length $data->{done}) {
- my @svers_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
- map {m{([^/]+)$}; $1;} @svers;
+ my @svers_order = sort_versions(map {m{([^/]+)$}; $1;}
+ @svers);
# determine if we need to reopen
- my @fixed_order = sort {Debbugs::Versions::Dpkg::vercmp($a,$b);}
- map {m{([^/]+)$}; $1;} keys %fixed_versions;
+ my @fixed_order = sort_versions(map {m{([^/]+)$}; $1;}
+ keys %fixed_versions);
if (not @fixed_order or
(Debbugs::Versions::Dpkg::vercmp($svers_order[-1],$fixed_order[-1]) >= 0)) {
$reopened = 1;
}
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) {
}
# skip a paragraph if it looks like it's control or
# pseudo-headers
- if ($line =~ m{^\s*(?:(?:Package|Source|Version)\:| #pseudo headers
- (?:package|(?:no|)owner|severity|tag|summary| #control
- reopen|close|(?:not|)(?:fixed|found)|clone|
- (?:force|)merge|user(?:category|tag|)
- )
- )\s+\S}x) {
+ if ($line =~ m{^\s*(?:Package|Source|Version|User|Tag|Severity)\:\s+\S}xi or #pseudo headers
+ $line =~ m{^(?:package:?|(?:no|)owner|severity|tags?|summary| #control
+ \#|reopen|close|(?:not|)(?:fixed|found)|clone|
+ debug|(?:not|)forwarded|priority|
+ (?:un|)block|limit|(?:un|)archive|
+ reassign|retitle|affects|wrongpackage
+ (?:un|force|)merge|user(?:category|tags?|)
+ )\s+\S}xis) {
if (not length $paragraph) {
print {$debug} "Found control/pseudo-headers and skiping them\n";
$in_pseudoheaders = 1;
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;
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}):(),
+ transcript => $transcript,
+ )) {
+ 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";
}
+=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,
+ },
+ transcript => {type => SCALARREF|HANDLE,
+ optional => 1,
+ },
+ },
+ );
+ my @data = make_list($param{data});
+ if (not @data or
+ not defined $param{limit} or
+ not keys %{$param{limit}}) {
+ return 1;
+ }
+ my $transcript = globify_scalar(exists $param{transcript}?$param{transcript}:undef);
+ my $going_to_fail = 0;
+ for my $data (@data) {
+ $data = split_status_fields(get_bug_status(bug => $data->{bug_num},
+ status => dclone($data),
+ ));
+ for my $field (keys %{$param{limit}}) {
+ next unless exists $param{limit}{$field};
+ my $match = 0;
+ my @data_fields = make_list($data->{$field});
+LIMIT: for my $limit (make_list($param{limit}{$field})) {
+ if (not ref $limit) {
+ for my $data_field (@data_fields) {
+ if ($data_field eq $limit) {
+ $match = 1;
+ last LIMIT;
+ }
+ }
+ }
+ elsif (ref($limit) eq 'Regexp') {
+ for my $data_field (@data_fields) {
+ if ($data_field =~ $limit) {
+ $match = 1;
+ last LIMIT;
+ }
+ }
+ }
+ else {
+ warn "Unknown type of reference: '".ref($limit)."' in key '$field'";
+ }
+ }
+ if (not $match) {
+ $going_to_fail = 1;
+ print {$transcript} qq($field: ).join(', ',map{qq("$_")} make_list($data->{$field})).
+ "' does not match at least one of ".
+ join(', ',map {ref($_)?'(regex)':qq("$_")} make_list($param{limit}{$field}))."\n";
+ }
+ }
+ }
+ return $going_to_fail?0:1;
+}
+
+
=head2 die
sig_die "foo"
projects / debbugs.git / blobdiff