home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume18 / perl / part33 < prev    next >
Internet Message Format  |  1991-04-20  |  51KB
  1. From: lwall@netlabs.com (Larry Wall)
  2. Newsgroups: comp.sources.misc
  3. Subject: v18i051:  perl - The perl programming language, Part33/36
  4. Message-ID: <1991Apr19.014936.5069@sparky.IMD.Sterling.COM>
  5. Date: 19 Apr 91 01:49:36 GMT
  6. Approved: kent@sparky.imd.sterling.com
  7. X-Checksum-Snefru: 4040c005 d15796d7 597e9da8 cf51eb08
  8.  
  9. Submitted-by: Larry Wall <lwall@netlabs.com>
  10. Posting-number: Volume 18, Issue 51
  11. Archive-name: perl/part33
  12.  
  13. [There are 36 kits for perl version 4.0.]
  14.  
  15. #! /bin/sh
  16.  
  17. # Make a new directory for the perl sources, cd to it, and run kits 1
  18. # thru 36 through sh.  When all 36 kits have been run, read README.
  19.  
  20. echo "This is perl 4.0 kit 33 (of 36).  If kit 33 is complete, the line"
  21. echo '"'"End of kit 33 (of 36)"'" will echo at the end.'
  22. echo ""
  23. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  24. mkdir eg eg/g eg/scan os2 t t/cmd t/comp t/io t/op usub x2p 2>/dev/null
  25. echo Extracting os2/makefile
  26. sed >os2/makefile <<'!STUFFY!FUNK!' -e 's/X//'
  27. X#
  28. X# Makefile for compiling Perl under OS/2
  29. X#
  30. X# Needs a Unix compatible make.
  31. X# This makefile works for an initial compilation.  It does not
  32. X# include all dependencies and thus is unsuitable for serious
  33. X# development work.  Hey, I'm just inheriting what Diomidis gave me.
  34. X#
  35. X# Originally by Diomidis Spinellis, March 1990
  36. X# Adjusted for OS/2 port by Raymond Chen, June 1990
  37. X#
  38. X
  39. X# Source files
  40. XSRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \
  41. Xeval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \
  42. Xstab.c str.c toke.c util.c os2.c popen.c director.c suffix.c mktemp.c
  43. X
  44. X# Object files
  45. XOBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \
  46. Xdolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \
  47. Xregexec.obj stab.obj str.obj toke.obj util.obj os2.obj popen.obj \
  48. Xdirector.obj suffix.obj mktemp.obj
  49. X
  50. X# Files in the OS/2 distribution
  51. XDOSFILES=config.h director.c dir.h makefile os2.c popen.c suffix.c \
  52. Xmktemp.c readme.os2
  53. X
  54. X# Yacc flags
  55. XYFLAGS=-d
  56. X
  57. X# Manual pages
  58. XMAN=perlman.1 perlman.2 perlman.3 perlman.4
  59. X
  60. XCC=cl
  61. X# CBASE = flags everybody gets
  62. X# CPLAIN = flags for modules that give the compiler indigestion
  63. X# CFLAGS = flags for milder modules
  64. X# PERL = which version of perl to build
  65. X#
  66. X# For preliminary building:  No optimization, DEBUGGING set, symbols included.
  67. X#CBASE=-AL -Zi -G2 -Gs -DDEBUGGING
  68. X#CPLAIN=$(CBASE) -Od
  69. X#CFLAGS=$(CBASE) -Od
  70. X#PERL=perlsym.exe
  71. X
  72. X# For the final build:  Optimization on, symbols stripped.
  73. XCBASE=-AL -Zi -G2 -Gs -DDEBUGGING
  74. XCPLAIN=$(CBASE) -Olt
  75. XCFLAGS=$(CBASE) -Oeglt
  76. XPERL=perl.exe
  77. X
  78. X# Destination directory for executables
  79. XDESTDIR=\usr\bin
  80. X
  81. X# Deliverables
  82. X#
  83. Xall: $(PERL) glob.exe
  84. X
  85. Xperl.exe: $(OBJ) perl.arp
  86. X    link @perl.arp,perl,nul,/stack:32767 /NOE;
  87. X    exehdr /nologo /newfiles /pmtype:windowcompat perl.exe >nul
  88. X
  89. Xperlsym.exe: $(OBJ) perl.arp
  90. X    link @perl.arp,perlsym,nul,/stack:32767 /NOE /CODE;
  91. X    exehdr /nologo /newfiles /pmtype:windowcompat perlsym.exe >nul
  92. X
  93. Xperl.arp:
  94. X    echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp
  95. X    echo eval+form+hash+perl+perly+regcomp+regexec+stab+suffix+ >>perl.arp
  96. X    echo str+toke+util+os2+popen+director+\c600\lib\setargv >>perl.arp
  97. X
  98. Xglob.exe: glob.c
  99. X    $(CC) glob.c setargv.obj -link /NOE
  100. X    exehdr /nologo /newfiles /pmtype:windowcompat glob.exe >nul
  101. X
  102. Xarray.obj: array.c
  103. X    $(CC) $(CPLAIN) -c array.c
  104. Xcmd.obj: cmd.c
  105. Xcons.obj: cons.c perly.h
  106. Xconsarg.obj: consarg.c
  107. X#    $(CC) $(CPLAIN) -c consarg.c
  108. Xdoarg.obj: doarg.c
  109. Xdoio.obj: doio.c
  110. Xdolist.obj: dolist.c
  111. Xdump.obj: dump.c
  112. Xeval.obj: eval.c evalargs.xc
  113. X    $(CC) /B2c2l /B3c3l $(CFLAGS) -c eval.c
  114. Xform.obj: form.c
  115. Xhash.obj: hash.c
  116. Xperl.obj: perl.y
  117. Xperly.obj: perly.c
  118. Xregcomp.obj: regcomp.c
  119. Xregexec.obj: regexec.c
  120. Xstab.obj: stab.c
  121. X    $(CC) $(CPLAIN) -c stab.c
  122. Xstr.obj: str.c
  123. Xsuffix.obj: suffix.c
  124. Xtoke.obj: toke.c
  125. X    $(CC) /B3c3l $(CFLAGS) -c toke.c
  126. Xutil.obj: util.c
  127. X#    $(CC) $(CPLAIN) -c util.c
  128. Xperly.h: ytab.h
  129. X    cp ytab.h perly.h
  130. Xdirector.obj: director.c
  131. Xpopen.obj: popen.c
  132. Xos2.obj: os2.c
  133. X
  134. Xperl.1: $(MAN)
  135. X    nroff -man $(MAN) >perl.1
  136. X
  137. Xinstall: all
  138. X    exepack perl.exe $(DESTDIR)\perl.exe
  139. X    exepack glob.exe $(DESTDIR)\glob.exe
  140. X
  141. Xclean:
  142. X    rm -f *.obj *.exe perl.1 perly.h perl.arp
  143. X
  144. Xtags:
  145. X    ctags *.c *.h *.xc
  146. X
  147. Xdosperl:
  148. X    mv $(DOSFILES) ../perl30.new
  149. X
  150. Xdoskit:
  151. X    mv $(DOSFILES) ../os2
  152. !STUFFY!FUNK!
  153. echo Extracting os2/Makefile
  154. sed >os2/Makefile <<'!STUFFY!FUNK!' -e 's/X//'
  155. X#
  156. X# Makefile for compiling Perl under OS/2
  157. X#
  158. X# Needs a Unix compatible make.
  159. X# This makefile works for an initial compilation.  It does not
  160. X# include all dependencies and thus is unsuitable for serious
  161. X# development work.  Hey, I'm just inheriting what Diomidis gave me.
  162. X#
  163. X# Originally by Diomidis Spinellis, March 1990
  164. X# Adjusted for OS/2 port by Raymond Chen, June 1990
  165. X#
  166. X
  167. X# Source files
  168. XSRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \
  169. Xeval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \
  170. Xstab.c str.c toke.c util.c os2.c popen.c director.c
  171. X
  172. X# Object files
  173. XOBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \
  174. Xdolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \
  175. Xregexec.obj stab.obj str.obj toke.obj util.obj os2.obj popen.obj \
  176. Xdirector.obj suffix.obj
  177. X
  178. X# Files in the OS/2 distribution
  179. XDOSFILES=config.h director.c makefile os2.c popen.c suffix.c readme.os2
  180. X
  181. X# Yacc flags
  182. XYFLAGS=-d
  183. X
  184. X# Manual pages
  185. XMAN=perlman.1 perlman.2 perlman.3 perlman.4
  186. X
  187. XCC=cl
  188. X# CBASE = flags everybody gets
  189. X# CPLAIN = flags for modules that give the compiler indigestion
  190. X# CFLAGS = flags for milder modules
  191. X# PERL = which version of perl to build
  192. X#
  193. X# For preliminary building:  No optimization, DEBUGGING set, symbols included.
  194. X#CBASE=-AL -Zi -G2 -Gs -DDEBUGGING
  195. X#CPLAIN=$(CBASE) -Od
  196. X#CFLAGS=$(CBASE) -Od
  197. X#PERL=perlsym.exe
  198. X
  199. X# For the final build:  Optimization on, no DEBUGGING, symbols stripped.
  200. XCBASE=-AL -Zi -G2 -Gs
  201. XCPLAIN=$(CBASE) -Oilt
  202. XCFLAGS=$(CBASE) -Ox
  203. XPERL=perl.exe
  204. X
  205. X# Destination directory for executables
  206. XDESTDIR=\usr\bin
  207. X
  208. X# Deliverables
  209. X# 
  210. Xall: $(PERL) glob.exe
  211. X
  212. Xperl.exe: $(OBJ) perl.arp
  213. X    link @perl.arp,perl,nul,/stack:32767 /NOE;
  214. X    exehdr /nologo /newfiles /pmtype:windowcompat perl.exe >nul
  215. X
  216. Xperlsym.exe: $(OBJ) perl.arp
  217. X    link @perl.arp,perlsym,nul,/stack:32767 /NOE /CODE;
  218. X    exehdr /nologo /newfiles /pmtype:windowcompat perlsym.exe >nul
  219. X
  220. Xperl.arp:
  221. X    echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp
  222. X    echo eval+form+hash+perl+perly+regcomp+regexec+stab+suffix+ >>perl.arp
  223. X    echo str+toke+util+os2+popen+director+\c600\lib\setargv >>perl.arp
  224. X
  225. Xglob.exe: glob.c
  226. X    $(CC) glob.c \c600\lib\setargv.obj -link /NOE
  227. X    exehdr /nologo /newfiles /pmtype:windowcompat glob.exe >nul
  228. X
  229. Xarray.obj: array.c
  230. X    $(CC) $(CPLAIN) -c array.c
  231. Xcmd.obj: cmd.c
  232. Xcons.obj: cons.c perly.h
  233. Xconsarg.obj: consarg.c
  234. X#    $(CC) $(CPLAIN) -c consarg.c
  235. Xdoarg.obj: doarg.c
  236. Xdoio.obj: doio.c
  237. Xdolist.obj: dolist.c
  238. Xdump.obj: dump.c
  239. Xeval.obj: eval.c evalargs.xc
  240. X    $(CC) /B3 \c600\binp\c3l $(CFLAGS) -c eval.c
  241. Xform.obj: form.c
  242. Xhash.obj: hash.c
  243. Xperl.obj: perl.y
  244. Xperly.obj: perly.c
  245. Xregcomp.obj: regcomp.c
  246. Xregexec.obj: regexec.c
  247. Xstab.obj: stab.c
  248. X    $(CC) $(CPLAIN) -c stab.c
  249. Xstr.obj: str.c
  250. Xsuffix.obj: suffix.c
  251. Xtoke.obj: toke.c
  252. X    $(CC) /B3 \c600\binp\c3l $(CFLAGS) -c toke.c
  253. Xutil.obj: util.c
  254. X#    $(CC) $(CPLAIN) -c util.c
  255. Xperly.h: ytab.h
  256. X    cp ytab.h perly.h
  257. Xdirector.obj: director.c
  258. Xpopen.obj: popen.c
  259. Xos2.obj: os2.c
  260. X
  261. Xperl.1: $(MAN)
  262. X    nroff -man $(MAN) >perl.1
  263. X
  264. Xinstall: all
  265. X    exepack perl.exe $(DESTDIR)\perl.exe
  266. X    exepack glob.exe $(DESTDIR)\glob.exe
  267. X
  268. Xclean:
  269. X    rm -f *.obj *.exe perl.1 perly.h perl.arp
  270. X
  271. Xtags:
  272. X    ctags *.c *.h *.xc
  273. X
  274. Xdosperl:
  275. X    mv $(DOSFILES) ../perl30.new
  276. X
  277. Xdoskit:
  278. X    mv $(DOSFILES) ../os2
  279. !STUFFY!FUNK!
  280. echo Extracting x2p/Makefile.SH
  281. sed >x2p/Makefile.SH <<'!STUFFY!FUNK!' -e 's/X//'
  282. Xcase "$0" in
  283. X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  284. Xesac
  285. Xcase $CONFIG in
  286. X'')
  287. X    if test ! -f config.sh; then
  288. X    ln ../config.sh . || \
  289. X    ln -s ../config.sh . || \
  290. X    ln ../../config.sh . || \
  291. X    ln ../../../config.sh . || \
  292. X    (echo "Can't find config.sh."; exit 1)
  293. X    fi 2>/dev/null
  294. X    . ./config.sh
  295. X    ;;
  296. Xesac
  297. Xcase "$mallocsrc" in
  298. X'') ;;
  299. X*) mallocsrc="../$mallocsrc";;
  300. Xesac
  301. Xecho "Extracting x2p/Makefile (with variable substitutions)"
  302. Xcat >Makefile <<!GROK!THIS!
  303. X# $Header: Makefile.SH,v 4.0 91/03/20 01:57:03 lwall Locked $
  304. X#
  305. X# $Log:    Makefile.SH,v $
  306. X# Revision 4.0  91/03/20  01:57:03  lwall
  307. X# 4.0 baseline.
  308. X# 
  309. X# 
  310. X
  311. XCC = $cc
  312. XYACC = $yacc
  313. Xbin = $bin
  314. Xlib = $lib
  315. Xmansrc = $mansrc
  316. Xmanext = $manext
  317. XCFLAGS = $ccflags $optimize
  318. XLDFLAGS = $ldflags
  319. XSMALL = $small
  320. XLARGE = $large $split
  321. Xmallocsrc = $mallocsrc
  322. Xmallocobj = $mallocobj
  323. X
  324. Xlibs = $libs
  325. X!GROK!THIS!
  326. X
  327. Xcat >>Makefile <<'!NO!SUBS!'
  328. X
  329. Xpublic = a2p s2p find2perl
  330. X
  331. Xprivate = 
  332. X
  333. Xmanpages = a2p.man s2p.man
  334. X
  335. Xutil =
  336. X
  337. Xsh = Makefile.SH makedepend.SH
  338. X
  339. Xh = EXTERN.h INTERN.h config.h handy.h hash.h a2p.h str.h util.h
  340. X
  341. Xc = hash.c $(mallocsrc) str.c util.c walk.c
  342. X
  343. Xobj = hash.o $(mallocobj) str.o util.o walk.o
  344. X
  345. Xlintflags = -phbvxac
  346. X
  347. Xaddedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
  348. X
  349. X# grrr
  350. XSHELL = /bin/sh
  351. X
  352. X.c.o:
  353. X    $(CC) -c $(CFLAGS) $(LARGE) $*.c
  354. X
  355. Xall: $(public) $(private) $(util)
  356. X    touch all
  357. X
  358. Xa2p: $(obj) a2p.o
  359. X    $(CC) $(LARGE) $(LDFLAGS) $(obj) a2p.o $(libs) -o a2p
  360. X
  361. Xa2p.c: a2p.y
  362. X    @ echo Expect 226 shift/reduce conflicts...
  363. X    $(YACC) a2p.y
  364. X    mv y.tab.c a2p.c
  365. X
  366. Xa2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h str.h hash.h
  367. X    $(CC) -c $(CFLAGS) $(LARGE) a2p.c
  368. X
  369. Xinstall: a2p s2p
  370. X# won't work with csh
  371. X    export PATH || exit 1
  372. X    - mv $(bin)/a2p $(bin)/a2p.old 2>/dev/null
  373. X    - mv $(bin)/s2p $(bin)/s2p.old 2>/dev/null
  374. X    - if test `pwd` != $(bin); then cp $(public) $(bin); fi
  375. X    cd $(bin); \
  376. Xfor pub in $(public); do \
  377. Xchmod +x `basename $$pub`; \
  378. Xdone
  379. X#    chmod +x makedir
  380. X#    - ./makedir `filexp $(lib)`
  381. X#    - \
  382. X#if test `pwd` != `filexp $(lib)`; then \
  383. X#cp $(private) `filexp $(lib)`; \
  384. X#fi
  385. X#    cd `filexp $(lib)`; \
  386. X#for priv in $(private); do \
  387. X#chmod +x `basename $$priv`; \
  388. X#done
  389. X    - if test `pwd` != $(mansrc); then \
  390. Xfor page in $(manpages); do \
  391. Xcp $$page $(mansrc)/`basename $$page .man`.$(manext); \
  392. Xdone; \
  393. Xfi
  394. X
  395. Xclean:
  396. X    rm -f a2p *.o
  397. X
  398. Xrealclean: clean
  399. X    rm -f *.orig */*.orig core $(addedbyconf) a2p.c s2p all
  400. X
  401. X# The following lint has practically everything turned on.  Unfortunately,
  402. X# you have to wade through a lot of mumbo jumbo that can't be suppressed.
  403. X# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
  404. X# for that spot.
  405. X
  406. Xlint:
  407. X    lint $(lintflags) $(defs) $(c) > a2p.fuzz
  408. X
  409. Xdepend: ../makedepend
  410. X    ../makedepend
  411. X
  412. Xclist:
  413. X    echo $(c) | tr ' ' '\012' >.clist
  414. X
  415. Xhlist:
  416. X    echo $(h) | tr ' ' '\012' >.hlist
  417. X
  418. Xshlist:
  419. X    echo $(sh) | tr ' ' '\012' >.shlist
  420. X
  421. Xconfig.sh: ../config.sh
  422. X    rm -f config.sh
  423. X    ln ../config.sh .
  424. X
  425. X# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
  426. X$(obj):
  427. X    @ echo "You haven't done a "'"make depend" yet!'; exit 1
  428. Xmakedepend: makedepend.SH
  429. X    /bin/sh makedepend.SH
  430. X!NO!SUBS!
  431. X$eunicefix Makefile
  432. Xcase `pwd` in
  433. X*SH)
  434. X    $rm -f ../Makefile
  435. X    ln Makefile ../Makefile
  436. X    ;;
  437. Xesac
  438. !STUFFY!FUNK!
  439. echo Extracting t/op/re_tests
  440. sed >t/op/re_tests <<'!STUFFY!FUNK!' -e 's/X//'
  441. Xabc    abc    y    $&    abc
  442. Xabc    xbc    n    -    -
  443. Xabc    axc    n    -    -
  444. Xabc    abx    n    -    -
  445. Xabc    xabcy    y    $&    abc
  446. Xabc    ababc    y    $&    abc
  447. Xab*c    abc    y    $&    abc
  448. Xab*bc    abc    y    $&    abc
  449. Xab*bc    abbc    y    $&    abbc
  450. Xab*bc    abbbbc    y    $&    abbbbc
  451. Xab{0,}bc    abbbbc    y    $&    abbbbc
  452. Xab+bc    abbc    y    $&    abbc
  453. Xab+bc    abc    n    -    -
  454. Xab+bc    abq    n    -    -
  455. Xab{1,}bc    abq    n    -    -
  456. Xab+bc    abbbbc    y    $&    abbbbc
  457. Xab{1,}bc    abbbbc    y    $&    abbbbc
  458. Xab{1,3}bc    abbbbc    y    $&    abbbbc
  459. Xab{3,4}bc    abbbbc    y    $&    abbbbc
  460. Xab{4,5}bc    abbbbc    n    -    -
  461. Xab?bc    abbc    y    $&    abbc
  462. Xab?bc    abc    y    $&    abc
  463. Xab{0,1}bc    abc    y    $&    abc
  464. Xab?bc    abbbbc    n    -    -
  465. Xab?c    abc    y    $&    abc
  466. Xab{0,1}c    abc    y    $&    abc
  467. X^abc$    abc    y    $&    abc
  468. X^abc$    abcc    n    -    -
  469. X^abc    abcc    y    $&    abc
  470. X^abc$    aabc    n    -    -
  471. Xabc$    aabc    y    $&    abc
  472. X^    abc    y    $&    
  473. X$    abc    y    $&    
  474. Xa.c    abc    y    $&    abc
  475. Xa.c    axc    y    $&    axc
  476. Xa.*c    axyzc    y    $&    axyzc
  477. Xa.*c    axyzd    n    -    -
  478. Xa[bc]d    abc    n    -    -
  479. Xa[bc]d    abd    y    $&    abd
  480. Xa[b-d]e    abd    n    -    -
  481. Xa[b-d]e    ace    y    $&    ace
  482. Xa[b-d]    aac    y    $&    ac
  483. Xa[-b]    a-    y    $&    a-
  484. Xa[b-]    a-    y    $&    a-
  485. Xa[b-a]    -    c    -    -
  486. Xa[]b    -    c    -    -
  487. Xa[    -    c    -    -
  488. Xa]    a]    y    $&    a]
  489. Xa[]]b    a]b    y    $&    a]b
  490. Xa[^bc]d    aed    y    $&    aed
  491. Xa[^bc]d    abd    n    -    -
  492. Xa[^-b]c    adc    y    $&    adc
  493. Xa[^-b]c    a-c    n    -    -
  494. Xa[^]b]c    a]c    n    -    -
  495. Xa[^]b]c    adc    y    $&    adc
  496. Xab|cd    abc    y    $&    ab
  497. Xab|cd    abcd    y    $&    ab
  498. X()ef    def    y    $&-$1    ef-
  499. X()*    -    c    -    -
  500. X*a    -    c    -    -
  501. X^*    -    c    -    -
  502. X$*    -    c    -    -
  503. X(*)b    -    c    -    -
  504. X$b    b    n    -    -
  505. Xa\    -    c    -    -
  506. Xa\(b    a(b    y    $&-$1    a(b-
  507. Xa\(*b    ab    y    $&    ab
  508. Xa\(*b    a((b    y    $&    a((b
  509. Xa\\b    a\b    y    $&    a\b
  510. Xabc)    -    c    -    -
  511. X(abc    -    c    -    -
  512. X((a))    abc    y    $&-$1-$2    a-a-a
  513. X(a)b(c)    abc    y    $&-$1-$2    abc-a-c
  514. Xa+b+c    aabbabc    y    $&    abc
  515. Xa{1,}b{1,}c    aabbabc    y    $&    abc
  516. Xa**    -    c    -    -
  517. Xa*?    -    c    -    -
  518. X(a*)*    -    c    -    -
  519. X(a*)+    -    c    -    -
  520. X(a|)*    -    c    -    -
  521. X(a*|b)*    -    c    -    -
  522. X(a+|b)*    ab    y    $&-$1    ab-b
  523. X(a+|b){0,}    ab    y    $&-$1    ab-b
  524. X(a+|b)+    ab    y    $&-$1    ab-b
  525. X(a+|b){1,}    ab    y    $&-$1    ab-b
  526. X(a+|b)?    ab    y    $&-$1    a-a
  527. X(a+|b){0,1}    ab    y    $&-$1    a-a
  528. X(^)*    -    c    -    -
  529. X(ab|)*    -    c    -    -
  530. X)(    -    c    -    -
  531. X[^ab]*    cde    y    $&    cde
  532. Xabc        n    -    -
  533. Xa*        y    $&    
  534. X([abc])*d    abbbcd    y    $&-$1    abbbcd-c
  535. X([abc])*bcd    abcd    y    $&-$1    abcd-a
  536. Xa|b|c|d|e    e    y    $&    e
  537. X(a|b|c|d|e)f    ef    y    $&-$1    ef-e
  538. X((a*|b))*    -    c    -    -
  539. Xabcd*efg    abcdefg    y    $&    abcdefg
  540. Xab*    xabyabbbz    y    $&    ab
  541. Xab*    xayabbbz    y    $&    a
  542. X(ab|cd)e    abcde    y    $&-$1    cde-cd
  543. X[abhgefdc]ij    hij    y    $&    hij
  544. X^(ab|cd)e    abcde    n    x$1y    xy
  545. X(abc|)ef    abcdef    y    $&-$1    ef-
  546. X(a|b)c*d    abcd    y    $&-$1    bcd-b
  547. X(ab|ab*)bc    abc    y    $&-$1    abc-a
  548. Xa([bc]*)c*    abc    y    $&-$1    abc-bc
  549. Xa([bc]*)(c*d)    abcd    y    $&-$1-$2    abcd-bc-d
  550. Xa([bc]+)(c*d)    abcd    y    $&-$1-$2    abcd-bc-d
  551. Xa([bc]*)(c+d)    abcd    y    $&-$1-$2    abcd-b-cd
  552. Xa[bcd]*dcdcde    adcdcde    y    $&    adcdcde
  553. Xa[bcd]+dcdcde    adcdcde    n    -    -
  554. X(ab|a)b*c    abc    y    $&-$1    abc-ab
  555. X((a)(b)c)(d)    abcd    y    $1-$2-$3-$4    abc-a-b-d
  556. X[a-zA-Z_][a-zA-Z0-9_]*    alpha    y    $&    alpha
  557. X^a(bc+|b[eh])g|.h$    abh    y    $&-$1    bh-
  558. X(bc+d$|ef*g.|h?i(j|k))    effgz    y    $&-$1-$2    effgz-effgz-
  559. X(bc+d$|ef*g.|h?i(j|k))    ij    y    $&-$1-$2    ij-ij-j
  560. X(bc+d$|ef*g.|h?i(j|k))    effg    n    -    -
  561. X(bc+d$|ef*g.|h?i(j|k))    bcdd    n    -    -
  562. X(bc+d$|ef*g.|h?i(j|k))    reffgz    y    $&-$1-$2    effgz-effgz-
  563. X((((((((((a))))))))))    a    y    $10    a
  564. X((((((((((a))))))))))\10    aa    y    $&    aa
  565. X((((((((((a))))))))))\41    aa    n    -    -
  566. X((((((((((a))))))))))\41    a!    y    $&    a!
  567. X(((((((((a)))))))))    a    y    $&    a
  568. Xmultiple words of text    uh-uh    n    -    -
  569. Xmultiple words    multiple words, yeah    y    $&    multiple words
  570. X(.*)c(.*)    abcde    y    $&-$1-$2    abcde-ab-de
  571. X\((.*), (.*)\)    (a, b)    y    ($2, $1)    (b, a)
  572. X[k]    ab    n    -    -
  573. Xabcd    abcd    y    $&-\$&-\\$&    abcd-$&-\abcd
  574. Xa(bc)d    abcd    y    $1-\$1-\\$1    bc-$1-\bc
  575. Xa[-]?c    ac    y    $&    ac
  576. X(abc)\1    abcabc    y    $1    abc
  577. X([a-c]*)\1    abcabc    y    $1    abc
  578. !STUFFY!FUNK!
  579. echo Extracting eg/g/gsh
  580. sed >eg/g/gsh <<'!STUFFY!FUNK!' -e 's/X//'
  581. X#! /usr/bin/perl
  582. X
  583. X# $Header: gsh,v 4.0 91/03/20 01:10:40 lwall Locked $
  584. X
  585. X# Do rsh globally--see man page
  586. X
  587. X$SIG{'QUIT'} = 'quit';            # install signal handler for SIGQUIT
  588. X
  589. Xsub getswitches {
  590. X    while ($ARGV[0] =~ /^-/) {        # parse switches
  591. X    $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift(@ARGV),next);
  592. X    $ARGV[0] =~ /^-s/ && ($silent++,shift(@ARGV),next);
  593. X    $ARGV[0] =~ /^-d/ && ($dodist++,shift(@ARGV),next);
  594. X    $ARGV[0] =~ /^-n/ && ($n=' -n',shift(@ARGV),next);
  595. X    $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift(@ARGV),shift(@ARGV),
  596. X                next);
  597. X    last;
  598. X    }
  599. X}
  600. X
  601. Xdo getswitches();            # get any switches before class
  602. X$systype = shift;            # get name representing set of hosts
  603. Xdo getswitches();            # same switches allowed after class
  604. X
  605. Xif ($dodist) {                # distribute input over all rshes?
  606. X    `cat >/tmp/gsh$$`;            #  get input into a handy place
  607. X    $dist = " </tmp/gsh$$";        #  each rsh takes input from there
  608. X}
  609. X
  610. X$cmd = join(' ',@ARGV);            # remaining args constitute the command
  611. X$cmd =~ s/'/'"'"'/g;            # quote any embedded single quotes
  612. X
  613. X$one_of_these = ":$systype:";        # prepare to expand "macros"
  614. X$one_of_these =~ s/\+/:/g;        # we hope to end up with list of
  615. X$one_of_these =~ s/-/:-/g;        #  colon separated attributes
  616. X
  617. X@ARGV = ();
  618. Xpush(@ARGV,'.grem') if -f '.grem';
  619. Xpush(@ARGV,'.ghosts') if -f '.ghosts';
  620. Xpush(@ARGV,'/etc/ghosts');
  621. X
  622. X$remainder = '';
  623. X
  624. Xline: while (<>) {        # for each line of ghosts
  625. X
  626. X    s/[ \t]*\n//;            # trim trailing whitespace
  627. X    if (!$_ || /^#/) {            # skip blank line or comment
  628. X    next line;
  629. X    }
  630. X
  631. X    if (/^(\w+)=(.+)/) {        # a macro line?
  632. X    $name = $1; $repl = $2;
  633. X    $repl =~ s/\+/:/g;
  634. X    $repl =~ s/-/:-/g;
  635. X    $one_of_these =~ s/:$name:/:$repl:/;    # do expansion in "wanted" list
  636. X    $repl =~ s/:/:-/g;
  637. X    $one_of_these =~ s/:-$name:/:-$repl:/;
  638. X    next line;
  639. X    }
  640. X
  641. X    # we have a normal line
  642. X
  643. X    @attr = split(' ');            # a list of attributes to match against
  644. X                    #   which we put into an array
  645. X    $host = $attr[0];            # the first attribute is the host name
  646. X    if ($showhost) {
  647. X    $showhost = "$host:\t";
  648. X    }
  649. X
  650. X    $wanted = 0;
  651. X    foreach $attr (@attr) {        # iterate over attribute array
  652. X    $wanted++ if index($one_of_these,":$attr:") >= 0;
  653. X    $wanted = -9999 if index($one_of_these,":-$attr:") >= 0;
  654. X    }
  655. X    if ($wanted > 0) {
  656. X    print "rsh $host$l$n '$cmd'\n" unless $silent;
  657. X    $SIG{'INT'} = 'DEFAULT';
  658. X    if (open(PIPE,"rsh $host$l$n '$cmd'$dist 2>&1|")) {    # start an rsh
  659. X        $SIG{'INT'} = 'cont';
  660. X        for ($iter=0; <PIPE>; $iter++) {
  661. X        unless ($iter) {
  662. X            $remainder .= "$host+"
  663. X            if /Connection timed out|Permission denied/;
  664. X        }
  665. X        print $showhost,$_;
  666. X        }
  667. X        close(PIPE);
  668. X    } else {
  669. X        print "(Can't execute rsh: $!)\n";
  670. X        $SIG{'INT'} = 'cont';
  671. X    }
  672. X    }
  673. X}
  674. X
  675. Xunlink "/tmp/gsh$$" if $dodist;
  676. X
  677. Xif ($remainder) {
  678. X    chop($remainder);
  679. X    open(grem,">.grem") || (printf stderr "Can't make a .grem file: $!\n");
  680. X    print grem 'rem=', $remainder, "\n";
  681. X    close(grem);
  682. X    print 'rem=', $remainder, "\n";
  683. X}
  684. X
  685. X# here are a couple of subroutines that serve as signal handlers
  686. X
  687. Xsub cont {
  688. X    print "\rContinuing...\n";
  689. X    $remainder .= "$host+";
  690. X}
  691. X
  692. Xsub quit {
  693. X    $| = 1;
  694. X    print "\r";
  695. X    $SIG{'INT'} = '';
  696. X    kill 2, $$;
  697. X}
  698. !STUFFY!FUNK!
  699. echo Extracting t/io/fs.t
  700. sed >t/io/fs.t <<'!STUFFY!FUNK!' -e 's/X//'
  701. X#!./perl
  702. X
  703. X# $Header: fs.t,v 4.0 91/03/20 01:50:55 lwall Locked $
  704. X
  705. Xprint "1..22\n";
  706. X
  707. X$wd = `pwd`;
  708. Xchop($wd);
  709. X
  710. X`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
  711. Xchdir './tmp';
  712. X`/bin/rm -rf a b c x`;
  713. X
  714. Xumask(022);
  715. X
  716. Xif (umask(0) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
  717. Xopen(fh,'>x') || die "Can't create x";
  718. Xclose(fh);
  719. Xopen(fh,'>a') || die "Can't create a";
  720. Xclose(fh);
  721. X
  722. Xif (link('a','b')) {print "ok 2\n";} else {print "not ok 2\n";}
  723. X
  724. Xif (link('b','c')) {print "ok 3\n";} else {print "not ok 3\n";}
  725. X
  726. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  727. X    $blksize,$blocks) = stat('c');
  728. X
  729. Xif ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";}
  730. Xif (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";}
  731. X
  732. Xif ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
  733. X
  734. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  735. X    $blksize,$blocks) = stat('c');
  736. Xif (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
  737. X
  738. Xif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
  739. X
  740. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  741. X    $blksize,$blocks) = stat('c');
  742. Xif (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
  743. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  744. X    $blksize,$blocks) = stat('x');
  745. Xif (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
  746. X
  747. Xif ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";}
  748. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  749. X    $blksize,$blocks) = stat('b');
  750. Xif ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
  751. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  752. X    $blksize,$blocks) = stat('x');
  753. Xif ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";}
  754. X
  755. Xif (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
  756. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  757. X    $blksize,$blocks) = stat('a');
  758. Xif ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
  759. X$foo = (utime 500000000,500000001,'b');
  760. Xif ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
  761. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  762. X    $blksize,$blocks) = stat('b');
  763. Xif ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
  764. Xif (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#)
  765. X    {print "ok 18\n";}
  766. Xelse
  767. X    {print "not ok 18 $atime $mtime\n";}
  768. X
  769. Xif ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";}
  770. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  771. X    $blksize,$blocks) = stat('b');
  772. Xif ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
  773. Xunlink 'c';
  774. X
  775. Xchdir $wd || die "Can't cd back to $wd";
  776. X
  777. Xunlink 'c';
  778. Xif (`ls -l perl 2>/dev/null` =~ /^l.*->/) {  # we have symbolic links
  779. X    if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
  780. X    $foo = `grep perl c`;
  781. X    if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
  782. X}
  783. Xelse {
  784. X    print "ok 21\nok 22\n";
  785. X}
  786. !STUFFY!FUNK!
  787. echo Extracting t/comp/cmdopt.t
  788. sed >t/comp/cmdopt.t <<'!STUFFY!FUNK!' -e 's/X//'
  789. X#!./perl
  790. X
  791. X# $Header: cmdopt.t,v 4.0 91/03/20 01:49:58 lwall Locked $
  792. X
  793. Xprint "1..40\n";
  794. X
  795. X# test the optimization of constants
  796. X
  797. Xif (1) { print "ok 1\n";} else { print "not ok 1\n";}
  798. Xunless (0) { print "ok 2\n";} else { print "not ok 2\n";}
  799. X
  800. Xif (0) { print "not ok 3\n";} else { print "ok 3\n";}
  801. Xunless (1) { print "not ok 4\n";} else { print "ok 4\n";}
  802. X
  803. Xunless (!1) { print "ok 5\n";} else { print "not ok 5\n";}
  804. Xif (!0) { print "ok 6\n";} else { print "not ok 6\n";}
  805. X
  806. Xunless (!0) { print "not ok 7\n";} else { print "ok 7\n";}
  807. Xif (!1) { print "not ok 8\n";} else { print "ok 8\n";}
  808. X
  809. X$x = 1;
  810. Xif (1 && $x) { print "ok 9\n";} else { print "not ok 9\n";}
  811. Xif (0 && $x) { print "not ok 10\n";} else { print "ok 10\n";}
  812. X$x = '';
  813. Xif (1 && $x) { print "not ok 11\n";} else { print "ok 11\n";}
  814. Xif (0 && $x) { print "not ok 12\n";} else { print "ok 12\n";}
  815. X
  816. X$x = 1;
  817. Xif (1 || $x) { print "ok 13\n";} else { print "not ok 13\n";}
  818. Xif (0 || $x) { print "ok 14\n";} else { print "not ok 14\n";}
  819. X$x = '';
  820. Xif (1 || $x) { print "ok 15\n";} else { print "not ok 15\n";}
  821. Xif (0 || $x) { print "not ok 16\n";} else { print "ok 16\n";}
  822. X
  823. X
  824. X# test the optimization of registers
  825. X
  826. X$x = 1;
  827. Xif ($x) { print "ok 17\n";} else { print "not ok 17\n";}
  828. Xunless ($x) { print "not ok 18\n";} else { print "ok 18\n";}
  829. X
  830. X$x = '';
  831. Xif ($x) { print "not ok 19\n";} else { print "ok 19\n";}
  832. Xunless ($x) { print "ok 20\n";} else { print "not ok 20\n";}
  833. X
  834. X# test optimization of string operations
  835. X
  836. X$a = 'a';
  837. Xif ($a eq 'a') { print "ok 21\n";} else { print "not ok 21\n";}
  838. Xif ($a ne 'a') { print "not ok 22\n";} else { print "ok 22\n";}
  839. X
  840. Xif ($a =~ /a/) { print "ok 23\n";} else { print "not ok 23\n";}
  841. Xif ($a !~ /a/) { print "not ok 24\n";} else { print "ok 24\n";}
  842. X# test interaction of logicals and other operations
  843. X
  844. X$a = 'a';
  845. X$x = 1;
  846. Xif ($a eq 'a' && $x) { print "ok 25\n";} else { print "not ok 25\n";}
  847. Xif ($a ne 'a' && $x) { print "not ok 26\n";} else { print "ok 26\n";}
  848. X$x = '';
  849. Xif ($a eq 'a' && $x) { print "not ok 27\n";} else { print "ok 27\n";}
  850. Xif ($a ne 'a' && $x) { print "not ok 28\n";} else { print "ok 28\n";}
  851. X
  852. X$x = 1;
  853. Xif ($a eq 'a' || $x) { print "ok 29\n";} else { print "not ok 29\n";}
  854. Xif ($a ne 'a' || $x) { print "ok 30\n";} else { print "not ok 30\n";}
  855. X$x = '';
  856. Xif ($a eq 'a' || $x) { print "ok 31\n";} else { print "not ok 31\n";}
  857. Xif ($a ne 'a' || $x) { print "not ok 32\n";} else { print "ok 32\n";}
  858. X
  859. X$x = 1;
  860. Xif ($a =~ /a/ && $x) { print "ok 33\n";} else { print "not ok 33\n";}
  861. Xif ($a !~ /a/ && $x) { print "not ok 34\n";} else { print "ok 34\n";}
  862. X$x = '';
  863. Xif ($a =~ /a/ && $x) { print "not ok 35\n";} else { print "ok 35\n";}
  864. X    if ($a !~ /a/ && $x) { print "not ok 36\n";} else { print "ok 36\n";}
  865. X
  866. X$x = 1;
  867. Xif ($a =~ /a/ || $x) { print "ok 37\n";} else { print "not ok 37\n";}
  868. Xif ($a !~ /a/ || $x) { print "ok 38\n";} else { print "not ok 38\n";}
  869. X$x = '';
  870. Xif ($a =~ /a/ || $x) { print "ok 39\n";} else { print "not ok 39\n";}
  871. Xif ($a !~ /a/ || $x) { print "not ok 40\n";} else { print "ok 40\n";}
  872. !STUFFY!FUNK!
  873. echo Extracting t/op/auto.t
  874. sed >t/op/auto.t <<'!STUFFY!FUNK!' -e 's/X//'
  875. X#!./perl
  876. X
  877. X# $Header: auto.t,v 4.0 91/03/20 01:51:35 lwall Locked $
  878. X
  879. Xprint "1..34\n";
  880. X
  881. X$x = 10000;
  882. Xif (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
  883. Xif (0 + $x-- - 1 == 10000) { print "ok 2\n";} else {print "not ok 2\n";}
  884. Xif (1 * $x == 10000) { print "ok 3\n";} else {print "not ok 3\n";}
  885. Xif (0 + $x-- - 0 == 10000) { print "ok 4\n";} else {print "not ok 4\n";}
  886. Xif (1 + $x == 10000) { print "ok 5\n";} else {print "not ok 5\n";}
  887. Xif (1 + $x++ == 10000) { print "ok 6\n";} else {print "not ok 6\n";}
  888. Xif (0 + $x == 10000) { print "ok 7\n";} else {print "not ok 7\n";}
  889. Xif (0 + --$x + 1 == 10000) { print "ok 8\n";} else {print "not ok 8\n";}
  890. Xif (0 + ++$x + 0 == 10000) { print "ok 9\n";} else {print "not ok 9\n";}
  891. Xif ($x == 10000) { print "ok 10\n";} else {print "not ok 10\n";}
  892. X
  893. X$x[0] = 10000;
  894. Xif (0 + ++$x[0] - 1 == 10000) { print "ok 11\n";} else {print "not ok 11\n";}
  895. Xif (0 + $x[0]-- - 1 == 10000) { print "ok 12\n";} else {print "not ok 12\n";}
  896. Xif (1 * $x[0] == 10000) { print "ok 13\n";} else {print "not ok 13\n";}
  897. Xif (0 + $x[0]-- - 0 == 10000) { print "ok 14\n";} else {print "not ok 14\n";}
  898. Xif (1 + $x[0] == 10000) { print "ok 15\n";} else {print "not ok 15\n";}
  899. Xif (1 + $x[0]++ == 10000) { print "ok 16\n";} else {print "not ok 16\n";}
  900. Xif (0 + $x[0] == 10000) { print "ok 17\n";} else {print "not ok 17\n";}
  901. Xif (0 + --$x[0] + 1 == 10000) { print "ok 18\n";} else {print "not ok 18\n";}
  902. Xif (0 + ++$x[0] + 0 == 10000) { print "ok 19\n";} else {print "not ok 19\n";}
  903. Xif ($x[0] == 10000) { print "ok 20\n";} else {print "not ok 20\n";}
  904. X
  905. X$x{0} = 10000;
  906. Xif (0 + ++$x{0} - 1 == 10000) { print "ok 21\n";} else {print "not ok 21\n";}
  907. Xif (0 + $x{0}-- - 1 == 10000) { print "ok 22\n";} else {print "not ok 22\n";}
  908. Xif (1 * $x{0} == 10000) { print "ok 23\n";} else {print "not ok 23\n";}
  909. Xif (0 + $x{0}-- - 0 == 10000) { print "ok 24\n";} else {print "not ok 24\n";}
  910. Xif (1 + $x{0} == 10000) { print "ok 25\n";} else {print "not ok 25\n";}
  911. Xif (1 + $x{0}++ == 10000) { print "ok 26\n";} else {print "not ok 26\n";}
  912. Xif (0 + $x{0} == 10000) { print "ok 27\n";} else {print "not ok 27\n";}
  913. Xif (0 + --$x{0} + 1 == 10000) { print "ok 28\n";} else {print "not ok 28\n";}
  914. Xif (0 + ++$x{0} + 0 == 10000) { print "ok 29\n";} else {print "not ok 29\n";}
  915. Xif ($x{0} == 10000) { print "ok 30\n";} else {print "not ok 30\n";}
  916. X
  917. X# test magical autoincrement
  918. X
  919. Xif (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
  920. Xif (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
  921. Xif (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
  922. Xif (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
  923. !STUFFY!FUNK!
  924. echo Extracting t/op/list.t
  925. sed >t/op/list.t <<'!STUFFY!FUNK!' -e 's/X//'
  926. X#!./perl
  927. X
  928. X# $Header: list.t,v 4.0 91/03/20 01:53:24 lwall Locked $
  929. X
  930. Xprint "1..27\n";
  931. X
  932. X@foo = (1, 2, 3, 4);
  933. Xif ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
  934. X
  935. X$_ = join(':',@foo);
  936. Xif ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
  937. X
  938. X($a,$b,$c,$d) = (1,2,3,4);
  939. Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
  940. X
  941. X($c,$b,$a) = split(/ /,"111 222 333");
  942. Xif ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
  943. X
  944. X($a,$b,$c) = ($c,$b,$a);
  945. Xif ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5 $a;$b;$c\n";}
  946. X
  947. X($a, $b) = ($b, $a);
  948. Xif ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
  949. X
  950. X($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
  951. Xif ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";}
  952. Xif ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";}
  953. Xif ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";}
  954. Xif ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
  955. X
  956. X@foo = (1,2,3,4,5,6,7,8);
  957. X($a, $b, $c, $d) = @foo;
  958. Xprint "#11    $a;$b;$c;$d eq 1;2;3;4\n";
  959. Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
  960. X
  961. X@foo = @bar = (1);
  962. Xif (join(':',@foo,@bar) eq '1:1') {print "ok 12\n";} else {print "not ok 12\n";}
  963. X
  964. X@foo = ();
  965. X@foo = 1+2+3;
  966. Xif (join(':',@foo) eq '6') {print "ok 13\n";} else {print "not ok 13\n";}
  967. X
  968. Xfor ($x = 0; $x < 3; $x++) {
  969. X    ($a, $b, $c) = 
  970. X        $x == 0?
  971. X            ('ok ', 14, "\n"):
  972. X        $x == 1?
  973. X            ('ok ', 15, "\n"):
  974. X        # default
  975. X            ('ok ', 16, "\n");
  976. X
  977. X    print $a,$b,$c;
  978. X}
  979. X
  980. X@a = ($x == 12345 || (1,2,3));
  981. Xif (join('',@a) eq '123') {print "ok 17\n";} else {print "not ok 17\n";}
  982. X
  983. X@a = ($x == $x || (4,5,6));
  984. Xif (join('',@a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
  985. X
  986. Xif (join('',1,2,(3,4,5)) eq '12345'){print "ok 19\n";}else{print "not ok 19\n";}
  987. Xif (join('',(1,2,3,4,5)) eq '12345'){print "ok 20\n";}else{print "not ok 20\n";}
  988. Xif (join('',(1,2,3,4),5) eq '12345'){print "ok 21\n";}else{print "not ok 21\n";}
  989. Xif (join('',1,(2,3,4),5) eq '12345'){print "ok 22\n";}else{print "not ok 22\n";}
  990. Xif (join('',1,2,(3,4),5) eq '12345'){print "ok 23\n";}else{print "not ok 23\n";}
  991. Xif (join('',1,2,3,(4),5) eq '12345'){print "ok 24\n";}else{print "not ok 24\n";}
  992. X
  993. Xfor ($x = 0; $x < 3; $x++) {
  994. X    ($a, $b, $c) = do {
  995. X        if ($x == 0) {
  996. X        ('ok ', 25, "\n");
  997. X        }
  998. X        elsif ($x == 1) {
  999. X        ('ok ', 26, "\n");
  1000. X        }
  1001. X        else {
  1002. X        ('ok ', 27, "\n");
  1003. X        }
  1004. X    };
  1005. X
  1006. X    print $a,$b,$c;
  1007. X}
  1008. X
  1009. !STUFFY!FUNK!
  1010. echo Extracting usub/mus
  1011. sed >usub/mus <<'!STUFFY!FUNK!' -e 's/X//'
  1012. X#!/usr/bin/perl
  1013. X
  1014. Xwhile (<>) {
  1015. X    if (s/^CASE\s+//) {
  1016. X    @fields = split;
  1017. X    $funcname = pop(@fields);
  1018. X    $rettype = "@fields";
  1019. X    @modes = ();
  1020. X    @types = ();
  1021. X    @names = ();
  1022. X    @outies = ();
  1023. X    @callnames = ();
  1024. X    $pre = "\n";
  1025. X    $post = '';
  1026. X
  1027. X    while (<>) {
  1028. X        last unless /^[IO]+\s/;
  1029. X        @fields = split(' ');
  1030. X        push(@modes, shift(@fields));
  1031. X        push(@names, pop(@fields));
  1032. X        push(@types, "@fields");
  1033. X    }
  1034. X    while (s/^<\s//) {
  1035. X        $pre .= "\t    $_";
  1036. X        $_ = <>;
  1037. X    }
  1038. X    while (s/^>\s//) {
  1039. X        $post .= "\t    $_";
  1040. X        $_ = <>;
  1041. X    }
  1042. X    $items = @names;
  1043. X    $namelist = '$' . join(', $', @names);
  1044. X    $namelist = '' if $namelist eq '$';
  1045. X    print <<EOF;
  1046. X    case US_$funcname:
  1047. X    if (items != $items)
  1048. X        fatal("Usage: &$funcname($namelist)");
  1049. X    else {
  1050. XEOF
  1051. X    if ($rettype eq 'void') {
  1052. X        print <<EOF;
  1053. X        int retval = 1;
  1054. XEOF
  1055. X    }
  1056. X    else {
  1057. X        print <<EOF;
  1058. X        $rettype retval;
  1059. XEOF
  1060. X    }
  1061. X    foreach $i (1..@names) {
  1062. X        $mode = $modes[$i-1];
  1063. X        $type = $types[$i-1];
  1064. X        $name = $names[$i-1];
  1065. X        if ($type =~ /^[A-Z]+\*$/) {
  1066. X        $cast = "*($type*)";
  1067. X        }
  1068. X        else {
  1069. X        $cast = "($type)";
  1070. X        }
  1071. X        $what = ($type =~ /^(struct\s+\w+|char|[A-Z]+)\s*\*$/ ? "get" : "gnum");
  1072. X        $type .= "\t" if length($type) < 4;
  1073. X        $cast .= "\t" if length($cast) < 8;
  1074. X        $x = "\t" x (length($name) < 6);
  1075. X        if ($mode =~ /O/) {
  1076. X        if ($what eq 'gnum') {
  1077. X            push(@outies, "\t    str_numset(st[$i], (double) $name);\n");
  1078. X        }
  1079. X        else {
  1080. X            push(@outies, "\t    str_set(st[$i], (char*) $name);\n");
  1081. X        }
  1082. X        push(@callnames, "&$name");
  1083. X        }
  1084. X        else {
  1085. X        push(@callnames, $name);
  1086. X        }
  1087. X        if ($mode =~ /I/) {
  1088. X        print <<EOF;
  1089. X        $type    $name =$x    $cast    str_$what(st[$i]);
  1090. XEOF
  1091. X        }
  1092. X        else {
  1093. X        print <<EOF;
  1094. X        $type    $name;
  1095. XEOF
  1096. X        }
  1097. X    }
  1098. X    $callnames = join(', ', @callnames);
  1099. X    $outies = join("\n",@outies);
  1100. X    if ($rettype eq 'void') {
  1101. X        print <<EOF;
  1102. X$pre        (void)$funcname($callnames);
  1103. XEOF
  1104. X    }
  1105. X    else {
  1106. X        print <<EOF;
  1107. X$pre        retval = $funcname($callnames);
  1108. XEOF
  1109. X    }
  1110. X    if ($rettype =~ /^(struct\s+\w+|char)\s*\*$/) {
  1111. X        print <<EOF;
  1112. X        str_set(st[0], (char*) retval);
  1113. XEOF
  1114. X    }
  1115. X    elsif ($rettype =~ /^[A-Z]+\s*\*$/) {
  1116. X        print <<EOF;
  1117. X        str_nset(st[0], (char*) &retval, sizeof retval);
  1118. XEOF
  1119. X    }
  1120. X    else {
  1121. X        print <<EOF;
  1122. X        str_numset(st[0], (double) retval);
  1123. XEOF
  1124. X    }
  1125. X    print $outies if $outies;
  1126. X    print $post if $post;
  1127. X    if (/^END/) {
  1128. X        print "\t}\n\treturn sp;\n";
  1129. X    }
  1130. X    else {
  1131. X        redo;
  1132. X    }
  1133. X    }
  1134. X    elsif (/^END/) {
  1135. X    print "\t}\n\treturn sp;\n";
  1136. X    }
  1137. X    else {
  1138. X    print;
  1139. X    }
  1140. X}
  1141. !STUFFY!FUNK!
  1142. echo Extracting eg/g/gcp
  1143. sed >eg/g/gcp <<'!STUFFY!FUNK!' -e 's/X//'
  1144. X#!/usr/bin/perl
  1145. X
  1146. X# $Header: gcp,v 4.0 91/03/20 01:10:05 lwall Locked $
  1147. X
  1148. X# Here is a script to do global rcps.  See man page.
  1149. X
  1150. X$#ARGV >= 1 || die "Not enough arguments.\n";
  1151. X
  1152. Xif ($ARGV[0] eq '-r') {
  1153. X    $rcp = 'rcp -r';
  1154. X    shift;
  1155. X} else {
  1156. X    $rcp = 'rcp';
  1157. X}
  1158. X$args = $rcp;
  1159. X$dest = $ARGV[$#ARGV];
  1160. X
  1161. X$SIG{'QUIT'} = 'CLEANUP';
  1162. X$SIG{'INT'} = 'CONT';
  1163. X
  1164. Xwhile ($arg = shift) {
  1165. X    if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
  1166. X    if ($systype && $systype ne $1) {
  1167. X        die "Can't mix system type specifers ($systype vs $1).\n";
  1168. X    }
  1169. X    $#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
  1170. X    $systype = $1;
  1171. X    $args .= " $arg";
  1172. X    } else {
  1173. X    if ($#ARGV >= 0) {
  1174. X        if ($arg =~ /^[\/~]/) {
  1175. X        $arg =~ /^(.*)\// && ($dir = $1);
  1176. X        } else {
  1177. X        if (!$pwd) {
  1178. X            chop($pwd = `pwd`);
  1179. X        }
  1180. X        $dir = $pwd;
  1181. X        }
  1182. X    }
  1183. X    if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
  1184. X        $args .= " $dest$olddir; $rcp";
  1185. X    }
  1186. X    $olddir = $dir;
  1187. X    $args .= " $arg";
  1188. X    }
  1189. X}
  1190. X
  1191. Xdie "No system type specified.\n" unless $systype;
  1192. X
  1193. X$args =~ s/:$/:$olddir/;
  1194. X
  1195. Xchop($thishost = `hostname`);
  1196. X
  1197. X$one_of_these = ":$systype:";
  1198. Xif ($systype =~ s/\+/[+]/g) {
  1199. X    $one_of_these =~ s/\+/:/g;
  1200. X}
  1201. X$one_of_these =~ s/-/:-/g;
  1202. X
  1203. X@ARGV = ();
  1204. Xpush(@ARGV,'.grem') if -f '.grem';
  1205. Xpush(@ARGV,'.ghosts') if -f '.ghosts';
  1206. Xpush(@ARGV,'/etc/ghosts');
  1207. X
  1208. X$remainder = '';
  1209. X
  1210. Xline: while (<>) {
  1211. X    s/[ \t]*\n//;
  1212. X    if (!$_ || /^#/) {
  1213. X    next line;
  1214. X    }
  1215. X    if (/^([a-zA-Z_0-9]+)=(.+)/) {
  1216. X    $name = $1; $repl = $2;
  1217. X    $repl =~ s/\+/:/g;
  1218. X    $repl =~ s/-/:-/g;
  1219. X    $one_of_these =~ s/:$name:/:$repl:/;
  1220. X    $repl =~ s/:/:-/g;
  1221. X    $one_of_these =~ s/:-$name:/:-$repl:/g;
  1222. X    next line;
  1223. X    }
  1224. X    @gh = split(' ');
  1225. X    $host = $gh[0];
  1226. X  next line if $host eq $thishost;    # should handle aliases too
  1227. X    $wanted = 0;
  1228. X    foreach $class (@gh) {
  1229. X    $wanted++ if index($one_of_these,":$class:") >= 0;
  1230. X    $wanted = -9999 if index($one_of_these,":-$class:") >= 0;
  1231. X    }
  1232. X    if ($wanted > 0) {
  1233. X    ($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
  1234. X    print "$cmd\n";
  1235. X    $result = `$cmd 2>&1`;
  1236. X    $remainder .= "$host+" if
  1237. X        $result =~ /Connection timed out|Permission denied/;
  1238. X    print $result;
  1239. X    }
  1240. X}
  1241. X
  1242. Xif ($remainder) {
  1243. X    chop($remainder);
  1244. X    open(grem,">.grem") || (printf stderr "Can't create .grem: $!\n");
  1245. X    print grem 'rem=', $remainder, "\n";
  1246. X    close(grem);
  1247. X    print 'rem=', $remainder, "\n";
  1248. X}
  1249. X
  1250. Xsub CLEANUP {
  1251. X    exit;
  1252. X}
  1253. X
  1254. Xsub CONT {
  1255. X    print "Continuing...\n";    # Just ignore the signal that kills rcp
  1256. X    $remainder .= "$host+";
  1257. X}
  1258. !STUFFY!FUNK!
  1259. echo Extracting t/cmd/while.t
  1260. sed >t/cmd/while.t <<'!STUFFY!FUNK!' -e 's/X//'
  1261. X#!./perl
  1262. X
  1263. X# $Header: while.t,v 4.0 91/03/20 01:49:51 lwall Locked $
  1264. X
  1265. Xprint "1..10\n";
  1266. X
  1267. Xopen (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp.";
  1268. Xprint tmp "tvi925\n";
  1269. Xprint tmp "tvi920\n";
  1270. Xprint tmp "vt100\n";
  1271. Xprint tmp "Amiga\n";
  1272. Xprint tmp "paper\n";
  1273. Xclose tmp;
  1274. X
  1275. X# test "last" command
  1276. X
  1277. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  1278. Xwhile (<fh>) {
  1279. X    last if /vt100/;
  1280. X}
  1281. Xif (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
  1282. X
  1283. X# test "next" command
  1284. X
  1285. X$bad = '';
  1286. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  1287. Xwhile (<fh>) {
  1288. X    next if /vt100/;
  1289. X    $bad = 1 if /vt100/;
  1290. X}
  1291. Xif (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
  1292. X
  1293. X# test "redo" command
  1294. X
  1295. X$bad = '';
  1296. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  1297. Xwhile (<fh>) {
  1298. X    if (s/vt100/VT100/g) {
  1299. X    s/VT100/Vt100/g;
  1300. X    redo;
  1301. X    }
  1302. X    $bad = 1 if /vt100/;
  1303. X    $bad = 1 if /VT100/;
  1304. X}
  1305. Xif (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
  1306. X
  1307. X# now do the same with a label and a continue block
  1308. X
  1309. X# test "last" command
  1310. X
  1311. X$badcont = '';
  1312. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  1313. Xline: while (<fh>) {
  1314. X    if (/vt100/) {last line;}
  1315. X} continue {
  1316. X    $badcont = 1 if /vt100/;
  1317. X}
  1318. Xif (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
  1319. Xif (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
  1320. X
  1321. X# test "next" command
  1322. X
  1323. X$bad = '';
  1324. X$badcont = 1;
  1325. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  1326. Xentry: while (<fh>) {
  1327. X    next entry if /vt100/;
  1328. X    $bad = 1 if /vt100/;
  1329. X} continue {
  1330. X    $badcont = '' if /vt100/;
  1331. X}
  1332. Xif (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
  1333. Xif (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
  1334. X
  1335. X# test "redo" command
  1336. X
  1337. X$bad = '';
  1338. X$badcont = '';
  1339. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  1340. Xloop: while (<fh>) {
  1341. X    if (s/vt100/VT100/g) {
  1342. X    s/VT100/Vt100/g;
  1343. X    redo loop;
  1344. X    }
  1345. X    $bad = 1 if /vt100/;
  1346. X    $bad = 1 if /VT100/;
  1347. X} continue {
  1348. X    $badcont = 1 if /vt100/;
  1349. X}
  1350. Xif (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
  1351. Xif (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
  1352. X
  1353. X`/bin/rm -f Cmd.while.tmp`;
  1354. X
  1355. X#$x = 0;
  1356. X#while (1) {
  1357. X#    if ($x > 1) {last;}
  1358. X#    next;
  1359. X#} continue {
  1360. X#    if ($x++ > 10) {last;}
  1361. X#    next;
  1362. X#}
  1363. X#
  1364. X#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
  1365. X
  1366. X$i = 9;
  1367. X{
  1368. X    $i++;
  1369. X}
  1370. Xprint "ok $i\n";
  1371. !STUFFY!FUNK!
  1372. echo Extracting t/op/dbm.t
  1373. sed >t/op/dbm.t <<'!STUFFY!FUNK!' -e 's/X//'
  1374. X#!./perl
  1375. X
  1376. X# $Header: dbm.t,v 4.0 91/03/20 01:51:52 lwall Locked $
  1377. X
  1378. Xif (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h') {
  1379. X    print "1..0\n";
  1380. X    exit;
  1381. X}
  1382. X
  1383. Xprint "1..12\n";
  1384. X
  1385. Xunlink <Op.dbmx.*>;
  1386. Xumask(0);
  1387. Xprint (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n");
  1388. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  1389. X   $blksize,$blocks) = stat('Op.dbmx.pag');
  1390. Xprint (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
  1391. Xwhile (($key,$value) = each(h)) {
  1392. X    $i++;
  1393. X}
  1394. Xprint (!$i ? "ok 3\n" : "not ok 3\n");
  1395. X
  1396. X$h{'goner1'} = 'snork';
  1397. X
  1398. X$h{'abc'} = 'ABC';
  1399. X$h{'def'} = 'DEF';
  1400. X$h{'jkl','mno'} = "JKL\034MNO";
  1401. X$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
  1402. X$h{'a'} = 'A';
  1403. X$h{'b'} = 'B';
  1404. X$h{'c'} = 'C';
  1405. X$h{'d'} = 'D';
  1406. X$h{'e'} = 'E';
  1407. X$h{'f'} = 'F';
  1408. X$h{'g'} = 'G';
  1409. X$h{'h'} = 'H';
  1410. X$h{'i'} = 'I';
  1411. X
  1412. X$h{'goner2'} = 'snork';
  1413. Xdelete $h{'goner2'};
  1414. X
  1415. Xdbmclose(h);
  1416. Xprint (dbmopen(h,'Op.dbmx',0640) ? "ok 4\n" : "not ok 4\n");
  1417. X
  1418. X$h{'j'} = 'J';
  1419. X$h{'k'} = 'K';
  1420. X$h{'l'} = 'L';
  1421. X$h{'m'} = 'M';
  1422. X$h{'n'} = 'N';
  1423. X$h{'o'} = 'O';
  1424. X$h{'p'} = 'P';
  1425. X$h{'q'} = 'Q';
  1426. X$h{'r'} = 'R';
  1427. X$h{'s'} = 'S';
  1428. X$h{'t'} = 'T';
  1429. X$h{'u'} = 'U';
  1430. X$h{'v'} = 'V';
  1431. X$h{'w'} = 'W';
  1432. X$h{'x'} = 'X';
  1433. X$h{'y'} = 'Y';
  1434. X$h{'z'} = 'Z';
  1435. X
  1436. X$h{'goner3'} = 'snork';
  1437. X
  1438. Xdelete $h{'goner1'};
  1439. Xdelete $h{'goner3'};
  1440. X
  1441. X@keys = keys(%h);
  1442. X@values = values(%h);
  1443. X
  1444. Xif ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
  1445. X
  1446. Xwhile (($key,$value) = each(h)) {
  1447. X    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
  1448. X    $key =~ y/a-z/A-Z/;
  1449. X    $i++ if $key eq $value;
  1450. X    }
  1451. X}
  1452. X
  1453. Xif ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
  1454. X
  1455. X@keys = ('blurfl', keys(h), 'dyick');
  1456. Xif ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
  1457. X
  1458. X$h{'foo'} = '';
  1459. X$h{''} = 'bar';
  1460. X
  1461. X# check cache overflow and numeric keys and contents
  1462. X$ok = 1;
  1463. Xfor ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
  1464. Xfor ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
  1465. Xprint ($ok ? "ok 8\n" : "not ok 8\n");
  1466. X
  1467. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  1468. X   $blksize,$blocks) = stat('Op.dbmx.pag');
  1469. Xprint ($size > 0 ? "ok 9\n" : "not ok 9\n");
  1470. X
  1471. X@h{0..200} = 200..400;
  1472. X@foo = @h{0..200};
  1473. Xprint join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
  1474. X
  1475. Xprint ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
  1476. Xprint ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
  1477. X
  1478. Xunlink 'Op.dbmx.dir', 'Op.dbmx.pag';
  1479. !STUFFY!FUNK!
  1480. echo Extracting eg/relink
  1481. sed >eg/relink <<'!STUFFY!FUNK!' -e 's/X//'
  1482. X#!/usr/bin/perl
  1483. X'di';
  1484. X'ig00';
  1485. X#
  1486. X# $Header: relink,v 4.0 91/03/20 01:11:40 lwall Locked $
  1487. X#
  1488. X# $Log:    relink,v $
  1489. X# Revision 4.0  91/03/20  01:11:40  lwall
  1490. X# 4.0 baseline.
  1491. X# 
  1492. X# Revision 3.0.1.2  90/08/09  03:17:44  lwall
  1493. X# patch19: added man page for relink and rename
  1494. X# 
  1495. X
  1496. X($op = shift) || die "Usage: relink perlexpr [filenames]\n";
  1497. Xif (!@ARGV) {
  1498. X    @ARGV = <STDIN>;
  1499. X    chop(@ARGV);
  1500. X}
  1501. Xfor (@ARGV) {
  1502. X    next unless -l;        # symbolic link?
  1503. X    $name = $_;
  1504. X    $_ = readlink($_);
  1505. X    $was = $_;
  1506. X    eval $op;
  1507. X    die $@ if $@;
  1508. X    if ($was ne $_) {
  1509. X    unlink($name);
  1510. X    symlink($_, $name);
  1511. X    }
  1512. X}
  1513. X##############################################################################
  1514. X
  1515. X    # These next few lines are legal in both Perl and nroff.
  1516. X
  1517. X.00;            # finish .ig
  1518. X 
  1519. X'di            \" finish diversion--previous line must be blank
  1520. X.nr nl 0-1        \" fake up transition to first page again
  1521. X.nr % 0            \" start at page 1
  1522. X';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
  1523. X.TH RELINK 1 "July 30, 1990"
  1524. X.AT 3
  1525. X.SH LINK
  1526. Xrelink \- relinks multiple symbolic links
  1527. X.SH SYNOPSIS
  1528. X.B relink perlexpr [symlinknames]
  1529. X.SH DESCRIPTION
  1530. X.I Relink
  1531. Xrelinks the symbolic links given according to the rule specified as the
  1532. Xfirst argument.
  1533. XThe argument is a Perl expression which is expected to modify the $_
  1534. Xstring in Perl for at least some of the names specified.
  1535. XFor each symbolic link named on the command line, the Perl expression
  1536. Xwill be executed on the contents of the symbolic link with that name.
  1537. XIf a given symbolic link's contents is not modified by the expression,
  1538. Xit will not be changed.
  1539. XIf a name given on the command line is not a symbolic link, it will be ignored.
  1540. XIf no names are given on the command line, names will be read
  1541. Xvia standard input.
  1542. X.PP
  1543. XFor example, to relink all symbolic links in the current directory
  1544. Xpointing to somewhere in X11R3 so that they point to X11R4, you might say
  1545. X.nf
  1546. X
  1547. X    relink 's/X11R3/X11R4/' *
  1548. X
  1549. X.fi
  1550. XTo change all occurences of links in the system from /usr/spool to /var/spool,
  1551. Xyou'd say
  1552. X.nf
  1553. X
  1554. X    find / -type l -print | relink 's#/usr/spool#/var/spool#'
  1555. X
  1556. X.fi
  1557. X.SH ENVIRONMENT
  1558. XNo environment variables are used.
  1559. X.SH FILES
  1560. X.SH AUTHOR
  1561. XLarry Wall
  1562. X.SH "SEE ALSO"
  1563. Xln(1)
  1564. X.br
  1565. Xperl(1)
  1566. X.SH DIAGNOSTICS
  1567. XIf you give an invalid Perl expression you'll get a syntax error.
  1568. X.SH BUGS
  1569. X.ex
  1570. !STUFFY!FUNK!
  1571. echo Extracting x2p/s2p.man
  1572. sed >x2p/s2p.man <<'!STUFFY!FUNK!' -e 's/X//'
  1573. X.rn '' }`
  1574. X''' $Header: s2p.man,v 4.0 91/03/20 01:58:07 lwall Locked $
  1575. X''' 
  1576. X''' $Log:    s2p.man,v $
  1577. X''' Revision 4.0  91/03/20  01:58:07  lwall
  1578. X''' 4.0 baseline.
  1579. X''' 
  1580. X''' Revision 3.0  89/10/18  15:35:09  lwall
  1581. X''' 3.0 baseline
  1582. X''' 
  1583. X''' Revision 2.0  88/06/05  00:15:59  root
  1584. X''' Baseline version 2.0.
  1585. X''' 
  1586. X''' 
  1587. X.de Sh
  1588. X.br
  1589. X.ne 5
  1590. X.PP
  1591. X\fB\\$1\fR
  1592. X.PP
  1593. X..
  1594. X.de Sp
  1595. X.if t .sp .5v
  1596. X.if n .sp
  1597. X..
  1598. X.de Ip
  1599. X.br
  1600. X.ie \\n.$>=3 .ne \\$3
  1601. X.el .ne 3
  1602. X.IP "\\$1" \\$2
  1603. X..
  1604. X'''
  1605. X'''     Set up \*(-- to give an unbreakable dash;
  1606. X'''     string Tr holds user defined translation string.
  1607. X'''     Bell System Logo is used as a dummy character.
  1608. X'''
  1609. X.tr \(*W-|\(bv\*(Tr
  1610. X.ie n \{\
  1611. X.ds -- \(*W-
  1612. X.if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
  1613. X.if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
  1614. X.ds L" ""
  1615. X.ds R" ""
  1616. X.ds L' '
  1617. X.ds R' '
  1618. X'br\}
  1619. X.el\{\
  1620. X.ds -- \(em\|
  1621. X.tr \*(Tr
  1622. X.ds L" ``
  1623. X.ds R" ''
  1624. X.ds L' `
  1625. X.ds R' '
  1626. X'br\}
  1627. X.TH S2P 1 NEW
  1628. X.SH NAME
  1629. Xs2p - Sed to Perl translator
  1630. X.SH SYNOPSIS
  1631. X.B s2p [options] filename
  1632. X.SH DESCRIPTION
  1633. X.I S2p
  1634. Xtakes a sed script specified on the command line (or from standard input)
  1635. Xand produces a comparable
  1636. X.I perl
  1637. Xscript on the standard output.
  1638. X.Sh "Options"
  1639. XOptions include:
  1640. X.TP 5
  1641. X.B \-D<number>
  1642. Xsets debugging flags.
  1643. X.TP 5
  1644. X.B \-n
  1645. Xspecifies that this sed script was always invoked with a sed -n.
  1646. XOtherwise a switch parser is prepended to the front of the script.
  1647. X.TP 5
  1648. X.B \-p
  1649. Xspecifies that this sed script was never invoked with a sed -n.
  1650. XOtherwise a switch parser is prepended to the front of the script.
  1651. X.Sh "Considerations"
  1652. XThe perl script produced looks very sed-ish, and there may very well be
  1653. Xbetter ways to express what you want to do in perl.
  1654. XFor instance, s2p does not make any use of the split operator, but you might
  1655. Xwant to.
  1656. X.PP
  1657. XThe perl script you end up with may be either faster or slower than the original
  1658. Xsed script.
  1659. XIf you're only interested in speed you'll just have to try it both ways.
  1660. XOf course, if you want to do something sed doesn't do, you have no choice.
  1661. X.SH ENVIRONMENT
  1662. XS2p uses no environment variables.
  1663. X.SH AUTHOR
  1664. XLarry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
  1665. X.SH FILES
  1666. X.SH SEE ALSO
  1667. Xperl    The perl compiler/interpreter
  1668. X.br
  1669. Xa2p    awk to perl translator
  1670. X.SH DIAGNOSTICS
  1671. X.SH BUGS
  1672. X.rn }` ''
  1673. !STUFFY!FUNK!
  1674. echo Extracting eg/scan/scan_suid
  1675. sed >eg/scan/scan_suid <<'!STUFFY!FUNK!' -e 's/X//'
  1676. X#!/usr/bin/perl -P
  1677. X
  1678. X# $Header: scan_suid,v 4.0 91/03/20 01:14:00 lwall Locked $
  1679. X
  1680. X# Look for new setuid root files.
  1681. X
  1682. Xchdir '/usr/adm/private/memories' || die "Can't cd to memories: $!\n";
  1683. X
  1684. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  1685. X   $blksize,$blocks) = stat('oldsuid');
  1686. Xif ($nlink) {
  1687. X    $lasttime = $mtime;
  1688. X    $tmp = $ctime - $atime;
  1689. X    if ($tmp <= 0 || $tmp >= 10) {
  1690. X    print "WARNING: somebody has read oldsuid!\n";
  1691. X    }
  1692. X    $tmp = $ctime - $mtime;
  1693. X    if ($tmp <= 0 || $tmp >= 10) {
  1694. X    print "WARNING: somebody has modified oldsuid!!!\n";
  1695. X    }
  1696. X} else {
  1697. X    $lasttime = time - 60 * 60 * 24;    # one day ago
  1698. X}
  1699. X$thistime = time;
  1700. X
  1701. X#if defined(mc300) || defined(mc500) || defined(mc700)
  1702. Xopen(Find, 'find / -perm -04000 -print |') ||
  1703. X    die "scan_find: can't run find";
  1704. X#else
  1705. Xopen(Find, 'find / \( -fstype nfs -prune \) -o -perm -04000 -ls |') ||
  1706. X    die "scan_find: can't run find";
  1707. X#endif
  1708. X
  1709. Xopen(suid, '>newsuid.tmp');
  1710. X
  1711. Xwhile (<Find>) {
  1712. X
  1713. X#if defined(mc300) || defined(mc500) || defined(mc700)
  1714. X    $x = `/bin/ls -il $_`;
  1715. X    $_ = $x;
  1716. X    s/^ *//;
  1717. X    ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
  1718. X      = split;
  1719. X#else
  1720. X    s/^ *//;
  1721. X    ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
  1722. X      = split;
  1723. X#endif
  1724. X
  1725. X    if ($perm =~ /[sS]/ && $owner eq 'root') {
  1726. X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  1727. X       $blksize,$blocks) = stat($name);
  1728. X    $foo = sprintf("%10s%3s %-8s %-8s%9s %3s %2s %s %s\n",
  1729. X        $perm,$links,$owner,$group,$size,$month,$day,$name,$inode);
  1730. X    print suid $foo;
  1731. X    if ($ctime > $lasttime) {
  1732. X        if ($ctime > $thistime) {
  1733. X        print "Future file: $foo";
  1734. X        }
  1735. X        else {
  1736. X        $ct .= $foo;
  1737. X        }
  1738. X    }
  1739. X    }
  1740. X}
  1741. Xclose(suid);
  1742. X
  1743. Xprint `sort +7 -8 newsuid.tmp >newsuid 2>&1`;
  1744. X$foo = `/bin/diff oldsuid newsuid 2>&1`;
  1745. Xprint "Differences in suid info:\n",$foo if $foo;
  1746. Xprint `mv oldsuid oldoldsuid 2>&1; mv newsuid oldsuid 2>&1`;
  1747. Xprint `touch oldsuid 2>&1;sleep 2 2>&1;chmod o+w oldsuid 2>&1`;
  1748. Xprint `rm -f newsuid.tmp 2>&1`;
  1749. X
  1750. X@ct = split(/\n/,$ct);
  1751. X$ct = '';
  1752. X$* = 1;
  1753. Xwhile ($#ct >= 0) {
  1754. X    $tmp = shift(@ct);
  1755. X    unless ($foo =~ "^>.*$tmp\n") { $ct .= "$tmp\n"; }
  1756. X}
  1757. X
  1758. Xprint "Inode changed since last time:\n",$ct if $ct;
  1759. X
  1760. !STUFFY!FUNK!
  1761. echo Extracting eg/g/gsh.man
  1762. sed >eg/g/gsh.man <<'!STUFFY!FUNK!' -e 's/X//'
  1763. X.\" $Header: gsh.man,v 4.0 91/03/20 01:10:46 lwall Locked $
  1764. X.TH GSH 8 "13 May 1988"
  1765. X.SH NAME
  1766. Xgsh \- global shell
  1767. X.SH SYNOPSIS
  1768. X.B gsh
  1769. X[options]
  1770. X.I host
  1771. X[options] 
  1772. X.I command
  1773. X.SH DESCRIPTION
  1774. X.I gsh
  1775. Xworks just like rsh(1C) except that you may specify a set of hosts to execute
  1776. Xthe command on.
  1777. XThe host sets are defined in the file /etc/ghosts.
  1778. X(An individual host name can be used as a set containing one member.)
  1779. XYou can give a command like
  1780. X
  1781. X    gsh sun /etc/mungmotd
  1782. X
  1783. Xto run /etc/mungmotd on all your Suns.
  1784. X.P
  1785. XYou may specify the union of two or more sets by using + as follows:
  1786. X
  1787. X    gsh 750+mc /etc/mungmotd
  1788. X
  1789. Xwhich will run mungmotd on all 750's and Masscomps.
  1790. X.P
  1791. XCommonly used sets should be defined in /etc/ghosts.
  1792. XFor example, you could add a line that says
  1793. X
  1794. X    pep=manny+moe+jack
  1795. X
  1796. XAnother way to do that would be to add the word "pep" after each of the host
  1797. Xentries:
  1798. X
  1799. X    manny    sun3 pep
  1800. X.br
  1801. X    moe        sun3 pep
  1802. X.br
  1803. X    jack        sun3 pep
  1804. X
  1805. XHosts and sets of host can also be excluded:
  1806. X
  1807. X    foo=sun-sun2
  1808. X
  1809. XAny host so excluded will never be included, even if a subsequent set on the
  1810. Xline includes it:
  1811. X
  1812. X    foo=abc+def
  1813. X    bar=xyz-abc+foo
  1814. X
  1815. Xcomes out to xyz+def.
  1816. X
  1817. XYou can define private host sets by creating .ghosts in your current directory
  1818. Xwith entries just like /etc/ghosts.
  1819. XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
  1820. Xfrom the last gsh or gcp that didn't succeed everywhere.
  1821. X
  1822. XOptions include all those defined by rsh, as well as
  1823. X
  1824. X.IP "\-d" 8
  1825. XCauses gsh to collect input till end of file, and then distribute that input
  1826. Xto each invokation of rsh.
  1827. X.IP "\-h" 8
  1828. XRather than print out the command followed by the output, merely prepends the
  1829. Xhost name to each line of output.
  1830. X.IP "\-s" 8
  1831. XDo work silently.
  1832. X.PP
  1833. XInterrupting with a SIGINT will cause the rsh to the current host to be skipped
  1834. Xand execution resumed with the next host.
  1835. XTo stop completely, send a SIGQUIT.
  1836. X.SH SEE ALSO
  1837. Xrsh(1C)
  1838. X.SH BUGS
  1839. XAll the bugs of rsh, since it calls rsh.
  1840. X
  1841. XAlso, will not properly return data from the remote execution that contains
  1842. Xnull characters.
  1843. !STUFFY!FUNK!
  1844. echo " "
  1845. echo "End of kit 33 (of 36)"
  1846. cat /dev/null >kit33isdone
  1847. run=''
  1848. config=''
  1849. 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
  1850.     if test -f kit${iskit}isdone; then
  1851.     run="$run $iskit"
  1852.     else
  1853.     todo="$todo $iskit"
  1854.     fi
  1855. done
  1856. case $todo in
  1857.     '')
  1858.     echo "You have run all your kits.  Please read README and then type Configure."
  1859.     for combo in *:AA; do
  1860.         if test -f "$combo"; then
  1861.         realfile=`basename $combo :AA`
  1862.         cat $realfile:[A-Z][A-Z] >$realfile
  1863.         rm -rf $realfile:[A-Z][A-Z]
  1864.         fi
  1865.     done
  1866.     rm -rf kit*isdone
  1867.     chmod 755 Configure
  1868.     ;;
  1869.     *)  echo "You have run$run."
  1870.     echo "You still need to run$todo."
  1871.     ;;
  1872. esac
  1873. : Someone might mail this, so...
  1874. exit
  1875.  
  1876. exit 0 # Just in case...
  1877. -- 
  1878. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1879. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1880. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1881. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1882.