use strict;
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
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 binary_to_source);
use Debbugs::Versions::Dpkg;
use POSIX qw(ceil);
use File::Copy qw(copy);
-use Encode qw(decode encode);
+use Encode qw(decode encode is_utf8);
use Storable qw(dclone);
use List::Util qw(min max);
qw(removefoundversions removefixedversions)
],
hook => [qw(bughook bughook_archive)],
+ indexdb => [qw(generate_index_db_line)],
fields => [qw(%fields)],
);
@EXPORT_OK = ();
blockedby => 'blocked-by',
unarchived => 'unarchived',
summary => 'summary',
+ outlook => 'outlook',
affects => 'affects',
);
$log = $status;
$log =~ s/\.summary$/.log/;
($location) = $status =~ m/(db-h|db|archive)/;
+ ($param{bug}) = $status =~ m/(\d+)\.summary$/;
}
if ($param{lock}) {
filelock("$config{spool_dir}/lock/$param{bug}",exists $param{locks}?$param{locks}:());
}
return undef;
}
+ binmode($status_fh,':encoding(UTF-8)');
my %data;
my @lines;
my %namemap = reverse %fields;
for my $line (@lines) {
- eval {
- $line = decode("utf8",$line,Encode::FB_CROAK);
- };
if ($line =~ /(\S+?): (.*)/) {
my ($name, $value) = (lc $1, $2);
# this is a bit of a hack; we should never, ever have \r
}
}
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}];
# create the found/fixed hashes which indicate when a
# particular version was marked found or marked fixed.
@{$data{$field}}{@{$data{"${field}_versions"}}} =
- (('') x (@{$data{"${field}_date"}} - @{$data{"${field}_versions"}}),
+ (('') x (@{$data{"${field}_versions"}} - @{$data{"${field}_date"}}),
@{$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];
+ $data{log_modified} = (stat($log))[9] // (stat("${log}.gz"))[9];
$data{last_modified} = max($status_modified,$data{log_modified});
$data{location} = $location;
$data{archived} = (defined($location) and ($location eq 'archive'))?1:0;
=cut
sub lockreadbugmerge {
- my ($bug_num,$location) = @_;
my $data = lockreadbug(@_);
if (not defined $data) {
return (0,undef);
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);
+ # We do a cmp sort instead of an <=> sort here, because that's
+ # what merge does
+ my $expectmerge= join(' ',grep {$_ != $bug } sort @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 $param{bug} mergedwith differs from bug $bug: ($newdata->{bug_num}: '$newdata->{mergedwith}') vs. ('$expectmerge') (".join(' ',@bugs).")";
}
}
}
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});
}
}
}
- eval {
- $contents = encode("utf8",$contents,Encode::FB_CROAK);
- };
return $contents;
}
Writes the bug status and summary files out.
-Skips writting out a status file if minversion is 2
+Skips writing out a status file if minversion is 2
Does not call bughook if disablebughook is true.
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 {
my $version = shift;
my $isbinary = shift;
return unless defined $version;
- undef $package if $package =~ m[(?:\s|/)];
+ undef $package if defined $package and $package =~ m[(?:\s|/)];
my $source = $package;
- if ($package =~ s/^src://) {
+ if (defined $package and $package =~ s/^src://) {
$isbinary = 0;
$source = $package;
}
number are removed.
Currently $package and $isbinary are entirely ignored, but accepted
-for backwards compatibilty.
+for backwards compatibility.
=cut
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*$//;
- $status{source} = binary_to_source(binary=>[split /\s*,\s*/, $status{package}],
+ $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 '');
return grep { $_ eq $severity } @{$config{strong_severities}};
}
+=head1 indexdb
+
+=head2 generate_index_db_line
+
+ my $data = read_bug(bug => $bug,
+ location => $initialdir);
+ # generate_index_db_line hasn't been written yet at all.
+ my $line = generate_index_db_line($data);
+
+Returns a line for a bug suitable to be written out to index.db.
+
+=cut
+
+sub generate_index_db_line {
+ my ($data,$bug) = @_;
+
+ # just in case someone has given us a split out data
+ $data = join_status_fields($data);
+
+ my $whendone = "open";
+ my $severity = $config{default_severity};
+ (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
+ $pkglist =~ s/^,+//;
+ $pkglist =~ s/,+$//;
+ $whendone = "forwarded" if defined $data->{forwarded} and length $data->{forwarded};
+ $whendone = "done" if defined $data->{done} and length $data->{done};
+ $severity = $data->{severity} if length $data->{severity};
+ return sprintf "%s %d %d %s [%s] %s %s\n",
+ $pkglist, $data->{bug_num}//$bug, $data->{date}, $whendone,
+ $data->{originator}, $severity, $data->{keywords};
+}
+
+
=head1 PRIVATE FUNCTIONS
my $idx_new = IO::File->new($file.'.new','w')
or die "Couldn't open ${file}.new: $!";
+ binmode($idx_old,':raw:utf8');
+ binmode($idx_new,':raw:encoding(UTF-8)');
my $min_bug = min(keys %bugs);
my $line;
my @line;
my $data = $bugs_temp{$bug};
appendfile("$config{spool_dir}/debbugs.trace","$type $bug\n",makestatus($data, 1));
- my $whendone = "open";
- my $severity = $config{default_severity};
- (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
- $pkglist =~ s/^,+//;
- $pkglist =~ s/,+$//;
- $whendone = "forwarded" if defined $data->{forwarded} and length $data->{forwarded};
- $whendone = "done" if defined $data->{done} and length $data->{done};
- $severity = $data->{severity} if length $data->{severity};
-
- my $k = sprintf "%s %d %d %s [%s] %s %s\n",
- $pkglist, $bug, $data->{date}, $whendone,
- $data->{originator}, $severity, $data->{keywords};
- $bugs{$bug} = $k;
+ $bugs{$bug} = generate_index_db_line($data,$bug);
}
update_realtime("$config{spool_dir}/index.db.realtime", %bugs);
projects / debbugs.git / blobdiff