home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume15 / perl2 / part14 / text0000.txt < prev   
Encoding:
Text File  |  1989-01-05  |  48.6 KB  |  1,958 lines
  1. #! /bin/sh
  2.  
  3. # Make a new directory for the perl sources, cd to it, and run kits 1
  4. # thru 15 through sh.  When all 15 kits have been run, read README.
  5.  
  6. echo "This is perl 2.0 kit 14 (of 15).  If kit 14 is complete, the line"
  7. echo '"'"End of kit 14 (of 15)"'" will echo at the end.'
  8. echo ""
  9. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  10. mkdir eg eg/g eg/scan eg/van lib t x2p 2>/dev/null
  11. echo Extracting t/op.auto
  12. sed >t/op.auto <<'!STUFFY!FUNK!' -e 's/X//'
  13. X#!./perl
  14. X
  15. X# $Header: op.auto,v 2.0 88/06/05 00:13:19 root Exp $
  16. X
  17. Xprint "1..34\n";
  18. X
  19. X$x = 10000;
  20. Xif (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
  21. Xif (0 + $x-- - 1 == 10000) { print "ok 2\n";} else {print "not ok 2\n";}
  22. Xif (1 * $x == 10000) { print "ok 3\n";} else {print "not ok 3\n";}
  23. Xif (0 + $x-- - 0 == 10000) { print "ok 4\n";} else {print "not ok 4\n";}
  24. Xif (1 + $x == 10000) { print "ok 5\n";} else {print "not ok 5\n";}
  25. Xif (1 + $x++ == 10000) { print "ok 6\n";} else {print "not ok 6\n";}
  26. Xif (0 + $x == 10000) { print "ok 7\n";} else {print "not ok 7\n";}
  27. Xif (0 + --$x + 1 == 10000) { print "ok 8\n";} else {print "not ok 8\n";}
  28. Xif (0 + ++$x + 0 == 10000) { print "ok 9\n";} else {print "not ok 9\n";}
  29. Xif ($x == 10000) { print "ok 10\n";} else {print "not ok 10\n";}
  30. X
  31. X$x[0] = 10000;
  32. Xif (0 + ++$x[0] - 1 == 10000) { print "ok 11\n";} else {print "not ok 11\n";}
  33. Xif (0 + $x[0]-- - 1 == 10000) { print "ok 12\n";} else {print "not ok 12\n";}
  34. Xif (1 * $x[0] == 10000) { print "ok 13\n";} else {print "not ok 13\n";}
  35. Xif (0 + $x[0]-- - 0 == 10000) { print "ok 14\n";} else {print "not ok 14\n";}
  36. Xif (1 + $x[0] == 10000) { print "ok 15\n";} else {print "not ok 15\n";}
  37. Xif (1 + $x[0]++ == 10000) { print "ok 16\n";} else {print "not ok 16\n";}
  38. Xif (0 + $x[0] == 10000) { print "ok 17\n";} else {print "not ok 17\n";}
  39. Xif (0 + --$x[0] + 1 == 10000) { print "ok 18\n";} else {print "not ok 18\n";}
  40. Xif (0 + ++$x[0] + 0 == 10000) { print "ok 19\n";} else {print "not ok 19\n";}
  41. Xif ($x[0] == 10000) { print "ok 20\n";} else {print "not ok 20\n";}
  42. X
  43. X$x{0} = 10000;
  44. Xif (0 + ++$x{0} - 1 == 10000) { print "ok 21\n";} else {print "not ok 21\n";}
  45. Xif (0 + $x{0}-- - 1 == 10000) { print "ok 22\n";} else {print "not ok 22\n";}
  46. Xif (1 * $x{0} == 10000) { print "ok 23\n";} else {print "not ok 23\n";}
  47. Xif (0 + $x{0}-- - 0 == 10000) { print "ok 24\n";} else {print "not ok 24\n";}
  48. Xif (1 + $x{0} == 10000) { print "ok 25\n";} else {print "not ok 25\n";}
  49. Xif (1 + $x{0}++ == 10000) { print "ok 26\n";} else {print "not ok 26\n";}
  50. Xif (0 + $x{0} == 10000) { print "ok 27\n";} else {print "not ok 27\n";}
  51. Xif (0 + --$x{0} + 1 == 10000) { print "ok 28\n";} else {print "not ok 28\n";}
  52. Xif (0 + ++$x{0} + 0 == 10000) { print "ok 29\n";} else {print "not ok 29\n";}
  53. Xif ($x{0} == 10000) { print "ok 30\n";} else {print "not ok 30\n";}
  54. X
  55. X# test magical autoincrement
  56. X
  57. Xif (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
  58. Xif (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
  59. Xif (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
  60. Xif (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
  61. !STUFFY!FUNK!
  62. echo Extracting t/op.pat
  63. sed >t/op.pat <<'!STUFFY!FUNK!' -e 's/X//'
  64. X#!./perl
  65. X
  66. X# $Header: op.pat,v 2.0 88/06/05 00:14:20 root Exp $
  67. X
  68. Xprint "1..30\n";
  69. X
  70. X$x = "abc\ndef\n";
  71. X
  72. Xif ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
  73. Xif ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
  74. X
  75. X$* = 1;
  76. Xif ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
  77. X$* = 0;
  78. X
  79. X$_ = '123';
  80. Xif (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
  81. X
  82. Xif ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
  83. Xif ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
  84. X
  85. Xif ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
  86. Xif ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
  87. X
  88. Xif ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
  89. Xif ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
  90. X
  91. Xif ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
  92. Xif ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
  93. X
  94. X$_ = 'aaabbbccc';
  95. Xif (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
  96. X    print "ok 13\n";
  97. X} else {
  98. X    print "not ok 13\n";
  99. X}
  100. Xif (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
  101. X    print "ok 14\n";
  102. X} else {
  103. X    print "not ok 14\n";
  104. X}
  105. X
  106. Xif (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
  107. X
  108. X$_ = 'aaabccc';
  109. Xif (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
  110. Xif (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
  111. X
  112. X$_ = 'aaaccc';
  113. Xif (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
  114. Xif (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
  115. X
  116. X$_ = 'abcdef';
  117. Xif (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
  118. Xif (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
  119. X
  120. Xif (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
  121. X
  122. Xif (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
  123. X
  124. X$* = 1;        # test 3 only tested the optimized version--this one is for real
  125. Xif ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
  126. X$* = 0;
  127. X
  128. X$XXX{123} = 123;
  129. X$XXX{234} = 234;
  130. X$XXX{345} = 345;
  131. X
  132. X@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
  133. Xwhile ($_ = shift(XXX)) {
  134. X    ?(.*)? && (print $1,"\n");
  135. X    /not/ && reset;
  136. X    /not ok 26/ && reset 'X';
  137. X}
  138. X
  139. Xwhile (($key,$val) = each(XXX)) {
  140. X    print "not ok 27\n";
  141. X    exit;
  142. X}
  143. X
  144. Xprint "ok 27\n";
  145. X
  146. X'cde' =~ /[^ab]*/;
  147. X'xyz' =~ //;
  148. Xif ($& eq 'xyz') {print "ok 28\n";} else {print "not ok 28\n";}
  149. X
  150. X$foo = '[^ab]*';
  151. X'cde' =~ /$foo/;
  152. X'xyz' =~ //;
  153. Xif ($& eq 'xyz') {print "ok 29\n";} else {print "not ok 29\n";}
  154. X
  155. X$foo = '[^ab]*';
  156. X'cde' =~ /$foo/;
  157. X'xyz' =~ /$null/;
  158. Xif ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
  159. !STUFFY!FUNK!
  160. echo Extracting eg/g/gcp
  161. sed >eg/g/gcp <<'!STUFFY!FUNK!' -e 's/X//'
  162. X#!/usr/bin/perl
  163. X
  164. X# $Header: gcp,v 2.0 88/06/05 00:17:02 root Exp $
  165. X
  166. X# Here is a script to do global rcps.  See man page.
  167. X
  168. X$#ARGV >= 1 || die "Not enough arguments.\n";
  169. X
  170. Xif ($ARGV[0] eq '-r') {
  171. X    $rcp = 'rcp -r';
  172. X    shift;
  173. X} else {
  174. X    $rcp = 'rcp';
  175. X}
  176. X$args = $rcp;
  177. X$dest = $ARGV[$#ARGV];
  178. X
  179. X$SIG{'QUIT'} = 'CLEANUP';
  180. X$SIG{'INT'} = 'CONT';
  181. X
  182. Xwhile ($arg = shift) {
  183. X    if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
  184. X    if ($systype && $systype ne $1) {
  185. X        die "Can't mix system type specifers ($systype vs $1).\n";
  186. X    }
  187. X    $#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
  188. X    $systype = $1;
  189. X    $args .= " $arg";
  190. X    } else {
  191. X    if ($#ARGV >= 0) {
  192. X        if ($arg =~ /^[\/~]/) {
  193. X        $arg =~ /^(.*)\// && ($dir = $1);
  194. X        } else {
  195. X        if (!$pwd) {
  196. X            chop($pwd = `pwd`);
  197. X        }
  198. X        $dir = $pwd;
  199. X        }
  200. X    }
  201. X    if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
  202. X        $args .= " $dest$olddir; $rcp";
  203. X    }
  204. X    $olddir = $dir;
  205. X    $args .= " $arg";
  206. X    }
  207. X}
  208. X
  209. Xdie "No system type specified.\n" unless $systype;
  210. X
  211. X$args =~ s/:$/:$olddir/;
  212. X
  213. Xchop($thishost = `hostname`);
  214. X
  215. X$one_of_these = ":$systype:";
  216. Xif ($systype =~ s/\+/[+]/g) {
  217. X    $one_of_these =~ s/\+/:/g;
  218. X}
  219. X$one_of_these =~ s/-/:-/g;
  220. X
  221. X@ARGV = ();
  222. Xpush(@ARGV,'.grem') if -f '.grem';
  223. Xpush(@ARGV,'.ghosts') if -f '.ghosts';
  224. Xpush(@ARGV,'/etc/ghosts');
  225. X
  226. X$remainder = '';
  227. X
  228. Xline: while (<>) {
  229. X    s/[ \t]*\n//;
  230. X    if (!$_ || /^#/) {
  231. X    next line;
  232. X    }
  233. X    if (/^([a-zA-Z_0-9]+)=(.+)/) {
  234. X    $name = $1; $repl = $2;
  235. X    $repl =~ s/\+/:/g;
  236. X    $repl =~ s/-/:-/g;
  237. X    $one_of_these =~ s/:$name:/:$repl:/;
  238. X    $repl =~ s/:/:-/g;
  239. X    $one_of_these =~ s/:-$name:/:-$repl:/g;
  240. X    next line;
  241. X    }
  242. X    @gh = split(' ');
  243. X    $host = $gh[0];
  244. X  next line if $host eq $thishost;    # should handle aliases too
  245. X    $wanted = 0;
  246. X    foreach $class (@gh) {
  247. X    $wanted++ if index($one_of_these,":$class:") >= 0;
  248. X    $wanted = -9999 if index($one_of_these,":-$class:") >= 0;
  249. X    }
  250. X    if ($wanted > 0) {
  251. X    ($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
  252. X    print "$cmd\n";
  253. X    $result = `$cmd 2>&1`;
  254. X    $remainder .= "$host+" if
  255. X        $result =~ /Connection timed out|Permission denied/;
  256. X    print $result;
  257. X    }
  258. X}
  259. X
  260. Xif ($remainder) {
  261. X    chop($remainder);
  262. X    open(grem,">.grem") || (printf stderr "Can't create .grem\n");
  263. X    print grem 'rem=', $remainder, "\n";
  264. X    close(grem);
  265. X    print 'rem=', $remainder, "\n";
  266. X}
  267. X
  268. Xsub CLEANUP {
  269. X    exit;
  270. X}
  271. X
  272. Xsub CONT {
  273. X    print "Continuing...\n";    # Just ignore the signal that kills rcp
  274. X    $remainder .= "$host+";
  275. X}
  276. !STUFFY!FUNK!
  277. echo Extracting t/cmd.while
  278. sed >t/cmd.while <<'!STUFFY!FUNK!' -e 's/X//'
  279. X#!./perl
  280. X
  281. X# $Header: cmd.while,v 2.0 88/06/05 00:12:31 root Exp $
  282. X
  283. Xprint "1..10\n";
  284. X
  285. Xopen (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp.";
  286. Xprint tmp "tvi925\n";
  287. Xprint tmp "tvi920\n";
  288. Xprint tmp "vt100\n";
  289. Xprint tmp "Amiga\n";
  290. Xprint tmp "paper\n";
  291. Xclose tmp;
  292. X
  293. X# test "last" command
  294. X
  295. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  296. Xwhile (<fh>) {
  297. X    last if /vt100/;
  298. X}
  299. Xif (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1\n";}
  300. X
  301. X# test "next" command
  302. X
  303. X$bad = '';
  304. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  305. Xwhile (<fh>) {
  306. X    next if /vt100/;
  307. X    $bad = 1 if /vt100/;
  308. X}
  309. Xif (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
  310. X
  311. X# test "redo" command
  312. X
  313. X$bad = '';
  314. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  315. Xwhile (<fh>) {
  316. X    if (s/vt100/VT100/g) {
  317. X    s/VT100/Vt100/g;
  318. X    redo;
  319. X    }
  320. X    $bad = 1 if /vt100/;
  321. X    $bad = 1 if /VT100/;
  322. X}
  323. Xif (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
  324. X
  325. X# now do the same with a label and a continue block
  326. X
  327. X# test "last" command
  328. X
  329. X$badcont = '';
  330. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  331. Xline: while (<fh>) {
  332. X    if (/vt100/) {last line;}
  333. X} continue {
  334. X    $badcont = 1 if /vt100/;
  335. X}
  336. Xif (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
  337. Xif (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
  338. X
  339. X# test "next" command
  340. X
  341. X$bad = '';
  342. X$badcont = 1;
  343. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  344. Xentry: while (<fh>) {
  345. X    next entry if /vt100/;
  346. X    $bad = 1 if /vt100/;
  347. X} continue {
  348. X    $badcont = '' if /vt100/;
  349. X}
  350. Xif (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
  351. Xif (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
  352. X
  353. X# test "redo" command
  354. X
  355. X$bad = '';
  356. X$badcont = '';
  357. Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
  358. Xloop: while (<fh>) {
  359. X    if (s/vt100/VT100/g) {
  360. X    s/VT100/Vt100/g;
  361. X    redo loop;
  362. X    }
  363. X    $bad = 1 if /vt100/;
  364. X    $bad = 1 if /VT100/;
  365. X} continue {
  366. X    $badcont = 1 if /vt100/;
  367. X}
  368. Xif (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
  369. Xif (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
  370. X
  371. X`/bin/rm -f Cmd.while.tmp`;
  372. X
  373. X#$x = 0;
  374. X#while (1) {
  375. X#    if ($x > 1) {last;}
  376. X#    next;
  377. X#} continue {
  378. X#    if ($x++ > 10) {last;}
  379. X#    next;
  380. X#}
  381. X#
  382. X#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
  383. X
  384. X$i = 9;
  385. X{
  386. X    $i++;
  387. X}
  388. Xprint "ok $i\n";
  389. !STUFFY!FUNK!
  390. echo Extracting eg/scan/scanner
  391. sed >eg/scan/scanner <<'!STUFFY!FUNK!' -e 's/X//'
  392. X#!/usr/bin/perl
  393. X
  394. X# $Header: scanner,v 2.0 88/06/05 00:17:42 root Exp $
  395. X
  396. X# This runs all the scan_* routines on all the machines in /etc/ghosts.
  397. X# We run this every morning at about 6 am:
  398. X
  399. X#    !/bin/sh
  400. X#    cd /usr/adm/private
  401. X#    decrypt scanner | perl >scan.out 2>&1
  402. X#    mail admin <scan.out
  403. X
  404. X# Note that the scan_* files should be encrypted with the key "-inquire", and
  405. X# scanner should be encrypted somehow so that people can't find that key.
  406. X# I leave it up to you to figure out how to unencrypt it before executing.
  407. X
  408. X$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb:.';
  409. X
  410. X$| = 1;        # command buffering on stdout
  411. X
  412. Xprint "Subject: bizarre happenings\n\n";
  413. X
  414. X(chdir '/usr/adm/private') || die "Can't cd.";
  415. X
  416. Xif ($#ARGV >= 0) {
  417. X    @scanlist = @ARGV;
  418. X} else {
  419. X    @scanlist = split(/[ \t\n]+/,`echo scan_*`);
  420. X}
  421. X
  422. Xscan: while ($scan = shift(@scanlist)) {
  423. X    print "\n********** $scan **********\n";
  424. X    $showhost++;
  425. X
  426. X    $systype = 'all';
  427. X
  428. X    open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
  429. X
  430. X    $one_of_these = ":$systype:";
  431. X    if ($systype =~ s/\+/[+]/g) {
  432. X    $one_of_these =~ s/\+/:/g;
  433. X    }
  434. X
  435. X    line: while (<ghosts>) {
  436. X    s/[ \t]*\n//;
  437. X    if (!$_ || /^#/) {
  438. X        next line;
  439. X    }
  440. X    if (/^([a-zA-Z_0-9]+)=(.+)/) {
  441. X        $name = $1; $repl = $2;
  442. X        $repl =~ s/\+/:/g;
  443. X        $one_of_these =~ s/:$name:/:$repl:/;
  444. X        next line;
  445. X    }
  446. X    @gh = split;
  447. X    $host = $gh[0];
  448. X    if ($showhost) { $showhost = "$host:\t"; }
  449. X    class: while ($class = pop(gh)) {
  450. X        if (index($one_of_these,":$class:") >=0) {
  451. X        $iter = 0;
  452. X        `exec crypt -inquire <$scan >.x 2>/dev/null`;
  453. X        unless (open(scan,'.x')) {
  454. X            print "Can't run $scan.";
  455. X            next scan;
  456. X        }
  457. X        $cmd = <scan>;
  458. X        unless ($cmd =~ s/#!(.*)\n/$1/) {
  459. X            $cmd = '/usr/bin/perl';
  460. X        }
  461. X        close(scan);
  462. X        if (open(pipe,"exec rsh $host '$cmd' <.x|")) {
  463. X            sleep(5);
  464. X            unlink '.x';
  465. X            while (<pipe>) {
  466. X            last if $iter++ > 1000;        # must be looping
  467. X            next if /^[0-9.]+u [0-9.]+s/;
  468. X            print $showhost,$_;
  469. X            }
  470. X            close(pipe);
  471. X        } else {
  472. X            print "(Can't execute rsh.)\n";
  473. X        }
  474. X        last class;
  475. X        }
  476. X    }
  477. X    }
  478. X}
  479. !STUFFY!FUNK!
  480. echo Extracting eg/g/gsh.man
  481. sed >eg/g/gsh.man <<'!STUFFY!FUNK!' -e 's/X//'
  482. X.\" $Header: gsh.man,v 2.0 88/06/05 00:17:23 root Exp $
  483. X.TH GSH 8 "13 May 1988"
  484. X.SH NAME
  485. Xgsh \- global shell
  486. X.SH SYNOPSIS
  487. X.B gsh
  488. X[options]
  489. X.I host
  490. X[options] 
  491. X.I command
  492. X.SH DESCRIPTION
  493. X.I gsh
  494. Xworks just like rsh(1C) except that you may specify a set of hosts to execute
  495. Xthe command on.
  496. XThe host sets are defined in the file /etc/ghosts.
  497. X(An individual host name can be used as a set containing one member.)
  498. XYou can give a command like
  499. X
  500. X    gsh sun /etc/mungmotd
  501. X
  502. Xto run /etc/mungmotd on all your Suns.
  503. X.P
  504. XYou may specify the union of two or more sets by using + as follows:
  505. X
  506. X    gsh 750+mc /etc/mungmotd
  507. X
  508. Xwhich will run mungmotd on all 750's and Masscomps.
  509. X.P
  510. XCommonly used sets should be defined in /etc/ghosts.
  511. XFor example, you could add a line that says
  512. X
  513. X    pep=manny+moe+jack
  514. X
  515. XAnother way to do that would be to add the word "pep" after each of the host
  516. Xentries:
  517. X
  518. X    manny    sun3 pep
  519. X.br
  520. X    moe        sun3 pep
  521. X.br
  522. X    jack        sun3 pep
  523. X
  524. XHosts and sets of host can also be excluded:
  525. X
  526. X    foo=sun-sun2
  527. X
  528. XAny host so excluded will never be included, even if a subsequent set on the
  529. Xline includes it:
  530. X
  531. X    foo=abc+def
  532. X    bar=xyz-abc+foo
  533. X
  534. Xcomes out to xyz+def.
  535. X
  536. XYou can define private host sets by creating .ghosts in your current directory
  537. Xwith entries just like /etc/ghosts.
  538. XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
  539. Xfrom the last gsh or gcp that didn't succeed everywhere.
  540. X
  541. XOptions include all those defined by rsh, as well as
  542. X
  543. X.IP "\-d" 8
  544. XCauses gsh to collect input till end of file, and then distribute that input
  545. Xto each invokation of rsh.
  546. X.IP "\-h" 8
  547. XRather than print out the command followed by the output, merely prepends the
  548. Xhost name to each line of output.
  549. X.IP "\-s" 8
  550. XDo work silently.
  551. X.PP
  552. XInterrupting with a SIGINT will cause the rsh to the current host to be skipped
  553. Xand execution resumed with the next host.
  554. XTo stop completely, send a SIGQUIT.
  555. X.SH SEE ALSO
  556. Xrsh(1C)
  557. X.SH BUGS
  558. XAll the bugs of rsh, since it calls rsh.
  559. X
  560. XAlso, will not properly return data from the remote execution that contains
  561. Xnull characters.
  562. !STUFFY!FUNK!
  563. echo Extracting eg/g/gcp.man
  564. sed >eg/g/gcp.man <<'!STUFFY!FUNK!' -e 's/X//'
  565. X.\" $Header: gcp.man,v 2.0 88/06/05 00:17:05 root Exp $
  566. X.TH GCP 1C "13 May 1988"
  567. X.SH NAME
  568. Xgcp \- global file copy
  569. X.SH SYNOPSIS
  570. X.B gcp
  571. Xfile1 file2
  572. X.br
  573. X.B gcp
  574. X[
  575. X.B \-r
  576. X] file ... directory
  577. X.SH DESCRIPTION
  578. X.I gcp
  579. Xworks just like rcp(1C) except that you may specify a set of hosts to copy files
  580. Xfrom or to.
  581. XThe host sets are defined in the file /etc/ghosts.
  582. X(An individual host name can be used as a set containing one member.)
  583. XYou can give a command like
  584. X
  585. X    gcp /etc/motd sun:
  586. X
  587. Xto copy your /etc/motd file to /etc/motd on all the Suns.
  588. XIf, on the other hand, you say
  589. X
  590. X    gcp /a/foo /b/bar sun:/tmp
  591. X
  592. Xthen your files will be copied to /tmp on all the Suns.
  593. XThe general rule is that if you don't specify the destination directory,
  594. Xfiles go to the same directory they are in currently.
  595. X.P
  596. XYou may specify the union of two or more sets by using + as follows:
  597. X
  598. X    gcp /a/foo /b/bar 750+mc:
  599. X
  600. Xwhich will copy /a/foo to /a/foo on all 750's and Masscomps, and then copy
  601. X/b/bar to /b/bar on all 750's and Masscomps.
  602. X.P
  603. XCommonly used sets should be defined in /etc/ghosts.
  604. XFor example, you could add a line that says
  605. X
  606. X    pep=manny+moe+jack
  607. X
  608. XAnother way to do that would be to add the word "pep" after each of the host
  609. Xentries:
  610. X
  611. X    manny    sun3 pep
  612. X.br
  613. X    moe        sun3 pep
  614. X.br
  615. X    jack        sun3 pep
  616. X
  617. XHosts and sets of host can also be excluded:
  618. X
  619. X    foo=sun-sun2
  620. X
  621. XAny host so excluded will never be included, even if a subsequent set on the
  622. Xline includes it:
  623. X
  624. X    foo=abc+def
  625. X.br
  626. X    bar=xyz-abc+foo
  627. X
  628. Xcomes out to xyz+def.
  629. X
  630. XYou can define private host sets by creating .ghosts in your current directory
  631. Xwith entries just like /etc/ghosts.
  632. XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
  633. Xfrom the last gsh or gcp that didn't succeed everywhere.
  634. X.PP
  635. XInterrupting with a SIGINT will cause the rcp to the current host to be skipped
  636. Xand execution resumed with the next host.
  637. XTo stop completely, send a SIGQUIT.
  638. X.SH SEE ALSO
  639. Xrcp(1C)
  640. X.SH BUGS
  641. XAll the bugs of rcp, since it calls rcp.
  642. !STUFFY!FUNK!
  643. echo Extracting t/op.study
  644. sed >t/op.study <<'!STUFFY!FUNK!' -e 's/X//'
  645. X#!./perl
  646. X
  647. X# $Header: op.study,v 2.0 88/06/05 00:14:45 root Exp $
  648. X
  649. Xprint "1..24\n";
  650. X
  651. X$x = "abc\ndef\n";
  652. Xstudy($x);
  653. X
  654. Xif ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
  655. Xif ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
  656. X
  657. X$* = 1;
  658. Xif ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
  659. X$* = 0;
  660. X
  661. X$_ = '123';
  662. Xstudy;
  663. Xif (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
  664. X
  665. Xif ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
  666. Xif ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
  667. X
  668. Xif ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
  669. Xif ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
  670. X
  671. Xstudy($x);
  672. Xif ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
  673. Xif ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
  674. X
  675. Xif ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
  676. Xif ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
  677. X
  678. X$_ = 'aaabbbccc';
  679. Xstudy;
  680. Xif (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
  681. X    print "ok 13\n";
  682. X} else {
  683. X    print "not ok 13\n";
  684. X}
  685. Xif (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
  686. X    print "ok 14\n";
  687. X} else {
  688. X    print "not ok 14\n";
  689. X}
  690. X
  691. Xif (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
  692. X
  693. X$_ = 'aaabccc';
  694. Xstudy;
  695. Xif (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
  696. Xif (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
  697. X
  698. X$_ = 'aaaccc';
  699. Xstudy;
  700. Xif (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
  701. Xif (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
  702. X
  703. X$_ = 'abcdef';
  704. Xstudy;
  705. Xif (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
  706. Xif (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
  707. X
  708. Xif (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
  709. X
  710. Xif (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
  711. X
  712. X$* = 1;        # test 3 only tested the optimized version--this one is for real
  713. Xif ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
  714. !STUFFY!FUNK!
  715. echo Extracting t/TEST
  716. sed >t/TEST <<'!STUFFY!FUNK!' -e 's/X//'
  717. X#!./perl
  718. X
  719. X# $Header: TEST,v 2.0 88/06/05 00:11:47 root Exp $
  720. X
  721. X# This is written in a peculiar style, since we're trying to avoid
  722. X# most of the constructs we'll be testing for.
  723. X
  724. Xif ($ARGV[0] eq '-v') {
  725. X    $verbose = 1;
  726. X    shift;
  727. X}
  728. X
  729. Xchdir 't' if -f 't/TEST';
  730. X
  731. Xif ($ARGV[0] eq '') {
  732. X    @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
  733. X}
  734. X
  735. Xopen(config,"../config.sh");
  736. Xwhile (<config>) {
  737. X    if (/sharpbang='(.*)'/) {
  738. X    $sharpbang = ($1 eq '#!');
  739. X    last;
  740. X    }
  741. X}
  742. X$bad = 0;
  743. Xwhile ($test = shift) {
  744. X    if ($test =~ /\.orig$/) {
  745. X    next;
  746. X    }
  747. X    print "$test...";
  748. X    if ($sharpbang) {
  749. X    open(results,"./$test|") || (print "can't run.\n");
  750. X    } else {
  751. X    open(script,"$test") || die "Can't run $test.\n";
  752. X    $_ = <script>;
  753. X    close(script);
  754. X    if (/#!..perl(.*)/) {
  755. X        $switch = $1;
  756. X    } else {
  757. X        $switch = '';
  758. X    }
  759. X    open(results,"./perl$switch $test|") || (print "can't run.\n");
  760. X    }
  761. X    $ok = 0;
  762. X    $next = 0;
  763. X    while (<results>) {
  764. X    if ($verbose) {
  765. X        print $_;
  766. X    }
  767. X    unless (/^#/) {
  768. X        if (/^1\.\.([0-9]+)/) {
  769. X        $max = $1;
  770. X        $next = 1;
  771. X        $ok = 1;
  772. X        } else {
  773. X        if (/^ok (.*)/ && $1 == $next) {
  774. X            $next = $next + 1;
  775. X        } else {
  776. X            $ok = 0;
  777. X        }
  778. X        }
  779. X    }
  780. X    }
  781. X    $next = $next - 1;
  782. X    if ($ok && $next == $max) {
  783. X    print "ok\n";
  784. X    } else {
  785. X    $next += 1;
  786. X    print "FAILED on test $next\n";
  787. X    $bad = $bad + 1;
  788. X    $_ = $test;
  789. X    if (/^base/) {
  790. X        die "Failed a basic test--cannot continue.\n";
  791. X    }
  792. X    }
  793. X}
  794. X
  795. Xif ($bad == 0) {
  796. X    if ($ok) {
  797. X    print "All tests successful.\n";
  798. X    } else {
  799. X    die "FAILED--no tests were run for some reason.\n";
  800. X    }
  801. X} else {
  802. X    if ($bad == 1) {
  803. X    die "Failed 1 test.\n";
  804. X    } else {
  805. X    die "Failed $bad tests.\n";
  806. X    }
  807. X}
  808. X($user,$sys,$cuser,$csys) = times;
  809. Xprint sprintf("u=%g  s=%g  cu=%g  cs=%g\n",$user,$sys,$cuser,$csys);
  810. !STUFFY!FUNK!
  811. echo Extracting t/cmd.subval
  812. sed >t/cmd.subval <<'!STUFFY!FUNK!' -e 's/X//'
  813. X#!./perl
  814. X
  815. X# $Header: cmd.subval,v 2.0 88/06/05 00:12:26 root Exp $
  816. X
  817. Xsub foo1 {
  818. X    'true1';
  819. X    if ($_[0]) { 'true2'; }
  820. X}
  821. X
  822. Xsub foo2 {
  823. X    'true1';
  824. X    if ($_[0]) { 'true2'; } else { 'true3'; }
  825. X}
  826. X
  827. Xsub foo3 {
  828. X    'true1';
  829. X    unless ($_[0]) { 'true2'; }
  830. X}
  831. X
  832. Xsub foo4 {
  833. X    'true1';
  834. X    unless ($_[0]) { 'true2'; } else { 'true3'; }
  835. X}
  836. X
  837. Xsub foo5 {
  838. X    'true1';
  839. X    'true2' if $_[0];
  840. X}
  841. X
  842. Xsub foo6 {
  843. X    'true1';
  844. X    'true2' unless $_[0];
  845. X}
  846. X
  847. Xprint "1..22\n";
  848. X
  849. Xif (do foo1(0) eq '') {print "ok 1\n";} else {print "not ok 1\n";}
  850. Xif (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
  851. Xif (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
  852. Xif (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
  853. X
  854. Xif (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
  855. Xif (do foo3(1) eq '') {print "ok 6\n";} else {print "not ok 6\n";}
  856. Xif (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
  857. Xif (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
  858. X
  859. Xif (do foo5(0) eq '') {print "ok 9\n";} else {print "not ok 9\n";}
  860. Xif (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
  861. Xif (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
  862. Xif (do foo6(1) eq '') {print "ok 12\n";} else {print "not ok 12\n";}
  863. X
  864. X# Now test to see that recursion works using a Fibonacci number generator
  865. X
  866. Xsub fib {
  867. X    local($arg) = @_;
  868. X    local($foo);
  869. X    $level++;
  870. X    if ($arg <= 2) {
  871. X    $foo = 1;
  872. X    }
  873. X    else {
  874. X    $foo = do fib($arg-1) + do fib($arg-2);
  875. X    }
  876. X    $level--;
  877. X    $foo;
  878. X}
  879. X
  880. X@good = (0,1,1,2,3,5,8,13,21,34,55,89);
  881. X
  882. Xfor ($i = 1; $i <= 10; $i++) {
  883. X    $foo = $i + 12;
  884. X    if (do fib($i) == $good[$i]) {
  885. X    print "ok $foo\n";
  886. X    }
  887. X    else {
  888. X    print "not ok $foo\n";
  889. X    }
  890. X}
  891. !STUFFY!FUNK!
  892. echo Extracting t/op.list
  893. sed >t/op.list <<'!STUFFY!FUNK!' -e 's/X//'
  894. X#!./perl
  895. X
  896. X# $Header: op.list,v 2.0 88/06/05 00:14:09 root Exp $
  897. X
  898. Xprint "1..18\n";
  899. X
  900. X@foo = (1, 2, 3, 4);
  901. Xif ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
  902. X
  903. X$_ = join(foo,':');
  904. Xif ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
  905. X
  906. X($a,$b,$c,$d) = (1,2,3,4);
  907. Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
  908. X
  909. X($c,$b,$a) = split(/ /,"111 222 333");
  910. Xif ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
  911. X
  912. X($a,$b,$c) = ($c,$b,$a);
  913. Xif ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5\n";}
  914. X
  915. X($a, $b) = ($b, $a);
  916. Xif ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
  917. X
  918. X($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
  919. Xif ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";}
  920. Xif ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";}
  921. Xif ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";}
  922. Xif ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
  923. X
  924. X@foo = (1,2,3,4,5,6,7,8);
  925. X($a, $b, $c, $d) = @foo;
  926. Xprint "#11    $a;$b;$c;$d eq 1;2;3;4\n";
  927. Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
  928. X
  929. X@foo = (1);
  930. Xif (join(':',@foo) eq '1') {print "ok 12\n";} else {print "not ok 12\n";}
  931. X
  932. X@foo = ();
  933. X@foo = 1+2+3;
  934. Xif (join(':',@foo) eq '6') {print "ok 13\n";} else {print "not ok 13\n";}
  935. X
  936. Xfor ($x = 0; $x < 3; $x++) {
  937. X    ($a, $b, $c) = 
  938. X        $x == 0?
  939. X            ('ok ', 14, "\n"):
  940. X        $x == 1?
  941. X            ('ok ', 15, "\n"):
  942. X        # default
  943. X            ('ok ', 16, "\n");
  944. X
  945. X    print $a,$b,$c;
  946. X}
  947. X
  948. X@a = ($x == 12345 || (1,2,3));
  949. Xif (join('',@a) eq '123') {print "ok 17\n";} else {print "not ok 17\n";}
  950. X
  951. X@a = ($x == $x || (4,5,6));
  952. Xif (join('',@a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
  953. !STUFFY!FUNK!
  954. echo Extracting t/op.subst
  955. sed >t/op.subst <<'!STUFFY!FUNK!' -e 's/X//'
  956. X#!./perl
  957. X
  958. X# $Header: op.subst,v 2.0 88/06/05 00:14:49 root Exp $
  959. X
  960. Xprint "1..13\n";
  961. X
  962. X$x = 'foo';
  963. X$_ = "x";
  964. Xs/x/\$x/;
  965. Xprint "#1\t:$_: eq :\$x:\n";
  966. Xif ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";}
  967. X
  968. X$_ = "x";
  969. Xs/x/$x/;
  970. Xprint "#2\t:$_: eq :foo:\n";
  971. Xif ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";}
  972. X
  973. X$_ = "x";
  974. Xs/x/\$x $x/;
  975. Xprint "#3\t:$_: eq :\$x foo:\n";
  976. Xif ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
  977. X
  978. X$b = 'cd';
  979. X($a = 'abcdef') =~ s'(b${b}e)'\n$1';
  980. Xprint "#4\t:$1: eq :bcde:\n";
  981. Xprint "#4\t:$a: eq :a\\n\$1f:\n";
  982. Xif ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
  983. X
  984. X$a = 'abacada';
  985. Xif (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
  986. X    {print "ok 5\n";} else {print "not ok 5\n";}
  987. X
  988. Xif (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
  989. X    {print "ok 6\n";} else {print "not ok 6\n";}
  990. X
  991. Xif (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
  992. X    {print "ok 7\n";} else {print "not ok 7 $a\n";}
  993. X
  994. X$_ = 'ABACADA';
  995. Xif (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8\n";}
  996. X
  997. X$_ = '\\' x 4;
  998. Xif (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
  999. Xs/\\/\\\\/g;
  1000. Xif ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10\n";}
  1001. X
  1002. X$_ = '\/' x 4;
  1003. Xif (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
  1004. Xs/\//\/\//g;
  1005. Xif ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
  1006. Xif (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
  1007. !STUFFY!FUNK!
  1008. echo Extracting eg/van/unvanish
  1009. sed >eg/van/unvanish <<'!STUFFY!FUNK!' -e 's/X//'
  1010. X#!/usr/bin/perl
  1011. X
  1012. X# $Header: unvanish,v 2.0 88/06/05 00:17:30 root Exp $
  1013. X
  1014. Xsub it {
  1015. X    if ($olddir ne '.') {
  1016. X    chop($pwd = `pwd`) if $pwd eq '';
  1017. X    (chdir $olddir) || die "Directory $olddir is not accesible";
  1018. X    }
  1019. X    unless ($olddir eq '.deleted') {
  1020. X    if (-d '.deleted') {
  1021. X        chdir '.deleted' || die "Directory .deleted is not accesible";
  1022. X    }
  1023. X    else {
  1024. X        chop($pwd = `pwd`) if $pwd eq '';
  1025. X        die "Directory .deleted does not exist" unless $pwd =~ /\.deleted$/;
  1026. X    }
  1027. X    }
  1028. X    print `mv $startfiles$filelist..$force`;
  1029. X    if ($olddir ne '.') {
  1030. X    (chdir $pwd) || die "Can't get back to original directory: $pwd";
  1031. X    }
  1032. X}
  1033. X
  1034. Xif ($#ARGV < 0) {
  1035. X    open(lastcmd,'.deleted/.lastcmd') || 
  1036. X    open(lastcmd,'.lastcmd') || 
  1037. X        die "No previous vanish in this dir";
  1038. X    $ARGV = <lastcmd>;
  1039. X    close(lastcmd);
  1040. X    @ARGV = split(/[\n ]+/,$ARGV);
  1041. X}
  1042. X
  1043. Xwhile ($ARGV[0] =~ /^-/) {
  1044. X    $_ = shift;
  1045. X    /^-f/ && ($force = ' >/dev/null 2>&1');
  1046. X    /^-i/ && ($interactive = 1);
  1047. X    if (/^-+$/) {
  1048. X    $startfiles = '- ';
  1049. X    last;
  1050. X    }
  1051. X}
  1052. X
  1053. Xwhile ($file = shift) {
  1054. X    if ($file =~ s|^(.*)/||) {
  1055. X    $dir = $1;
  1056. X    }
  1057. X    else {
  1058. X    $dir = '.';
  1059. X    }
  1060. X
  1061. X    if ($dir ne $olddir) {
  1062. X    do it() if $olddir;
  1063. X    $olddir = $dir;
  1064. X    }
  1065. X
  1066. X    if ($interactive) {
  1067. X    print "unvanish: restore $dir/$file? ";
  1068. X    next unless <stdin> =~ /^y/i;
  1069. X    }
  1070. X
  1071. X    $filelist .= $file; $filelist .= ' ';
  1072. X
  1073. X}
  1074. X
  1075. Xdo it() if $olddir;
  1076. !STUFFY!FUNK!
  1077. echo Extracting eg/van/vanish
  1078. sed >eg/van/vanish <<'!STUFFY!FUNK!' -e 's/X//'
  1079. X#!/usr/bin/perl
  1080. X
  1081. X# $Header: vanish,v 2.0 88/06/05 00:17:36 root Exp $
  1082. X
  1083. Xsub it {
  1084. X    if ($olddir ne '.') {
  1085. X    chop($pwd = `pwd`) if $pwd eq '';
  1086. X    (chdir $olddir) || die "Directory $olddir is not accesible";
  1087. X    }
  1088. X    if (!-d .deleted) {
  1089. X    print `mkdir .deleted; chmod 775 .deleted`;
  1090. X    die "You can't remove files from $olddir" if $?;
  1091. X    }
  1092. X    $filelist =~ s/ $//;
  1093. X    $filelist =~ s/#/\\#/g;
  1094. X    if ($filelist !~ /^[ \t]*$/) {
  1095. X    open(lastcmd,'>.deleted/.lastcmd');
  1096. X    print lastcmd $filelist,"\n";
  1097. X    close(lastcmd);
  1098. X    print `/bin/mv $startfiles$filelist .deleted$force`;
  1099. X    }
  1100. X    if ($olddir ne '.') {
  1101. X    (chdir $pwd) || die "Can't get back to original directory: $pwd";
  1102. X    }
  1103. X}
  1104. X
  1105. Xwhile ($ARGV[0] =~ /^-/) {
  1106. X    $_ = shift;
  1107. X    /^-f/ && ($force = ' >/dev/null 2>&1');
  1108. X    /^-i/ && ($interactive = 1);
  1109. X    if (/^-+$/) {
  1110. X    $startfiles = '- ';
  1111. X    last;
  1112. X    }
  1113. X}
  1114. X
  1115. Xchop($pwd = `pwd`);
  1116. X
  1117. Xwhile ($file = shift) {
  1118. X    if ($file =~ s|^(.*)/||) {
  1119. X    $dir = $1;
  1120. X    }
  1121. X    else {
  1122. X    $dir = '.';
  1123. X    }
  1124. X
  1125. X    if ($interactive) {
  1126. X    print "vanish: remove $dir/$file? ";
  1127. X    next unless <stdin> =~ /^y/i;
  1128. X    }
  1129. X
  1130. X    if ($file eq '.deleted') {
  1131. X    print stderr "To delete .deleted (the trashcan) use the 'empty' command.\n";
  1132. X    next;
  1133. X    }
  1134. X
  1135. X    if ($dir ne $olddir) {
  1136. X    do it() if $olddir;
  1137. X    $olddir = $dir;
  1138. X    }
  1139. X
  1140. X    $filelist .= $file; $filelist .= ' ';
  1141. X}
  1142. X
  1143. Xdo it() if $olddir;
  1144. !STUFFY!FUNK!
  1145. echo Extracting eg/scan/scan_df
  1146. sed >eg/scan/scan_df <<'!STUFFY!FUNK!' -e 's/X//'
  1147. X#!/usr/bin/perl -P
  1148. X
  1149. X# $Header: scan_df,v 2.0 88/06/05 00:17:56 root Exp $
  1150. X
  1151. X# This report points out filesystems that are in danger of overflowing.
  1152. X
  1153. X(chdir '/usr/adm/private/memories') || die "Can't cd.";
  1154. X`df >newdf`;
  1155. Xopen(Df, 'olddf');
  1156. X
  1157. Xwhile (<Df>) {
  1158. X    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
  1159. X    next if $fs =~ /:/;
  1160. X    next if $fs eq '';
  1161. X    $oldused{$fs} = $used;
  1162. X}
  1163. X
  1164. Xopen(Df, 'newdf') || die "scan_df: can't open newdf";
  1165. X
  1166. Xwhile (<Df>) {
  1167. X    ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
  1168. X    next if $fs =~ /:/;
  1169. X    next if $fs eq '';
  1170. X    $oldused = $oldused{$fs};
  1171. X    next if ($oldused == $used && $capacity < 99);    # inactive filesystem
  1172. X    if ($capacity >= 90) {
  1173. X#if defined(mc300) || defined(mc500) || defined(mc700)
  1174. X    $_ = substr($_,0,13) . '        ' . substr($_,13,1000);
  1175. X    $kbytes /= 2;        # translate blocks to K
  1176. X    $used /= 2;
  1177. X    $oldused /= 2;
  1178. X    $avail /= 2;
  1179. X#endif
  1180. X    $diff = int($used - $oldused);
  1181. X    if ($avail < $diff * 2) {    # mark specially if in danger
  1182. X        $mounted_on .= ' *';
  1183. X    }
  1184. X    next if $diff < 50 && $mounted_on eq '/';
  1185. X    $fs =~ s|/dev/||;
  1186. X    if ($diff >= 0) {
  1187. X        $diff = '(+' . $diff . ')';
  1188. X    }
  1189. X    else {
  1190. X        $diff = '(' . $diff . ')';
  1191. X    }
  1192. X    printf "%-8s%8d%8d %-8s%8d%7s    %s\n",
  1193. X        $fs,$kbytes,$used,$diff,$avail,$capacity,$mounted_on;
  1194. X    }
  1195. X}
  1196. X
  1197. Xrename('newdf','olddf');
  1198. !STUFFY!FUNK!
  1199. echo Extracting eg/scan/scan_last
  1200. sed >eg/scan/scan_last <<'!STUFFY!FUNK!' -e 's/X//'
  1201. X#!/usr/bin/perl -P
  1202. X
  1203. X# $Header: scan_last,v 2.0 88/06/05 00:17:58 root Exp $
  1204. X
  1205. X# This reports who was logged on at weird hours
  1206. X
  1207. X($dy, $mo, $lastdt) = split(/ +/,`date`);
  1208. X
  1209. Xopen(Last, 'exec last 2>&1 |') || die "scan_last: can't run last";
  1210. X
  1211. Xwhile (<Last>) {
  1212. X#if defined(mc300) || defined(mc500) || defined(mc700)
  1213. X    $_ = substr($_,0,19) . substr($_,23,100);
  1214. X#endif
  1215. X    next if /^$/;
  1216. X    (print),next if m|^/|;
  1217. X    $login  = substr($_,0,8);
  1218. X    $tty    = substr($_,10,7);
  1219. X    $from   = substr($_,19,15);
  1220. X    $day    = substr($_,36,3);
  1221. X    $mo     = substr($_,40,3);
  1222. X    $dt     = substr($_,44,2);
  1223. X    $hr     = substr($_,47,2);
  1224. X    $min    = substr($_,50,2);
  1225. X    $dash   = substr($_,53,1);
  1226. X    $tohr   = substr($_,55,2);
  1227. X    $tomin  = substr($_,58,2);
  1228. X    $durhr  = substr($_,63,2);
  1229. X    $durmin = substr($_,66,2);
  1230. X    
  1231. X    next unless $hr;
  1232. X    next if $login eq 'reboot  ';
  1233. X    next if $login eq 'shutdown';
  1234. X
  1235. X    if ($dt != $lastdt) {
  1236. X    if ($lastdt < $dt) {
  1237. X        $seen += $dt - $lastdt;
  1238. X    }
  1239. X    else {
  1240. X        $seen++;
  1241. X    }
  1242. X    $lastdt = $dt;
  1243. X    }
  1244. X
  1245. X    $inat = $hr + $min / 60;
  1246. X    if ($tohr =~ /^[a-z]/) {
  1247. X    $outat = 12;        # something innocuous
  1248. X    } else {
  1249. X    $outat = $tohr + $tomin / 60;
  1250. X    }
  1251. X
  1252. X  last if $seen + ($inat < 8) > 1;
  1253. X
  1254. X    if ($inat < 5 || $inat > 21 || $outat < 6 || $outat > 23) {
  1255. X    print;
  1256. X    }
  1257. X}
  1258. !STUFFY!FUNK!
  1259. echo Extracting makedir.SH
  1260. sed >makedir.SH <<'!STUFFY!FUNK!' -e 's/X//'
  1261. Xcase $CONFIG in
  1262. X'')
  1263. X    if test ! -f config.sh; then
  1264. X    ln ../config.sh . || \
  1265. X    ln ../../config.sh . || \
  1266. X    ln ../../../config.sh . || \
  1267. X    (echo "Can't find config.sh."; exit 1)
  1268. X    fi
  1269. X    . ./config.sh
  1270. X    ;;
  1271. Xesac
  1272. Xcase "$0" in
  1273. X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  1274. Xesac
  1275. Xecho "Extracting makedir (with variable substitutions)"
  1276. X$spitshell >makedir <<!GROK!THIS!
  1277. X$startsh
  1278. X# $Header: makedir.SH,v 2.0 88/06/05 00:09:13 root Exp $
  1279. X# 
  1280. X# $Log:    makedir.SH,v $
  1281. X# Revision 2.0  88/06/05  00:09:13  root
  1282. X# Baseline version 2.0.
  1283. X# 
  1284. X# 
  1285. X
  1286. Xexport PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
  1287. X
  1288. Xcase \$# in
  1289. X  0)
  1290. X    $echo "makedir pathname filenameflag"
  1291. X    exit 1
  1292. X    ;;
  1293. Xesac
  1294. X
  1295. X: guarantee one slash before 1st component
  1296. Xcase \$1 in
  1297. X  /*) ;;
  1298. X  *)  set ./\$1 \$2 ;;
  1299. Xesac
  1300. X
  1301. X: strip last component if it is to be a filename
  1302. Xcase X\$2 in
  1303. X  X1) set \`$echo \$1 | $sed 's:\(.*\)/[^/]*\$:\1:'\` ;;
  1304. X  *)  set \$1 ;;
  1305. Xesac
  1306. X
  1307. X: return reasonable status if nothing to be created
  1308. Xif $test -d "\$1" ; then
  1309. X    exit 0
  1310. Xfi
  1311. X
  1312. Xlist=''
  1313. Xwhile true ; do
  1314. X    case \$1 in
  1315. X    */*)
  1316. X    list="\$1 \$list"
  1317. X    set \`echo \$1 | $sed 's:\(.*\)/:\1 :'\`
  1318. X    ;;
  1319. X    *)
  1320. X    break
  1321. X    ;;
  1322. X    esac
  1323. Xdone
  1324. X
  1325. Xset \$list
  1326. X
  1327. Xfor dir do
  1328. X    $mkdir \$dir >/dev/null 2>&1
  1329. Xdone
  1330. X!GROK!THIS!
  1331. X$eunicefix makedir
  1332. Xchmod +x makedir
  1333. !STUFFY!FUNK!
  1334. echo Extracting hash.h
  1335. sed >hash.h <<'!STUFFY!FUNK!' -e 's/X//'
  1336. X/* $Header: hash.h,v 2.0 88/06/05 00:09:08 root Exp $
  1337. X *
  1338. X * $Log:    hash.h,v $
  1339. X * Revision 2.0  88/06/05  00:09:08  root
  1340. X * Baseline version 2.0.
  1341. X * 
  1342. X */
  1343. X
  1344. X#define FILLPCT 60        /* don't make greater than 99 */
  1345. X
  1346. X#define COEFFSIZE (16 * 8)    /* size of array below */
  1347. X#ifdef DOINIT
  1348. Xchar coeff[] = {
  1349. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1350. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1351. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1352. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1353. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1354. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1355. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1356. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
  1357. X#else
  1358. Xextern char coeff[];
  1359. X#endif
  1360. X
  1361. Xtypedef struct hentry HENT;
  1362. X
  1363. Xstruct hentry {
  1364. X    HENT    *hent_next;
  1365. X    char    *hent_key;
  1366. X    STR        *hent_val;
  1367. X    int        hent_hash;
  1368. X};
  1369. X
  1370. Xstruct htbl {
  1371. X    HENT    **tbl_array;
  1372. X    int        tbl_max;
  1373. X    int        tbl_fill;
  1374. X    int        tbl_riter;    /* current root of iterator */
  1375. X    HENT    *tbl_eiter;    /* current entry of iterator */
  1376. X};
  1377. X
  1378. XSTR *hfetch();
  1379. Xbool hstore();
  1380. XSTR *hdelete();
  1381. XHASH *hnew();
  1382. Xvoid hclear();
  1383. Xvoid hfree();
  1384. Xvoid hentfree();
  1385. Xint hiterinit();
  1386. XHENT *hiternext();
  1387. Xchar *hiterkey();
  1388. XSTR *hiterval();
  1389. !STUFFY!FUNK!
  1390. echo Extracting eg/findcp
  1391. sed >eg/findcp <<'!STUFFY!FUNK!' -e 's/X//'
  1392. X#!/usr/bin/perl
  1393. X
  1394. X# $Header: findcp,v 2.0 88/06/05 00:16:47 root Exp $
  1395. X
  1396. X# This is a wrapper around the find command that pretends find has a switch
  1397. X# of the form -cp host:destination.  It presumes your find implements -ls.
  1398. X# It uses tar to do the actual copy.  If your tar knows about the I switch
  1399. X# you may prefer to use findtar, since this one has to do the tar in batches.
  1400. X
  1401. Xsub copy {
  1402. X    `tar cf - $list | rsh $desthost cd $destdir '&&' tar xBpf -`;
  1403. X}
  1404. X
  1405. X$sourcedir = $ARGV[0];
  1406. Xif ($sourcedir =~ /^\//) {
  1407. X    $ARGV[0] = '.';
  1408. X    unless (chdir($sourcedir)) { die "Can't find directory: $sourcedir"; }
  1409. X}
  1410. X
  1411. X$args = join(' ',@ARGV);
  1412. Xif ($args =~ s/-cp *([^ ]+)/-ls/) {
  1413. X    $dest = $1;
  1414. X    if ($dest =~ /(.*):(.*)/) {
  1415. X    $desthost = $1;
  1416. X    $destdir = $2;
  1417. X    }
  1418. X    else {
  1419. X    die "Malformed destination--should be host:directory";
  1420. X    }
  1421. X}
  1422. Xelse {
  1423. X    die("No destination specified");
  1424. X}
  1425. X
  1426. Xopen(find,"find $args |") || die "Can't run find for you.";
  1427. X
  1428. Xwhile (<find>) {
  1429. X    @x = split(' ');
  1430. X    if ($x[2] =~ /^d/) { next;}
  1431. X    chop($filename = $x[10]);
  1432. X    if (length($list) > 5000) {
  1433. X    do copy();
  1434. X    $list = '';
  1435. X    }
  1436. X    else {
  1437. X    $list .= ' ';
  1438. X    }
  1439. X    $list .= $filename;
  1440. X}
  1441. X
  1442. Xif ($list) {
  1443. X    do copy();
  1444. X}
  1445. !STUFFY!FUNK!
  1446. echo Extracting spat.h
  1447. sed >spat.h <<'!STUFFY!FUNK!' -e 's/X//'
  1448. X/* $Header: spat.h,v 2.0 88/06/05 00:10:58 root Exp $
  1449. X *
  1450. X * $Log:    spat.h,v $
  1451. X * Revision 2.0  88/06/05  00:10:58  root
  1452. X * Baseline version 2.0.
  1453. X * 
  1454. X */
  1455. X
  1456. Xstruct scanpat {
  1457. X    SPAT    *spat_next;        /* list of all scanpats */
  1458. X    REGEXP    *spat_regexp;        /* compiled expression */
  1459. X    ARG        *spat_repl;        /* replacement string for subst */
  1460. X    ARG        *spat_runtime;        /* compile pattern at runtime */
  1461. X    STR        *spat_short;        /* for a fast bypass of execute() */
  1462. X    bool    spat_flags;
  1463. X    char    spat_slen;
  1464. X};
  1465. X
  1466. X#define SPAT_USED 1            /* spat has been used once already */
  1467. X#define SPAT_ONCE 2            /* use pattern only once per article */
  1468. X#define SPAT_SCANFIRST 4        /* initial constant not anchored */
  1469. X#define SPAT_ALL 8            /* initial constant is whole pat */
  1470. X#define SPAT_SKIPWHITE 16        /* skip leading whitespace for split */
  1471. X#define SPAT_FOLD 32            /* case insensitivity */
  1472. X
  1473. XEXT SPAT *spat_root;        /* list of all spats */
  1474. XEXT SPAT *curspat;        /* what to do \ interps from */
  1475. XEXT SPAT *lastspat;        /* what to use in place of null pattern */
  1476. X
  1477. XEXT char *hint INIT(Nullch);    /* hint from cmd_exec to do_match et al */
  1478. X
  1479. X#define Nullspat Null(SPAT*)
  1480. !STUFFY!FUNK!
  1481. echo Extracting x2p/hash.h
  1482. sed >x2p/hash.h <<'!STUFFY!FUNK!' -e 's/X//'
  1483. X/* $Header: hash.h,v 2.0 88/06/05 00:15:52 root Exp $
  1484. X *
  1485. X * $Log:    hash.h,v $
  1486. X * Revision 2.0  88/06/05  00:15:52  root
  1487. X * Baseline version 2.0.
  1488. X * 
  1489. X */
  1490. X
  1491. X#define FILLPCT 60        /* don't make greater than 99 */
  1492. X
  1493. X#ifdef DOINIT
  1494. Xchar coeff[] = {
  1495. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1496. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1497. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1498. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1499. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1500. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1501. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  1502. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
  1503. X#else
  1504. Xextern char coeff[];
  1505. X#endif
  1506. X
  1507. Xtypedef struct hentry HENT;
  1508. X
  1509. Xstruct hentry {
  1510. X    HENT    *hent_next;
  1511. X    char    *hent_key;
  1512. X    STR        *hent_val;
  1513. X    int        hent_hash;
  1514. X};
  1515. X
  1516. Xstruct htbl {
  1517. X    HENT    **tbl_array;
  1518. X    int        tbl_max;
  1519. X    int        tbl_fill;
  1520. X    int        tbl_riter;    /* current root of iterator */
  1521. X    HENT    *tbl_eiter;    /* current entry of iterator */
  1522. X};
  1523. X
  1524. XSTR *hfetch();
  1525. Xbool hstore();
  1526. Xbool hdelete();
  1527. XHASH *hnew();
  1528. Xint hiterinit();
  1529. XHENT *hiternext();
  1530. Xchar *hiterkey();
  1531. XSTR *hiterval();
  1532. !STUFFY!FUNK!
  1533. echo Extracting t/op.eval
  1534. sed >t/op.eval <<'!STUFFY!FUNK!' -e 's/X//'
  1535. X#!./perl
  1536. X
  1537. X# $Header: op.eval,v 2.0 88/06/05 00:13:40 root Exp $
  1538. X
  1539. Xprint "1..10\n";
  1540. X
  1541. Xeval 'print "ok 1\n";';
  1542. X
  1543. Xif ($@ eq '') {print "ok 2\n";} else {print "not ok 2\n";}
  1544. X
  1545. Xeval "\$foo\n    = # this is a comment\n'ok 3';";
  1546. Xprint $foo,"\n";
  1547. X
  1548. Xeval "\$foo\n    = # this is a comment\n'ok 4\n';";
  1549. Xprint $foo;
  1550. X
  1551. Xprint eval '
  1552. X$foo =';        # this tests for a call through yyerror()
  1553. Xif ($@ =~ /line 2/) {print "ok 5\n";} else {print "not ok 5\n";}
  1554. X
  1555. Xprint eval '$foo = /';    # this tests for a call through fatal()
  1556. Xif ($@ =~ /Search/) {print "ok 6\n";} else {print "not ok 6\n";}
  1557. X
  1558. Xprint eval '"ok 7\n";';
  1559. X
  1560. X# calculate a factorial with recursive evals
  1561. X
  1562. X$foo = 5;
  1563. X$fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}';
  1564. X$ans = eval $fact;
  1565. Xif ($ans == 120) {print "ok 8\n";} else {print "not ok 8\n";}
  1566. X
  1567. X$foo = 5;
  1568. X$fact = 'local($foo); $foo <= 1 ? 1 : $foo-- * (eval $fact);';
  1569. X$ans = eval $fact;
  1570. Xif ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
  1571. X
  1572. Xopen(try,'>Op.eval');
  1573. Xprint try 'print "ok 10\n"; unlink "Op.eval";',"\n";
  1574. Xclose try;
  1575. X
  1576. Xdo 'Op.eval'; print $@;
  1577. !STUFFY!FUNK!
  1578. echo Extracting eg/scan/scan_sudo
  1579. sed >eg/scan/scan_sudo <<'!STUFFY!FUNK!' -e 's/X//'
  1580. X#!/usr/bin/perl -P
  1581. X
  1582. X# $Header: scan_sudo,v 2.0 88/06/05 00:18:01 root Exp $
  1583. X
  1584. X# Analyze the sudo log.
  1585. X
  1586. Xchdir('/usr/adm/private/memories') || die "Can't cd.";
  1587. X
  1588. Xif (open(Oldsudo,'oldsudo')) {
  1589. X    $maxpos = <Oldsudo>;
  1590. X    close Oldsudo;
  1591. X}
  1592. Xelse {
  1593. X    $maxpos = 0;
  1594. X    `echo 0 >oldsudo`;
  1595. X}
  1596. X
  1597. Xunless (open(Sudo, '/usr/adm/sudo.log')) {
  1598. X    print "Somebody removed sudo.log!!!\n" if $maxpos;
  1599. X    exit 0;
  1600. X}
  1601. X
  1602. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  1603. X   $blksize,$blocks) = stat(Sudo);
  1604. X
  1605. Xif ($size < $maxpos) {
  1606. X    $maxpos = 0;
  1607. X    print "Somebody reset sudo.log!!!\n";
  1608. X}
  1609. X
  1610. Xseek(Sudo,$maxpos,0);
  1611. X
  1612. Xwhile (<Sudo>) {
  1613. X    s/^.* :[ \t]+//;
  1614. X    s/ipcrm.*/ipcrm/;
  1615. X    s/kill.*/kill/;
  1616. X    unless ($seen{$_}++) {
  1617. X    push(@seen,$_);
  1618. X    }
  1619. X    $last = $_;
  1620. X}
  1621. X$max = tell(Sudo);
  1622. X
  1623. Xopen(tmp,'|sort >oldsudo.tmp') || die "Can't create tmp file.";
  1624. Xwhile ($_ = pop(@seen)) {
  1625. X    print tmp $_;
  1626. X}
  1627. Xclose(tmp);
  1628. Xopen(tmp,'oldsudo.tmp') || die "Can't reopen tmp file.";
  1629. Xwhile (<tmp>) {
  1630. X    print $seen{$_},":\t",$_;
  1631. X}
  1632. X
  1633. Xprint `(rm -f oldsudo.tmp; echo $max > oldsudo) 2>&1`;
  1634. !STUFFY!FUNK!
  1635. echo Extracting str.h
  1636. sed >str.h <<'!STUFFY!FUNK!' -e 's/X//'
  1637. X/* $Header: str.h,v 2.0 88/06/05 00:11:11 root Exp $
  1638. X *
  1639. X * $Log:    str.h,v $
  1640. X * Revision 2.0  88/06/05  00:11:11  root
  1641. X * Baseline version 2.0.
  1642. X * 
  1643. X */
  1644. X
  1645. Xstruct string {
  1646. X    char *    str_ptr;    /* pointer to malloced string */
  1647. X    double    str_nval;    /* numeric value, if any */
  1648. X    int        str_len;    /* allocated size */
  1649. X    int        str_cur;    /* length of str_ptr as a C string */
  1650. X    union {
  1651. X    STR *str_next;        /* while free, link to next free str */
  1652. X    STAB *str_magic;    /* while in use, ptr to magic stab, if any */
  1653. X    } str_link;
  1654. X    char    str_pok;    /* state of str_ptr */
  1655. X    char    str_nok;    /* state of str_nval */
  1656. X    char    str_rare;    /* used by search strings */
  1657. X    char    str_prev;    /* also used by search strings */
  1658. X};
  1659. X
  1660. X#define Nullstr Null(STR*)
  1661. X
  1662. X/* the following macro updates any magic values this str is associated with */
  1663. X
  1664. X#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x))
  1665. X
  1666. XEXT STR **tmps_list;
  1667. XEXT int tmps_max INIT(-1);
  1668. XEXT int tmps_base INIT(-1);
  1669. X
  1670. Xchar *str_2ptr();
  1671. Xdouble str_2num();
  1672. XSTR *str_static();
  1673. XSTR *str_make();
  1674. XSTR *str_nmake();
  1675. !STUFFY!FUNK!
  1676. echo Extracting regexp.h
  1677. sed >regexp.h <<'!STUFFY!FUNK!' -e 's/X//'
  1678. X/*
  1679. X * Definitions etc. for regexp(3) routines.
  1680. X *
  1681. X * Caveat:  this is V8 regexp(3) [actually, a reimplementation thereof],
  1682. X * not the System V one.
  1683. X */
  1684. X
  1685. X/* $Header: regexp.h,v 2.0 88/06/05 00:10:53 root Exp $
  1686. X *
  1687. X * $Log:    regexp.h,v $
  1688. X * Revision 2.0  88/06/05  00:10:53  root
  1689. X * Baseline version 2.0.
  1690. X * 
  1691. X */
  1692. X
  1693. X#define ALIGN
  1694. X
  1695. X#define NSUBEXP  10
  1696. X
  1697. Xtypedef struct regexp {
  1698. X    char *startp[NSUBEXP];
  1699. X    char *endp[NSUBEXP];
  1700. X    STR *regstart;        /* Internal use only. */
  1701. X    char *regstclass;
  1702. X    STR *regmust;        /* Internal use only. */
  1703. X    int regback;        /* Can regmust locate first try? */
  1704. X    char *precomp;        /* pre-compilation regular expression */
  1705. X    char *subbase;        /* saved string so \digit works forever */
  1706. X    char reganch;        /* Internal use only. */
  1707. X    char do_folding;    /* do case-insensitive match? */
  1708. X    char lastparen;        /* last paren matched */
  1709. X    char nparens;        /* number of parentheses */
  1710. X    char program[1];    /* Unwarranted chumminess with compiler. */
  1711. X} regexp;
  1712. X
  1713. Xextern regexp *regcomp();
  1714. Xextern int regexec();
  1715. Xextern void regsub();
  1716. Xextern void regerror();
  1717. !STUFFY!FUNK!
  1718. echo Extracting t/op.time
  1719. sed >t/op.time <<'!STUFFY!FUNK!' -e 's/X//'
  1720. X#!./perl
  1721. X
  1722. X# $Header: op.time,v 2.0 88/06/05 00:14:58 root Exp $
  1723. X
  1724. Xprint "1..5\n";
  1725. X
  1726. X($beguser,$begsys) = times;
  1727. X
  1728. X$beg = time;
  1729. X
  1730. Xwhile (($now = time) == $beg) {}
  1731. X
  1732. Xif ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";}
  1733. X
  1734. Xfor ($i = 0; $i < 100000; $i++) {
  1735. X    ($nowuser, $nowsys) = times;
  1736. X    $i = 200000 if $nowuser > $beguser && $nowsys > $begsys;
  1737. X    last if time - $beg > 20;
  1738. X}
  1739. X
  1740. Xif ($i >= 200000) {print "ok 2\n";} else {print "not ok 2\n";}
  1741. X
  1742. X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg);
  1743. X($xsec,$foo) = localtime($now);
  1744. X$localyday = $yday;
  1745. X
  1746. Xif ($sec != $xsec && $mday && $year)
  1747. X    {print "ok 3\n";}
  1748. Xelse
  1749. X    {print "not ok 3\n";}
  1750. X
  1751. X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg);
  1752. X($xsec,$foo) = localtime($now);
  1753. X
  1754. Xif ($sec != $xsec && $mday && $year)
  1755. X    {print "ok 4\n";}
  1756. Xelse
  1757. X    {print "not ok 4\n";}
  1758. X
  1759. Xif (index(" :0:1:-1:365:366:-365:-366:",':' . ($localyday - $yday) . ':') > 0)
  1760. X    {print "ok 5\n";}
  1761. Xelse
  1762. X    {print "not ok 5\n";}
  1763. !STUFFY!FUNK!
  1764. echo Extracting t/op.do
  1765. sed >t/op.do <<'!STUFFY!FUNK!' -e 's/X//'
  1766. X#!./perl
  1767. X
  1768. X# $Header: op.do,v 2.0 88/06/05 00:13:36 root Exp $
  1769. X
  1770. Xsub foo1
  1771. X{
  1772. X    print $_[0];
  1773. X    'value';
  1774. X}
  1775. X
  1776. Xsub foo2
  1777. X{
  1778. X    shift(_);
  1779. X    print $_[0];
  1780. X    $x = 'value';
  1781. X    $x;
  1782. X}
  1783. X
  1784. Xprint "1..15\n";
  1785. X
  1786. X$_[0] = "not ok 1\n";
  1787. X$result = do foo1("ok 1\n");
  1788. Xprint "#2\t:$result: eq :value:\n";
  1789. Xif ($result EQ 'value') { print "ok 2\n"; } else { print "not ok 2\n"; }
  1790. Xif ($_[0] EQ "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; }
  1791. X
  1792. X$_[0] = "not ok 4\n";
  1793. X$result = do foo2("not ok 4\n","ok 4\n","not ok 4\n");
  1794. Xprint "#5\t:$result: eq :value:\n";
  1795. Xif ($result EQ 'value') { print "ok 5\n"; } else { print "not ok 5\n"; }
  1796. Xif ($_[0] EQ "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; }
  1797. X
  1798. X$result = do{print "ok 7\n"; 'value';};
  1799. Xprint "#8\t:$result: eq :value:\n";
  1800. Xif ($result EQ 'value') { print "ok 8\n"; } else { print "not ok 8\n"; }
  1801. X
  1802. Xsub blather {
  1803. X    print @_;
  1804. X}
  1805. X
  1806. Xdo blather("ok 9\n","ok 10\n");
  1807. X@x = ("ok 11\n", "ok 12\n");
  1808. X@y = ("ok 14\n", "ok 15\n");
  1809. Xdo blather(@x,"ok 13\n",@y);
  1810. !STUFFY!FUNK!
  1811. echo Extracting t/op.each
  1812. sed >t/op.each <<'!STUFFY!FUNK!' -e 's/X//'
  1813. X#!./perl
  1814. X
  1815. X# $Header: op.each,v 2.0 88/06/05 00:13:38 root Exp $
  1816. X
  1817. Xprint "1..3\n";
  1818. X
  1819. X$h{'abc'} = 'ABC';
  1820. X$h{'def'} = 'DEF';
  1821. X$h{'jkl'} = 'JKL';
  1822. X$h{'xyz'} = 'XYZ';
  1823. X$h{'a'} = 'A';
  1824. X$h{'b'} = 'B';
  1825. X$h{'c'} = 'C';
  1826. X$h{'d'} = 'D';
  1827. X$h{'e'} = 'E';
  1828. X$h{'f'} = 'F';
  1829. X$h{'g'} = 'G';
  1830. X$h{'h'} = 'H';
  1831. X$h{'i'} = 'I';
  1832. X$h{'j'} = 'J';
  1833. X$h{'k'} = 'K';
  1834. X$h{'l'} = 'L';
  1835. X$h{'m'} = 'M';
  1836. X$h{'n'} = 'N';
  1837. X$h{'o'} = 'O';
  1838. X$h{'p'} = 'P';
  1839. X$h{'q'} = 'Q';
  1840. X$h{'r'} = 'R';
  1841. X$h{'s'} = 'S';
  1842. X$h{'t'} = 'T';
  1843. X$h{'u'} = 'U';
  1844. X$h{'v'} = 'V';
  1845. X$h{'w'} = 'W';
  1846. X$h{'x'} = 'X';
  1847. X$h{'y'} = 'Y';
  1848. X$h{'z'} = 'Z';
  1849. X
  1850. X@keys = keys(h);
  1851. X@values = values(h);
  1852. X
  1853. Xif ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
  1854. X
  1855. Xwhile (($key,$value) = each(h)) {
  1856. X    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
  1857. X    $key =~ y/a-z/A-Z/;
  1858. X    $i++ if $key eq $value;
  1859. X    }
  1860. X}
  1861. X
  1862. Xif ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";}
  1863. X
  1864. X@keys = ('blurfl', keys(h), 'dyick');
  1865. Xif ($#keys == 31) {print "ok 3\n";} else {print "not ok 3\n";}
  1866. !STUFFY!FUNK!
  1867. echo Extracting lib/getopt.pl
  1868. sed >lib/getopt.pl <<'!STUFFY!FUNK!' -e 's/X//'
  1869. X;# $Header: getopt.pl,v 2.0 88/06/05 00:16:22 root Exp $
  1870. X
  1871. X;# Process single-character switches with switch clustering.  Pass one argument
  1872. X;# which is a string containing all switches that take an argument.  For each
  1873. X;# switch found, sets $opt_x (where x is the switch name) to the value of the
  1874. X;# argument, or 1 if no argument.  Switches which take an argument don't care
  1875. X;# whether there is a space between the switch and the argument.
  1876. X
  1877. X;# Usage:
  1878. X;#    do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
  1879. X
  1880. Xsub Getopt {
  1881. X    local($argumentative) = @_;
  1882. X    local($_,$first,$rest);
  1883. X
  1884. X    while (($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  1885. X    ($first,$rest) = ($1,$2);
  1886. X    if (index($argumentative,$first) >= $[) {
  1887. X        if ($rest ne '') {
  1888. X        shift;
  1889. X        }
  1890. X        else {
  1891. X        shift;
  1892. X        $rest = shift;
  1893. X        }
  1894. X        eval "\$opt_$first = \$rest;";
  1895. X    }
  1896. X    else {
  1897. X        eval "\$opt_$first = 1;";
  1898. X        if ($rest ne '') {
  1899. X        $ARGV[0] = "-$rest";
  1900. X        }
  1901. X        else {
  1902. X        shift;
  1903. X        }
  1904. X    }
  1905. X    }
  1906. X}
  1907. !STUFFY!FUNK!
  1908. echo Extracting t/comp.script
  1909. sed >t/comp.script <<'!STUFFY!FUNK!' -e 's/X//'
  1910. X#!./perl
  1911. X
  1912. X# $Header: comp.script,v 2.0 88/06/05 00:12:49 root Exp $
  1913. X
  1914. Xprint "1..3\n";
  1915. X
  1916. X$x = `./perl -e 'print "ok\n";'`;
  1917. X
  1918. Xif ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
  1919. X
  1920. Xopen(try,">Comp.script") || (die "Can't open temp file.");
  1921. Xprint try 'print "ok\n";'; print try "\n";
  1922. Xclose try;
  1923. X
  1924. X$x = `./perl Comp.script`;
  1925. X
  1926. Xif ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
  1927. X
  1928. X$x = `./perl <Comp.script`;
  1929. X
  1930. Xif ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
  1931. X
  1932. X`/bin/rm -f Comp.script`;
  1933. !STUFFY!FUNK!
  1934. echo ""
  1935. echo "End of kit 14 (of 15)"
  1936. cat /dev/null >kit14isdone
  1937. run=''
  1938. config=''
  1939. for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15; do
  1940.     if test -f kit${iskit}isdone; then
  1941.     run="$run $iskit"
  1942.     else
  1943.     todo="$todo $iskit"
  1944.     fi
  1945. done
  1946. case $todo in
  1947.     '')
  1948.     echo "You have run all your kits.  Please read README and then type Configure."
  1949.     chmod 755 Configure
  1950.     ;;
  1951.     *)  echo "You have run$run."
  1952.     echo "You still need to run$todo."
  1953.     ;;
  1954. esac
  1955. : Someone might mail this, so...
  1956. exit
  1957.  
  1958.