Article 10935 of comp.lang.perl:
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!gatech!swrinde!cs.utexas.edu!uunet!sybus.sybus.com!myrddin!pdn!bcutter
From:
[email protected] (Brooks Cutter)
Newsgroups: comp.lang.perl
Subject: Perl shell (iperl)
Date: 24 Feb 1994 00:07:50 GMT
Organization: AT&T Paradyne, Largo Florida
Lines: 109
Message-ID: <
[email protected]>
NNTP-Posting-Host: natas.paradyne.com
A number of people have been looking for a Perl Shell. I picked this
up off the net a while back, it was written by Cameron Simpson and
allows you to execute perl a line at a time...
The only thing I miss in it is history with gnu readline support...
#!/usr/local/bin/perl
#
# Interactive Perl.
#
# ! command Pass command to shell. $val <== $?
# ? Print $val.
# perl stuff $val <== eval 'perl stuff'
#
# Multiline perl text uses slosh extension.
# - Cameron Simpson <
[email protected]>, 23feb93
#
require 'flush.pl';
($cmd=$0) =~ s:.*/::;
$tty=(-t STDIN);
$ps1=$cmd.'> ';
$ps2=(' ' x length($cmd)).'> ';
defined($ENV{'SHELL'}) || ($ENV{'SHELL'}='/bin/sh');
$SIG{'INT'}='IGNORE';
$xit=0;
$val=0;
MAINLOOP:
while (&flush(STDOUT), ($tty && print STDERR $ps1), defined($_=<STDIN>)) {
tr/\n//d;
s/^\s+//;
# slosh extension
while (/\\$/) {
s/\\$//;
if (($tty && print STDERR $ps2), defined($line=<STDIN>)) {
$line =~ tr/\n//d;
$_.="\n".$line;
} else {
print STDERR "$cmd: unexpected EOF\n";
$xit=1;
last MAINLOOP;
}
}
if (/^!/) {
s/^!//;
$val=&shellcmd($_);
} else {
s/\s+$//;
if ($_ eq '?') {
print $val, "\n";
} else {
$val=eval $_;
if ($@) {
print STDERR "eval: $@\n";
$xit=1;
} else {
$xit=($val == 0);
}
}
}
}
$tty && print STDERR "\n";
exit $xit;
sub shellcmd {
local($shc)=@_;
local($xit,$pid);
if (!defined($pid=fork)) {
print STDERR "$cmd: fork fails: $!\n";
$xit=$!;
} elsif ($pid == 0) {
# child
$SIG{'INT'}='DEFAULT';
exec($ENV{'SHELL'},'-c',$shc);
print STDERR "$cmd: exec $ENV{'SHELL'} fails: $!\n";
exit 1;
} else {
# parent
local($wait);
$wait=waitpid($pid,0);
$SIG{'INT'}='IGNORE';
if ($wait == -1) {
die "no child? (waitpid: $!)";
} else {
if ($pid != $wait) {
die "waitpid($pid,0) == $wait";
} else {
$xit=$?;
}
}
}
$xit;
}
--
Brooks Cutter (I:
[email protected]) (U: ...uunet!pdn!bcutter)
Unix System Administrator, Engineering Services
AT&T Paradyne, Largo Florida
(Opinions expressed are my own and do not reflect those of my employer)
