2 package Debbugs::Status;
6 Debbugs::Status -- Routines for dealing with summary and status files
15 This module is a replacement for the parts of errorlib.pl which write
16 and read status and summary files.
18 It also contains generic routines for returning information about the
19 status of a particular bug
27 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
28 use base qw(Exporter);
30 use Params::Validate qw(validate_with :types);
31 use Debbugs::Common qw(:util :lock :quit :misc);
32 use Debbugs::Config qw(:config);
33 use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
34 use Debbugs::Packages qw(makesourceversions getversions binarytosource);
35 use Debbugs::Versions;
36 use Debbugs::Versions::Dpkg;
42 $DEBUG = 0 unless defined $DEBUG;
45 %EXPORT_TAGS = (status => [qw(splitpackages get_bug_status buggy bug_archiveable),
46 qw(isstrongseverity bug_presence),
48 read => [qw(readbug read_bug lockreadbug)],
49 write => [qw(writebug makestatus unlockwritebug)],
50 versions => [qw(addfoundversions addfixedversions),
51 qw(removefoundversions)
53 hook => [qw(bughook bughook_archive)],
56 Exporter::export_ok_tags(qw(status read write versions hook));
57 $EXPORT_TAGS{all} = [@EXPORT_OK];
63 readbug($bug_num,$location)
66 Reads a summary file from the archive given a bug number and a bug
67 location. Valid locations are those understood by L</getbugcomponent>
72 my %fields = (originator => 'submitter',
75 msgid => 'message-id',
76 'package' => 'package',
79 forwarded => 'forwarded-to',
80 mergedwith => 'merged-with',
81 severity => 'severity',
83 found_versions => 'found-in',
84 found_date => 'found-date',
85 fixed_versions => 'fixed-in',
86 fixed_date => 'fixed-date',
88 blockedby => 'blocked-by',
91 # Fields which need to be RFC1522-decoded in format versions earlier than 3.
92 my @rfc1522_fields = qw(originator subject done forwarded owner);
95 return read_bug(bug => $_[0],
96 (@_ > 1)?(location => $_[1]):()
102 read_bug(bug => $bug_num,
103 location => 'archive',
105 read_bug(summary => 'path/to/bugnum.summary');
108 A more complete function than readbug; it enables you to pass a full
109 path to the summary file instead of the bug number and/or location.
115 =item bug -- the bug number
117 =item location -- optional location which is passed to getbugcomponent
119 =item summary -- complete path to the .summary file which will be read
123 One of C<bug> or C<summary> must be passed. This function will return
124 undef on failure, and will die if improper arguments are passed.
132 my %param = validate_with(params => \@_,
133 spec => {bug => {type => SCALAR,
137 # negative bugnumbers
140 location => {type => SCALAR|UNDEF,
143 summary => {type => SCALAR,
148 die "One of bug or summary must be passed to read_bug"
149 if not exists $param{bug} and not exists $param{summary};
151 if (not defined $param{summary}) {
152 my ($lref, $location) = @param{qw(bug location)};
153 if (not defined $location) {
154 $location = getbuglocation($lref,'summary');
155 return undef if not defined $location;
157 $status = getbugcomponent($lref, 'summary', $location);
158 return undef unless defined $status;
161 $status = $param{summary};
163 my $status_fh = new IO::File $status, 'r' or
164 warn "Unable to open $status for reading: $!" and return undef;
171 while (<$status_fh>) {
174 $version = $1 if /^Format-Version: ([0-9]+)/i;
177 # Version 3 is the latest format version currently supported.
178 return undef if $version > 3;
180 my %namemap = reverse %fields;
181 for my $line (@lines) {
182 if ($line =~ /(\S+?): (.*)/) {
183 my ($name, $value) = (lc $1, $2);
184 $data{$namemap{$name}} = $value if exists $namemap{$name};
187 for my $field (keys %fields) {
188 $data{$field} = '' unless exists $data{$field};
191 $data{severity} = $config{default_severity} if $data{severity} eq '';
192 for my $field (qw(found_versions fixed_versions found_date fixed_date)) {
193 $data{$field} = [split ' ', $data{$field}];
195 for my $field (qw(found fixed)) {
196 # create the found/fixed hashes which indicate when a
197 # particular version was marked found or marked fixed.
198 @{$data{$field}}{@{$data{"${field}_versions"}}} =
199 (('') x (@{$data{"${field}_date"}} - @{$data{"${field}_versions"}}),
200 @{$data{"${field}_date"}});
204 for my $field (@rfc1522_fields) {
205 $data{$field} = decode_rfc1522($data{$field});
214 lockreadbug($bug_num,$location)
216 Performs a filelock, then reads the bug; the bug is unlocked if the
217 return is undefined, otherwise, you need to call unfilelock or
220 See readbug above for information on what this returns
225 my ($lref, $location) = @_;
226 &filelock("lock/$lref");
227 my $data = read_bug(bug => $lref, location => $location);
228 &unfilelock unless defined $data;
232 my @v1fieldorder = qw(originator date subject msgid package
233 keywords done forwarded mergedwith severity);
237 my $content = makestatus($status,$version)
238 my $content = makestatus($status);
240 Creates the content for a status file based on the $status hashref
243 Really only useful for writebug
245 Currently defaults to version 2 (non-encoded rfc1522 names) but will
246 eventually default to version 3. If you care, you should specify a
252 my ($data,$version) = @_;
253 $version = 2 unless defined $version;
257 my %newdata = %$data;
258 for my $field (qw(found fixed)) {
259 if (exists $newdata{$field}) {
260 $newdata{"${field}_date"} =
261 [map {$newdata{$field}{$_}||''} keys %{$newdata{$field}}];
265 for my $field (qw(found_versions fixed_versions found_date fixed_date)) {
266 $newdata{$field} = join ' ', @{$newdata{$field}||[]};
270 for my $field (@rfc1522_fields) {
271 $newdata{$field} = encode_rfc1522($newdata{$field});
276 for my $field (@v1fieldorder) {
277 if (exists $newdata{$field} and defined $newdata{$field}) {
278 $contents .= "$newdata{$field}\n";
283 } elsif ($version == 2 or $version == 3) {
284 # Version 2 or 3. Add a file format version number for the sake of
285 # further extensibility in the future.
286 $contents .= "Format-Version: $version\n";
287 for my $field (keys %fields) {
288 if (exists $newdata{$field} and defined $newdata{$field}
289 and $newdata{$field} ne '') {
290 # Output field names in proper case, e.g. 'Merged-With'.
291 my $properfield = $fields{$field};
292 $properfield =~ s/(?:^|(?<=-))([a-z])/\u$1/g;
293 $contents .= "$properfield: $newdata{$field}\n";
303 writebug($bug_num,$status,$location,$minversion,$disablebughook)
305 Writes the bug status and summary files out.
307 Skips writting out a status file if minversion is 2
309 Does not call bughook if disablebughook is true.
314 my ($ref, $data, $location, $minversion, $disablebughook) = @_;
317 my %outputs = (1 => 'status', 2 => 'summary');
318 for my $version (keys %outputs) {
319 next if defined $minversion and $version < $minversion;
320 my $status = getbugcomponent($ref, $outputs{$version}, $location);
321 &quit("can't find location for $ref") unless defined $status;
322 open(S,"> $status.new") || &quit("opening $status.new: $!");
323 print(S makestatus($data, $version)) ||
324 &quit("writing $status.new: $!");
325 close(S) || &quit("closing $status.new: $!");
331 rename("$status.new",$status) || &quit("installing new $status: $!");
334 # $disablebughook is a bit of a hack to let format migration scripts use
335 # this function rather than having to duplicate it themselves.
336 &bughook($change,$ref,$data) unless $disablebughook;
339 =head2 unlockwritebug
341 unlockwritebug($bug_num,$status,$location,$minversion,$disablebughook);
343 Writes a bug, then calls unfilelock; see writebug for what these
355 The following functions are exported with the :versions tag
357 =head2 addfoundversions
359 addfoundversions($status,$package,$version,$isbinary);
366 sub addfoundversions {
370 my $isbinary = shift;
371 return unless defined $version;
372 undef $package if $package =~ m[(?:\s|/)];
373 my $source = $package;
375 if (defined $package and $isbinary) {
376 my @srcinfo = binarytosource($package, $version, undef);
378 # We know the source package(s). Use a fully-qualified version.
379 addfoundversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
382 # Otherwise, an unqualified version will have to do.
386 # Strip off various kinds of brain-damage.
388 $version =~ s/ *\(.*\)//;
389 $version =~ s/ +[A-Za-z].*//;
391 foreach my $ver (split /[,\s]+/, $version) {
392 my $sver = defined($source) ? "$source/$ver" : '';
393 unless (grep { $_ eq $ver or $_ eq $sver } @{$data->{found_versions}}) {
394 push @{$data->{found_versions}}, defined($source) ? $sver : $ver;
396 @{$data->{fixed_versions}} =
397 grep { $_ ne $ver and $_ ne $sver } @{$data->{fixed_versions}};
401 =head2 removefoundversions
403 removefoundversions($data,$package,$versiontoremove)
405 Removes found versions from $data
407 If a version is fully qualified (contains /) only versions matching
408 exactly are removed. Otherwise, all versions matching the version
411 Currently $package and $isbinary are entirely ignored, but accepted
412 for backwards compatibilty.
416 sub removefoundversions {
420 my $isbinary = shift;
421 return unless defined $version;
423 foreach my $ver (split /[,\s]+/, $version) {
425 # fully qualified version
426 @{$data->{found_versions}} =
428 @{$data->{found_versions}};
431 # non qualified version; delete all matchers
432 @{$data->{found_versions}} =
433 grep {$_ !~ m[(?:^|/)\Q$ver\E$]}
434 @{$data->{found_versions}};
440 sub addfixedversions {
444 my $isbinary = shift;
445 return unless defined $version;
446 undef $package if defined $package and $package =~ m[(?:\s|/)];
447 my $source = $package;
449 if (defined $package and $isbinary) {
450 my @srcinfo = binarytosource($package, $version, undef);
452 # We know the source package(s). Use a fully-qualified version.
453 addfixedversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
456 # Otherwise, an unqualified version will have to do.
460 # Strip off various kinds of brain-damage.
462 $version =~ s/ *\(.*\)//;
463 $version =~ s/ +[A-Za-z].*//;
465 foreach my $ver (split /[,\s]+/, $version) {
466 my $sver = defined($source) ? "$source/$ver" : '';
467 unless (grep { $_ eq $ver or $_ eq $sver } @{$data->{fixed_versions}}) {
468 push @{$data->{fixed_versions}}, defined($source) ? $sver : $ver;
470 @{$data->{found_versions}} =
471 grep { $_ ne $ver and $_ ne $sver } @{$data->{found_versions}};
475 sub removefixedversions {
479 my $isbinary = shift;
480 return unless defined $version;
481 undef $package if $package =~ m[(?:\s|/)];
482 my $source = $package;
484 if (defined $package and $isbinary) {
485 my @srcinfo = binarytosource($package, $version, undef);
487 # We know the source package(s). Use a fully-qualified version.
488 removefixedversions($data, $_->[0], $_->[1], '') foreach @srcinfo;
491 # Otherwise, an unqualified version will have to do.
495 foreach my $ver (split /[,\s]+/, $version) {
496 my $sver = defined($source) ? "$source/$ver" : '';
497 @{$data->{fixed_versions}} =
498 grep { $_ ne $ver and $_ ne $sver } @{$data->{fixed_versions}};
508 Split a package string from the status file into a list of package names.
514 return unless defined $pkgs;
515 return map lc, split /[ \t?,()]+/, $pkgs;
519 =head2 bug_archiveable
521 bug_archiveable(bug => $bug_num);
527 =item bug -- bug number (required)
529 =item status -- Status hashref returned by read_bug or get_bug_status (optional)
531 =item version -- Debbugs::Version information (optional)
533 =item days_until -- return days until the bug can be archived
537 Returns 1 if the bug can be archived
538 Returns 0 if the bug cannot be archived
540 If days_until is true, returns the number of days until the bug can be
541 archived, -1 if it cannot be archived. 0 means that the bug can be
542 archived the next time the archiver runs.
544 Returns undef on failure.
548 # This will eventually need to be fixed before we start using mod_perl
549 my $version_cache = {};
551 my %param = validate_with(params => \@_,
552 spec => {bug => {type => SCALAR,
555 status => {type => HASHREF,
558 days_until => {type => BOOLEAN,
563 # This is what we return if the bug cannot be archived.
564 my $cannot_archive = $param{days_until}?-1:0;
565 # read the status information
566 my $status = $param{status};
567 if (not exists $param{status} or not defined $status) {
568 $status = read_bug(bug=>$param{bug});
569 return undef if not defined $status;
571 # Bugs can be archived if they are
573 return $cannot_archive if not defined $status->{done} or not length $status->{done};
574 # If we just are checking if the bug can be archived, we'll not even bother
575 # checking the versioning information if the bug has been -done for less than 28 days.
576 if (not $param{days_until} and $config{remove_age} >
577 -M getbugcomponent($param{ref},'log')
579 return $cannot_archive;
581 # At this point, we have to get the versioning information for this bug.
582 # We examine the set of distribution tags. If a bug has no distribution
583 # tags set, we assume a default set, otherwise we use the tags the bug
586 # There must be fixed_versions for us to look at the versioning
588 if (@{$status->{fixed_versions}}) {
590 @dist_tags{@{$config{removal_distribution_tags}}} =
591 (1) x @{$config{removal_distribution_tags}};
593 @dists{@{$config{removal_default_distribution_tags}}} =
594 (1) x @{$config{removal_default_distribution_tags}};
595 for my $tag (split ' ', $status->{tags}) {
596 next unless $dist_tags{$tag};
600 for my $dist (keys %dists){
602 @versions = getversions($status->{package},
605 # TODO: This should probably be handled further out for efficiency and
606 # for more ease of distinguishing between pkg= and src= queries.
607 my @sourceversions = makesourceversions($status->{package},
610 @source_versions{@sourceversions} = (1) x @sourceversions;
612 if ('found' eq max_buggy(bug => $param{bug},
613 sourceversions => [keys %source_versions],
614 found => $status->{found_versions},
615 fixed => $status->{fixed_versions},
616 version_cache => $version_cache,
617 package => $status->{package},
619 return $cannot_archive;
622 # 6. at least 28 days have passed since the last action has occured or the bug was closed
623 # XXX We still need some more work here before we actually can archive;
624 # we really need to track when a bug was closed in a version.
625 my $age = ceil($config{remove_age} - -M getbugcomponent($param{bug},'log'));
627 return $param{days_until}?$age:0;
630 return $param{days_until}?0:1;
635 =head2 get_bug_status
637 my $status = get_bug_status(bug => $nnn);
639 my $status = get_bug_status($bug_num)
645 =item bug -- scalar bug number
647 =item status -- optional hashref of bug status as returned by readbug
648 (can be passed to avoid rereading the bug information)
650 =item bug_index -- optional tied index of bug status infomration;
651 currently not correctly implemented.
653 =item version -- optional version(s) to check package status at
655 =item dist -- optional distribution(s) to check package status at
657 =item arch -- optional architecture(s) to check package status at
659 =item usertags -- optional hashref of usertags
661 =item sourceversion -- optional arrayref of source/version; overrides
662 dist, arch, and version. [The entries in this array must be in the
663 "source/version" format.] Eventually this can be used to for caching.
667 Note: Currently the version information is cached; this needs to be
668 changed before using this function in long lived programs.
676 my %param = validate_with(params => \@_,
677 spec => {bug => {type => SCALAR,
680 status => {type => HASHREF,
683 bug_index => {type => OBJECT,
686 version => {type => SCALAR|ARRAYREF,
689 dist => {type => SCALAR|ARRAYREF,
692 arch => {type => SCALAR|ARRAYREF,
695 usertags => {type => HASHREF,
698 sourceversions => {type => ARRAYREF,
705 if (defined $param{bug_index} and
706 exists $param{bug_index}{$param{bug}}) {
707 %status = %{ $param{bug_index}{$param{bug}} };
708 $status{pending} = $status{ status };
709 $status{id} = $param{bug};
712 if (defined $param{status}) {
713 %status = %{$param{status}};
716 my $location = getbuglocation($param{bug}, 'summary');
717 return {} if not length $location;
718 %status = %{ readbug( $param{bug}, $location ) };
720 $status{id} = $param{bug};
722 if (defined $param{usertags}{$param{bug}}) {
723 $status{keywords} = "" unless defined $status{keywords};
724 $status{keywords} .= " " unless $status{keywords} eq "";
725 $status{keywords} .= join(" ", @{$param{usertags}{$param{bug}}});
727 $status{tags} = $status{keywords};
728 my %tags = map { $_ => 1 } split ' ', $status{tags};
730 $status{"package"} =~ s/\s*$//;
731 $status{"package"} = 'unknown' if ($status{"package"} eq '');
732 $status{"severity"} = 'normal' if ($status{"severity"} eq '');
734 $status{"pending"} = 'pending';
735 $status{"pending"} = 'forwarded' if (length($status{"forwarded"}));
736 $status{"pending"} = 'pending-fixed' if ($tags{pending});
737 $status{"pending"} = 'fixed' if ($tags{fixed});
740 my $presence = bug_presence(map{(exists $param{$_})?($_,$param{$_}):()}
741 qw(bug sourceversions arch dist version found fixed package)
743 if (defined $presence) {
744 if ($presence eq 'fixed') {
745 $status{pending} = 'done';
747 elsif ($presence eq 'absent') {
748 $status{pending} = 'absent';
756 my $precence = bug_presence(bug => nnn,
760 Returns 'found', 'absent', 'fixed' or undef based on whether the bug
761 is found, absent, fixed, or no information is available in the
762 distribution (dist) and/or architecture (arch) specified.
769 =item bug -- scalar bug number
771 =item status -- optional hashref of bug status as returned by readbug
772 (can be passed to avoid rereading the bug information)
774 =item bug_index -- optional tied index of bug status infomration;
775 currently not correctly implemented.
777 =item version -- optional version to check package status at
779 =item dist -- optional distribution to check package status at
781 =item arch -- optional architecture to check package status at
783 =item sourceversion -- optional arrayref of source/version; overrides
784 dist, arch, and version. [The entries in this array must be in the
785 "source/version" format.] Eventually this can be used to for caching.
792 my %param = validate_with(params => \@_,
793 spec => {bug => {type => SCALAR,
796 status => {type => HASHREF,
799 version => {type => SCALAR|ARRAYREF,
802 dist => {type => SCALAR|ARRAYREF,
805 arch => {type => SCALAR|ARRAYREF,
808 sourceversions => {type => ARRAYREF,
814 if (defined $param{status}) {
815 %status = %{$param{status}};
818 my $location = getbuglocation($param{bug}, 'summary');
819 return {} if not length $location;
820 %status = %{ readbug( $param{bug}, $location ) };
824 if (not exists $param{sourceversions}) {
826 if (defined $param{version}) {
827 foreach my $arch (make_list($param{arch})) {
828 my @temp = makesourceversions($status{package},
830 make_list($param{version})
832 @sourceversions{@temp} = (1) x @temp;
834 } elsif (defined $param{dist}) {
835 foreach my $arch (make_list($param{arch})) {
837 foreach my $dist (make_list($param{dist})) {
838 push @versions, getversions($status{package}, $dist, $arch);
840 my @temp = makesourceversions($status{package},
844 @sourceversions{@temp} = (1) x @temp;
848 # TODO: This should probably be handled further out for efficiency and
849 # for more ease of distinguishing between pkg= and src= queries.
850 @sourceversions = keys %sourceversions;
853 @sourceversions = @{$param{sourceversions}};
855 my $maxbuggy = 'undef';
856 if (@sourceversions) {
857 $maxbuggy = max_buggy(bug => $param{bug},
858 sourceversions => \@sourceversions,
859 found => $status{found_versions},
860 fixed => $status{fixed_versions},
861 package => $status{package},
862 version_cache => $version_cache,
865 if (length($status{done}) and
866 (not @sourceversions or not @{$status{fixed_versions}})) {
881 =item bug -- scalar bug number
883 =item sourceversion -- optional arrayref of source/version; overrides
884 dist, arch, and version. [The entries in this array must be in the
885 "source/version" format.] Eventually this can be used to for caching.
889 Note: Currently the version information is cached; this needs to be
890 changed before using this function in long lived programs.
895 my %param = validate_with(params => \@_,
896 spec => {bug => {type => SCALAR,
899 sourceversions => {type => ARRAYREF,
902 found => {type => ARRAYREF,
905 fixed => {type => ARRAYREF,
908 package => {type => SCALAR,
910 version_cache => {type => HASHREF,
915 # Resolve bugginess states (we might be looking at multiple
916 # architectures, say). Found wins, then fixed, then absent.
917 my $maxbuggy = 'absent';
918 for my $version (@{$param{sourceversions}}) {
919 my $buggy = buggy(bug => $param{bug},
921 found => $param{found},
922 fixed => $param{fixed},
923 version_cache => $param{version_cache},
924 package => $param{package},
926 if ($buggy eq 'found') {
928 } elsif ($buggy eq 'fixed') {
945 Returns the output of Debbugs::Versions::buggy for a particular
946 package, version and found/fixed set. Automatically turns found, fixed
947 and version into source/version strings.
949 Caching can be had by using the version_cache, but no attempt to check
950 to see if the on disk information is more recent than the cache is
951 made. [This will need to be fixed for long-lived processes.]
956 my %param = validate_with(params => \@_,
957 spec => {bug => {type => SCALAR,
960 found => {type => ARRAYREF,
963 fixed => {type => ARRAYREF,
966 version_cache => {type => HASHREF,
969 package => {type => SCALAR,
971 version => {type => SCALAR,
975 my @found = @{$param{found}};
976 my @fixed = @{$param{fixed}};
977 if (grep {$_ !~ m{/}} (@{$param{found}}, @{$param{fixed}})) {
978 # We have non-source version versions
979 @found = makesourceversions($param{package},undef,
982 @fixed = makesourceversions($param{package},undef,
986 if ($param{version} !~ m{/}) {
987 $param{version} = makesourceversions($param{package},undef,
991 # Figure out which source packages we need
993 @sources{map {m{(.+)/}; $1} @found} = (1) x @found;
994 @sources{map {m{(.+)/}; $1} @fixed} = (1) x @fixed;
995 @sources{map {m{(.+)/}; $1} $param{version}} = 1;
997 if (not defined $param{version_cache} or
998 not exists $param{version_cache}{join(',',sort keys %sources)}) {
999 $version = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp);
1000 foreach my $source (keys %sources) {
1001 my $srchash = substr $source, 0, 1;
1002 my $version_fh = new IO::File "$config{version_packages_dir}/$srchash/$source", 'r' or
1003 warn "Unable to open $config{version_packages_dir}/$srchash/$source: $!" and next;
1004 $version->load($version_fh);
1006 if (defined $param{version_cache}) {
1007 $param{version_cache}{join(',',sort keys %sources)} = $version;
1011 $version = $param{version_cache}{join(',',sort keys %sources)};
1013 return $version->buggy($param{version},\@found,\@fixed);
1016 sub isstrongseverity {
1017 my $severity = shift;
1018 $severity = $config{default_severity} if $severity eq '';
1019 return grep { $_ eq $severity } @{$config{strong_severities}};
1023 =head1 PRIVATE FUNCTIONS
1027 sub update_realtime {
1028 my ($file, $bug, $new) = @_;
1030 # update realtime index.db
1032 open(IDXDB, "<$file") or die "Couldn't open $file";
1033 open(IDXNEW, ">$file.new");
1037 while($line = <IDXDB>) {
1038 @line = split /\s/, $line;
1039 last if ($line[1] >= $bug);
1044 if ($new eq "NOCHANGE") {
1045 print IDXNEW $line if ($line ne "" and $line[1] == $bug);
1046 } elsif ($new eq "REMOVE") {
1051 if (defined $line and $line ne "" and @line and $line[1] > $bug) {
1056 print IDXNEW while(<IDXDB>);
1061 rename("$file.new", $file);
1066 sub bughook_archive {
1068 &filelock("debbugs.trace.lock");
1069 &appendfile("debbugs.trace","archive $ref\n");
1070 my $line = update_realtime(
1071 "$config{spool_dir}/index.db.realtime",
1074 update_realtime("$config{spool_dir}/index.archive.realtime",
1080 my ( $type, $ref, $data ) = @_;
1081 &filelock("debbugs.trace.lock");
1083 &appendfile("debbugs.trace","$type $ref\n",makestatus($data, 1));
1085 my $whendone = "open";
1086 my $severity = $config{default_severity};
1087 (my $pkglist = $data->{package}) =~ s/[,\s]+/,/g;
1088 $pkglist =~ s/^,+//;
1089 $pkglist =~ s/,+$//;
1090 $whendone = "forwarded" if defined $data->{forwarded} and length $data->{forwarded};
1091 $whendone = "done" if defined $data->{done} and length $data->{done};
1092 $severity = $data->{severity} if length $data->{severity};
1094 my $k = sprintf "%s %d %d %s [%s] %s %s\n",
1095 $pkglist, $ref, $data->{date}, $whendone,
1096 $data->{originator}, $severity, $data->{keywords};
1098 update_realtime("$config{spool_dir}/index.db.realtime", $ref, $k);