view release on metacpan or  search on metacpan

lib/builtins/compat.pm  view on Meta::CPAN

use 5.008001;
use strict;
use warnings;

package builtins::compat;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.004';

sub _true () {
	!!1;
}

sub _false () {
	!!0;
}

BEGIN {
	# uncoverable statement
	*LEGACY_PERL = ( $] lt '5.036' ) ? \&_true : \&_false;
};

our %EXPORT_TAGS = (
	'5.36' => [ qw<
		true     false    is_bool
		weaken   unweaken is_weak
		blessed  refaddr  reftype
		created_as_string created_as_number
		ceil     floor    trim     indexed
	> ],
	'bool' => [ qw< true false is_bool > ],
);

sub parse_args {
	my $class = shift;
	my @args  = @_ ? @_ : ':5.36';

	my $want  = {};
	for my $arg ( @args ) {
		if ( $arg =~ /^:(.+)/ ) {
			my $tag = $1;
			if ( not exists $EXPORT_TAGS{$tag} ) {
				require Carp;
				Carp::carp( qq["$tag" is not defined in $class\::EXPORT_TAGS] );
			}
			$want->{$_} = 1 for @{ $EXPORT_TAGS{$tag} or [] };
		}
		elsif ( $arg =~ /^\!(.+)/ ) {
			my $unwanted = $1;
			delete $want->{$_};
		}
		else {
			$want->{$arg} = 1;
		}
	}

	return $want;
}

sub import {
	goto \&import_compat if LEGACY_PERL;

	my $class = shift;
	my %want  = %{ $class->parse_args( @_ ) };

	# uncoverable statement
	'warnings'->unimport( 'experimental::builtin' );

	# uncoverable statement
	'builtin'->import( keys %want );
}

sub import_compat {
	my $class = shift;

	my $caller = caller;
	my $subs   = $class->get_subs;
	my %want   = %{ $class->parse_args( @_ ) };

	for my $name ( sort keys %want ) {