Parent Directory
| 
Revision Log
added bin/wwsh - a rudimentary webwork shell which (currently) allows access to CourseEnvironment and DB objects. This could be extended to provide a full shell for the WeBWorK system. (Uses PSH.pm.) -sam
1 package PSH; 2 3 use vars '$it'; 4 5 $PSH::VERSION = '0.7'; 6 7 #use strict; ##use only for testing !!!!!!!! 8 9 sub welcome { 10 print STDOUT "Welcome to psh $PSH::VERSION by Jenda\@Krynicky.cz\nRunning under Perl $]\n\n"; 11 } 12 13 $PSH::allowsystem = 1; 14 %PSH::specials = (); 15 16 eval {require 'PSH.config'}; 17 print STDERR "Error in psh.config : $@\n" if ($@ and $@ !~ /^Can't locate PSH.config in \@INC/i); 18 $@=''; 19 20 sub Exec { 21 my $line = shift; 22 if ($PSH::allowsystem) { 23 if ($line =~ s/>\s*$//) { 24 ${$PSH::package.'::it'}= `$line`; 25 } else { 26 $line =~ /^(.*?)(?:\s(.*))?$/; 27 my $cmd; 28 if (defined ($cmd = $PSH::alias{lc $1})) { 29 ${$PSH::package.'::it'}=system( $cmd.' '.$2 ); 30 } else { 31 ${$PSH::package.'::it'}=system( $line ); 32 } 33 } 34 } else { 35 print STDOUT "Disallowed by the script!\n"; 36 } 37 } 38 39 sub specials { 40 return if @_ % 2; # I need even number of parameters 41 my ($char,$fun); 42 while (defined($char = shift)) { 43 $fun = shift; 44 if ($fun) { 45 $PSH::specials{$char} = $fun; 46 } else { 47 delete $PSH::specials{$char}; 48 } 49 } 50 $PSH::specials = join('|', map {"\Q$_\E"} keys %PSH::specials); 51 } 52 53 $PSH::specials{'!'} = \&PSH::Exec; 54 55 sub prompt { 56 my $prompt = shift || 'perl'; 57 my $eval = shift; 58 $PSH::specials = join('|', map {"\Q$_\E"} keys %PSH::specials); # just for sure 59 local $it=''; 60 my $command=''; 61 local ($PSH::package, $PSH::filename, $PSH::ln) = caller; 62 ${$PSH::package.'::it'}=''; 63 # print "called from $PSH::package\n"; 64 print STDOUT "$prompt\$ "; 65 66 my $line; 67 while (defined ($line = <STDIN>)) { 68 if (!$command and $line =~ /^$/) { 69 print STDOUT "$prompt\$ "; 70 } elsif (!$command and $PSH::specials and $line =~ /^\s*($PSH::specials)\s*/ and $PSH::specials{$1}) { 71 $line =~ s/^\s*($PSH::specials)\s*(.*)$/$2/o; 72 ${$PSH::package.'::it'}= &{$PSH::specials{$1}}($line); 73 print STDOUT "\n$prompt\$ "; 74 } elsif ($line =~ /^\?$/) { 75 PSH::help(); 76 print STDOUT "\n$prompt\$ "; 77 78 } elsif (!$command and $line =~ /^<<(.*)$/) { 79 my $eoc = $1; 80 print STDOUT "$prompt($eoc)\$ "; 81 while (defined ($line = <STDIN>)) { 82 last if $line =~ /^\Q$eoc\E\s*$/; 83 $command .=$line; 84 print STDOUT "$prompt($eoc)\$ "; 85 } 86 if ($eval) { 87 ${$PSH::package.'::it'} = &$eval($command); 88 } else { 89 ${$PSH::package.'::it'} = eval "package $PSH::package;\n".$command; 90 } 91 $command = ''; 92 print STDOUT "\nERROR: $@\n" if $@; 93 print STDOUT "\n$prompt\$ "; 94 } elsif ($line =~ s/;$//) { 95 if ($eval) { 96 ${$PSH::package.'::it'} = &$eval($command.$line); 97 } else { 98 ${$PSH::package.'::it'} = eval "package $PSH::package;\n".$command.$line; 99 } 100 $command = ''; 101 print STDOUT "\nERROR: $@\n" if $@; 102 print STDOUT "\n$prompt\$ "; 103 } else { 104 $command .= $line; 105 print STDOUT "$prompt> "; 106 } 107 } 108 return ${$PSH::package.'::it'}; 109 } 110 111 sub PSH::help { 112 print STDOUT <<"*END*"; 113 Commands starting by ! are passed to the command prompt. 114 If the line ends by >, the output of the command is redirected to 115 variable \$it. If you want to catch both STDOUT and STDERR use this: 116 117 perl\$ ! command 2>&1 > 118 119 All other commands are suposed to be a perl code. 120 121 The code to be evaluated may be entered in two ways 122 or use something like heredoc 123 124 If the first line in a new command starts with <<, the rest of the line 125 is considered as the heredoc delimiter. As long as you do not enter a 126 line containing only those characters, the lines are only appended into 127 a variable. As soon as you close the heredoc, the code is evaluated. 128 129 Otherwise the code you enter is evaluated as soon as you enter a line 130 finished by a semicolon. 131 132 The value of the last command may be found in \$it. 133 134 You may exit this "shell" by either "exit;" or CTRL+Z. 135 Please keep in mind that "exit;" will close the whole script, while 136 CTRL+Z will only close the prompt and the script will continue runing! 137 138 Therefore you should use "exit;" with caution. 139 140 psh $PSH::VERSION by Jenda\@Krynicky.cz 141 *END* 142 } 143 144 "I am an excellent programmer"; # A required file must return a true value ;-) 145 146 __END__ 147 148 =head1 NAME 149 150 PSH - perl shell 151 152 Version 0.7 153 154 =head1 SYNOPSIS 155 156 use PSH; 157 ... 158 PSH::prompt; 159 160 =head1 DESCRIPTION 161 162 This module provides a "perl command prompt" facility for your program. 163 You may do some processing and then simply call PSH::prompt to allow 164 the user to finish the task if something went wrong by calling the functions 165 of your program. 166 167 I use it for example at the end of the Golem (peoplemeter data processing software) 168 import script. Sometimes I get not only the new data, but also some 169 repairs of old ones and sometimes some stage of import fails. 170 This perl prompt at the end of the script allows me to fix such problems "by hand". 171 172 =head2 Usage 173 174 This module provides two functions, PSH::prompt and PSH::welcome. 175 The first prints the "perl$" prompt, waits for user interaction and executes the entered 176 commands. The user then closes the prompt by pressing CTRL-D (Unix/Mac) or CTRL-Z (Windoze). 177 178 All commands are processed in the same package from which PSH::prompt was 179 called. You may access all global or local() variables, but of course not 180 my() variables. 181 182 The call to PSH::prompt returns the value of the last executed statement. 183 184 185 Since version 0.4 you may pass two parameters to PSH::prompt : 186 187 PSH::prompt [$prompttext, [ \&evalsub ] ] 188 189 The first sets the prompt used by the module, the second sets the function used 190 to evaluate the code you entered. Default is 191 192 PSH::prompt 'perl', \&eval; 193 194 The second function prints out the version info. 195 196 =head2 Prompt 197 198 Commands starting by ! are passed to the command prompt, 199 If the line ends by >, the output of the command is redirected to 200 variable $it. If you want to catch both STDOUT and STDERR use this: 201 202 perl$ ! command 2>&1 > 203 204 All other commands are supposed to be a perl code. 205 206 The code to be evaluated may be entered in two ways 207 or use something like heredoc 208 209 If the first line in a new command starts with <<, the rest of the line 210 is considered as the heredoc delimiter. As long as you do not enter a 211 line containing only those characters, the lines are only appended into 212 a variable. As soon as you close the heredoc, the code is evaluated. 213 214 Otherwise the code you enter is evaluated as soon as you enter a line 215 finished by a semicolon. 216 217 The value of the last command may be found in $it. 218 219 You may exit this "shell" by either "exit;" or CTRL+Z. 220 Please keep in mind that "exit;" will close the whole script, while 221 CTRL+Z will only close the prompt and the script will continue running! 222 223 Therefore you should use "exit;" with caution. 224 225 =head2 PSH.config 226 227 In the same directory as PSH.pm may be also file PSH.config. 228 This file will be "required" whenever you use PSH. You may add some 229 function definitions and variables there. 230 231 Please keep in mind that this file is required in PSH package so 232 the variables and functions you define therein are in this package by default! 233 234 Also keep in mind that this file is require()d! 235 The last statement in this file MUST return a true value!!! 236 And there must be some command in the file! At least 237 238 1; 239 240 You should not do any changes to PSH.pm cause it would 241 be quite hard to upgrade then. If possible, do the necessary personalization 242 through PSH.config. If you find something that would be useful for other people, 243 or something you cannot do from within PSH.config, contact me. 244 I'm always open to suggestions and additions :-) 245 246 =head2 Options and settings 247 248 $PSH::allowsystem = should the prompt allow executing system 249 commands through "! command" ? Default = yes. 250 251 %PSH::alias = a hash of aliases for commands. 252 Every time you enter a line starting with an exclamation mark, 253 the first word is looked up in this hash and if a match is found, 254 this word is replaced by the value from the hash. 255 All keys in this hash should be lowercase, the match is case-insensitive. 256 257 You will probably want to populate this hash according to macros in 258 your preferred shell or OS. On my pages you may find examples for 259 reading doskey macros and applications registered to Windoze. 260 261 %PSH::specials = a hash of specials 262 This hash allows you to install additional special characters 263 similar to "!". If PSH sees a special character (a key from 264 this hash), it calls the specified function for that character 265 (the value). Actually it doesn't have to be a character :-) 266 267 Default : $PSH::specials{'!'} = \&PSH::Exec; 268 269 You should not modify this hash directly, you'd better use function 270 PSH::specials : 271 272 PSH::specials '^' => \&foo; 273 PSH::specials '!' => undef; 274 275 Otherwise the change may be ignored ! 276 277 =head2 Example 278 279 use PSH; 280 END {PSH::prompt unless $OK} 281 $do->some('processing) or die "Error : $do->{error}!\n"; 282 some(more->commands) or die "Error : some went wrong!\n"; 283 $OK=1; 284 __END__ 285 286 This will allow the user to do some by-hand cleansing if an error occures. 287 288 use PSH; 289 PSH::prompt 'hello', sub {print $_[0]}; 290 291 =head2 Ussage example 292 293 perl$ print 45+6; 294 51 295 perl$ print 12 296 perl> + 15; 297 27 298 perl$ sub Foo { 299 perl> print "Foo called\n"; 300 301 ERROR: Missing right bracket at (eval 3) line 5, at end of line 302 syntax error at (eval 3) line 5, at EOF 303 304 perl$ sub Foo { 305 perl> print "Foo called\n"; # 306 perl> }; 307 308 perl$ Foo; 309 Foo called 310 311 perl$ <<END 312 perl(END)$ sub Bar { 313 perl(END)$ my $arg = shift; 314 perl(END)$ print "Bar called with ($arg)\n"; 315 perl(END)$ } 316 perl(END)$ END 317 318 perl$ Bar(45); 319 Bar called with (45) 320 321 perl$ ^Z 322 323 c:\> 324 325 =head2 AUTHOR 326 327 Jenda@Krynicky.cz 328 329 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |