# Revision history for Perl extension Encode.
#
-# $Id: Changes,v 1.65 2002/04/30 16:13:37 dankogai Exp dankogai $
+# $Id: Changes,v 1.66 2002/05/01 05:41:06 dankogai Exp dankogai $
#
-$Revision: 1.65 $ $Date: 2002/04/30 16:13:37 $
+$Revision: 1.66 $ $Date: 2002/05/01 05:41:06 $
+! Encode.xs t/fallback.t
+ WARN_ON_ERR no longer assumes RETURN_ON_ERR so you can issue a warning
+ while fallback is in effect. This even came with a welcome side-effect
+ of cleaner code with less nests! Thank you, NI-XS. t/fallback.t is
+ also modified to test this.
+ And of course, the corresponding varialbles to UV[Xx]f are appropriately
+ cast. This should've concluded NI-XS homework.
+! Encode.pm
+ encode(undef) does warn again! Repented upon suggestion by NI-XS.
+ Document for unless vs. '' added
+ Message-Id: <20020430171547.3322.13@bactrian.elixent.com>
+
+1.65 2002/04/30 16:13:37
! Encode.pm
encode(undef) no longer warns for C<Use of uninitialized value in
subroutine entry>. Suggested by Paul.
Typo fixes and improvements by jhi
Message-Id: <200204010201.FAA03564@alpha.hut.fi>, et al.
-1.11 $Date: 2002/04/30 16:13:37 $
+1.11 $Date: 2002/05/01 05:41:06 $
+ t/encoding.t
+ t/jperl.t
! MANIFEST
#
-# $Id: Encode.pm,v 1.65 2002/04/30 16:13:37 dankogai Exp dankogai $
+# $Id: Encode.pm,v 1.66 2002/05/01 05:41:06 dankogai Exp dankogai $
#
package Encode;
use strict;
-our $VERSION = do { my @r = (q$Revision: 1.65 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+our $VERSION = do { my @r = (q$Revision: 1.66 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
our $DEBUG = 0;
use XSLoader ();
XSLoader::load(__PACKAGE__, $VERSION);
sub encode($$;$)
{
my ($name, $string, $check) = @_;
- defined $string or return;
$check ||=0;
my $enc = find_encoding($name);
unless(defined $enc){
sub decode($$;$)
{
my ($name,$octets,$check) = @_;
- defined $octets or return;
$check ||=0;
my $enc = find_encoding($name);
unless(defined $enc){
sub from_to($$$;$)
{
my ($string,$from,$to,$check) = @_;
- defined $string or return;
$check ||=0;
my $f = find_encoding($from);
unless (defined $f){
sub encode_utf8($)
{
my ($str) = @_;
- defined $str or return;
utf8::encode($str);
return $str;
}
sub decode_utf8($)
{
my ($str) = @_;
- defined $str or return;
return undef unless utf8::decode($str);
return $str;
}
the result is always off, even when it contains completely valid utf8
string. See L</"The UTF-8 flag"> below.
+encode($valid_encoding, undef) is harmless but warns you for
+C<Use of uninitialized value in subroutine entry>.
+encode($valid_encoding, '') is harmless and warnless.
+
=item $string = decode(ENCODING, $octets [, CHECK])
Decodes a sequence of octets assumed to be in I<ENCODING> into Perl's
ASCII data (or EBCDIC on EBCDIC machines). See L</"The UTF-8 flag">
below.
+decode($valid_encoding, undef) is harmless but warns you for
+C<Use of uninitialized value in subroutine entry>.
+decode($valid_encoding, '') is harmless and warnless.
+
=item [$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK])
Converts B<in-place> data between two encodings. The data in $octets
FB_DEFAULT FB_CROAK FB_QUIET FB_WARN FB_PERLQQ
DIE_ON_ERR 0x0001 X
- WARN_ON_ER 0x0002 X
+ WARN_ON_ERR 0x0002 X
RETURN_ON_ERR 0x0004 X X
LEAVE_SRC 0x0008
PERLQQ 0x0100 X
/*
- $Id: Encode.xs,v 1.42 2002/04/29 06:54:06 dankogai Exp $
+ $Id: Encode.xs,v 1.43 2002/05/01 05:41:06 dankogai Exp dankogai $
*/
#define PERL_NO_GET_CONTEXT
&clen, UTF8_ALLOW_ANY|UTF8_CHECK_ONLY);
if (check & ENCODE_DIE_ON_ERR) {
Perl_croak(
- aTHX_ "\"\\N{U+%" UVxf "}\" does not map to %s, %d",
- ch, enc->name[0], __LINE__);
- }else{
- if (check & ENCODE_RETURN_ON_ERR){
- if (check & ENCODE_WARN_ON_ERR){
- Perl_warner(
- aTHX_ packWARN(WARN_UTF8),
+ aTHX_ "\"\\N{U+%" UVxf "}\" does not map to %s",
+ (UV)ch, enc->name[0]);
+ return &PL_sv_undef; /* never reaches but be safe */
+ }
+ if (check & ENCODE_WARN_ON_ERR){
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
"\"\\N{U+%" UVxf "}\" does not map to %s",
- ch,enc->name[0]);
- }
- goto ENCODE_SET_SRC;
- }else if (check & ENCODE_PERLQQ){
- SV* perlqq =
- sv_2mortal(newSVpvf("\\x{%04"UVxf"}", ch));
- sdone += slen + clen;
- ddone += dlen + SvCUR(perlqq);
- sv_catsv(dst, perlqq);
- }else if (check & ENCODE_HTMLCREF){
- SV* htmlcref =
- sv_2mortal(newSVpvf("&#%" UVuf ";", ch));
- sdone += slen + clen;
- ddone += dlen + SvCUR(htmlcref);
- sv_catsv(dst, htmlcref);
- }else if (check & ENCODE_XMLCREF){
- SV* xmlcref =
- sv_2mortal(newSVpvf("&#x%" UVxf ";", ch));
- sdone += slen + clen;
- ddone += dlen + SvCUR(xmlcref);
- sv_catsv(dst, xmlcref);
- } else {
- /* fallback char */
- sdone += slen + clen;
- ddone += dlen + enc->replen;
- sv_catpvn(dst, (char*)enc->rep, enc->replen);
- }
+ (UV)ch, enc->name[0]);
+ }
+ if (check & ENCODE_RETURN_ON_ERR){
+ goto ENCODE_SET_SRC;
+ }
+ if (check & ENCODE_PERLQQ){
+ SV* perlqq =
+ sv_2mortal(newSVpvf("\\x{%04"UVxf"}", (UV)ch));
+ sdone += slen + clen;
+ ddone += dlen + SvCUR(perlqq);
+ sv_catsv(dst, perlqq);
+ }else if (check & ENCODE_HTMLCREF){
+ SV* htmlcref =
+ sv_2mortal(newSVpvf("&#%" UVuf ";", (UV)ch));
+ sdone += slen + clen;
+ ddone += dlen + SvCUR(htmlcref);
+ sv_catsv(dst, htmlcref);
+ }else if (check & ENCODE_XMLCREF){
+ SV* xmlcref =
+ sv_2mortal(newSVpvf("&#x%" UVxf ";", (UV)ch));
+ sdone += slen + clen;
+ ddone += dlen + SvCUR(xmlcref);
+ sv_catsv(dst, xmlcref);
+ } else {
+ /* fallback char */
+ sdone += slen + clen;
+ ddone += dlen + enc->replen;
+ sv_catpvn(dst, (char*)enc->rep, enc->replen);
}
}
/* decoding */
else {
if (check & ENCODE_DIE_ON_ERR){
Perl_croak(
- aTHX_ "%s \"\\x%02" UVXf
+ aTHX_ "%s \"\\x%02" UVXf
"\" does not map to Unicode (%d)",
- enc->name[0], (U8) s[slen], code);
- }else{
- if (check & ENCODE_RETURN_ON_ERR){
- if (check & ENCODE_WARN_ON_ERR){
- Perl_warner(
- aTHX_ packWARN(WARN_UTF8),
- "%s \"\\x%02" UVXf
- "\" does not map to Unicode (%d)",
- enc->name[0], (U8) s[slen], code);
- }
- goto ENCODE_SET_SRC;
- }else if (check &
- (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
- SV* perlqq =
- sv_2mortal(newSVpvf("\\x%02" UVXf, s[slen]));
- sdone += slen + 1;
- ddone += dlen + SvCUR(perlqq);
- sv_catsv(dst, perlqq);
- } else {
- sdone += slen + 1;
- ddone += dlen + strlen(FBCHAR_UTF8);
- sv_catpv(dst, FBCHAR_UTF8);
- }
+ (UV)enc->name[0], (U8)s[slen], code);
+ return &PL_sv_undef; /* never reaches but be safe */
+ }
+ if (check & ENCODE_WARN_ON_ERR){
+ Perl_warner(
+ aTHX_ packWARN(WARN_UTF8),
+ "%s \"\\x%02" UVXf
+ "\" does not map to Unicode (%d)",
+ (UV)enc->name[0], (U8)s[slen], code);
+ }
+ if (check & ENCODE_RETURN_ON_ERR){
+ goto ENCODE_SET_SRC;
+ }
+ if (check &
+ (ENCODE_PERLQQ|ENCODE_HTMLCREF|ENCODE_XMLCREF)){
+ SV* perlqq =
+ sv_2mortal(newSVpvf("\\x%02" UVXf, (UV)s[slen]));
+ sdone += slen + 1;
+ ddone += dlen + SvCUR(perlqq);
+ sv_catsv(dst, perlqq);
+ } else {
+ sdone += slen + 1;
+ ddone += dlen + strlen(FBCHAR_UTF8);
+ sv_catpv(dst, FBCHAR_UTF8);
}
}
/* settle variables when fallback */
use strict;
#use Test::More qw(no_plan);
-use Test::More tests => 19;
+use Test::More tests => 22;
use Encode q(:all);
-
my $original = '';
my $nofallback = '';
my ($fallenback, $quiet, $perlqq, $htmlcref, $xmlcref);
is($dst, $quiet, "FB_WARN");
is($src, $residue, "FB_WARN residue");
like($message, qr/does not map to ascii/o, "FB_WARN message");
+
+ $message = '';
+
+ $src = $original;
+ $dst = $meth->encode($src, WARN_ON_ERR);
+
+ is($dst, $fallenback, "WARN_ON_ERR");
+ is($src, '', "WARN_ON_ERR residue");
+ like($message, qr/does not map to ascii/o, "WARN_ON_ERR message");
}
$src = $original;
projects / p5sagit/p5-mst-13.2.git / commitdiff