qw(cleanup_eval_fail),
qw(hash_slice),
],
+ utf8 => [qw(encode_utf8_structure)],
date => [qw(secs_to_english)],
quit => [qw(quit)],
lock => [qw(filelock unfilelock lockpid)],
);
@EXPORT_OK = ();
- Exporter::export_ok_tags(qw(lock quit date util misc));
+ Exporter::export_ok_tags(keys %EXPORT_TAGS);
$EXPORT_TAGS{all} = [@EXPORT_OK];
}
use Debbugs::MIME qw(decode_rfc1522);
use Mail::Address;
use Cwd qw(cwd);
+use Encode qw(encode_utf8 is_utf8);
+use Storable qw(dclone);
use Params::Validate qw(validate_with :types);
if (defined ref($scalar)) {
if (ref($scalar) eq 'SCALAR' and
not UNIVERSAL::isa($scalar,'GLOB')) {
- return IO::Scalar->new($scalar);
+ open $handle, '>:scalar:utf8', $scalar;
+ return $handle;
}
else {
return $scalar;
carp "Given a non-scalar reference, non-glob to globify_scalar; returning /dev/null handle";
}
}
- return IO::File->new('/dev/null','w');
+ return IO::File->new('/dev/null','>:utf8');
}
=head2 cleanup_eval_fail()
return map {exists $hashref->{$_}?($_,$hashref->{$_}):()} @keys;
}
+
+=head1 UTF-8
+
+These functions are exported with the :utf8 tag
+
+=head2 encode_utf8_structure
+
+ %newdata = encode_utf8_structure(%newdata);
+
+Takes a complex data structure and encodes any strings with is_utf8
+set into their constituent octets.
+
+=cut
+
+our $depth = 0;
+sub encode_utf8_structure {
+ ++$depth;
+ my @ret;
+ for my $_ (@_) {
+ if (ref($_) eq 'HASH') {
+ push @ret, {encode_utf8_structure(%{$depth == 1 ? dclone($_):$_})};
+ }
+ elsif (ref($_) eq 'ARRAY') {
+ push @ret, [encode_utf8_structure(@{$depth == 1 ? dclone($_):$_})];
+ }
+ elsif (ref($_)) {
+ # we don't know how to handle non hash or non arrays
+ push @ret,$_;
+ }
+ else {
+ push @ret,__encode_utf8($_);
+ }
+ }
+ --$depth;
+ return @ret;
+}
+
+sub __encode_utf8 {
+ my @ret;
+ for my $r (@_) {
+ if (not ref($r) and is_utf8($r)) {
+ $r = encode_utf8($r);
+ }
+ push @ret,$r;
+ }
+ return @ret;
+}
+
+
+
1;
__END__
headers =>
[To => $data->{submitter},
Subject => "$config{ubug}#$data->{bug_num} ".
- "closed by $param{requester} ($param{request_subject})",
+ "closed by $param{requester} ".(defined $param{request_subject}?"($param{request_subject})":""),
],
)
],
# handle being passed undef properly
return undef if not defined $rawstr;
+ if (is_utf8($rawstr)) {
+ $rawstr= encode_utf8($rawstr);
+ }
# We process words in reverse so we can preserve spacing between
# encoded words. This regex splits on word|nonword boundaries and
# nonword|nonword boundaries. We also consider parenthesis and "
use warnings;
use strict;
use vars qw($DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
+use Debbugs::SOAP::Server;
use base qw(Exporter SOAP::Server::Parameters);
BEGIN{
}
-
use IO::File;
use Debbugs::Status qw(get_bug_status);
-use Debbugs::Common qw(make_list getbuglocation getbugcomponent);
+use Debbugs::Common qw(make_list getbuglocation getbugcomponent :utf8);
use Debbugs::Packages;
-use Storable qw(nstore retrieve);
+
+use Storable qw(nstore retrieve dclone);
use Scalar::Util qw(looks_like_number);
delete $ut{$tag} unless exists $tags{$tag};
}
}
- return \%ut;
+ return encode_utf8_structure(\%ut);
}
}
}
# __prepare_response($self);
- return \%status;
+ return encode_utf8_structure(\%status);
}
=head2 get_bugs
my %params = __collapse_params(@params);
my @bugs;
@bugs = Debbugs::Bugs::get_bugs(%params);
- return \@bugs;
+ return encode_utf8_structure(\@bugs);
}
=head2 newest_bugs
my $VERSION = __populate_version(pop);
my ($self,$num) = @_;
my $newest_bug = Debbugs::Bugs::newest_bug();
- return [($newest_bug - $num + 1) .. $newest_bug];
+ return encode_utf8_structure([($newest_bug - $num + 1) .. $newest_bug]);
}
msg_num => $current_msg,
};
}
- return \@messages;
+ return encode_utf8_structure(\@messages);
}
=head2 binary_to_source
my ($self,@params) = @_;
if ($VERSION <= 1) {
- return [Debbugs::Packages::binary_to_source(binary => $params[0],
+ return encode_utf8_structure([Debbugs::Packages::binary_to_source(binary => $params[0],
(@params > 1)?(version => $params[1]):(),
(@params > 2)?(arch => $params[2]):(),
- )];
+ )]);
}
else {
- return [Debbugs::Packages::binary_to_source(@params)];
+ return encode_utf8_structure([Debbugs::Packages::binary_to_source(@params)]);
}
}
my $VERSION = __populate_version(pop);
my ($self,@params) = @_;
- return [Debbugs::Packages::sourcetobinary(@params)];
+ return encode_utf8_structure([Debbugs::Packages::sourcetobinary(@params)]);
}
=head2 get_versions
my $VERSION = __populate_version(pop);
my ($self,@params) = @_;
- return scalar Debbugs::Packages::get_versions(@params);
+ return encode_utf8_structure(scalar Debbugs::Packages::get_versions(@params));
}
=head1 VERSION COMPATIBILITY
use base qw(Exporter);
use Params::Validate qw(validate_with :types);
-use Debbugs::Common qw(:util :lock :quit :misc);
+use Debbugs::Common qw(:util :lock :quit :misc :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);
}
my %namemap = reverse %fields;
+ for my $field (keys %fields) {
+ $data{$field} = '' unless exists $data{$field};
+ }
+ if ($version < 3) {
+ for my $field (@rfc1522_fields) {
+ $data{$field} = decode_rfc1522($data{$field});
+ }
+ }
for my $line (@lines) {
- eval {
- $line = decode("utf8",$line,Encode::FB_CROAK);
- };
+ my @encodings_to_try = qw(utf8 iso8859-1);
+ if ($version >= 3) {
+ @encodings_to_try = qw(utf8);
+ }
+ for (@encodings_to_try) {
+ last if is_utf8($line);
+ my $temp;
+ eval {
+ $temp = decode("$_",$line,Encode::FB_CROAK);
+ };
+ if (not $@) { # only update the line if there are no errors.
+ $line = $temp;
+ last;
+ }
+ }
if ($line =~ /(\S+?): (.*)/) {
my ($name, $value) = (lc $1, $2);
# this is a bit of a hack; we should never, ever have \r
$data{$namemap{$name}} = $value if exists $namemap{$name};
}
}
- for my $field (keys %fields) {
- $data{$field} = '' unless exists $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];
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;
}
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 {
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
}
+# STDOUT should be using the utf8 io layer
+binmode(STDOUT,':utf8');
+
use POSIX qw(strftime);
use MIME::Parser;
use MIME::Decoder;
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
}
+# STDOUT should be in utf8 mode
+binmode(STDOUT,':utf8');
+
use POSIX qw(strftime nice);
use Debbugs::Config qw(:globals :text :config);
# 2: test encode
-ok(Debbugs::MIME::decode_rfc1522(Debbugs::MIME::encode_rfc1522($test_str)) eq $test_str,
+ok(Debbugs::MIME::decode_rfc1522(Debbugs::MIME::encode_rfc1522($test_str)) eq encode_utf8($test_str),
"encode_rfc1522 encodes strings that decode_rfc1522 can decode");
-ok(Debbugs::MIME::decode_rfc1522(Debbugs::MIME::encode_rfc1522($test_str2)) eq $test_str2,
+ok(Debbugs::MIME::decode_rfc1522(Debbugs::MIME::encode_rfc1522($test_str2)) eq encode_utf8($test_str2),
"encode_rfc1522 encodes strings that decode_rfc1522 can decode");
-ok(Debbugs::MIME::decode_rfc1522(Debbugs::MIME::encode_rfc1522($test_str3)) eq $test_str3,
+ok(Debbugs::MIME::decode_rfc1522(Debbugs::MIME::encode_rfc1522($test_str3)) eq encode_utf8($test_str3),
"encode_rfc1522 properly handles parentesis and \"");
--- /dev/null
+# -*- mode: cperl;-*-
+
+use Test::More tests => 2;
+use Encode qw(decode_utf8);
+
+use_ok('Debbugs::Common');
+is_deeply(Debbugs::Common::encode_utf8_structure(
+ {a => decode_utf8('föö'),
+ b => [map {decode_utf8($_)} qw(blëh bl♥h)],
+ }),
+ {a => 'föö',
+ b => [qw(blëh bl♥h)],
+ },
+ );
use UNIVERSAL;
use Debbugs::MIME qw(decode_rfc1522);
+use Encode qw(encode_utf8);
use_ok('Debbugs::Mail');
END
# 1: test decode
-ok(decode_rfc1522(Debbugs::Mail::encode_headers($test_str)) eq $test_str);
+ok(decode_rfc1522(Debbugs::Mail::encode_headers($test_str)) eq encode_utf8($test_str));
# XXX Figure out a good way to test the send message bit of
# Debbugs::Mail
projects / debbugs.git / commitdiff