File Coverage

blib/lib/Unicode/Debug.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	10	14	71.4
condition	2	3	66.6
subroutine	9	9	100.0
pod	1	1	100.0
total	58	63	92.0

package Unicode::Debug;

use 5.008001;
use strict;
use warnings;
use charnames ':full';
use utf8;

BEGIN
{
	$Unicode::Debug::AUTHORITY = 'cpan:TOBYINK';
	$Unicode::Debug::VERSION   = '0.002';
}

use Exporter ();
our @ISA         = qw( Exporter );
our @EXPORT      = qw( unidebug );
our @EXPORT_OK   = ( @EXPORT, qw(unidecode) );
our %EXPORT_TAGS = (
	default  => \@EXPORT,
	standard => \@EXPORT,
	all      => \@EXPORT_OK,
	nothing  => [],
);

our $Whitespace = 0;
our $Names      = 0;

sub unidecode
{
	unless (defined wantarray)
	{
		s/(\r\n|[^\x20-\x7F])/_char($1)/eg for @_;
		return;
	}

	my @str = map {
		(my $str = $_) =~ s/(\r\n|\\|[^\x20-\x7F])/_char($1)/eg;
		$str;
	} (wantarray ? @_ : $_[0]);

	wantarray ? @str : $str[0];
}

my %wschars = (
	"\r\n" => "\\r\\n\n",
	"\r"   => "\\r\n",
	"\n"   => "\\n\n",
	"\t"   => "\\t",
);

sub _char
{
	return $Whitespace ? $wschars{$_[0]} : $_[0]
		if exists $wschars{$_[0]};

	my $chr = shift;
	my $ord = ord $chr;

	return "\\\\" if $chr eq "\\";

	if ($Names and my $name = charnames::viacode($ord))
	{
		return sprintf('\N{%s}', $name);
	}

	sprintf('\x{%04x}', $ord);
}

*unidebug = \&unidecode;

require PerlIO::via::UnicodeDebug;

__PACKAGE__
__END__