File Coverage

blib/lib/usw.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	4	6	66.6
condition	2	5	40.0
subroutine	8	8	100.0
pod			n/a
total	42	47	89.3

package usw;
use 5.012005;
use parent qw(utf8 strict warnings);
use Encode qw(is_utf8 encode_utf8 decode_utf8);

our $VERSION = "0.12";
my $enc;
sub _get_encoding {$enc}

sub import {
    $_->import for qw( utf8 strict warnings );   # borrowed from https://metacpan.org/pod/Mojo::Base
    require encoding;
    my $cp = encoding::_get_locale_encoding();    # borrowed from https://metacpan.org/pod/open
    $enc = $cp =~ /^utf-?8/i ? 'UTF-8' : $cp;
    $enc ||= ( split /\./, $ENV{LANG} )[-1];      # Cannot find encoding in some environment

    if ($enc) {
        $| = 1;
        binmode \*STDIN  => ":encoding($enc)";
        binmode \*STDOUT => ":encoding($enc)";
        binmode \*STDERR => ":encoding($enc)";
    }

    $SIG{__WARN__} = \&_redecode;
    $SIG{__DIE__}  = sub { die _redecode(@_) };
    return;
}

sub unimport {
    require Carp;
    Carp::croak "$_[0] doesn't provide `no` pragma";
}

sub _redecode {
    $_[0] =~ /^(.+) at (.+) line (\d+)\.$/;
    my @texts = split $2, $_[0];
    return is_utf8($1)
        ? $texts[0] || '' . decode_utf8($2) . $texts[1] || ''
        : decode_utf8 $_[0];
}

1;

__END__