1: #!/usr/bin/perl -W
   2: 
   3: # Copyright Jacob Filipp, 2003
   4: # This program is provided as is, you are free to use
   5: # it in any way as long as the copyright notice is
   6: # in the code
   7:  
   8: # Yes dear monks, Quick-And-Dirty-Operating-System (DOS)
   9: # is still used. Here is a tiny shell wrapper in Perl,
  10: # to implement all the wonderful features that DOS lacks
  11: # ,like command aliasing. Although this tiny script is
  12: # meagre compared to your mathematical-script prowess
  13: # it is very flexible and someone might actually like
  14: # to use it ( from sheer curiosity, of course ).
  15: 
  16: # The only fancy trick it has is the ability to launch
  17: # your browser when a URL is typed ( the first case in
  18: # the dispatch table. Interactive progs are run in a
  19: # separate window.
  20: 
  21: use Strict;     # just for you monks, I never use it
  22: 
  23: $SIG{ CHLD } = sub{ wait() };
  24: 
  25: $browser_path  = 'C:\Program Files\Internet Explorer\iexplore';
  26: $prompt   = sub{ 'Sh-wrap>' };	# can be a routine...
  27: @kids = ();			# forked processes
  28: 
  29: # dispatch table with regexes, used to execute commands
  30: # based on a shell command passed to it as an argument
  31: 
  32: %dispatch = (
  33: 
  34: '^(http://)?\S+\.(\w){3}.*$'        =>sub{
  35: 	my $kpid = fork();
  36: 	if( $kpid == 0 ){ exec("\"$browser_path\" $_[0]") and exit}
  37: 	else { push( @kids, $kpid ); sleep 1 }
  38: # sleep needed to make sure that child acts first
  39: 	},
  40: 
  41: '^cd\s'		=> sub
  42: 	{ $_[0] =~ s!^cd\s!!; chdir($_[0]) },
  43: 
  44: '^(exit|quit)$'	=> sub{ kill( 9, @kids); exit },
  45: 
  46: '^(ftp|telnet|edit|debug).*'	=> sub { `start $_[0]` }
  47: # interactive progs in new window
  48: # will barf when running ftpd, telnetter, editors, debuggame etc...
  49: );
  50: 
  51: WH: while(1)
  52: {
  53: 
  54: print $prompt->();
  55: my $line = <>;
  56: chomp $line;
  57: 
  58: foreach $regex ( keys %dispatch )
  59:  {
  60:    if( $line =~ m!$regex! )
  61:    { $dispatch{ $regex }->($line); next WH }
  62:    # permit only one match
  63:  }
  64: 
  65: print `$line`;
  66: 
  67: }