File Coverage

blib/lib/uni/perl.pm

Criterion	Covered	Total	%
statement	67	67	100.0
branch	5	8	62.5
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	80	83	96.3

package uni::perl;

our $VERSION = '0.92';

BEGIN {
	defined ${^WARNING_BITS}
		?	${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\xfc\x3f\xf3\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x03\x3f\x00\xc0"
		:	${^WARNING_BITS} = "\xfc\x3f\xf3\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x03\x3f\x00\xc0";
	$^H |= 0x1c8e0ee2;

}
m{
use strict;
use warnings;
}x;
use mro ();

# paste this into perl to find bitmask

# no warnings;
# use warnings qw(FATAL closed threads internal debugging pack substr malloc unopened portable prototype
#                 inplace io pipe unpack regexp deprecated exiting glob digit printf
#                 utf8 layer reserved parenthesis taint closure semicolon);
# no warnings qw(exec newline);
# BEGIN { warn join "", map "\\x$_", unpack "(H2)*", ${^WARNING_BITS}; exit 0 };

BEGIN {
	for my $sub (qw(carp croak confess)) {
		no strict 'refs';
		*$sub = sub {
			my $caller = caller;
			local *__ANON__ = $caller .'::'. $sub;
			require Carp;
			*{ $caller.'::'.$sub } = \&{ 'Carp::'.$sub };
			goto &{ 'Carp::'.$sub };
		};
	}
}

sub import {
	my $me = shift;
	my $caller = caller;
	local $^W;
	# use warnings
	${^WARNING_BITS} ^= ${^WARNING_BITS} ^ "\xfc\x3f\xf3\x00\x0f\xf3\xcf\xc0\xf3\xfc\x33\x03\x3f\x00\xc0";

	# use strict, utf8, open, 5.010, ...
	$^H |= 0x1c8e0ee2;

	# use feature qw(feature_switch feature_unicode open> feature_state feature_arybase feature_say open<)
	$^H{'feature_switch'} = 1;
	$^H{'feature_unicode'} = 1;
	$^H{'open>'} = ":utf8";
	$^H{'feature_state'} = 1;
	$^H{'feature_arybase'} = 1;
	$^H{'feature_say'} = 1;
	$^H{'open<'} = ":utf8";

	# use mro 'c3';
	mro::set_mro($caller, 'c3');

	#use open (:utf8 :std);
	${^OPEN} = ":utf8\0:utf8";
	binmode(STDIN,   ":utf8");
	binmode(STDOUT,  ":utf8");
	binmode(STDERR,  ":utf8");

	for my $sub (qw(carp croak confess)) {
		no strict 'refs';
		*{ $caller .'::'. $sub } = \&$sub;
	}
	return if $caller =~ /^$me/;
	while (@_) {
		my $feature = shift;
		if ($feature =~ s/^://) {
			my $package = $me. '::'. $feature;
			eval "require $package; 1" or croak( "$@" );
			$package->load( $caller );
		}
	}
	require uni::perl::utf;
	uni::perl::utf->load($caller);
	return;
}

sub unimport {
	my $me = shift;
	my $caller = caller;
	# no warnings
	${^WARNING_BITS} = "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00";

	# no strict, utf8, open, 5.010, ...
	$^H &= ~0x1c8e0ee2;

	# no feature qw(feature_switch feature_unicode open> feature_state feature_arybase feature_say open<)
	delete $^H{'feature_switch'};
	delete $^H{'feature_unicode'};
	delete $^H{'open>'};
	delete $^H{'feature_state'};
	delete $^H{'feature_arybase'};
	delete $^H{'feature_say'};
	delete $^H{'open<'};

	${^OPEN} = ":raw\0:raw";
	binmode(STDIN,   ":raw");
	binmode(STDOUT,  ":raw");
	binmode(STDERR,  ":raw");
	return;
}

1;

__END__