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;