lwall@netlabs.com (Larry Wall) (04/19/91)
Submitted-by: Larry Wall <lwall@netlabs.com>
Posting-number: Volume 18, Issue 51
Archive-name: perl/part33
[There are 36 kits for perl version 4.0.]
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 36 through sh. When all 36 kits have been run, read README.
echo "This is perl 4.0 kit 33 (of 36). If kit 33 is complete, the line"
echo '"'"End of kit 33 (of 36)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg eg/g eg/scan os2 t t/cmd t/comp t/io t/op usub x2p 2>/dev/null
echo Extracting os2/makefile
sed >os2/makefile <<'!STUFFY!FUNK!' -e 's/X//'
X#
X# Makefile for compiling Perl under OS/2
X#
X# Needs a Unix compatible make.
X# This makefile works for an initial compilation. It does not
X# include all dependencies and thus is unsuitable for serious
X# development work. Hey, I'm just inheriting what Diomidis gave me.
X#
X# Originally by Diomidis Spinellis, March 1990
X# Adjusted for OS/2 port by Raymond Chen, June 1990
X#
X
X# Source files
XSRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \
Xeval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \
Xstab.c str.c toke.c util.c os2.c popen.c director.c suffix.c mktemp.c
X
X# Object files
XOBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \
Xdolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \
Xregexec.obj stab.obj str.obj toke.obj util.obj os2.obj popen.obj \
Xdirector.obj suffix.obj mktemp.obj
X
X# Files in the OS/2 distribution
XDOSFILES=config.h director.c dir.h makefile os2.c popen.c suffix.c \
Xmktemp.c readme.os2
X
X# Yacc flags
XYFLAGS=-d
X
X# Manual pages
XMAN=perlman.1 perlman.2 perlman.3 perlman.4
X
XCC=cl
X# CBASE = flags everybody gets
X# CPLAIN = flags for modules that give the compiler indigestion
X# CFLAGS = flags for milder modules
X# PERL = which version of perl to build
X#
X# For preliminary building: No optimization, DEBUGGING set, symbols included.
X#CBASE=-AL -Zi -G2 -Gs -DDEBUGGING
X#CPLAIN=$(CBASE) -Od
X#CFLAGS=$(CBASE) -Od
X#PERL=perlsym.exe
X
X# For the final build: Optimization on, symbols stripped.
XCBASE=-AL -Zi -G2 -Gs -DDEBUGGING
XCPLAIN=$(CBASE) -Olt
XCFLAGS=$(CBASE) -Oeglt
XPERL=perl.exe
X
X# Destination directory for executables
XDESTDIR=\usr\bin
X
X# Deliverables
X#
Xall: $(PERL) glob.exe
X
Xperl.exe: $(OBJ) perl.arp
X link @perl.arp,perl,nul,/stack:32767 /NOE;
X exehdr /nologo /newfiles /pmtype:windowcompat perl.exe >nul
X
Xperlsym.exe: $(OBJ) perl.arp
X link @perl.arp,perlsym,nul,/stack:32767 /NOE /CODE;
X exehdr /nologo /newfiles /pmtype:windowcompat perlsym.exe >nul
X
Xperl.arp:
X echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp
X echo eval+form+hash+perl+perly+regcomp+regexec+stab+suffix+ >>perl.arp
X echo str+toke+util+os2+popen+director+\c600\lib\setargv >>perl.arp
X
Xglob.exe: glob.c
X $(CC) glob.c setargv.obj -link /NOE
X exehdr /nologo /newfiles /pmtype:windowcompat glob.exe >nul
X
Xarray.obj: array.c
X $(CC) $(CPLAIN) -c array.c
Xcmd.obj: cmd.c
Xcons.obj: cons.c perly.h
Xconsarg.obj: consarg.c
X# $(CC) $(CPLAIN) -c consarg.c
Xdoarg.obj: doarg.c
Xdoio.obj: doio.c
Xdolist.obj: dolist.c
Xdump.obj: dump.c
Xeval.obj: eval.c evalargs.xc
X $(CC) /B2c2l /B3c3l $(CFLAGS) -c eval.c
Xform.obj: form.c
Xhash.obj: hash.c
Xperl.obj: perl.y
Xperly.obj: perly.c
Xregcomp.obj: regcomp.c
Xregexec.obj: regexec.c
Xstab.obj: stab.c
X $(CC) $(CPLAIN) -c stab.c
Xstr.obj: str.c
Xsuffix.obj: suffix.c
Xtoke.obj: toke.c
X $(CC) /B3c3l $(CFLAGS) -c toke.c
Xutil.obj: util.c
X# $(CC) $(CPLAIN) -c util.c
Xperly.h: ytab.h
X cp ytab.h perly.h
Xdirector.obj: director.c
Xpopen.obj: popen.c
Xos2.obj: os2.c
X
Xperl.1: $(MAN)
X nroff -man $(MAN) >perl.1
X
Xinstall: all
X exepack perl.exe $(DESTDIR)\perl.exe
X exepack glob.exe $(DESTDIR)\glob.exe
X
Xclean:
X rm -f *.obj *.exe perl.1 perly.h perl.arp
X
Xtags:
X ctags *.c *.h *.xc
X
Xdosperl:
X mv $(DOSFILES) ../perl30.new
X
Xdoskit:
X mv $(DOSFILES) ../os2
!STUFFY!FUNK!
echo Extracting os2/Makefile
sed >os2/Makefile <<'!STUFFY!FUNK!' -e 's/X//'
X#
X# Makefile for compiling Perl under OS/2
X#
X# Needs a Unix compatible make.
X# This makefile works for an initial compilation. It does not
X# include all dependencies and thus is unsuitable for serious
X# development work. Hey, I'm just inheriting what Diomidis gave me.
X#
X# Originally by Diomidis Spinellis, March 1990
X# Adjusted for OS/2 port by Raymond Chen, June 1990
X#
X
X# Source files
XSRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \
Xeval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \
Xstab.c str.c toke.c util.c os2.c popen.c director.c
X
X# Object files
XOBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \
Xdolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \
Xregexec.obj stab.obj str.obj toke.obj util.obj os2.obj popen.obj \
Xdirector.obj suffix.obj
X
X# Files in the OS/2 distribution
XDOSFILES=config.h director.c makefile os2.c popen.c suffix.c readme.os2
X
X# Yacc flags
XYFLAGS=-d
X
X# Manual pages
XMAN=perlman.1 perlman.2 perlman.3 perlman.4
X
XCC=cl
X# CBASE = flags everybody gets
X# CPLAIN = flags for modules that give the compiler indigestion
X# CFLAGS = flags for milder modules
X# PERL = which version of perl to build
X#
X# For preliminary building: No optimization, DEBUGGING set, symbols included.
X#CBASE=-AL -Zi -G2 -Gs -DDEBUGGING
X#CPLAIN=$(CBASE) -Od
X#CFLAGS=$(CBASE) -Od
X#PERL=perlsym.exe
X
X# For the final build: Optimization on, no DEBUGGING, symbols stripped.
XCBASE=-AL -Zi -G2 -Gs
XCPLAIN=$(CBASE) -Oilt
XCFLAGS=$(CBASE) -Ox
XPERL=perl.exe
X
X# Destination directory for executables
XDESTDIR=\usr\bin
X
X# Deliverables
X#
Xall: $(PERL) glob.exe
X
Xperl.exe: $(OBJ) perl.arp
X link @perl.arp,perl,nul,/stack:32767 /NOE;
X exehdr /nologo /newfiles /pmtype:windowcompat perl.exe >nul
X
Xperlsym.exe: $(OBJ) perl.arp
X link @perl.arp,perlsym,nul,/stack:32767 /NOE /CODE;
X exehdr /nologo /newfiles /pmtype:windowcompat perlsym.exe >nul
X
Xperl.arp:
X echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp
X echo eval+form+hash+perl+perly+regcomp+regexec+stab+suffix+ >>perl.arp
X echo str+toke+util+os2+popen+director+\c600\lib\setargv >>perl.arp
X
Xglob.exe: glob.c
X $(CC) glob.c \c600\lib\setargv.obj -link /NOE
X exehdr /nologo /newfiles /pmtype:windowcompat glob.exe >nul
X
Xarray.obj: array.c
X $(CC) $(CPLAIN) -c array.c
Xcmd.obj: cmd.c
Xcons.obj: cons.c perly.h
Xconsarg.obj: consarg.c
X# $(CC) $(CPLAIN) -c consarg.c
Xdoarg.obj: doarg.c
Xdoio.obj: doio.c
Xdolist.obj: dolist.c
Xdump.obj: dump.c
Xeval.obj: eval.c evalargs.xc
X $(CC) /B3 \c600\binp\c3l $(CFLAGS) -c eval.c
Xform.obj: form.c
Xhash.obj: hash.c
Xperl.obj: perl.y
Xperly.obj: perly.c
Xregcomp.obj: regcomp.c
Xregexec.obj: regexec.c
Xstab.obj: stab.c
X $(CC) $(CPLAIN) -c stab.c
Xstr.obj: str.c
Xsuffix.obj: suffix.c
Xtoke.obj: toke.c
X $(CC) /B3 \c600\binp\c3l $(CFLAGS) -c toke.c
Xutil.obj: util.c
X# $(CC) $(CPLAIN) -c util.c
Xperly.h: ytab.h
X cp ytab.h perly.h
Xdirector.obj: director.c
Xpopen.obj: popen.c
Xos2.obj: os2.c
X
Xperl.1: $(MAN)
X nroff -man $(MAN) >perl.1
X
Xinstall: all
X exepack perl.exe $(DESTDIR)\perl.exe
X exepack glob.exe $(DESTDIR)\glob.exe
X
Xclean:
X rm -f *.obj *.exe perl.1 perly.h perl.arp
X
Xtags:
X ctags *.c *.h *.xc
X
Xdosperl:
X mv $(DOSFILES) ../perl30.new
X
Xdoskit:
X mv $(DOSFILES) ../os2
!STUFFY!FUNK!
echo Extracting x2p/Makefile.SH
sed >x2p/Makefile.SH <<'!STUFFY!FUNK!' -e 's/X//'
Xcase "$0" in
X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
Xesac
Xcase $CONFIG in
X'')
X if test ! -f config.sh; then
X ln ../config.sh . || \
X ln -s ../config.sh . || \
X ln ../../config.sh . || \
X ln ../../../config.sh . || \
X (echo "Can't find config.sh."; exit 1)
X fi 2>/dev/null
X . ./config.sh
X ;;
Xesac
Xcase "$mallocsrc" in
X'') ;;
X*) mallocsrc="../$mallocsrc";;
Xesac
Xecho "Extracting x2p/Makefile (with variable substitutions)"
Xcat >Makefile <<!GROK!THIS!
X# $Header: Makefile.SH,v 4.0 91/03/20 01:57:03 lwall Locked $
X#
X# $Log: Makefile.SH,v $
X# Revision 4.0 91/03/20 01:57:03 lwall
X# 4.0 baseline.
X#
X#
X
XCC = $cc
XYACC = $yacc
Xbin = $bin
Xlib = $lib
Xmansrc = $mansrc
Xmanext = $manext
XCFLAGS = $ccflags $optimize
XLDFLAGS = $ldflags
XSMALL = $small
XLARGE = $large $split
Xmallocsrc = $mallocsrc
Xmallocobj = $mallocobj
X
Xlibs = $libs
X!GROK!THIS!
X
Xcat >>Makefile <<'!NO!SUBS!'
X
Xpublic = a2p s2p find2perl
X
Xprivate =
X
Xmanpages = a2p.man s2p.man
X
Xutil =
X
Xsh = Makefile.SH makedepend.SH
X
Xh = EXTERN.h INTERN.h config.h handy.h hash.h a2p.h str.h util.h
X
Xc = hash.c $(mallocsrc) str.c util.c walk.c
X
Xobj = hash.o $(mallocobj) str.o util.o walk.o
X
Xlintflags = -phbvxac
X
Xaddedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
X
X# grrr
XSHELL = /bin/sh
X
X.c.o:
X $(CC) -c $(CFLAGS) $(LARGE) $*.c
X
Xall: $(public) $(private) $(util)
X touch all
X
Xa2p: $(obj) a2p.o
X $(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
X
Xa2p.c: a2p.y
X @ echo Expect 226 shift/reduce conflicts...
X $(YACC) a2p.y
X mv y.tab.c a2p.c
X
Xa2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h
X $(CC) -c $(CFLAGS) $(LARGE) a2p.c
X
Xinstall: a2p s2p
X# won't work with csh
X export PATH || exit 1
X - mv $(bin)/a2p $(bin)/a2p.old 2>/dev/null
X - mv $(bin)/s2p $(bin)/s2p.old 2>/dev/null
X - if test `pwd` != $(bin); then cp $(public) $(bin); fi
X cd $(bin); \
Xfor pub in $(public); do \
Xchmod +x `basename $$pub`; \
Xdone
X# chmod +x makedir
X# - ./makedir `filexp $(lib)`
X# - \
X#if test `pwd` != `filexp $(lib)`; then \
X#cp $(private) `filexp $(lib)`; \
X#fi
X# cd `filexp $(lib)`; \
X#for priv in $(private); do \
X#chmod +x `basename $$priv`; \
X#done
X - if test `pwd` != $(mansrc); then \
Xfor page in $(manpages); do \
Xcp $$page $(mansrc)/`basename $$page .man`.$(manext); \
Xdone; \
Xfi
X
Xclean:
X rm -f a2p *.o
X
Xrealclean: clean
X rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p all
X
X# The following lint has practically everything turned on. Unfortunately,
X# you have to wade through a lot of mumbo jumbo that can't be suppressed.
X# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
X# for that spot.
X
Xlint:
X lint $(lintflags) $(defs) $(c) > a2p.fuzz
X
Xdepend: ../makedepend
X ../makedepend
X
Xclist:
X echo $(c) | tr ' ' '\012' >.clist
X
Xhlist:
X echo $(h) | tr ' ' '\012' >.hlist
X
Xshlist:
X echo $(sh) | tr ' ' '\012' >.shlist
X
Xconfig.sh: ../config.sh
X rm -f config.sh
X ln ../config.sh .
X
X# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
X$(obj):
X @ echo "You haven't done a "'"make depend" yet!'; exit 1
Xmakedepend: makedepend.SH
X /bin/sh makedepend.SH
X!NO!SUBS!
X$eunicefix Makefile
Xcase `pwd` in
X*SH)
X $rm -f ../Makefile
X ln Makefile ../Makefile
X ;;
Xesac
!STUFFY!FUNK!
echo Extracting t/op/re_tests
sed >t/op/re_tests <<'!STUFFY!FUNK!' -e 's/X//'
Xabc abc y $& abc
Xabc xbc n - -
Xabc axc n - -
Xabc abx n - -
Xabc xabcy y $& abc
Xabc ababc y $& abc
Xab*c abc y $& abc
Xab*bc abc y $& abc
Xab*bc abbc y $& abbc
Xab*bc abbbbc y $& abbbbc
Xab{0,}bc abbbbc y $& abbbbc
Xab+bc abbc y $& abbc
Xab+bc abc n - -
Xab+bc abq n - -
Xab{1,}bc abq n - -
Xab+bc abbbbc y $& abbbbc
Xab{1,}bc abbbbc y $& abbbbc
Xab{1,3}bc abbbbc y $& abbbbc
Xab{3,4}bc abbbbc y $& abbbbc
Xab{4,5}bc abbbbc n - -
Xab?bc abbc y $& abbc
Xab?bc abc y $& abc
Xab{0,1}bc abc y $& abc
Xab?bc abbbbc n - -
Xab?c abc y $& abc
Xab{0,1}c abc y $& abc
X^abc$ abc y $& abc
X^abc$ abcc n - -
X^abc abcc y $& abc
X^abc$ aabc n - -
Xabc$ aabc y $& abc
X^ abc y $&
X$ abc y $&
Xa.c abc y $& abc
Xa.c axc y $& axc
Xa.*c axyzc y $& axyzc
Xa.*c axyzd n - -
Xa[bc]d abc n - -
Xa[bc]d abd y $& abd
Xa[b-d]e abd n - -
Xa[b-d]e ace y $& ace
Xa[b-d] aac y $& ac
Xa[-b] a- y $& a-
Xa[b-] a- y $& a-
Xa[b-a] - c - -
Xa[]b - c - -
Xa[ - c - -
Xa] a] y $& a]
Xa[]]b a]b y $& a]b
Xa[^bc]d aed y $& aed
Xa[^bc]d abd n - -
Xa[^-b]c adc y $& adc
Xa[^-b]c a-c n - -
Xa[^]b]c a]c n - -
Xa[^]b]c adc y $& adc
Xab|cd abc y $& ab
Xab|cd abcd y $& ab
X()ef def y $&-$1 ef-
X()* - c - -
X*a - c - -
X^* - c - -
X$* - c - -
X(*)b - c - -
X$b b n - -
Xa\ - c - -
Xa\(b a(b y $&-$1 a(b-
Xa\(*b ab y $& ab
Xa\(*b a((b y $& a((b
Xa\\b a\b y $& a\b
Xabc) - c - -
X(abc - c - -
X((a)) abc y $&-$1-$2 a-a-a
X(a)b(c) abc y $&-$1-$2 abc-a-c
Xa+b+c aabbabc y $& abc
Xa{1,}b{1,}c aabbabc y $& abc
Xa** - c - -
Xa*? - c - -
X(a*)* - c - -
X(a*)+ - c - -
X(a|)* - c - -
X(a*|b)* - c - -
X(a+|b)* ab y $&-$1 ab-b
X(a+|b){0,} ab y $&-$1 ab-b
X(a+|b)+ ab y $&-$1 ab-b
X(a+|b){1,} ab y $&-$1 ab-b
X(a+|b)? ab y $&-$1 a-a
X(a+|b){0,1} ab y $&-$1 a-a
X(^)* - c - -
X(ab|)* - c - -
X)( - c - -
X[^ab]* cde y $& cde
Xabc n - -
Xa* y $&
X([abc])*d abbbcd y $&-$1 abbbcd-c
X([abc])*bcd abcd y $&-$1 abcd-a
Xa|b|c|d|e e y $& e
X(a|b|c|d|e)f ef y $&-$1 ef-e
X((a*|b))* - c - -
Xabcd*efg abcdefg y $& abcdefg
Xab* xabyabbbz y $& ab
Xab* xayabbbz y $& a
X(ab|cd)e abcde y $&-$1 cde-cd
X[abhgefdc]ij hij y $& hij
X^(ab|cd)e abcde n x$1y xy
X(abc|)ef abcdef y $&-$1 ef-
X(a|b)c*d abcd y $&-$1 bcd-b
X(ab|ab*)bc abc y $&-$1 abc-a
Xa([bc]*)c* abc y $&-$1 abc-bc
Xa([bc]*)(c*d) abcd y $&-$1-$2 abcd-bc-d
Xa([bc]+)(c*d) abcd y $&-$1-$2 abcd-bc-d
Xa([bc]*)(c+d) abcd y $&-$1-$2 abcd-b-cd
Xa[bcd]*dcdcde adcdcde y $& adcdcde
Xa[bcd]+dcdcde adcdcde n - -
X(ab|a)b*c abc y $&-$1 abc-ab
X((a)(b)c)(d) abcd y $1-$2-$3-$4 abc-a-b-d
X[a-zA-Z_][a-zA-Z0-9_]* alpha y $& alpha
X^a(bc+|b[eh])g|.h$ abh y $&-$1 bh-
X(bc+d$|ef*g.|h?i(j|k)) effgz y $&-$1-$2 effgz-effgz-
X(bc+d$|ef*g.|h?i(j|k)) ij y $&-$1-$2 ij-ij-j
X(bc+d$|ef*g.|h?i(j|k)) effg n - -
X(bc+d$|ef*g.|h?i(j|k)) bcdd n - -
X(bc+d$|ef*g.|h?i(j|k)) reffgz y $&-$1-$2 effgz-effgz-
X((((((((((a)))))))))) a y $10 a
X((((((((((a))))))))))\10 aa y $& aa
X((((((((((a))))))))))\41 aa n - -
X((((((((((a))))))))))\41 a! y $& a!
X(((((((((a))))))))) a y $& a
Xmultiple words of text uh-uh n - -
Xmultiple words multiple words, yeah y $& multiple words
X(.*)c(.*) abcde y $&-$1-$2 abcde-ab-de
X\((.*), (.*)\) (a, b) y ($2, $1) (b, a)
X[k] ab n - -
Xabcd abcd y $&-\$&-\\$& abcd-$&-\abcd
Xa(bc)d abcd y $1-\$1-\\$1 bc-$1-\bc
Xa[-]?c ac y $& ac
X(abc)\1 abcabc y $1 abc
X([a-c]*)\1 abcabc y $1 abc
!STUFFY!FUNK!
echo Extracting eg/g/gsh
sed >eg/g/gsh <<'!STUFFY!FUNK!' -e 's/X//'
X#! /usr/bin/perl
X
X# $Header: gsh,v 4.0 91/03/20 01:10:40 lwall Locked $
X
X# Do rsh globally--see man page
X
X$SIG{'QUIT'} = 'quit'; # install signal handler for SIGQUIT
X
Xsub getswitches {
X while ($ARGV[0] =~ /^-/) { # parse switches
X $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift(@ARGV),next);
X $ARGV[0] =~ /^-s/ && ($silent++,shift(@ARGV),next);
X $ARGV[0] =~ /^-d/ && ($dodist++,shift(@ARGV),next);
X $ARGV[0] =~ /^-n/ && ($n=' -n',shift(@ARGV),next);
X $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift(@ARGV),shift(@ARGV),
X next);
X last;
X }
X}
X
Xdo getswitches(); # get any switches before class
X$systype = shift; # get name representing set of hosts
Xdo getswitches(); # same switches allowed after class
X
Xif ($dodist) { # distribute input over all rshes?
X `cat >/tmp/gsh$$`; # get input into a handy place
X $dist = " </tmp/gsh$$"; # each rsh takes input from there
X}
X
X$cmd = join(' ',@ARGV); # remaining args constitute the command
X$cmd =~ s/'/'"'"'/g; # quote any embedded single quotes
X
X$one_of_these = ":$systype:"; # prepare to expand "macros"
X$one_of_these =~ s/\+/:/g; # we hope to end up with list of
X$one_of_these =~ s/-/:-/g; # colon separated attributes
X
X@ARGV = ();
Xpush(@ARGV,'.grem') if -f '.grem';
Xpush(@ARGV,'.ghosts') if -f '.ghosts';
Xpush(@ARGV,'/etc/ghosts');
X
X$remainder = '';
X
Xline: while (<>) { # for each line of ghosts
X
X s/[ \t]*\n//; # trim trailing whitespace
X if (!$_ || /^#/) { # skip blank line or comment
X next line;
X }
X
X if (/^(\w+)=(.+)/) { # a macro line?
X $name = $1; $repl = $2;
X $repl =~ s/\+/:/g;
X $repl =~ s/-/:-/g;
X $one_of_these =~ s/:$name:/:$repl:/; # do expansion in "wanted" list
X $repl =~ s/:/:-/g;
X $one_of_these =~ s/:-$name:/:-$repl:/;
X next line;
X }
X
X # we have a normal line
X
X @attr = split(' '); # a list of attributes to match against
X # which we put into an array
X $host = $attr[0]; # the first attribute is the host name
X if ($showhost) {
X $showhost = "$host:\t";
X }
X
X $wanted = 0;
X foreach $attr (@attr) { # iterate over attribute array
X $wanted++ if index($one_of_these,":$attr:") >= 0;
X $wanted = -9999 if index($one_of_these,":-$attr:") >= 0;
X }
X if ($wanted > 0) {
X print "rsh $host$l$n '$cmd'\n" unless $silent;
X $SIG{'INT'} = 'DEFAULT';
X if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) { # start an rsh
X $SIG{'INT'} = 'cont';
X for ($iter=0; <PIPE>; $iter++) {
X unless ($iter) {
X $remainder .= "$host+"
X if /Connection timed out|Permission denied/;
X }
X print $showhost,$_;
X }
X close(PIPE);
X } else {
X print "(Can't execute rsh: $!)\n";
X $SIG{'INT'} = 'cont';
X }
X }
X}
X
Xunlink "/tmp/gsh$$" if $dodist;
X
Xif ($remainder) {
X chop($remainder);
X open(grem,">.grem") || (printf stderr "Can't make a .grem file: $!\n");
X print grem 'rem=', $remainder, "\n";
X close(grem);
X print 'rem=', $remainder, "\n";
X}
X
X# here are a couple of subroutines that serve as signal handlers
X
Xsub cont {
X print "\rContinuing...\n";
X $remainder .= "$host+";
X}
X
Xsub quit {
X $| = 1;
X print "\r";
X $SIG{'INT'} = '';
X kill 2, $$;
X}
!STUFFY!FUNK!
echo Extracting t/io/fs.t
sed >t/io/fs.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: fs.t,v 4.0 91/03/20 01:50:55 lwall Locked $
X
Xprint "1..22\n";
X
X$wd = `pwd`;
Xchop($wd);
X
X`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
Xchdir './tmp';
X`/bin/rm -rf a b c x`;
X
Xumask(022);
X
Xif (umask(0) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
Xopen(fh,'>x') || die "Can't create x";
Xclose(fh);
Xopen(fh,'>a') || die "Can't create a";
Xclose(fh);
X
Xif (link('a','b')) {print "ok 2\n";} else {print "not ok 2\n";}
X
Xif (link('b','c')) {print "ok 3\n";} else {print "not ok 3\n";}
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('c');
X
Xif ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";}
Xif (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";}
X
Xif ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('c');
Xif (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
X
Xif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('c');
Xif (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('x');
Xif (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
X
Xif ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";}
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('b');
Xif ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('x');
Xif ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";}
X
Xif (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('a');
Xif ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
X$foo = (utime 500000000,500000001,'b');
Xif ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('b');
Xif ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
Xif (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#)
X {print "ok 18\n";}
Xelse
X {print "not ok 18 $atime $mtime\n";}
X
Xif ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";}
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('b');
Xif ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
Xunlink 'c';
X
Xchdir $wd || die "Can't cd back to $wd";
X
Xunlink 'c';
Xif (`ls -l perl 2>/dev/null` =~ /^l.*->/) { # we have symbolic links
X if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
X $foo = `grep perl c`;
X if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
X}
Xelse {
X print "ok 21\nok 22\n";
X}
!STUFFY!FUNK!
echo Extracting t/comp/cmdopt.t
sed >t/comp/cmdopt.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cmdopt.t,v 4.0 91/03/20 01:49:58 lwall Locked $
X
Xprint "1..40\n";
X
X# test the optimization of constants
X
Xif (1) { print "ok 1\n";} else { print "not ok 1\n";}
Xunless (0) { print "ok 2\n";} else { print "not ok 2\n";}
X
Xif (0) { print "not ok 3\n";} else { print "ok 3\n";}
Xunless (1) { print "not ok 4\n";} else { print "ok 4\n";}
X
Xunless (!1) { print "ok 5\n";} else { print "not ok 5\n";}
Xif (!0) { print "ok 6\n";} else { print "not ok 6\n";}
X
Xunless (!0) { print "not ok 7\n";} else { print "ok 7\n";}
Xif (!1) { print "not ok 8\n";} else { print "ok 8\n";}
X
X$x = 1;
Xif (1 && $x) { print "ok 9\n";} else { print "not ok 9\n";}
Xif (0 && $x) { print "not ok 10\n";} else { print "ok 10\n";}
X$x = '';
Xif (1 && $x) { print "not ok 11\n";} else { print "ok 11\n";}
Xif (0 && $x) { print "not ok 12\n";} else { print "ok 12\n";}
X
X$x = 1;
Xif (1 || $x) { print "ok 13\n";} else { print "not ok 13\n";}
Xif (0 || $x) { print "ok 14\n";} else { print "not ok 14\n";}
X$x = '';
Xif (1 || $x) { print "ok 15\n";} else { print "not ok 15\n";}
Xif (0 || $x) { print "not ok 16\n";} else { print "ok 16\n";}
X
X
X# test the optimization of registers
X
X$x = 1;
Xif ($x) { print "ok 17\n";} else { print "not ok 17\n";}
Xunless ($x) { print "not ok 18\n";} else { print "ok 18\n";}
X
X$x = '';
Xif ($x) { print "not ok 19\n";} else { print "ok 19\n";}
Xunless ($x) { print "ok 20\n";} else { print "not ok 20\n";}
X
X# test optimization of string operations
X
X$a = 'a';
Xif ($a eq 'a') { print "ok 21\n";} else { print "not ok 21\n";}
Xif ($a ne 'a') { print "not ok 22\n";} else { print "ok 22\n";}
X
Xif ($a =~ /a/) { print "ok 23\n";} else { print "not ok 23\n";}
Xif ($a !~ /a/) { print "not ok 24\n";} else { print "ok 24\n";}
X# test interaction of logicals and other operations
X
X$a = 'a';
X$x = 1;
Xif ($a eq 'a' && $x) { print "ok 25\n";} else { print "not ok 25\n";}
Xif ($a ne 'a' && $x) { print "not ok 26\n";} else { print "ok 26\n";}
X$x = '';
Xif ($a eq 'a' && $x) { print "not ok 27\n";} else { print "ok 27\n";}
Xif ($a ne 'a' && $x) { print "not ok 28\n";} else { print "ok 28\n";}
X
X$x = 1;
Xif ($a eq 'a' || $x) { print "ok 29\n";} else { print "not ok 29\n";}
Xif ($a ne 'a' || $x) { print "ok 30\n";} else { print "not ok 30\n";}
X$x = '';
Xif ($a eq 'a' || $x) { print "ok 31\n";} else { print "not ok 31\n";}
Xif ($a ne 'a' || $x) { print "not ok 32\n";} else { print "ok 32\n";}
X
X$x = 1;
Xif ($a =~ /a/ && $x) { print "ok 33\n";} else { print "not ok 33\n";}
Xif ($a !~ /a/ && $x) { print "not ok 34\n";} else { print "ok 34\n";}
X$x = '';
Xif ($a =~ /a/ && $x) { print "not ok 35\n";} else { print "ok 35\n";}
X if ($a !~ /a/ && $x) { print "not ok 36\n";} else { print "ok 36\n";}
X
X$x = 1;
Xif ($a =~ /a/ || $x) { print "ok 37\n";} else { print "not ok 37\n";}
Xif ($a !~ /a/ || $x) { print "ok 38\n";} else { print "not ok 38\n";}
X$x = '';
Xif ($a =~ /a/ || $x) { print "ok 39\n";} else { print "not ok 39\n";}
Xif ($a !~ /a/ || $x) { print "not ok 40\n";} else { print "ok 40\n";}
!STUFFY!FUNK!
echo Extracting t/op/auto.t
sed >t/op/auto.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: auto.t,v 4.0 91/03/20 01:51:35 lwall Locked $
X
Xprint "1..34\n";
X
X$x = 10000;
Xif (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
Xif (0 + $x-- - 1 == 10000) { print "ok 2\n";} else {print "not ok 2\n";}
Xif (1 * $x == 10000) { print "ok 3\n";} else {print "not ok 3\n";}
Xif (0 + $x-- - 0 == 10000) { print "ok 4\n";} else {print "not ok 4\n";}
Xif (1 + $x == 10000) { print "ok 5\n";} else {print "not ok 5\n";}
Xif (1 + $x++ == 10000) { print "ok 6\n";} else {print "not ok 6\n";}
Xif (0 + $x == 10000) { print "ok 7\n";} else {print "not ok 7\n";}
Xif (0 + --$x + 1 == 10000) { print "ok 8\n";} else {print "not ok 8\n";}
Xif (0 + ++$x + 0 == 10000) { print "ok 9\n";} else {print "not ok 9\n";}
Xif ($x == 10000) { print "ok 10\n";} else {print "not ok 10\n";}
X
X$x[0] = 10000;
Xif (0 + ++$x[0] - 1 == 10000) { print "ok 11\n";} else {print "not ok 11\n";}
Xif (0 + $x[0]-- - 1 == 10000) { print "ok 12\n";} else {print "not ok 12\n";}
Xif (1 * $x[0] == 10000) { print "ok 13\n";} else {print "not ok 13\n";}
Xif (0 + $x[0]-- - 0 == 10000) { print "ok 14\n";} else {print "not ok 14\n";}
Xif (1 + $x[0] == 10000) { print "ok 15\n";} else {print "not ok 15\n";}
Xif (1 + $x[0]++ == 10000) { print "ok 16\n";} else {print "not ok 16\n";}
Xif (0 + $x[0] == 10000) { print "ok 17\n";} else {print "not ok 17\n";}
Xif (0 + --$x[0] + 1 == 10000) { print "ok 18\n";} else {print "not ok 18\n";}
Xif (0 + ++$x[0] + 0 == 10000) { print "ok 19\n";} else {print "not ok 19\n";}
Xif ($x[0] == 10000) { print "ok 20\n";} else {print "not ok 20\n";}
X
X$x{0} = 10000;
Xif (0 + ++$x{0} - 1 == 10000) { print "ok 21\n";} else {print "not ok 21\n";}
Xif (0 + $x{0}-- - 1 == 10000) { print "ok 22\n";} else {print "not ok 22\n";}
Xif (1 * $x{0} == 10000) { print "ok 23\n";} else {print "not ok 23\n";}
Xif (0 + $x{0}-- - 0 == 10000) { print "ok 24\n";} else {print "not ok 24\n";}
Xif (1 + $x{0} == 10000) { print "ok 25\n";} else {print "not ok 25\n";}
Xif (1 + $x{0}++ == 10000) { print "ok 26\n";} else {print "not ok 26\n";}
Xif (0 + $x{0} == 10000) { print "ok 27\n";} else {print "not ok 27\n";}
Xif (0 + --$x{0} + 1 == 10000) { print "ok 28\n";} else {print "not ok 28\n";}
Xif (0 + ++$x{0} + 0 == 10000) { print "ok 29\n";} else {print "not ok 29\n";}
Xif ($x{0} == 10000) { print "ok 30\n";} else {print "not ok 30\n";}
X
X# test magical autoincrement
X
Xif (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
Xif (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
Xif (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
Xif (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
!STUFFY!FUNK!
echo Extracting t/op/list.t
sed >t/op/list.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: list.t,v 4.0 91/03/20 01:53:24 lwall Locked $
X
Xprint "1..27\n";
X
X@foo = (1, 2, 3, 4);
Xif ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
X
X$_ = join(':',@foo);
Xif ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
X
X($a,$b,$c,$d) = (1,2,3,4);
Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
X
X($c,$b,$a) = split(/ /,"111 222 333");
Xif ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
X
X($a,$b,$c) = ($c,$b,$a);
Xif ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5 $a;$b;$c\n";}
X
X($a, $b) = ($b, $a);
Xif ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
X
X($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
Xif ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";}
Xif ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";}
Xif ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";}
Xif ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
X
X@foo = (1,2,3,4,5,6,7,8);
X($a, $b, $c, $d) = @foo;
Xprint "#11 $a;$b;$c;$d eq 1;2;3;4\n";
Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
X
X@foo = @bar = (1);
Xif (join(':',@foo,@bar) eq '1:1') {print "ok 12\n";} else {print "not ok 12\n";}
X
X@foo = ();
X@foo = 1+2+3;
Xif (join(':',@foo) eq '6') {print "ok 13\n";} else {print "not ok 13\n";}
X
Xfor ($x = 0; $x < 3; $x++) {
X ($a, $b, $c) =
X $x == 0?
X ('ok ', 14, "\n"):
X $x == 1?
X ('ok ', 15, "\n"):
X # default
X ('ok ', 16, "\n");
X
X print $a,$b,$c;
X}
X
X@a = ($x == 12345 || (1,2,3));
Xif (join('',@a) eq '123') {print "ok 17\n";} else {print "not ok 17\n";}
X
X@a = ($x == $x || (4,5,6));
Xif (join('',@a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
X
Xif (join('',1,2,(3,4,5)) eq '12345'){print "ok 19\n";}else{print "not ok 19\n";}
Xif (join('',(1,2,3,4,5)) eq '12345'){print "ok 20\n";}else{print "not ok 20\n";}
Xif (join('',(1,2,3,4),5) eq '12345'){print "ok 21\n";}else{print "not ok 21\n";}
Xif (join('',1,(2,3,4),5) eq '12345'){print "ok 22\n";}else{print "not ok 22\n";}
Xif (join('',1,2,(3,4),5) eq '12345'){print "ok 23\n";}else{print "not ok 23\n";}
Xif (join('',1,2,3,(4),5) eq '12345'){print "ok 24\n";}else{print "not ok 24\n";}
X
Xfor ($x = 0; $x < 3; $x++) {
X ($a, $b, $c) = do {
X if ($x == 0) {
X ('ok ', 25, "\n");
X }
X elsif ($x == 1) {
X ('ok ', 26, "\n");
X }
X else {
X ('ok ', 27, "\n");
X }
X };
X
X print $a,$b,$c;
X}
X
!STUFFY!FUNK!
echo Extracting usub/mus
sed >usub/mus <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
Xwhile (<>) {
X if (s/^CASE\s+//) {
X @fields = split;
X $funcname = pop(@fields);
X $rettype = "@fields";
X @modes = ();
X @types = ();
X @names = ();
X @outies = ();
X @callnames = ();
X $pre = "\n";
X $post = '';
X
X while (<>) {
X last unless /^[IO]+\s/;
X @fields = split(' ');
X push(@modes, shift(@fields));
X push(@names, pop(@fields));
X push(@types, "@fields");
X }
X while (s/^<\s//) {
X $pre .= "\t $_";
X $_ = <>;
X }
X while (s/^>\s//) {
X $post .= "\t $_";
X $_ = <>;
X }
X $items = @names;
X $namelist = '$' . join(', $', @names);
X $namelist = '' if $namelist eq '$';
X print <<EOF;
X case US_$funcname:
X if (items != $items)
X fatal("Usage: &$funcname($namelist)");
X else {
XEOF
X if ($rettype eq 'void') {
X print <<EOF;
X int retval = 1;
XEOF
X }
X else {
X print <<EOF;
X $rettype retval;
XEOF
X }
X foreach $i (1..@names) {
X $mode = $modes[$i-1];
X $type = $types[$i-1];
X $name = $names[$i-1];
X if ($type =~ /^[A-Z]+\*$/) {
X $cast = "*($type*)";
X }
X else {
X $cast = "($type)";
X }
X $what = ($type =~ /^(struct\s+\w+|char|[A-Z]+)\s*\*$/ ? "get" : "gnum");
X $type .= "\t" if length($type) < 4;
X $cast .= "\t" if length($cast) < 8;
X $x = "\t" x (length($name) < 6);
X if ($mode =~ /O/) {
X if ($what eq 'gnum') {
X push(@outies, "\t str_numset(st[$i], (double) $name);\n");
X }
X else {
X push(@outies, "\t str_set(st[$i], (char*) $name);\n");
X }
X push(@callnames, "&$name");
X }
X else {
X push(@callnames, $name);
X }
X if ($mode =~ /I/) {
X print <<EOF;
X $type $name =$x $cast str_$what(st[$i]);
XEOF
X }
X else {
X print <<EOF;
X $type $name;
XEOF
X }
X }
X $callnames = join(', ', @callnames);
X $outies = join("\n",@outies);
X if ($rettype eq 'void') {
X print <<EOF;
X$pre (void)$funcname($callnames);
XEOF
X }
X else {
X print <<EOF;
X$pre retval = $funcname($callnames);
XEOF
X }
X if ($rettype =~ /^(struct\s+\w+|char)\s*\*$/) {
X print <<EOF;
X str_set(st[0], (char*) retval);
XEOF
X }
X elsif ($rettype =~ /^[A-Z]+\s*\*$/) {
X print <<EOF;
X str_nset(st[0], (char*) &retval, sizeof retval);
XEOF
X }
X else {
X print <<EOF;
X str_numset(st[0], (double) retval);
XEOF
X }
X print $outies if $outies;
X print $post if $post;
X if (/^END/) {
X print "\t}\n\treturn sp;\n";
X }
X else {
X redo;
X }
X }
X elsif (/^END/) {
X print "\t}\n\treturn sp;\n";
X }
X else {
X print;
X }
X}
!STUFFY!FUNK!
echo Extracting eg/g/gcp
sed >eg/g/gcp <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: gcp,v 4.0 91/03/20 01:10:05 lwall Locked $
X
X# Here is a script to do global rcps. See man page.
X
X$#ARGV >= 1 || die "Not enough arguments.\n";
X
Xif ($ARGV[0] eq '-r') {
X $rcp = 'rcp -r';
X shift;
X} else {
X $rcp = 'rcp';
X}
X$args = $rcp;
X$dest = $ARGV[$#ARGV];
X
X$SIG{'QUIT'} = 'CLEANUP';
X$SIG{'INT'} = 'CONT';
X
Xwhile ($arg = shift) {
X if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
X if ($systype && $systype ne $1) {
X die "Can't mix system type specifers ($systype vs $1).\n";
X }
X $#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
X $systype = $1;
X $args .= " $arg";
X } else {
X if ($#ARGV >= 0) {
X if ($arg =~ /^[\/~]/) {
X $arg =~ /^(.*)\// && ($dir = $1);
X } else {
X if (!$pwd) {
X chop($pwd = `pwd`);
X }
X $dir = $pwd;
X }
X }
X if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
X $args .= " $dest$olddir; $rcp";
X }
X $olddir = $dir;
X $args .= " $arg";
X }
X}
X
Xdie "No system type specified.\n" unless $systype;
X
X$args =~ s/:$/:$olddir/;
X
Xchop($thishost = `hostname`);
X
X$one_of_these = ":$systype:";
Xif ($systype =~ s/\+/[+]/g) {
X $one_of_these =~ s/\+/:/g;
X}
X$one_of_these =~ s/-/:-/g;
X
X@ARGV = ();
Xpush(@ARGV,'.grem') if -f '.grem';
Xpush(@ARGV,'.ghosts') if -f '.ghosts';
Xpush(@ARGV,'/etc/ghosts');
X
X$remainder = '';
X
Xline: while (<>) {
X s/[ \t]*\n//;
X if (!$_ || /^#/) {
X next line;
X }
X if (/^([a-zA-Z_0-9]+)=(.+)/) {
X $name = $1; $repl = $2;
X $repl =~ s/\+/:/g;
X $repl =~ s/-/:-/g;
X $one_of_these =~ s/:$name:/:$repl:/;
X $repl =~ s/:/:-/g;
X $one_of_these =~ s/:-$name:/:-$repl:/g;
X next line;
X }
X @gh = split(' ');
X $host = $gh[0];
X next line if $host eq $thishost; # should handle aliases too
X $wanted = 0;
X foreach $class (@gh) {
X $wanted++ if index($one_of_these,":$class:") >= 0;
X $wanted = -9999 if index($one_of_these,":-$class:") >= 0;
X }
X if ($wanted > 0) {
X ($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
X print "$cmd\n";
X $result = `$cmd 2>&1`;
X $remainder .= "$host+" if
X $result =~ /Connection timed out|Permission denied/;
X print $result;
X }
X}
X
Xif ($remainder) {
X chop($remainder);
X open(grem,">.grem") || (printf stderr "Can't create .grem: $!\n");
X print grem 'rem=', $remainder, "\n";
X close(grem);
X print 'rem=', $remainder, "\n";
X}
X
Xsub CLEANUP {
X exit;
X}
X
Xsub CONT {
X print "Continuing...\n"; # Just ignore the signal that kills rcp
X $remainder .= "$host+";
X}
!STUFFY!FUNK!
echo Extracting t/cmd/while.t
sed >t/cmd/while.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: while.t,v 4.0 91/03/20 01:49:51 lwall Locked $
X
Xprint "1..10\n";
X
Xopen (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp.";
Xprint tmp "tvi925\n";
Xprint tmp "tvi920\n";
Xprint tmp "vt100\n";
Xprint tmp "Amiga\n";
Xprint tmp "paper\n";
Xclose tmp;
X
X# test "last" command
X
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile (<fh>) {
X last if /vt100/;
X}
Xif (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
X
X# test "next" command
X
X$bad = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile (<fh>) {
X next if /vt100/;
X $bad = 1 if /vt100/;
X}
Xif (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
X
X# test "redo" command
X
X$bad = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile (<fh>) {
X if (s/vt100/VT100/g) {
X s/VT100/Vt100/g;
X redo;
X }
X $bad = 1 if /vt100/;
X $bad = 1 if /VT100/;
X}
Xif (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
X
X# now do the same with a label and a continue block
X
X# test "last" command
X
X$badcont = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xline: while (<fh>) {
X if (/vt100/) {last line;}
X} continue {
X $badcont = 1 if /vt100/;
X}
Xif (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
Xif (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
X
X# test "next" command
X
X$bad = '';
X$badcont = 1;
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xentry: while (<fh>) {
X next entry if /vt100/;
X $bad = 1 if /vt100/;
X} continue {
X $badcont = '' if /vt100/;
X}
Xif (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
Xif (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
X
X# test "redo" command
X
X$bad = '';
X$badcont = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xloop: while (<fh>) {
X if (s/vt100/VT100/g) {
X s/VT100/Vt100/g;
X redo loop;
X }
X $bad = 1 if /vt100/;
X $bad = 1 if /VT100/;
X} continue {
X $badcont = 1 if /vt100/;
X}
Xif (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
Xif (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
X
X`/bin/rm -f Cmd.while.tmp`;
X
X#$x = 0;
X#while (1) {
X# if ($x > 1) {last;}
X# next;
X#} continue {
X# if ($x++ > 10) {last;}
X# next;
X#}
X#
X#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
X
X$i = 9;
X{
X $i++;
X}
Xprint "ok $i\n";
!STUFFY!FUNK!
echo Extracting t/op/dbm.t
sed >t/op/dbm.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: dbm.t,v 4.0 91/03/20 01:51:52 lwall Locked $
X
Xif (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h') {
X print "1..0\n";
X exit;
X}
X
Xprint "1..12\n";
X
Xunlink <Op.dbmx.*>;
Xumask(0);
Xprint (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n");
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('Op.dbmx.pag');
Xprint (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
Xwhile (($key,$value) = each(h)) {
X $i++;
X}
Xprint (!$i ? "ok 3\n" : "not ok 3\n");
X
X$h{'goner1'} = 'snork';
X
X$h{'abc'} = 'ABC';
X$h{'def'} = 'DEF';
X$h{'jkl','mno'} = "JKL\034MNO";
X$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
X$h{'a'} = 'A';
X$h{'b'} = 'B';
X$h{'c'} = 'C';
X$h{'d'} = 'D';
X$h{'e'} = 'E';
X$h{'f'} = 'F';
X$h{'g'} = 'G';
X$h{'h'} = 'H';
X$h{'i'} = 'I';
X
X$h{'goner2'} = 'snork';
Xdelete $h{'goner2'};
X
Xdbmclose(h);
Xprint (dbmopen(h,'Op.dbmx',0640) ? "ok 4\n" : "not ok 4\n");
X
X$h{'j'} = 'J';
X$h{'k'} = 'K';
X$h{'l'} = 'L';
X$h{'m'} = 'M';
X$h{'n'} = 'N';
X$h{'o'} = 'O';
X$h{'p'} = 'P';
X$h{'q'} = 'Q';
X$h{'r'} = 'R';
X$h{'s'} = 'S';
X$h{'t'} = 'T';
X$h{'u'} = 'U';
X$h{'v'} = 'V';
X$h{'w'} = 'W';
X$h{'x'} = 'X';
X$h{'y'} = 'Y';
X$h{'z'} = 'Z';
X
X$h{'goner3'} = 'snork';
X
Xdelete $h{'goner1'};
Xdelete $h{'goner3'};
X
X@keys = keys(%h);
X@values = values(%h);
X
Xif ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
X
Xwhile (($key,$value) = each(h)) {
X if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
X $key =~ y/a-z/A-Z/;
X $i++ if $key eq $value;
X }
X}
X
Xif ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
X
X@keys = ('blurfl', keys(h), 'dyick');
Xif ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
X
X$h{'foo'} = '';
X$h{''} = 'bar';
X
X# check cache overflow and numeric keys and contents
X$ok = 1;
Xfor ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
Xfor ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
Xprint ($ok ? "ok 8\n" : "not ok 8\n");
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('Op.dbmx.pag');
Xprint ($size > 0 ? "ok 9\n" : "not ok 9\n");
X
X@h{0..200} = 200..400;
X@foo = @h{0..200};
Xprint join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
X
Xprint ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
Xprint ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
X
Xunlink 'Op.dbmx.dir', 'Op.dbmx.pag';
!STUFFY!FUNK!
echo Extracting eg/relink
sed >eg/relink <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X'di';
X'ig00';
X#
X# $Header: relink,v 4.0 91/03/20 01:11:40 lwall Locked $
X#
X# $Log: relink,v $
X# Revision 4.0 91/03/20 01:11:40 lwall
X# 4.0 baseline.
X#
X# Revision 3.0.1.2 90/08/09 03:17:44 lwall
X# patch19: added man page for relink and rename
X#
X
X($op = shift) || die "Usage: relink perlexpr [filenames]\n";
Xif (!@ARGV) {
X @ARGV = <STDIN>;
X chop(@ARGV);
X}
Xfor (@ARGV) {
X next unless -l; # symbolic link?
X $name = $_;
X $_ = readlink($_);
X $was = $_;
X eval $op;
X die $@ if $@;
X if ($was ne $_) {
X unlink($name);
X symlink($_, $name);
X }
X}
X##############################################################################
X
X # These next few lines are legal in both Perl and nroff.
X
X.00; # finish .ig
X
X'di \" finish diversion--previous line must be blank
X.nr nl 0-1 \" fake up transition to first page again
X.nr % 0 \" start at page 1
X';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
X.TH RELINK 1 "July 30, 1990"
X.AT 3
X.SH LINK
Xrelink \- relinks multiple symbolic links
X.SH SYNOPSIS
X.B relink perlexpr [symlinknames]
X.SH DESCRIPTION
X.I Relink
Xrelinks the symbolic links given according to the rule specified as the
Xfirst argument.
XThe argument is a Perl expression which is expected to modify the $_
Xstring in Perl for at least some of the names specified.
XFor each symbolic link named on the command line, the Perl expression
Xwill be executed on the contents of the symbolic link with that name.
XIf a given symbolic link's contents is not modified by the expression,
Xit will not be changed.
XIf a name given on the command line is not a symbolic link, it will be ignored.
XIf no names are given on the command line, names will be read
Xvia standard input.
X.PP
XFor example, to relink all symbolic links in the current directory
Xpointing to somewhere in X11R3 so that they point to X11R4, you might say
X.nf
X
X relink 's/X11R3/X11R4/' *
X
X.fi
XTo change all occurences of links in the system from /usr/spool to /var/spool,
Xyou'd say
X.nf
X
X find / -type l -print | relink 's#/usr/spool#/var/spool#'
X
X.fi
X.SH ENVIRONMENT
XNo environment variables are used.
X.SH FILES
X.SH AUTHOR
XLarry Wall
X.SH "SEE ALSO"
Xln(1)
X.br
Xperl(1)
X.SH DIAGNOSTICS
XIf you give an invalid Perl expression you'll get a syntax error.
X.SH BUGS
X.ex
!STUFFY!FUNK!
echo Extracting x2p/s2p.man
sed >x2p/s2p.man <<'!STUFFY!FUNK!' -e 's/X//'
X.rn '' }`
X''' $Header: s2p.man,v 4.0 91/03/20 01:58:07 lwall Locked $
X'''
X''' $Log: s2p.man,v $
X''' Revision 4.0 91/03/20 01:58:07 lwall
X''' 4.0 baseline.
X'''
X''' Revision 3.0 89/10/18 15:35:09 lwall
X''' 3.0 baseline
X'''
X''' Revision 2.0 88/06/05 00:15:59 root
X''' Baseline version 2.0.
X'''
X'''
X.de Sh
X.br
X.ne 5
X.PP
X\fB\\$1\fR
X.PP
X..
X.de Sp
X.if t .sp .5v
X.if n .sp
X..
X.de Ip
X.br
X.ie \\n.$>=3 .ne \\$3
X.el .ne 3
X.IP "\\$1" \\$2
X..
X'''
X''' Set up \*(-- to give an unbreakable dash;
X''' string Tr holds user defined translation string.
X''' Bell System Logo is used as a dummy character.
X'''
X.tr \(*W-|\(bv\*(Tr
X.ie n \{\
X.ds -- \(*W-
X.if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
X.if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
X.ds L" ""
X.ds R" ""
X.ds L' '
X.ds R' '
X'br\}
X.el\{\
X.ds -- \(em\|
X.tr \*(Tr
X.ds L" ``
X.ds R" ''
X.ds L' `
X.ds R' '
X'br\}
X.TH S2P 1 NEW
X.SH NAME
Xs2p - Sed to Perl translator
X.SH SYNOPSIS
X.B s2p [options] filename
X.SH DESCRIPTION
X.I S2p
Xtakes a sed script specified on the command line (or from standard input)
Xand produces a comparable
X.I perl
Xscript on the standard output.
X.Sh "Options"
XOptions include:
X.TP 5
X.B \-D<number>
Xsets debugging flags.
X.TP 5
X.B \-n
Xspecifies that this sed script was always invoked with a sed -n.
XOtherwise a switch parser is prepended to the front of the script.
X.TP 5
X.B \-p
Xspecifies that this sed script was never invoked with a sed -n.
XOtherwise a switch parser is prepended to the front of the script.
X.Sh "Considerations"
XThe perl script produced looks very sed-ish, and there may very well be
Xbetter ways to express what you want to do in perl.
XFor instance, s2p does not make any use of the split operator, but you might
Xwant to.
X.PP
XThe perl script you end up with may be either faster or slower than the original
Xsed script.
XIf you're only interested in speed you'll just have to try it both ways.
XOf course, if you want to do something sed doesn't do, you have no choice.
X.SH ENVIRONMENT
XS2p uses no environment variables.
X.SH AUTHOR
XLarry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
X.SH FILES
X.SH SEE ALSO
Xperl The perl compiler/interpreter
X.br
Xa2p awk to perl translator
X.SH DIAGNOSTICS
X.SH BUGS
X.rn }` ''
!STUFFY!FUNK!
echo Extracting eg/scan/scan_suid
sed >eg/scan/scan_suid <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: scan_suid,v 4.0 91/03/20 01:14:00 lwall Locked $
X
X# Look for new setuid root files.
X
Xchdir '/usr/adm/private/memories' || die "Can't cd to memories: $!\n";
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('oldsuid');
Xif ($nlink) {
X $lasttime = $mtime;
X $tmp = $ctime - $atime;
X if ($tmp <= 0 || $tmp >= 10) {
X print "WARNING: somebody has read oldsuid!\n";
X }
X $tmp = $ctime - $mtime;
X if ($tmp <= 0 || $tmp >= 10) {
X print "WARNING: somebody has modified oldsuid!!!\n";
X }
X} else {
X $lasttime = time - 60 * 60 * 24; # one day ago
X}
X$thistime = time;
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
Xopen(Find, 'find / -perm -04000 -print |') ||
X die "scan_find: can't run find";
X#else
Xopen(Find, 'find / \( -fstype nfs -prune \) -o -perm -04000 -ls |') ||
X die "scan_find: can't run find";
X#endif
X
Xopen(suid, '>newsuid.tmp');
X
Xwhile (<Find>) {
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
X $x = `/bin/ls -il $_`;
X $_ = $x;
X s/^ *//;
X ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
X = split;
X#else
X s/^ *//;
X ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
X = split;
X#endif
X
X if ($perm =~ /[sS]/ && $owner eq 'root') {
X ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat($name);
X $foo = sprintf("%10s%3s %-8s %-8s%9s %3s %2s %s %s\n",
X $perm,$links,$owner,$group,$size,$month,$day,$name,$inode);
X print suid $foo;
X if ($ctime > $lasttime) {
X if ($ctime > $thistime) {
X print "Future file: $foo";
X }
X else {
X $ct .= $foo;
X }
X }
X }
X}
Xclose(suid);
X
Xprint `sort +7 -8 newsuid.tmp >newsuid 2>&1`;
X$foo = `/bin/diff oldsuid newsuid 2>&1`;
Xprint "Differences in suid info:\n",$foo if $foo;
Xprint `mv oldsuid oldoldsuid 2>&1; mv newsuid oldsuid 2>&1`;
Xprint `touch oldsuid 2>&1;sleep 2 2>&1;chmod o+w oldsuid 2>&1`;
Xprint `rm -f newsuid.tmp 2>&1`;
X
X@ct = split(/\n/,$ct);
X$ct = '';
X$* = 1;
Xwhile ($#ct >= 0) {
X $tmp = shift(@ct);
X unless ($foo =~ "^>.*$tmp\n") { $ct .= "$tmp\n"; }
X}
X
Xprint "Inode changed since last time:\n",$ct if $ct;
X
!STUFFY!FUNK!
echo Extracting eg/g/gsh.man
sed >eg/g/gsh.man <<'!STUFFY!FUNK!' -e 's/X//'
X.\" $Header: gsh.man,v 4.0 91/03/20 01:10:46 lwall Locked $
X.TH GSH 8 "13 May 1988"
X.SH NAME
Xgsh \- global shell
X.SH SYNOPSIS
X.B gsh
X[options]
X.I host
X[options]
X.I command
X.SH DESCRIPTION
X.I gsh
Xworks just like rsh(1C) except that you may specify a set of hosts to execute
Xthe command on.
XThe host sets are defined in the file /etc/ghosts.
X(An individual host name can be used as a set containing one member.)
XYou can give a command like
X
X gsh sun /etc/mungmotd
X
Xto run /etc/mungmotd on all your Suns.
X.P
XYou may specify the union of two or more sets by using + as follows:
X
X gsh 750+mc /etc/mungmotd
X
Xwhich will run mungmotd on all 750's and Masscomps.
X.P
XCommonly used sets should be defined in /etc/ghosts.
XFor example, you could add a line that says
X
X pep=manny+moe+jack
X
XAnother way to do that would be to add the word "pep" after each of the host
Xentries:
X
X manny sun3 pep
X.br
X moe sun3 pep
X.br
X jack sun3 pep
X
XHosts and sets of host can also be excluded:
X
X foo=sun-sun2
X
XAny host so excluded will never be included, even if a subsequent set on the
Xline includes it:
X
X foo=abc+def
X bar=xyz-abc+foo
X
Xcomes out to xyz+def.
X
XYou can define private host sets by creating .ghosts in your current directory
Xwith entries just like /etc/ghosts.
XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
Xfrom the last gsh or gcp that didn't succeed everywhere.
X
XOptions include all those defined by rsh, as well as
X
X.IP "\-d" 8
XCauses gsh to collect input till end of file, and then distribute that input
Xto each invokation of rsh.
X.IP "\-h" 8
XRather than print out the command followed by the output, merely prepends the
Xhost name to each line of output.
X.IP "\-s" 8
XDo work silently.
X.PP
XInterrupting with a SIGINT will cause the rsh to the current host to be skipped
Xand execution resumed with the next host.
XTo stop completely, send a SIGQUIT.
X.SH SEE ALSO
Xrsh(1C)
X.SH BUGS
XAll the bugs of rsh, since it calls rsh.
X
XAlso, will not properly return data from the remote execution that contains
Xnull characters.
!STUFFY!FUNK!
echo " "
echo "End of kit 33 (of 36)"
cat /dev/null >kit33isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
for combo in *:AA; do
if test -f "$combo"; then
realfile=`basename $combo :AA`
cat $realfile:[A-Z][A-Z] >$realfile
rm -rf $realfile:[A-Z][A-Z]
fi
done
rm -rf kit*isdone
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
exit 0 # Just in case...
--
Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.