use Params::Validate qw(validate_with :types);
use Debbugs::Common qw(:util :lock :quit :misc);
+use Debbugs::UTF8;
use Debbugs::Config qw(:config);
use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
-use Debbugs::Packages qw(makesourceversions make_source_versions getversions get_versions binarytosource);
+use Debbugs::Packages qw(makesourceversions make_source_versions getversions get_versions binary_to_source);
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
use POSIX qw(ceil);
+use File::Copy qw(copy);
+use Encode qw(decode encode is_utf8);
use Storable qw(dclone);
use List::Util qw(min max);
qw(lock_read_all_merged_bugs),
],
write => [qw(writebug makestatus unlockwritebug)],
+ new => [qw(new_bug)],
versions => [qw(addfoundversions addfixedversions),
qw(removefoundversions removefixedversions)
],
fields => [qw(%fields)],
);
@EXPORT_OK = ();
- Exporter::export_ok_tags(qw(status read write versions hook fields));
+ Exporter::export_ok_tags(keys %EXPORT_TAGS);
$EXPORT_TAGS{all} = [@EXPORT_OK];
}
blockedby => 'blocked-by',
unarchived => 'unarchived',
summary => 'summary',
+ outlook => 'outlook',
affects => 'affects',
);
something modifying it while the bug has been read. You B<must> call
C<unfilelock();> if something not undef is returned from read_bug.
+=item locks -- hashref of already obtained locks; incremented as new
+locks are needed, and decremented as locks are released on particular
+files.
+
=back
One of C<bug> or C<summary> must be passed. This function will return
lock => {type => BOOLEAN,
optional => 1,
},
+ locks => {type => HASHREF,
+ optional => 1,
+ },
},
);
die "One of bug or summary must be passed to read_bug"
($location) = $status =~ m/(db-h|db|archive)/;
}
if ($param{lock}) {
- filelock("$config{spool_dir}/lock/$param{bug}");
+ filelock("$config{spool_dir}/lock/$param{bug}",exists $param{locks}?$param{locks}:());
}
my $status_fh = IO::File->new($status, 'r');
if (not defined $status_fh) {
warn "Unable to open $status for reading: $!";
if ($param{lock}) {
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
}
return undef;
}
+ binmode($status_fh,':encoding(UTF-8)');
my %data;
my @lines;
if ($version > 3) {
warn "Unsupported status version '$version'";
if ($param{lock}) {
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
}
return undef;
}
for my $line (@lines) {
if ($line =~ /(\S+?): (.*)/) {
my ($name, $value) = (lc $1, $2);
- $data{$namemap{$name}} = $value if exists $namemap{$name};
+ # this is a bit of a hack; we should never, ever have \r
+ # or \n in the fields of status. Kill them off here.
+ # [Eventually, this should be superfluous.]
+ $value =~ s/[\r\n]//g;
+ $data{$namemap{$name}} = $value if exists $namemap{$name};
}
}
for my $field (keys %fields) {
- $data{$field} = '' unless exists $data{$field};
+ $data{$field} = '' unless exists $data{$field};
+ }
+ if ($version < 3) {
+ for my $field (@rfc1522_fields) {
+ $data{$field} = decode_rfc1522($data{$field});
+ }
}
-
$data{severity} = $config{default_severity} if $data{severity} eq '';
for my $field (qw(found_versions fixed_versions found_date fixed_date)) {
$data{$field} = [split ' ', $data{$field}];
@{$data{"${field}_date"}});
}
- if ($version < 3) {
- for my $field (@rfc1522_fields) {
- $data{$field} = decode_rfc1522($data{$field});
- }
- }
my $status_modified = (stat($status))[9];
# Add log last modified time
$data{log_modified} = (stat($log))[9];
affects => \&splitpackages,
blocks => $ditch_empty_space,
blockedby => $ditch_empty_space,
+ # this isn't strictly correct, but we'll split both of them for
+ # the time being until we ditch all use of keywords everywhere
+ # from the code
+ keywords => $ditch_empty_space,
tags => $ditch_empty_space,
found_versions => $ditch_empty_space,
fixed_versions => $ditch_empty_space,
) {
@elements = split $split_fields{$field}, $data->{$field};
}
- if (@elements != 1) {
- $data->{$field} = \@elements;
- }
- else {
- $data->{$field} = $elements[0];
- }
+ $data->{$field} = \@elements;
}
}
}
=cut
sub lock_read_all_merged_bugs {
- my ($bug_num,$location) = @_;
+ my %param = validate_with(params => \@_,
+ spec => {bug => {type => SCALAR,
+ regex => qr/^\d+$/,
+ },
+ location => {type => SCALAR,
+ optional => 1,
+ },
+ locks => {type => HASHREF,
+ optional => 1,
+ },
+ },
+ );
my $locks = 0;
- my @data = (lockreadbug(@_));
+ my @data = read_bug(bug => $param{bug},
+ lock => 1,
+ exists $param{location} ? (location => $param{location}):(),
+ exists $param{locks} ? (locks => $param{locks}):(),
+ );
if (not @data or not defined $data[0]) {
return ($locks,());
}
if (not length $data[0]->{mergedwith}) {
return ($locks,@data);
}
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
$locks--;
- filelock("$config{spool_dir}/lock/merge");
+ filelock("$config{spool_dir}/lock/merge",exists $param{locks}?$param{locks}:());
$locks++;
- @data = (lockreadbug(@_));
+ @data = read_bug(bug => $param{bug},
+ lock => 1,
+ exists $param{location} ? (location => $param{location}):(),
+ exists $param{locks} ? (locks => $param{locks}):(),
+ );
if (not @data or not defined $data[0]) {
- unfilelock(); #for merge lock above
+ unfilelock(exists $param{locks}?$param{locks}:()); #for merge lock above
$locks--;
return ($locks,());
}
$locks++;
my @bugs = split / /, $data[0]->{mergedwith};
+ push @bugs, $param{bug};
for my $bug (@bugs) {
my $newdata = undef;
- if ($bug ne $bug_num) {
- $newdata = lockreadbug($bug,$location);
+ if ($bug != $param{bug}) {
+ $newdata =
+ read_bug(bug => $bug,
+ lock => 1,
+ exists $param{location} ? (location => $param{location}):(),
+ exists $param{locks} ? (locks => $param{locks}):(),
+ );
if (not defined $newdata) {
for (1..$locks) {
- unfilelock();
+ unfilelock(exists $param{locks}?$param{locks}:());
}
$locks = 0;
- warn "Unable to read bug: $bug while handling merged bug: $bug_num";
+ warn "Unable to read bug: $bug while handling merged bug: $param{bug}";
return ($locks,());
}
$locks++;
push @data,$newdata;
- }
- # perform a sanity check to make sure that the merged bugs are
- # all merged with eachother
- my $expectmerge= join(' ',grep {$_ != $bug } sort { $a <=> $b } (@bugs,$bug_num));
- if ($newdata->{mergedwith} ne $expectmerge) {
- for (1..$locks) {
- unfilelock();
+ # perform a sanity check to make sure that the merged bugs
+ # are all merged with eachother
+ my $expectmerge= join(' ',grep {$_ != $bug } sort { $a <=> $b } @bugs);
+ if ($newdata->{mergedwith} ne $expectmerge) {
+ for (1..$locks) {
+ unfilelock(exists $param{locks}?$param{locks}:());
+ }
+ die "Bug $param{bug} differs from bug $bug: ($newdata->{bug_num}: '$newdata->{mergedwith}') vs. ('$expectmerge') (".join(' ',@bugs).")";
}
- die "Bug $bug_num differs from bug $bug: ($newdata->{bug_num}: $newdata->{mergedwith}) vs. ($expectmerge) (".join(' ',@bugs).")";
}
}
return ($locks,@data);
}
+=head2 new_bug
+
+ my $new_bug_num = new_bug(copy => $data->{bug_num});
+
+Creates a new bug and returns the new bug number upon success.
+
+Dies upon failures.
+
+=cut
+
+sub new_bug {
+ my %param =
+ validate_with(params => \@_,
+ spec => {copy => {type => SCALAR,
+ regex => qr/^\d+/,
+ optional => 1,
+ },
+ },
+ );
+ filelock("nextnumber.lock");
+ my $nn_fh = IO::File->new("nextnumber",'r') or
+ die "Unable to open nextnuber for reading: $!";
+ local $\;
+ my $nn = <$nn_fh>;
+ ($nn) = $nn =~ m/^(\d+)\n$/ or die "Bad format of nextnumber; is not exactly ".'^\d+\n$';
+ close $nn_fh;
+ overwritefile("nextnumber",
+ ($nn+1)."\n");
+ unfilelock();
+ my $nn_hash = get_hashname($nn);
+ if ($param{copy}) {
+ my $c_hash = get_hashname($param{copy});
+ for my $file (qw(log status summary report)) {
+ copy("db-h/$c_hash/$param{copy}.$file",
+ "db-h/$nn_hash/${nn}.$file")
+ }
+ }
+ else {
+ for my $file (qw(log status summary report)) {
+ overwritefile("db-h/$nn_hash/${nn}.$file",
+ "");
+ }
+ }
+
+ # this probably needs to be munged to do something more elegant
+# &bughook('new', $clone, $data);
+
+ return($nn);
+}
+
+
my @v1fieldorder = qw(originator date subject msgid package
keywords done forwarded mergedwith severity);
sub makestatus {
my ($data,$version) = @_;
- $version = 2 unless defined $version;
+ $version = 3 unless defined $version;
my $contents = '';
}
%newdata = %{join_status_fields(\%newdata)};
+ %newdata = encode_utf8_structure(%newdata);
+
if ($version < 3) {
for my $field (@rfc1522_fields) {
$newdata{$field} = encode_rfc1522($newdata{$field});
}
}
+ # this is a bit of a hack; we should never, ever have \r or \n in
+ # the fields of status. Kill them off here. [Eventually, this
+ # should be superfluous.]
+ for my $field (keys %newdata) {
+ $newdata{$field} =~ s/[\r\n]//g if defined $newdata{$field};
+ }
+
if ($version == 1) {
for my $field (@v1fieldorder) {
if (exists $newdata{$field} and defined $newdata{$field}) {
# Output field names in proper case, e.g. 'Merged-With'.
my $properfield = $fields{$field};
$properfield =~ s/(?:^|(?<=-))([a-z])/\u$1/g;
- $contents .= "$properfield: $newdata{$field}\n";
+ my $data = $newdata{$field};
+ $contents .= "$properfield: $data\n";
}
}
}
-
return $contents;
}
my ($ref, $data, $location, $minversion, $disablebughook) = @_;
my $change;
- my %outputs = (1 => 'status', 2 => 'summary');
+ my %outputs = (1 => 'status', 3 => 'summary');
for my $version (keys %outputs) {
next if defined $minversion and $version < $minversion;
my $status = getbugcomponent($ref, $outputs{$version}, $location);
die "can't find location for $ref" unless defined $status;
- open(S,"> $status.new") || die "opening $status.new: $!";
- print(S makestatus($data, $version)) ||
+ my $sfh;
+ if ($version >= 3) {
+ open $sfh,">","$status.new" or
+ die "opening $status.new: $!";
+ }
+ else {
+ open $sfh,">","$status.new" or
+ die "opening $status.new: $!";
+ }
+ print {$sfh} makestatus($data, $version) or
die "writing $status.new: $!";
- close(S) || die "closing $status.new: $!";
+ close($sfh) or die "closing $status.new: $!";
if (-e $status) {
$change = 'change';
} else {
sub unlockwritebug {
writebug(@_);
- &unfilelock;
+ unfilelock();
}
=head1 VERSIONS
addfoundversions($status,$package,$version,$isbinary);
-
+All use of this should be phased out in favor of Debbugs::Control::fixed/found
=cut
return unless defined $version;
undef $package if $package =~ m[(?:\s|/)];
my $source = $package;
+ if ($package =~ s/^src://) {
+ $isbinary = 0;
+ $source = $package;
+ }
if (defined $package and $isbinary) {
- my @srcinfo = binarytosource($package, $version, undef);
+ my @srcinfo = binary_to_source(binary => $package,
+ version => $version);
if (@srcinfo) {
# We know the source package(s). Use a fully-qualified version.
addfoundversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
my $source = $package;
if (defined $package and $isbinary) {
- my @srcinfo = binarytosource($package, $version, undef);
+ my @srcinfo = binary_to_source(binary => $package,
+ version => $version);
if (@srcinfo) {
# We know the source package(s). Use a fully-qualified version.
addfixedversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
}
# Check to make sure that the bug has none of the unremovable tags set
if (@{$config{removal_unremovable_tags}}) {
- for my $tag (split ' ', ($status->{tags}||'')) {
+ for my $tag (split ' ', ($status->{keywords}||'')) {
if (grep {$tag eq $_} @{$config{removal_unremovable_tags}}) {
print STDERR "Cannot archive $param{bug} because it has an unremovable tag '$tag'\n" if $DEBUG;
return $cannot_archive;
@dist_tags{@{$config{removal_distribution_tags}}} =
(1) x @{$config{removal_distribution_tags}};
my %dists;
- for my $tag (split ' ', ($status->{tags}||'')) {
+ for my $tag (split ' ', ($status->{keywords}||'')) {
next unless exists $config{distribution_aliases}{$tag};
next unless $dist_tags{$config{distribution_aliases}{$tag}};
$dists{$config{distribution_aliases}{$tag}} = 1;
Note: Currently the version information is cached; this needs to be
changed before using this function in long lived programs.
+=head3 Returns
+
+Currently returns a hashref of status with the following keys.
+
+=over
+
+=item id -- bug number
+
+=item bug_num -- duplicate of id
+
+=item keywords -- tags set on the bug, including usertags if bugusertags passed.
+
+=item tags -- duplicate of keywords
+
+=item package -- name of package that the bug is assigned to
+
+=item severity -- severity of the bug
+
+=item pending -- pending state of the bug; one of following possible
+values; values listed later have precedence if multiple conditions are
+satisifed:
+
+=over
+
+=item pending -- default state
+
+=item forwarded -- bug has been forwarded
+
+=item pending-fixed -- bug is tagged pending
+
+=item fixed -- bug is tagged fixed
+
+=item absent -- bug does not apply to this distribution/architecture
+
+=item done -- bug is resolved in this distribution/architecture
+
+=back
+
+=item location -- db-h or archive; the location in the filesystem
+
+=item subject -- title of the bug
+
+=item last_modified -- epoch that the bug was last modified
+
+=item date -- epoch that the bug was filed
+
+=item originator -- bug reporter
+
+=item log_modified -- epoch that the log file was last modified
+
+=item msgid -- Message id of the original bug report
+
+=back
+
+
+Other key/value pairs are returned but are not currently documented here.
+
=cut
sub get_bug_status {
$status{package} = '' if not defined $status{package};
$status{"package"} =~ s/\s*$//;
- # if we aren't supposed to indicate the source, we'll return
- # unknown here.
- $status{source} = 'unknown';
- if ($param{indicatesource}) {
- my @packages = split /\s*,\s*/, $status{package};
- my @source;
- for my $package (@packages) {
- next if $package eq '';
- if ($package =~ /^src\:$/) {
- push @source,$1;
- }
- else {
- push @source, binarytosource($package);
- }
- }
- if (@source) {
- $status{source} = join(', ',@source);
- }
- }
+
+ $status{source} = binary_to_source(binary=>[split /\s*,\s*/, $status{package}],
+ source_only => 1,
+ );
$status{"package"} = 'unknown' if ($status{"package"} eq '');
$status{"severity"} = 'normal' if (not defined $status{severity} or $status{"severity"} eq '');
(1) x @{$config{affects_distribution_tags}};
my $some_distributions_disallowed = 0;
my %allowed_distributions;
- for my $tag (split ' ', ($status{tags}||'')) {
+ for my $tag (split ' ', ($status{keywords}||'')) {
if (exists $config{distribution_aliases}{$tag} and
exists $affects_distribution_tags{$config{distribution_aliases}{$tag}}) {
$some_distributions_disallowed = 1;
$allowed_distributions{$tag} = 1;
}
}
- foreach my $arch (make_list(exists $param{arch}?$param{arch}:undef)) {
- for my $package (split /\s*,\s*/, $status{package}) {
+ my @archs = make_list(exists $param{arch}?$param{arch}:());
+ GET_SOURCE_VERSIONS:
+ foreach my $arch (@archs) {
+ for my $package (split /\s*,\s*/, $status{package}) {
my @versions = ();
my $source = 0;
if ($package =~ /^src:(.+)$/) {
@sourceversions{@temp} = (1) x @temp;
}
}
+ # this should really be split out into a subroutine,
+ # but it'd touch so many things currently, that we fake
+ # it; it's needed to properly handle bugs which are
+ # erroneously assigned to the binary package, and we'll
+ # probably have it go away eventually.
+ if (not keys %sourceversions and (not @archs or defined $archs[0])) {
+ @archs = (undef);
+ goto GET_SOURCE_VERSIONS;
+ }
}
# TODO: This should probably be handled further out for efficiency and
sub bughook_archive {
my @refs = @_;
- &filelock("$config{spool_dir}/debbugs.trace.lock");
- &appendfile("debbugs.trace","archive ".join(',',@refs)."\n");
+ filelock("$config{spool_dir}/debbugs.trace.lock");
+ appendfile("$config{spool_dir}/debbugs.trace","archive ".join(',',@refs)."\n");
my %bugs = update_realtime("$config{spool_dir}/index.db.realtime",
map{($_,'REMOVE')} @refs);
update_realtime("$config{spool_dir}/index.archive.realtime",
%bugs);
- &unfilelock;
+ unfilelock();
}
sub bughook {
my ( $type, %bugs_temp ) = @_;
- &filelock("$config{spool_dir}/debbugs.trace.lock");
+ filelock("$config{spool_dir}/debbugs.trace.lock");
my %bugs;
for my $bug (keys %bugs_temp) {
my $data = $bugs_temp{$bug};
- &appendfile("debbugs.trace","$type $bug\n",makestatus($data, 1));
+ appendfile("$config{spool_dir}/debbugs.trace","$type $bug\n",makestatus($data, 1));
my $whendone = "open";
my $severity = $config{default_severity};
}
update_realtime("$config{spool_dir}/index.db.realtime", %bugs);
- &unfilelock;
+ unfilelock();
}