output to transcript even in cases of internal requests

[debbugs.git] / Debbugs / Status.pm

diff --git a/Debbugs/Status.pm b/Debbugs/Status.pm
index bdac7550efa61a3149a9271624c37142139e3b84..d44d0bdea277da4add795748ab9c200cabafc3b1 100644 (file)
--- a/Debbugs/Status.pm
+++ b/Debbugs/Status.pm
@@ -44,6 +44,8 @@ use Debbugs::Packages qw(makesourceversions make_source_versions getversions get
 use Debbugs::Versions;
 use Debbugs::Versions::Dpkg;
 use POSIX qw(ceil);
+use File::Copy qw(copy);
+use Encode qw(decode encode);
 
 use Storable qw(dclone);
 use List::Util qw(min max);
@@ -62,6 +64,7 @@ BEGIN{
                                qw(lock_read_all_merged_bugs),
                               ],
                     write  => [qw(writebug makestatus unlockwritebug)],
+                    new => [qw(new_bug)],
                     versions => [qw(addfoundversions addfixedversions),
                                  qw(removefoundversions removefixedversions)
                                 ],
@@ -69,7 +72,7 @@ BEGIN{
                     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];
 }
 
@@ -237,6 +240,9 @@ sub read_bug{
 
     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
@@ -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);
@@ -583,11 +640,14 @@ 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";
             }
         }
     }
-
+    eval {
+       $contents = encode("utf8",$contents,Encode::FB_CROAK);
+    };
     return $contents;
 }