| 1 | ## do not modify - autogenerated ## |
| 2 | package Psh::Strategy::Bang; |
| 3 | |
| 4 | require Psh::Strategy; |
| 5 | |
| 6 | |
| 7 | =item * C<bang> |
| 8 | |
| 9 | If the input line starts with ! all remaining input will be |
| 10 | sent unchanged to /bin/sh |
| 11 | |
| 12 | =cut |
| 13 | |
| 14 | |
| 15 | @Psh::Strategy::Bang::ISA=('Psh::Strategy'); |
| 16 | |
| 17 | sub consumes { |
| 18 | return Psh::Strategy::CONSUME_LINE; |
| 19 | } |
| 20 | |
| 21 | sub runs_before { |
| 22 | return qw(brace); |
| 23 | } |
| 24 | |
| 25 | sub applies { |
| 26 | return 'pass to sh' if substr(${$_[1]},0,1) eq '!'; |
| 27 | } |
| 28 | |
| 29 | sub execute { |
| 30 | my $command= substr(${$_[1]},1); |
| 31 | |
| 32 | my $fgflag = 1; |
| 33 | if ($command =~ /^(.*)\&\s*$/) { |
| 34 | $command= $1; |
| 35 | $fgflag=0; |
| 36 | } |
| 37 | |
| 38 | Psh::OS::fork_process( $command, $fgflag, $command, 1); |
| 39 | return (1,undef); |
| 40 | } |
| 41 | |
| 42 | 1; |
| 43 | package Psh::Strategy::Perl; |
| 44 | |
| 45 | =item * C<perl> |
| 46 | |
| 47 | If the input line starts with p! all remaining input will be |
| 48 | sent unchanged to the perl interpreter |
| 49 | |
| 50 | =cut |
| 51 | |
| 52 | |
| 53 | require Psh::Strategy; |
| 54 | |
| 55 | @Psh::Strategy::Perl::ISA=('Psh::Strategy'); |
| 56 | |
| 57 | sub consumes { |
| 58 | return Psh::Strategy::CONSUME_LINE; |
| 59 | } |
| 60 | |
| 61 | sub runs_before { |
| 62 | return qw(built_in brace); |
| 63 | } |
| 64 | |
| 65 | sub applies { |
| 66 | return 'perl evaluation' if substr(${$_[1]},0,2) eq 'p!'; |
| 67 | } |
| 68 | |
| 69 | sub execute { |
| 70 | ${$_[1]}= substr(${$_[1]},2); |
| 71 | Psh::Strategy::Eval::execute(@_); |
| 72 | } |
| 73 | |
| 74 | 1; |
| 75 | package Psh::Strategy::Brace; |
| 76 | |
| 77 | |
| 78 | =item * C<bang> |
| 79 | |
| 80 | Input within curly braces will be sent unchanged to the perl |
| 81 | interpreter. |
| 82 | |
| 83 | =cut |
| 84 | |
| 85 | |
| 86 | require Psh::Strategy; |
| 87 | |
| 88 | @Psh::Strategy::Brace::ISA=('Psh::Strategy'); |
| 89 | |
| 90 | sub consumes { |
| 91 | return Psh::Strategy::CONSUME_TOKENS; |
| 92 | } |
| 93 | |
| 94 | sub runs_before { |
| 95 | return qw(built_in); |
| 96 | } |
| 97 | |
| 98 | sub applies { |
| 99 | return 'perl evaluation' if substr(${$_[1]},0,1) eq '{'; |
| 100 | } |
| 101 | |
| 102 | sub execute { |
| 103 | Psh::Strategy::Eval::execute(@_); |
| 104 | } |
| 105 | |
| 106 | 1; |
| 107 | package Psh::Strategy::Built_in; |
| 108 | |
| 109 | require Psh::Strategy; |
| 110 | require Psh::Options; |
| 111 | require Psh::Support::Builtins; |
| 112 | |
| 113 | @Psh::Strategy::Built_in::ISA=('Psh::Strategy'); |
| 114 | |
| 115 | Psh::Support::Builtins::build_autoload_list(); |
| 116 | |
| 117 | sub new { Psh::Strategy::new(@_) } |
| 118 | |
| 119 | sub consumes { |
| 120 | return Psh::Strategy::CONSUME_TOKENS; |
| 121 | } |
| 122 | |
| 123 | sub runs_before { |
| 124 | return qw(executable auto_resume auto_cd); |
| 125 | } |
| 126 | |
| 127 | sub applies { |
| 128 | my $fnname= ${$_[2]}[0]; |
| 129 | |
| 130 | if( $fnname= Psh::Support::Builtins::is_builtin($fnname)) { |
| 131 | eval 'use Psh::Builtins::'.ucfirst($fnname); |
| 132 | if ($@) { |
| 133 | Psh::Util::print_error_i18n('builtin_failed',$@); |
| 134 | } |
| 135 | return $fnname; |
| 136 | } |
| 137 | return ''; |
| 138 | } |
| 139 | |
| 140 | sub execute { |
| 141 | my $line= ${$_[1]}; |
| 142 | my @words= @{$_[2]}; |
| 143 | my $command= $_[3]; |
| 144 | shift @words; |
| 145 | my $coderef; |
| 146 | |
| 147 | my $rest= join(' ',@words); |
| 148 | |
| 149 | no strict 'refs'; |
| 150 | $coderef= *{join('','Psh::Builtins::',ucfirst($command), |
| 151 | '::bi_',$command)}; |
| 152 | return (1,sub { &{$coderef}($rest,\@words); }, [], 0, undef ); |
| 153 | } |
| 154 | |
| 155 | 1; |
| 156 | package Psh::Strategy::Perlfunc; |
| 157 | |
| 158 | =item * C<perlfunc> |
| 159 | |
| 160 | Tries to detect perl builtins - this is helpful if you e.g. have |
| 161 | a print command on your system. This is a small, minimal version |
| 162 | without options which will react on your own sub's or on a limited |
| 163 | list of important perl builtins. Please also see the strategy |
| 164 | perlfunc_heavy |
| 165 | |
| 166 | =cut |
| 167 | |
| 168 | require Psh::Strategy; |
| 169 | |
| 170 | @Psh::Strategy::Perlfunc::ISA=('Psh::Strategy'); |
| 171 | |
| 172 | sub new { Psh::Strategy::new(@_) } |
| 173 | |
| 174 | sub consumes { |
| 175 | return Psh::Strategy::CONSUME_TOKENS; |
| 176 | } |
| 177 | |
| 178 | sub runs_before { |
| 179 | return qw(perlscript auto_resume executable); |
| 180 | } |
| 181 | |
| 182 | my %perl_builtins = qw( |
| 183 | print 1 printf 1 push 1 pop 1 shift 1 unshift 1 system 1 |
| 184 | package 1 |
| 185 | chop 1 chomp 1 use 1 for 1 foreach 1 sub 1 do 1 |
| 186 | ); |
| 187 | |
| 188 | sub applies { |
| 189 | my @words= @{$_[2]}; |
| 190 | my $line= ${$_[1]}; |
| 191 | |
| 192 | my $fnname = $words[0]; |
| 193 | my $parenthesized = 0; |
| 194 | |
| 195 | # catch "join(':',@foo)" here as well: |
| 196 | if ($fnname =~ m/\(/) { |
| 197 | $parenthesized = 1; |
| 198 | $fnname = (split('\(', $fnname))[0]; |
| 199 | } |
| 200 | |
| 201 | my $qPerlFunc = 0; |
| 202 | if (exists $perl_builtins{$fnname}) { |
| 203 | my $needArgs = $perl_builtins{$fnname}; |
| 204 | if ($needArgs > 0 |
| 205 | and ($parenthesized |
| 206 | or scalar(@{$_[2]}) >= $needArgs)) { |
| 207 | $qPerlFunc = 1; |
| 208 | } |
| 209 | } elsif( $fnname =~ /^([a-zA-Z0-9_]+)\:\:([a-zA-Z0-9_:]+)$/) { |
| 210 | if( $1 eq 'CORE') { |
| 211 | my $needArgs = $perl_builtins{$2}; |
| 212 | if ($needArgs > 0 |
| 213 | and ($parenthesized or scalar(@{$_[2]}) >= $needArgs)) { |
| 214 | $qPerlFunc = 1; |
| 215 | } |
| 216 | } else { |
| 217 | $qPerlFunc = (Psh::PerlEval::protected_eval("defined(&{'$fnname'})"))[0]; |
| 218 | } |
| 219 | } elsif( $fnname =~ /^[a-zA-Z0-9_]+$/) { |
| 220 | $qPerlFunc = (Psh::PerlEval::protected_eval("defined(&{'$fnname'})"))[0]; |
| 221 | } |
| 222 | |
| 223 | return $line if $qPerlFunc; |
| 224 | return ''; |
| 225 | } |
| 226 | |
| 227 | sub execute { |
| 228 | my @args= @_; |
| 229 | $args[4]=undef; |
| 230 | return Psh::Strategy::Eval::execute(@args); |
| 231 | } |
| 232 | |
| 233 | 1; |
| 234 | package Psh::Strategy::Executable; |
| 235 | |
| 236 | |
| 237 | =item * C<executable> |
| 238 | |
| 239 | This strategy will search for an executable file and execute it |
| 240 | if possible. |
| 241 | |
| 242 | =cut |
| 243 | |
| 244 | require Psh::Strategy; |
| 245 | require Psh::Options; |
| 246 | |
| 247 | @Psh::Strategy::Executable::ISA=('Psh::Strategy'); |
| 248 | |
| 249 | my %built_ins=(); |
| 250 | |
| 251 | sub consumes { |
| 252 | return Psh::Strategy::CONSUME_TOKENS; |
| 253 | } |
| 254 | |
| 255 | sub runs_before { |
| 256 | return qw(eval); |
| 257 | } |
| 258 | |
| 259 | sub applies { |
| 260 | my $com= @{$_[2]}->[0]; |
| 261 | my $executable= Psh::Util::which($com); |
| 262 | return $executable if defined $executable; |
| 263 | return ''; |
| 264 | } |
| 265 | |
| 266 | sub execute { |
| 267 | my $inputline= ${$_[1]}; |
| 268 | my @words= @{$_[2]}; |
| 269 | my $tmp= shift @words; |
| 270 | my $executable= $_[3]; |
| 271 | |
| 272 | if (Psh::Options::get_option('expansion') and |
| 273 | (!$Psh::current_options or !$Psh::current_options->{noexpand})) { |
| 274 | @words= Psh::PerlEval::variable_expansion(\@words); |
| 275 | } |
| 276 | if (Psh::Options::get_option('globbing') and |
| 277 | (!$Psh::current_options or !$Psh::current_options->{noglob})) { |
| 278 | @words = Psh::Parser::glob_expansion(\@words); |
| 279 | } |
| 280 | @words = map { Psh::Parser::unquote($_)} @words; |
| 281 | |
| 282 | return (1,join(' ',$executable,@words),[$executable,$tmp,@words], 0, undef, ); |
| 283 | } |
| 284 | |
| 285 | 1; |
| 286 | package Psh::Strategy::Eval; |
| 287 | |
| 288 | =item * C<eval> |
| 289 | |
| 290 | All input will be evaluated by the perl interpreter without |
| 291 | any conditions. |
| 292 | |
| 293 | =cut |
| 294 | |
| 295 | require Psh::Strategy; |
| 296 | |
| 297 | @Psh::Strategy::Eval::ISA=('Psh::Strategy'); |
| 298 | |
| 299 | sub new { Psh::Strategy::new(@_) } |
| 300 | |
| 301 | sub consumes { |
| 302 | return Psh::Strategy::CONSUME_TOKENS; |
| 303 | } |
| 304 | |
| 305 | sub applies { |
| 306 | return 'perl evaluation'; |
| 307 | } |
| 308 | |
| 309 | sub execute { |
| 310 | my $todo= ${$_[1]}; |
| 311 | |
| 312 | if( $_[4]) { # we are second or later in a pipe |
| 313 | my $code; |
| 314 | $todo=~ s/\} ?([qg])\s*$/\}/; |
| 315 | my $mods= $1 || ''; |
| 316 | if( $mods eq 'q' ) { # non-print mode |
| 317 | $code='while(<STDIN>) { @_= split /\s+/; '.$todo.' ; }'; |
| 318 | } elsif( $mods eq 'g') { # grep mode |
| 319 | $code='while(<STDIN>) { @_= split /\s+/; print $_ if eval { '.$todo.' }; } '; |
| 320 | } else { |
| 321 | $code='while(<STDIN>) { @_= split /\s+/; '.$todo.' ; print $_ if $_; }'; |
| 322 | } |
| 323 | return (1,sub {return 1,Psh::PerlEval::protected_eval($code,'eval'); }, [], 0, undef); |
| 324 | } else { |
| 325 | return (1,sub { |
| 326 | local @Psh::tmp= Psh::PerlEval::protected_eval($todo,'eval'); |
| 327 | return ((@Psh::tmp && $Psh::tmp[0])?1:0, @Psh::tmp); |
| 328 | }, [], 0, undef); |
| 329 | } |
| 330 | } |
| 331 | |
| 332 | 1; |