view release on metacpan or  search on metacpan

lib/MooX/Pression.pm  view on Meta::CPAN

	elsif ($#orig_lines < $#new_lines) {
		$owed += ($#new_lines - $#orig_lines);
	}
	
	substr $$ref, 0, $trim_length, $new_code;
}

#
# KEYWORDS/UTILITIES
#

my @EXPORTABLES = qw(
	-booleans
	-privacy
	-utils
	-types
	-is
	-assert
	-features
	try
	class abstract role interface
	include toolkit begin end extends with requires
	has constant method multi factory before after around
	type_name coerce
	version authority overload
);

sub import {
	no warnings 'closure';
	my ($me, %opts) = (shift, @_);
	my $caller = ($opts{caller} ||= caller);
	
	# Need to reproduce this logic from MooX::Press to find out
	# the name of the type library.
	#
	require MooX::Press;
	$opts{prefix}           = $opts{caller} unless exists $opts{prefix};
	$opts{factory_package}  = $opts{prefix} unless exists $opts{factory_package};
	$opts{type_library}     = 'Types'       unless exists $opts{type_library};
	$opts{type_library}     = 'MooX::Press'->qualify_name($opts{type_library}, $opts{prefix});
	
	my %want = map +($_ => 1), @{ $opts{keywords} || \@EXPORTABLES };
	
	# Optionally export wrapper subs for pre-declared types
	#
	if ($opts{declare}) {
		my $types = $opts{type_library};
		for my $name (@{ $opts{declare} }) {
			eval qq{
				sub $caller\::$name         ()   { goto \\&$types\::$name }
				sub $caller\::is_$name      (\$) { goto \\&$types\::is_$name }
				sub $caller\::assert_$name  (\$) { goto \\&$types\::assert_$name }
				1;
			} or die($@);
		}
	}
	
	# Export utility stuff
	#
	MooX::Pression::_Gather->import::into($caller, -gather => %opts);
	strict->import::into($caller);
	warnings->import::into($caller);
	MooX::Press::Keywords->import::into($caller, $_)
		for grep $want{$_}, qw(-booleans -privacy -util);
	Syntax::Keyword::Try->import::into($caller) if $want{try};
	if ($] >= 5.018) {
		feature->import::into($caller, qw( say state unicode_strings unicode_eval evalbytes current_sub fc ))
			if $want{-features};
	}
	elsif ($] >= 5.014) {
		feature->import::into($caller, qw( say state unicode_strings ))
			if $want{-features};
	}
	for my $library (qw/ Types::Standard Types::Common::Numeric Types::Common::String /) {
		$library->import::into($caller, $_)
			for grep $want{$_}, qw( -types -is -assert );
	}
	
	# `include` keyword
	#
	Keyword::Simple::define include => sub {
		my $ref = shift;
		
		$$ref =~ _fetch_re('MxpIncludeSyntax', anchor => 'start') or $me->_syntax_error(
			'include directive',
			'include <name>',
			$ref,
		);
		
		my ($pos, $name) = ($+[0], $+{name});
		my $qualified = 'MooX::Press'->qualify_name($name, $opts{prefix});
		$me->_inject($ref, $pos, sprintf('BEGIN { eval(q[%s]->_include(%s)) or die($@) };', $me, B::perlstring($qualified)));
	} if $want{include};

	# `class` keyword
	#
	Keyword::Simple::define class => sub {
		my $ref = shift;
		
		$$ref =~ _fetch_re('MxpClassSyntax', anchor => 'start') or $me->_syntax_error(
			'class declaration',
			'class <name> (<signature>) { <block> }',
			'class <name> { <block> }',
			'class <name>',
			'class (<signature>) { <block> }',
			'class { <block> }',
			'class;',
			$ref,
		);
		
		my ($pos, $plus, $name, $sig, $block) = ($+[0], $+{plus}, $+{name}, $+{sig}, $+{block});
		my $has_sig = !!exists $+{sig};
		$plus  ||= '';
		$block ||= '{}';
		
		$me->_inject($ref, $pos, "\n#\n#\n#\n#\n".$me->_handle_package_keyword(class => $name, $block, $has_sig, $sig, $plus, \%opts), 1);
	} if $want{class};

	Keyword::Simple::define abstract => sub {
		my $ref = shift;