]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Status.pm
add rebuild index support
[debbugs.git] / Debbugs / Status.pm
index bdac7550efa61a3149a9271624c37142139e3b84..76dab7454c4f6da65bda29f7f6e96a4415e210f6 100644 (file)
@@ -38,12 +38,15 @@ use base qw(Exporter);
 
 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;
 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);
@@ -62,14 +65,16 @@ BEGIN{
                                qw(lock_read_all_merged_bugs),
                               ],
                     write  => [qw(writebug makestatus unlockwritebug)],
+                    new => [qw(new_bug)],
                     versions => [qw(addfoundversions addfixedversions),
                                  qw(removefoundversions removefixedversions)
                                 ],
                     hook     => [qw(bughook bughook_archive)],
+                     indexdb  => [qw(generate_index_db_line)],
                     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];
 }
 
@@ -105,6 +110,7 @@ our %fields = (originator     => 'submitter',
               blockedby      => 'blocked-by',
              unarchived     => 'unarchived',
              summary        => 'summary',
+             outlook        => 'outlook',
              affects        => 'affects',
              );
 
@@ -214,6 +220,7 @@ sub read_bug{
        }
        return undef;
     }
+    binmode($status_fh,':encoding(UTF-8)');
 
     my %data;
     my @lines;
@@ -247,9 +254,13 @@ sub read_bug{
         }
     }
     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}];
@@ -262,11 +273,6 @@ sub read_bug{
               @{$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];
@@ -517,6 +523,57 @@ sub lock_read_all_merged_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);
@@ -539,7 +596,7 @@ version.
 
 sub makestatus {
     my ($data,$version) = @_;
-    $version = 2 unless defined $version;
+    $version = 3 unless defined $version;
 
     my $contents = '';
 
@@ -552,6 +609,8 @@ sub makestatus {
     }
     %newdata = %{join_status_fields(\%newdata)};
 
+    %newdata = encode_utf8_structure(%newdata);
+
     if ($version < 3) {
         for my $field (@rfc1522_fields) {
             $newdata{$field} = encode_rfc1522($newdata{$field});
@@ -583,11 +642,11 @@ sub makestatus {
                 # 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;
 }
 
@@ -607,15 +666,23 @@ sub writebug {
     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 {
@@ -1043,6 +1110,63 @@ a source package). Defaults to true.
 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 {
@@ -1476,6 +1600,40 @@ sub isstrongseverity {
     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) = @_;
+
+    # 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}, $data->{date}, $whendone,
+            $data->{originator}, $severity, $data->{keywords};
+}
+
+
 
 =head1 PRIVATE FUNCTIONS
 
@@ -1492,6 +1650,8 @@ sub update_realtime {
        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;
@@ -1556,19 +1716,7 @@ sub bughook {
             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);
        }
        update_realtime("$config{spool_dir}/index.db.realtime", %bugs);