Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Psh / StrategyBunch.pm

## do not modify - autogenerated ##
package Psh::Strategy::Bang;

require Psh::Strategy;


=item * C<bang>

If the input line starts with ! all remaining input will be
sent unchanged to /bin/sh

=cut


@Psh::Strategy::Bang::ISA=('Psh::Strategy');

sub consumes {
	return Psh::Strategy::CONSUME_LINE;
}

sub runs_before {
	return qw(brace);
}

sub applies {
	return 'pass to sh' if substr(${$_[1]},0,1) eq '!';
}

sub execute {
	my $command= substr(${$_[1]},1);

	my $fgflag = 1;
	if ($command =~ /^(.*)\&\s*$/) {
		$command= $1;
		$fgflag=0;
	}

	Psh::OS::fork_process( $command, $fgflag, $command, 1);
	return (1,undef);
}

1;
package Psh::Strategy::Perl;

=item * C<perl>

If the input line starts with p! all remaining input will be
sent unchanged to the perl interpreter

=cut


require Psh::Strategy;

@Psh::Strategy::Perl::ISA=('Psh::Strategy');

sub consumes {
	return Psh::Strategy::CONSUME_LINE;
}

sub runs_before {
	return qw(built_in brace);
}

sub applies {
	return 'perl evaluation' if substr(${$_[1]},0,2) eq 'p!';
}

sub execute {
	${$_[1]}= substr(${$_[1]},2);
	Psh::Strategy::Eval::execute(@_);
}

1;
package Psh::Strategy::Brace;


=item * C<bang>

Input within curly braces will be sent unchanged to the perl
interpreter.

=cut


require Psh::Strategy;

@Psh::Strategy::Brace::ISA=('Psh::Strategy');

sub consumes {
	return Psh::Strategy::CONSUME_TOKENS;
}

sub runs_before {
	return qw(built_in);
}

sub applies {
	return 'perl evaluation' if substr(${$_[1]},0,1) eq '{';
}

sub execute {
	Psh::Strategy::Eval::execute(@_);
}

1;
package Psh::Strategy::Built_in;

require Psh::Strategy;
require Psh::Options;
require Psh::Support::Builtins;

@Psh::Strategy::Built_in::ISA=('Psh::Strategy');

Psh::Support::Builtins::build_autoload_list();

sub new { Psh::Strategy::new(@_) }

sub consumes {
	return Psh::Strategy::CONSUME_TOKENS;
}

sub runs_before {
	return qw(executable auto_resume auto_cd);
}

sub applies {
	my $fnname= ${$_[2]}[0];

	if( $fnname= Psh::Support::Builtins::is_builtin($fnname)) {
		eval 'use Psh::Builtins::'.ucfirst($fnname);
		if ($@) {
			Psh::Util::print_error_i18n('builtin_failed',$@);
		}
		return $fnname;
	}
	return '';
}

sub execute {
	my $line= ${$_[1]};
	my @words= @{$_[2]};
	my $command= $_[3];
	shift @words;
	my $coderef;

	my $rest= join(' ',@words);

	no strict 'refs';
	$coderef= *{join('','Psh::Builtins::',ucfirst($command),
					 '::bi_',$command)};
	return (1,sub { &{$coderef}($rest,\@words); }, [], 0, undef );
}

1;
package Psh::Strategy::Perlfunc;

=item * C<perlfunc>

Tries to detect perl builtins - this is helpful if you e.g. have
a print command on your system. This is a small, minimal version
without options which will react on your own sub's or on a limited
list of important perl builtins. Please also see the strategy
perlfunc_heavy

=cut

require Psh::Strategy;

@Psh::Strategy::Perlfunc::ISA=('Psh::Strategy');

sub new { Psh::Strategy::new(@_) }

sub consumes {
	return Psh::Strategy::CONSUME_TOKENS;
}

sub runs_before {
	return qw(perlscript auto_resume executable);
}

my %perl_builtins = qw(
 print 1 printf 1 push 1 pop 1 shift 1 unshift 1 system 1
 package 1
 chop 1 chomp 1 use 1 for 1 foreach 1 sub 1 do 1
);

sub applies {
	my @words= @{$_[2]};
	my $line= ${$_[1]};

	my $fnname = $words[0];
	my $parenthesized = 0;

	# catch "join(':',@foo)" here as well:
	if ($fnname =~ m/\(/) {
		$parenthesized = 1;
		$fnname = (split('\(', $fnname))[0];
	}

	my $qPerlFunc = 0;
	if (exists $perl_builtins{$fnname}) {
		my $needArgs = $perl_builtins{$fnname};
		if ($needArgs > 0
			and ($parenthesized
				 or scalar(@{$_[2]}) >= $needArgs)) {
			$qPerlFunc = 1;
		}
	} elsif( $fnname =~ /^([a-zA-Z0-9_]+)\:\:([a-zA-Z0-9_:]+)$/) {
		if( $1 eq 'CORE') {
			my $needArgs = $perl_builtins{$2};
			if ($needArgs > 0
				and ($parenthesized or scalar(@{$_[2]}) >= $needArgs)) {
				$qPerlFunc = 1;
			}
		} else {
			$qPerlFunc = (Psh::PerlEval::protected_eval("defined(&{'$fnname'})"))[0];
		}
	} elsif( $fnname =~ /^[a-zA-Z0-9_]+$/) {
		$qPerlFunc = (Psh::PerlEval::protected_eval("defined(&{'$fnname'})"))[0];
	}

	return $line if $qPerlFunc;
	return '';
}

sub execute {
	my @args= @_;
	$args[4]=undef;
	return Psh::Strategy::Eval::execute(@args);
}

1;
package Psh::Strategy::Executable;


=item * C<executable>

This strategy will search for an executable file and execute it
if possible.

=cut

require Psh::Strategy;
require Psh::Options;

@Psh::Strategy::Executable::ISA=('Psh::Strategy');

my %built_ins=();

sub consumes {
	return Psh::Strategy::CONSUME_TOKENS;
}

sub runs_before {
	return qw(eval);
}

sub applies {
	my $com= @{$_[2]}->[0];
	my $executable= Psh::Util::which($com);
	return $executable if defined $executable;
	return '';
}

sub execute {
	my $inputline= ${$_[1]};
	my @words= @{$_[2]};
	my $tmp= shift @words;
	my $executable= $_[3];

	if (Psh::Options::get_option('expansion') and
	    (!$Psh::current_options or !$Psh::current_options->{noexpand})) {
		@words= Psh::PerlEval::variable_expansion(\@words);
	}
	if (Psh::Options::get_option('globbing') and
		(!$Psh::current_options or !$Psh::current_options->{noglob})) {
		@words = Psh::Parser::glob_expansion(\@words);
	}
	@words = map { Psh::Parser::unquote($_)} @words;

	return (1,join(' ',$executable,@words),[$executable,$tmp,@words], 0, undef, );
}

1;
package Psh::Strategy::Eval;

=item * C<eval>

All input will be evaluated by the perl interpreter without
any conditions.

=cut

require Psh::Strategy;

@Psh::Strategy::Eval::ISA=('Psh::Strategy');

sub new { Psh::Strategy::new(@_) }

sub consumes {
	return Psh::Strategy::CONSUME_TOKENS;
}

sub applies {
	return 'perl evaluation';
}

sub execute {
	my $todo= ${$_[1]};

	if( $_[4]) { # we are second or later in a pipe
		my $code;
		$todo=~ s/\} ?([qg])\s*$/\}/;
		my $mods= $1 || '';
		if( $mods eq 'q' ) { # non-print mode
			$code='while(<STDIN>) { @_= split /\s+/; '.$todo.' ; }';
		} elsif( $mods eq 'g') { # grep mode
			$code='while(<STDIN>) { @_= split /\s+/; print $_ if eval { '.$todo.' }; } ';
		} else {
			$code='while(<STDIN>) { @_= split /\s+/; '.$todo.' ; print $_ if $_; }';
		}
		return (1,sub {return 1,Psh::PerlEval::protected_eval($code,'eval'); }, [], 0, undef);
    } else {
		return (1,sub {
					local @Psh::tmp= Psh::PerlEval::protected_eval($todo,'eval');
					return ((@Psh::tmp && $Psh::tmp[0])?1:0, @Psh::tmp);
		}, [], 0, undef);
	}
}

1;