view release on metacpan or  search on metacpan

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

sub modify_block_code
# /type method
# /effect ""
# //parameters
#	block_id
#	target
# //returns
{
	my ($this, $block_id, $target) = @ARGUMENTS;

	unless ($$this =~ s{
		(?:\012|\015\012?)\#--8<--\ \w+-$block_id-head\ -->8--\#\K
		(.*
		(?:\012|\015\012?)\}\ \#--8<--\ \w+-$block_id-close\ -->8--\#)
	}{
		$target->re_replacement_value($1);
	}sxe) {
		$translated_errors->advocate(
			'block_not_found',
			[$block_id]);
	}
	return;
}

sub modify_block_body_code
# /type method
# /effect ""
# //parameters
#	block_id
#	target
# //returns
{
	my ($this, $block_id, $target) = @ARGUMENTS;

	unless ($$this =~ s{
		(?:\012|\015\012?)\{\ \#--8<--\ \w+-$block_id-open\ -->8--\#\K
		(.*)
		((?:\012|\015\012?)\}\ \#--8<--\ \w+-$block_id-close\ -->8--\#)
	}{
		$target->re_replacement_value($1).$2;
	}sxe) {
		$translated_errors->advocate(
			'block_not_found',
			[$block_id]);
	}
	return;
}

sub remove_block_id
# /type method
# /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;
}

sub extract_modifier_block_body
# /type method
# /effect "Extract the source code of a subroutine by block id"
# //parameters
#	block_id
# /returns
#	::Personality::Abstract::Text
{
	my ($this, $block_id) = @ARGUMENTS;

	$$this =~ m
	{
		(?:\012|\015\012?)\{\ \#--8<--\ \w+-$block_id-open\ -->8--\#
		(.*)
		(?:\012|\015\012?)\}\ \#--8<--\ \w+-$block_id-close\ -->8--\#
	}sx;
	my $perl_code = $1;
	return($perl_code) if (defined($perl_code));

	return('') if ($$this =~ m
		{
			(?:\012|\015\012?)\;\ \#--8<--\ sub-$block_id-openclose\ -->8--\#
		}sx);

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

sub seek_modifier_open
# /type method
# /effect ""
# //parameters
#	block_id
# /returns
#	::Personality::Abstract::Text
{
	my ($this, $block_id) = @ARGUMENTS;

	unless ($$this =~ m{
		(?:\012|\015\012?)\{\ \#--8<--\ \w+-$block_id-open\ -->8--\#
	}sxg) {
		$translated_errors->advocate(
			'block_not_found',
			[$block_id]);
	}
	return;
}