0: #!/usr/bin/perl
1: #  yapsh - Yet Another Perl Shell
2: #  Copyright (C) 2001 Drake Wilson
3: #  This program is free software; you can redistribute it and/or
4: #  modify it under the terms of the GNU General Public License
5: #  as published by the Free Software Foundation; either version 2
6: #  of the License, or (at your option) any later version.
7: #  
8: #  This program is distributed in the hope that it will be useful,
9: #  but WITHOUT ANY WARRANTY; without even the implied warranty of
10: #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11: #  GNU General Public License for more details.
12: #  
13: #  If you wish to receive a copy of the GNU General Public License, write to the Free Software
14: #  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA, or see
15: #  <http://www.gnu.org/copyleft/gpl.html>.
16: #  
17: #  You can contact me by e-mail at drake@libcom.com.
18: 
19: use strict 'subs';
20: use Term::ReadLine;
21: use Shell;
22: my (@brackets, %special, $nprompt, $bprompt, $reader, $command, $toe);
23: @brackets = (%special = ());
24: $nprompt="& ";
25: $bprompt=". ";
26: $reader=new Term::ReadLine 'perl shell';
27: 
28: print "This is yapsh v1.0.  See source for license...\n\n";
29: 
30: {
31:     print $nprompt;
32:     last unless (defined($_ = $reader->readline()));
33:     $command="";
34:     do
35:     {
36: 	{
37: 	    my ($foo,$qux);
38: 	    foreach $foo (keys %special)
39: 	    {
40: 		if ($_ eq $foo)
41: 		{
42: 		    $qux = $special{$foo};
43: 		    &$qux();
44: 		}
45: 	    }
46: 	}
47: 	$_ = scalar reverse $_;
48: 	{
49: 	    my $ch;
50: 	    while ($ch = chop $_)
51: 	    {
52: 		$command .= $ch;
53: 		foreach ('{','(','[')
54: 		{
55: 		    push @brackets, $ch if ($ch eq $_);
56: 		}
57: 		foreach ('}',')',']')
58: 		{
59: 		    if ($ch eq $_)
60: 		    {
61: 			$ch = '[' if ($ch eq ']'); 
62: 			$ch = '(' if ($ch eq ')');
63: 			$ch = '{' if ($ch eq '}');
64: 			warn "Mismatched parentheses.\n" unless ($ch eq pop @brackets);
65: 		    }
66: 		}
67: 	    }
68: 	}
69: 	if (@brackets)
70: 	{
71: 	    $command .= " ";
72: 	    print $bprompt;
73: 	    $_ = $reader->readline();
74: 	}
75:     } while (@brackets);
76:     eval ($command);
77:     warn "$@\n" if ($@);
78:     redo;
79: }
80: __END__
81: 
82: =head1 yapsh - Yet Another Perl Shell
83: 
84: As the title implies, this is -- yet another Perl Shell.  Any
85: text typed in will be interpreted as Perl and executed immediately,
86: unless there are unmatched open brackets, in which case a different
87: prompt will be displayed to allow the user to continue until the
88: bracket becomes matched.
89: 
90: See the Shell.pm documentation for more information.
91: 
92: =head1 COPYRIGHT
93: 
94: Copyright (C) 2001 Drake Wilson, drake@libcom.com.