Carrot

 view release on metacpan or  search on metacpan

lib/Carrot/Diversity/Block_Modifiers/Monad/Source_Code.pm  view on Meta::CPAN

# /effect ""
# //parameters
#	block_id
# //returns
{
	my ($this, $block_id) = @ARGUMENTS;

	unless ($$this =~ s{
		(?:\012|\015\012?)(\h*)\#--8<--\ \w+-$block_id-head\ -->8--\#
		.*
		(?:\012|\015\012?)\g{1}(?:\}|;)\ \#--8<--\ \w+-$block_id-(?:open)?close\ -->8--\#
	}{}sx) {

		require Data::Dumper;
		print(STDERR Data::Dumper::Dumper($this));

		$translated_errors->advocate(
			'block_not_found',
			[$block_id]);
	}
	return;

lib/Carrot/Diversity/Block_Modifiers/Plugin/Package/Attribute_Construction.pm  view on Meta::CPAN

			push($ready_made, "\t\$this->superseded;");
			next;
		}
		$value //= '';

		my $atr_name = 'ATR_'.uc($name);
		if ($value =~ m{\((\d+)\)}saa)
		{
			push($ready_made, "\t\$this->[$atr_name] = \$_[$1];");

		} elsif ($value =~ m{\A('|")(.*)\g{1}\z}saa)
		{
			push($ready_made, "\t\$this->[$atr_name] = q{$2};");

		} elsif ($value =~ m{\A(\d+)\z}saa)
		{
			#FIXME: re_number would be better
			push($ready_made, "\t\$this->[$atr_name] = $1;");

		} elsif ($value =~ m{\A([A-Z]+_[A-Z_]+)\z}saa)
		{

lib/Carrot/Diversity/English/Regular_Expression.pm  view on Meta::CPAN

		'NON_WORD_BOUNDARY' => '\B',

		'NO_BACKREFERENCE' => '?:',
		'BRANCH_RESET' => '?|',
		'POSITIVE_LOOK_AHEAD' => '?=',
		'NEGATIVE_LOOK_AHEAD' => '?!',
		'POSITIVE_LOOK_BEHIND' => '?<=',
		'NEGATIVE_LOOK_BEHIND' => '?<!',
#		'' => '',

		'FIRST_BACKREFERENCE' => '\g{1}',
		'SECOND_BACKREFERENCE' => '\g{2}',
		'THIRD_BACKREFERENCE' => '\g{3}',

		'MULTIPLE_LINES_MODIFIER' => 'm',
		'SINGLE_LINE_MODIFIER' => 's',
		'IGNORE_CASE_MODIFIER' => 'i',
		'RELAXED_WHITESPACE_MODIFIER' => 'x',
		'PRESERVE_MATCH_MODIFIER' => 'p',
		'LOCALE_MODIFIER' => 'l',
		'UNICODE_MODIFIER' => 'u',
		'SAFE_UNICODE_MODIFIER' => 'a',
		'SAFER_UNICODE_MODIFIER' => 'aa',

lib/Carrot/Diversity/Include_Block.pm  view on Meta::CPAN

# //parameters
#	meta_monad  ::Meta::Monad::Phase::Prepare
#	source_code
# //returns
{
	my ($this, $meta_monad, $source_code) = @ARGUMENTS;

	$$source_code =~ s{
		(?:\012|\015\012?)(\h+)PREPARE\h+\{(?:\012|\015\012?)
		((?:\h+[^\012\015]+(?:\012|\015\012?))+)
		\g{1}\}
	}{
		${$this->translate_code($meta_monad, $2)}
	}sxe;

	return;
}

sub translate_code
# /type method
# /effect ""

lib/Carrot/Meta/Greenhouse/Carrot_Arguments.pm  view on Meta::CPAN

	use strict;
	use warnings 'FATAL' => 'all';

	BEGIN {
		require('Carrot/Meta/Greenhouse/Carrot_Arguments./manual_modularity.pl');
	} #BEGIN

	my $THIS = bless({'carrot-mode' => 'default'}, __PACKAGE__);
	foreach my $argument (splice(\@PROGRAM_ARGUMENTS))
	{
		if ($argument =~ m{\A--(carrot-[\w\-]+)=(\"|\'|)(.*?)\g{2}\z}s)
		{
			$THIS->{$1} = $3;
		} else {
			push(\@PROGRAM_ARGUMENTS, $argument);
		}
	}
	Internals::hv_clear_placeholders(%$THIS);
        Internals::SvREADONLY(%$THIS, 1);

# =--------------------------------------------------------------------------= #

lib/Carrot/Meta/Monad/Phase/Prepare.pm  view on Meta::CPAN

		$source_code->add_individuality_markers;

	} else {
		$source_code->add_individuality_after_end;
	}

	#NOTE: the following is manual diversity
	if ($$source_code =~ s{
			(?:\012|\015\012?)(\h+)PREPARE\h+\{(?:\012|\015\012?)
			((?:\h+[^\012\015]+(?:\012|\015\012?))+?)
			\g{1}\}\ \#PREPARE
		}
		{}sx)
	{
		my $block_code = $2;
		$block_code =~ s
			{Carrot::diversity\h+;}
			{\$this;}s;
		# the code might modify $_[SPX_PKG_FILE]
		#FIXME: access to $source_code too much?
		eval $block_code;

lib/Carrot/Modularity/Package/Shadow.pm  view on Meta::CPAN

	$buffer =~ s{
		(?:\012|\015\012?)\#(?:[\ \t]+)PREPARE\ \{
		.*\}\ \#PREPARE\s*}{}sx;

	$buffer =~ s{\ *\#--8<--\ \w+-[\w\:]+-\w+\ -->8--\#}{}sgx;
#	$buffer =~ s{
#		(?:\012|\015\012?)\h+use\h+strict;}{}sx;
	my $modified = ($buffer =~ s{
		(?:\012|\015\012?)\h+(END)\h+\{\h+\#(\d+)
		.*
		(?:\012|\015\012?)\h+\}\h+\#\g{1}-\g{2}}{\n}sgx);
	unless ($modified == 1)
	{
		die("Could not remove end block in '$pkg_file'.");
	}
	$buffer =~ s{#--8<-- carrot-(modularity|individuality)-(start|end) -->8--#}{}saag;

	$file_content->overwrite_from($shadow_pkg, $buffer);
	$writable_overlay->remove($pkg_file);

	return;