File Coverage

blib/lib/Psh/PerlEval.pm

Criterion	Covered	Total	%
statement	0	40	0.0
branch	0	14	0.0
condition	0	24	0.0
subroutine	0	2	0.0
pod	0	2	0.0
total	0	82	0.0

package Psh::PerlEval;

#
# Must be on top of file before any "my" variables!
#
#
# array protected_eval(string EXPR, string FROM)
#
# Evaluates "$Psh::eval_preamble EXPR", handling trapped signals and
# printing errors properly. The FROM string is passed on to
# handle_message to indicate where errors came from.
#
# If EXPR ends in an ampersand, it is stripped and the eval is done in
# a forked copy of perl.
#

$Psh::PerlEval::current_package='main';

sub protected_eval
{
	#
	# Local package variables because lexical variables here mask
	# variables of the same name in main!!
	#

	local ($Psh::PerlEval::str, $Psh::PerlEval::from) = @_;
	local $Psh::PerlEval::redo_sentinel        = 0;

	# It's not possible to use fork_process for foreground perl
	# as we would lose all variables etc.

	{   #Dummy block to catch loop-control statements at outermost
		#level in EXPR
		# First, protect against infinite loop
		# caused by redo:
		if ($Psh::PerlEval::redo_sentinel) { last; }
		$Psh::PerlEval::redo_sentinel = 1;
		local $Psh::currently_active= -1;
		$_= $Psh::PerlEval::lastscalar;
		@_= @Psh::PerlEval::lastarray;
		local @Psh::PerlEval::result= eval $Psh::eval_preamble.' package '.$Psh::PerlEval::current_package.'; '.$Psh::PerlEval::str;
		$Psh::PerlEval::lastscalar= $_;
		@Psh::PerlEval::lastarray= @_;

		if ( !$@ && @Psh::PerlEval::result &&
			 $#Psh::PerlEval::result==0 && $Psh::PerlEval::str &&
			 $Psh::PerlEval::result[0] &&
			 $Psh::PerlEval::result[0] eq $Psh::PerlEval::str &&
			 !Psh::is_number($Psh::PerlEval::str) &&
			 $Psh::PerlEval::str=~ /^\s*\S+\s*$/ &&
			 $Psh::PerlEval::str!~ /^\s*(\'|\")\S+(\'|\")\s*$/ ) {
			#
			# Very whacky error handling
			# If you pass one word to perl and it's no function etc
			# it will simply return the word - that's not even a
			# bug actually but in case of psh it's annoying
			# so we try to detect these cases
			#

			Psh::Util::print_error_i18n('no_command',$Psh::PerlEval::str);
			return undef;
		}
		else {
			if ($@) {
				Psh::handle_message($@, $Psh::PerlEval::from);
			}
		}
		return @Psh::PerlEval::result;
	}
	Psh::handle_message("Can't use loop control outside a block",
						$Psh::PerlEval::from);
	return undef;
}


#
# array variable_expansion (arrayref WORDS)
#
# For each element x of the array referred to by WORDS, substitute
# perl variables that appear in x respecting the quoting symbols ' and
# ", and return the array of substituted values. Substitutions inside
# quotes always return a single element in the resulting array;
# outside quotes, the result is split() and pushed on to the
# accumulating array of substituted values
#

sub variable_expansion
{
	local ($Psh::arref) = @_;
	local @Psh::retval  = ();
	local $Psh::word;

	for $Psh::word (@{$Psh::arref}) {
		if    ($Psh::word =~ m/^\'/) { push @Psh::retval, $Psh::word; }
		elsif ($Psh::word =~ m/^\"/) {
			local $Psh::word2= $Psh::word;
			$Psh::word2 =~ s/\\/\\\\/g;
			local $Psh::val = eval("$Psh::eval_preamble $Psh::word2");

			if ($@) { push @Psh::retval, $Psh::word; }
			else    { push @Psh::retval, "\"$Psh::val\""; }
		} else {
			local $Psh::word2= $Psh::word;
			$Psh::word2 =~ s/\\/\\\\/g;
			local $Psh::val = eval("$Psh::eval_preamble \"$Psh::word2\"");

			if ($@) { push @Psh::retval, $Psh::word; }
			else    { push @Psh::retval, $Psh::val; }
			# in former times we used to do a wordsplit here in
			# case of success, but this breaks certain things and
			# don't know exactly why it was here in the first place
		}
	}

	return @Psh::retval;
}

1;


__END__