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);
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',
);
}
return undef;
}
+ binmode($status_fh,':encoding(UTF-8)');
my %data;
my @lines;
}
}
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];
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});
# 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 {
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 {
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;