File Coverage

blib/lib/Keyword/Pluggable.pm

Criterion	Covered	Total	%
statement	50	55	90.9
branch	10	16	62.5
condition	2	4	50.0
subroutine	13	13	100.0
pod	2	2	100.0
total	77	90	85.5

package Keyword::Pluggable;

use v5.14.0;
use warnings;
our %kw;

use Carp qw(croak);

use XSLoader;
BEGIN {
	our $VERSION = '1.02';
	XSLoader::load __PACKAGE__, $VERSION;
}

sub define {
	my %p = @_;
	my ($kw, $sub, $expression, $global, $package) = @p{qw(keyword code expression global package)};
	$kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier";
	defined($sub) or croak "'code' is not defined";

	my $xsub = (ref($sub) eq 'CODE') ?
		sub { substr ${$_[0]}, 0, 0, $sub->(${$_[0]}) } :
		sub { substr ${$_[0]}, 0, 0, $sub };

	my $entry = [ $xsub, !!$expression ];

	if ( defined $package) {
		no strict 'refs';
		my $keywords = \%{$package . '::/keywords' };
		$keywords->{$kw} = $entry;
	} elsif ( $global ) {
		define_global($kw, $entry);
	} else {
		my %keywords = %{$^H{+HINTK_KEYWORDS} // {}};
		$keywords{$kw} = $entry;
		$^H{+HINTK_KEYWORDS} = \%keywords;
	}
}

sub undefine {
	my %p = @_;
	my ($kw, $global, $package) = @p{qw(keyword global package)};
	$kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier";

	if ( defined $package ) {
		no strict 'refs';
		my $keywords = \%{$package . '::/keywords' };
		delete $keywords->{$kw};
	} elsif ( $global ) {
		undefine_global($kw);
	} else {
		my %keywords = %{$^H{+HINTK_KEYWORDS} // {}};
		delete $keywords{$kw};
		$^H{+HINTK_KEYWORDS} = \%keywords;
	}
}

END { cleanup() }

'ok'

__END__