Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Introduce new Encode check flag Encode::ONLY_PRAGMA_WARNINGS #134

Merged
merged 7 commits into from
Jun 28, 2018
Merged

Introduce new Encode check flag Encode::ONLY_PRAGMA_WARNINGS #134

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
a474ad9
Encode: Add new check flag Encode::ONLY_PRAGMA_WARNINGS
pali Jul 1, 2017
3e0101d
Rewrite encode, decode, encode_utf8, decode_utf8 and from_to function…
pali Sep 12, 2017
30082bd
Add compile check that SV_NOSTEAL does not cause memory corruptions
pali Jun 16, 2018
7303cc7
encengine.c: Fix typo in comment
khwilliamson May 28, 2018
cb36f73
Include 5.28 core UTF8 to/from U32/U64 functions
khwilliamson May 25, 2018
5e2183a
Define missing macros and functions for older Perl versions
pali Jun 16, 2018
d4692cf
Update documentation for ENCODE::ONLY_PRAGMA_WARNINGS
pali Jun 28, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
135 changes: 7 additions & 128 deletions Encode.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ BEGIN {

use Exporter 5.57 'import';

use Carp ();
our @CARP_NOT = qw(Encode::Encoder);

# Public, encouraged API is exported by default
Expand Down Expand Up @@ -170,134 +171,6 @@ sub clone_encoding($) {
return Storable::dclone($obj);
}

sub encode($$;$) {
my ( $name, $string, $check ) = @_;
return undef unless defined $string;
$string .= ''; # stringify;
$check ||= 0;
unless ( defined $name ) {
require Carp;
Carp::croak("Encoding name should not be undef");
}
my $enc = find_encoding($name);
unless ( defined $enc ) {
require Carp;
Carp::croak("Unknown encoding '$name'");
}
# For Unicode, warnings need to be caught and re-issued at this level
# so that callers can disable utf8 warnings lexically.
my $octets;
if ( ref($enc) eq 'Encode::Unicode' ) {
my $warn = '';
{
local $SIG{__WARN__} = sub { $warn = shift };
$octets = $enc->encode( $string, $check );
}
warnings::warnif('utf8', $warn) if length $warn;
}
else {
$octets = $enc->encode( $string, $check );
}
$_[1] = $string if $check and !ref $check and !( $check & LEAVE_SRC );
return $octets;
}
*str2bytes = \&encode;

sub decode($$;$) {
my ( $name, $octets, $check ) = @_;
return undef unless defined $octets;
$octets .= '';
$check ||= 0;
my $enc = find_encoding($name);
unless ( defined $enc ) {
require Carp;
Carp::croak("Unknown encoding '$name'");
}
# For Unicode, warnings need to be caught and re-issued at this level
# so that callers can disable utf8 warnings lexically.
my $string;
if ( ref($enc) eq 'Encode::Unicode' ) {
my $warn = '';
{
local $SIG{__WARN__} = sub { $warn = shift };
$string = $enc->decode( $octets, $check );
}
warnings::warnif('utf8', $warn) if length $warn;
}
else {
$string = $enc->decode( $octets, $check );
}
$_[1] = $octets if $check and !ref $check and !( $check & LEAVE_SRC );
return $string;
}
*bytes2str = \&decode;

sub from_to($$$;$) {
my ( $string, $from, $to, $check ) = @_;
return undef unless defined $string;
$check ||= 0;
my $f = find_encoding($from);
unless ( defined $f ) {
require Carp;
Carp::croak("Unknown encoding '$from'");
}
my $t = find_encoding($to);
unless ( defined $t ) {
require Carp;
Carp::croak("Unknown encoding '$to'");
}

# For Unicode, warnings need to be caught and re-issued at this level
# so that callers can disable utf8 warnings lexically.
my $uni;
if ( ref($f) eq 'Encode::Unicode' ) {
my $warn = '';
{
local $SIG{__WARN__} = sub { $warn = shift };
$uni = $f->decode($string);
}
warnings::warnif('utf8', $warn) if length $warn;
}
else {
$uni = $f->decode($string);
}

if ( ref($t) eq 'Encode::Unicode' ) {
my $warn = '';
{
local $SIG{__WARN__} = sub { $warn = shift };
$_[0] = $string = $t->encode( $uni, $check );
}
warnings::warnif('utf8', $warn) if length $warn;
}
else {
$_[0] = $string = $t->encode( $uni, $check );
}

return undef if ( $check && length($uni) );
return defined( $_[0] ) ? length($string) : undef;
}

sub encode_utf8($) {
my ($str) = @_;
return undef unless defined $str;
utf8::encode($str);
return $str;
}

my $utf8enc;

sub decode_utf8($;$) {
my ( $octets, $check ) = @_;
return undef unless defined $octets;
$octets .= '';
$check ||= 0;
$utf8enc ||= find_encoding('utf8');
my $string = $utf8enc->decode( $octets, $check );
$_[0] = $octets if $check and !ref $check and !( $check & LEAVE_SRC );
return $string;
}

onBOOT;

if ($ON_EBCDIC) {
Expand Down Expand Up @@ -824,6 +697,12 @@ code to do exactly that:
This is the same as C<FB_QUIET> above, except that instead of being silent
on errors, it issues a warning. This is handy for when you are debugging.

B<CAVEAT>: All warnings from Encode module are reported, independently of
L<pragma warnings|warnings> settings. If you want to follow settings of
lexical warnings configured by L<pragma warnings|warnings> then append
also check value C<ENCODE::ONLY_PRAGMA_WARNINGS>. This value is available
since Encode version 2.99.

=head3 FB_PERLQQ FB_HTMLCREF FB_XMLCREF

=over 2
Expand Down
Loading