rsalz@bbn.com (Rich Salz) (07/13/88)
Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Posting-number: Volume 15, Issue 103
Archive-name: perl2/part14
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 15 through sh. When all 15 kits have been run, read README.
echo "This is perl 2.0 kit 14 (of 15). If kit 14 is complete, the line"
echo '"'"End of kit 14 (of 15)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg eg/g eg/scan eg/van lib t x2p 2>/dev/null
echo Extracting t/op.auto
sed >t/op.auto <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.auto,v 2.0 88/06/05 00:13:19 root Exp $
X
Xprint "1..34\n";
X
X$x = 10000;
Xif (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
Xif (0 + $x-- - 1 == 10000) { print "ok 2\n";} else {print "not ok 2\n";}
Xif (1 * $x == 10000) { print "ok 3\n";} else {print "not ok 3\n";}
Xif (0 + $x-- - 0 == 10000) { print "ok 4\n";} else {print "not ok 4\n";}
Xif (1 + $x == 10000) { print "ok 5\n";} else {print "not ok 5\n";}
Xif (1 + $x++ == 10000) { print "ok 6\n";} else {print "not ok 6\n";}
Xif (0 + $x == 10000) { print "ok 7\n";} else {print "not ok 7\n";}
Xif (0 + --$x + 1 == 10000) { print "ok 8\n";} else {print "not ok 8\n";}
Xif (0 + ++$x + 0 == 10000) { print "ok 9\n";} else {print "not ok 9\n";}
Xif ($x == 10000) { print "ok 10\n";} else {print "not ok 10\n";}
X
X$x[0] = 10000;
Xif (0 + ++$x[0] - 1 == 10000) { print "ok 11\n";} else {print "not ok 11\n";}
Xif (0 + $x[0]-- - 1 == 10000) { print "ok 12\n";} else {print "not ok 12\n";}
Xif (1 * $x[0] == 10000) { print "ok 13\n";} else {print "not ok 13\n";}
Xif (0 + $x[0]-- - 0 == 10000) { print "ok 14\n";} else {print "not ok 14\n";}
Xif (1 + $x[0] == 10000) { print "ok 15\n";} else {print "not ok 15\n";}
Xif (1 + $x[0]++ == 10000) { print "ok 16\n";} else {print "not ok 16\n";}
Xif (0 + $x[0] == 10000) { print "ok 17\n";} else {print "not ok 17\n";}
Xif (0 + --$x[0] + 1 == 10000) { print "ok 18\n";} else {print "not ok 18\n";}
Xif (0 + ++$x[0] + 0 == 10000) { print "ok 19\n";} else {print "not ok 19\n";}
Xif ($x[0] == 10000) { print "ok 20\n";} else {print "not ok 20\n";}
X
X$x{0} = 10000;
Xif (0 + ++$x{0} - 1 == 10000) { print "ok 21\n";} else {print "not ok 21\n";}
Xif (0 + $x{0}-- - 1 == 10000) { print "ok 22\n";} else {print "not ok 22\n";}
Xif (1 * $x{0} == 10000) { print "ok 23\n";} else {print "not ok 23\n";}
Xif (0 + $x{0}-- - 0 == 10000) { print "ok 24\n";} else {print "not ok 24\n";}
Xif (1 + $x{0} == 10000) { print "ok 25\n";} else {print "not ok 25\n";}
Xif (1 + $x{0}++ == 10000) { print "ok 26\n";} else {print "not ok 26\n";}
Xif (0 + $x{0} == 10000) { print "ok 27\n";} else {print "not ok 27\n";}
Xif (0 + --$x{0} + 1 == 10000) { print "ok 28\n";} else {print "not ok 28\n";}
Xif (0 + ++$x{0} + 0 == 10000) { print "ok 29\n";} else {print "not ok 29\n";}
Xif ($x{0} == 10000) { print "ok 30\n";} else {print "not ok 30\n";}
X
X# test magical autoincrement
X
Xif (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
Xif (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
Xif (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
Xif (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
!STUFFY!FUNK!
echo Extracting t/op.pat
sed >t/op.pat <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.pat,v 2.0 88/06/05 00:14:20 root Exp $
X
Xprint "1..30\n";
X
X$x = "abc\ndef\n";
X
Xif ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
Xif ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
X
X$* = 1;
Xif ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
X$* = 0;
X
X$_ = '123';
Xif (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
X
Xif ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
Xif ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
X
Xif ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
Xif ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
X
Xif ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
Xif ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
X
Xif ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
Xif ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
X
X$_ = 'aaabbbccc';
Xif (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
X print "ok 13\n";
X} else {
X print "not ok 13\n";
X}
Xif (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
X print "ok 14\n";
X} else {
X print "not ok 14\n";
X}
X
Xif (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
X
X$_ = 'aaabccc';
Xif (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
Xif (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
X
X$_ = 'aaaccc';
Xif (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
Xif (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
X
X$_ = 'abcdef';
Xif (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
Xif (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
X
Xif (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
X
Xif (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
X
X$* = 1; # test 3 only tested the optimized version--this one is for real
Xif ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
X$* = 0;
X
X$XXX{123} = 123;
X$XXX{234} = 234;
X$XXX{345} = 345;
X
X@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
Xwhile ($_ = shift(XXX)) {
X ?(.*)? && (print $1,"\n");
X /not/ && reset;
X /not ok 26/ && reset 'X';
X}
X
Xwhile (($key,$val) = each(XXX)) {
X print "not ok 27\n";
X exit;
X}
X
Xprint "ok 27\n";
X
X'cde' =~ /[^ab]*/;
X'xyz' =~ //;
Xif ($& eq 'xyz') {print "ok 28\n";} else {print "not ok 28\n";}
X
X$foo = '[^ab]*';
X'cde' =~ /$foo/;
X'xyz' =~ //;
Xif ($& eq 'xyz') {print "ok 29\n";} else {print "not ok 29\n";}
X
X$foo = '[^ab]*';
X'cde' =~ /$foo/;
X'xyz' =~ /$null/;
Xif ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
!STUFFY!FUNK!
echo Extracting eg/g/gcp
sed >eg/g/gcp <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: gcp,v 2.0 88/06/05 00:17:02 root Exp $
X
X# Here is a script to do global rcps. See man page.
X
X$#ARGV >= 1 || die "Not enough arguments.\n";
X
Xif ($ARGV[0] eq '-r') {
X $rcp = 'rcp -r';
X shift;
X} else {
X $rcp = 'rcp';
X}
X$args = $rcp;
X$dest = $ARGV[$#ARGV];
X
X$SIG{'QUIT'} = 'CLEANUP';
X$SIG{'INT'} = 'CONT';
X
Xwhile ($arg = shift) {
X if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
X if ($systype && $systype ne $1) {
X die "Can't mix system type specifers ($systype vs $1).\n";
X }
X $#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
X $systype = $1;
X $args .= " $arg";
X } else {
X if ($#ARGV >= 0) {
X if ($arg =~ /^[\/~]/) {
X $arg =~ /^(.*)\// && ($dir = $1);
X } else {
X if (!$pwd) {
X chop($pwd = `pwd`);
X }
X $dir = $pwd;
X }
X }
X if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
X $args .= " $dest$olddir; $rcp";
X }
X $olddir = $dir;
X $args .= " $arg";
X }
X}
X
Xdie "No system type specified.\n" unless $systype;
X
X$args =~ s/:$/:$olddir/;
X
Xchop($thishost = `hostname`);
X
X$one_of_these = ":$systype:";
Xif ($systype =~ s/\+/[+]/g) {
X $one_of_these =~ s/\+/:/g;
X}
X$one_of_these =~ s/-/:-/g;
X
X@ARGV = ();
Xpush(@ARGV,'.grem') if -f '.grem';
Xpush(@ARGV,'.ghosts') if -f '.ghosts';
Xpush(@ARGV,'/etc/ghosts');
X
X$remainder = '';
X
Xline: while (<>) {
X s/[ \t]*\n//;
X if (!$_ || /^#/) {
X next line;
X }
X if (/^([a-zA-Z_0-9]+)=(.+)/) {
X $name = $1; $repl = $2;
X $repl =~ s/\+/:/g;
X $repl =~ s/-/:-/g;
X $one_of_these =~ s/:$name:/:$repl:/;
X $repl =~ s/:/:-/g;
X $one_of_these =~ s/:-$name:/:-$repl:/g;
X next line;
X }
X @gh = split(' ');
X $host = $gh[0];
X next line if $host eq $thishost; # should handle aliases too
X $wanted = 0;
X foreach $class (@gh) {
X $wanted++ if index($one_of_these,":$class:") >= 0;
X $wanted = -9999 if index($one_of_these,":-$class:") >= 0;
X }
X if ($wanted > 0) {
X ($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
X print "$cmd\n";
X $result = `$cmd 2>&1`;
X $remainder .= "$host+" if
X $result =~ /Connection timed out|Permission denied/;
X print $result;
X }
X}
X
Xif ($remainder) {
X chop($remainder);
X open(grem,">.grem") || (printf stderr "Can't create .grem\n");
X print grem 'rem=', $remainder, "\n";
X close(grem);
X print 'rem=', $remainder, "\n";
X}
X
Xsub CLEANUP {
X exit;
X}
X
Xsub CONT {
X print "Continuing...\n"; # Just ignore the signal that kills rcp
X $remainder .= "$host+";
X}
!STUFFY!FUNK!
echo Extracting t/cmd.while
sed >t/cmd.while <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cmd.while,v 2.0 88/06/05 00:12:31 root Exp $
X
Xprint "1..10\n";
X
Xopen (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp.";
Xprint tmp "tvi925\n";
Xprint tmp "tvi920\n";
Xprint tmp "vt100\n";
Xprint tmp "Amiga\n";
Xprint tmp "paper\n";
Xclose tmp;
X
X# test "last" command
X
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile (<fh>) {
X last if /vt100/;
X}
Xif (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1\n";}
X
X# test "next" command
X
X$bad = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile (<fh>) {
X next if /vt100/;
X $bad = 1 if /vt100/;
X}
Xif (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
X
X# test "redo" command
X
X$bad = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile (<fh>) {
X if (s/vt100/VT100/g) {
X s/VT100/Vt100/g;
X redo;
X }
X $bad = 1 if /vt100/;
X $bad = 1 if /VT100/;
X}
Xif (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
X
X# now do the same with a label and a continue block
X
X# test "last" command
X
X$badcont = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xline: while (<fh>) {
X if (/vt100/) {last line;}
X} continue {
X $badcont = 1 if /vt100/;
X}
Xif (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
Xif (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
X
X# test "next" command
X
X$bad = '';
X$badcont = 1;
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xentry: while (<fh>) {
X next entry if /vt100/;
X $bad = 1 if /vt100/;
X} continue {
X $badcont = '' if /vt100/;
X}
Xif (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
Xif (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
X
X# test "redo" command
X
X$bad = '';
X$badcont = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xloop: while (<fh>) {
X if (s/vt100/VT100/g) {
X s/VT100/Vt100/g;
X redo loop;
X }
X $bad = 1 if /vt100/;
X $bad = 1 if /VT100/;
X} continue {
X $badcont = 1 if /vt100/;
X}
Xif (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
Xif (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
X
X`/bin/rm -f Cmd.while.tmp`;
X
X#$x = 0;
X#while (1) {
X# if ($x > 1) {last;}
X# next;
X#} continue {
X# if ($x++ > 10) {last;}
X# next;
X#}
X#
X#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
X
X$i = 9;
X{
X $i++;
X}
Xprint "ok $i\n";
!STUFFY!FUNK!
echo Extracting eg/scan/scanner
sed >eg/scan/scanner <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: scanner,v 2.0 88/06/05 00:17:42 root Exp $
X
X# This runs all the scan_* routines on all the machines in /etc/ghosts.
X# We run this every morning at about 6 am:
X
X# !/bin/sh
X# cd /usr/adm/private
X# decrypt scanner | perl >scan.out 2>&1
X# mail admin <scan.out
X
X# Note that the scan_* files should be encrypted with the key "-inquire", and
X# scanner should be encrypted somehow so that people can't find that key.
X# I leave it up to you to figure out how to unencrypt it before executing.
X
X$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/ucb:.';
X
X$| = 1; # command buffering on stdout
X
Xprint "Subject: bizarre happenings\n\n";
X
X(chdir '/usr/adm/private') || die "Can't cd.";
X
Xif ($#ARGV >= 0) {
X @scanlist = @ARGV;
X} else {
X @scanlist = split(/[ \t\n]+/,`echo scan_*`);
X}
X
Xscan: while ($scan = shift(@scanlist)) {
X print "\n********** $scan **********\n";
X $showhost++;
X
X $systype = 'all';
X
X open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
X
X $one_of_these = ":$systype:";
X if ($systype =~ s/\+/[+]/g) {
X $one_of_these =~ s/\+/:/g;
X }
X
X line: while (<ghosts>) {
X s/[ \t]*\n//;
X if (!$_ || /^#/) {
X next line;
X }
X if (/^([a-zA-Z_0-9]+)=(.+)/) {
X $name = $1; $repl = $2;
X $repl =~ s/\+/:/g;
X $one_of_these =~ s/:$name:/:$repl:/;
X next line;
X }
X @gh = split;
X $host = $gh[0];
X if ($showhost) { $showhost = "$host:\t"; }
X class: while ($class = pop(gh)) {
X if (index($one_of_these,":$class:") >=0) {
X $iter = 0;
X `exec crypt -inquire <$scan >.x 2>/dev/null`;
X unless (open(scan,'.x')) {
X print "Can't run $scan.";
X next scan;
X }
X $cmd = <scan>;
X unless ($cmd =~ s/#!(.*)\n/$1/) {
X $cmd = '/usr/bin/perl';
X }
X close(scan);
X if (open(pipe,"exec rsh $host '$cmd' <.x|")) {
X sleep(5);
X unlink '.x';
X while (<pipe>) {
X last if $iter++ > 1000; # must be looping
X next if /^[0-9.]+u [0-9.]+s/;
X print $showhost,$_;
X }
X close(pipe);
X } else {
X print "(Can't execute rsh.)\n";
X }
X last class;
X }
X }
X }
X}
!STUFFY!FUNK!
echo Extracting eg/g/gsh.man
sed >eg/g/gsh.man <<'!STUFFY!FUNK!' -e 's/X//'
X.\" $Header: gsh.man,v 2.0 88/06/05 00:17:23 root Exp $
X.TH GSH 8 "13 May 1988"
X.SH NAME
Xgsh \- global shell
X.SH SYNOPSIS
X.B gsh
X[options]
X.I host
X[options]
X.I command
X.SH DESCRIPTION
X.I gsh
Xworks just like rsh(1C) except that you may specify a set of hosts to execute
Xthe command on.
XThe host sets are defined in the file /etc/ghosts.
X(An individual host name can be used as a set containing one member.)
XYou can give a command like
X
X gsh sun /etc/mungmotd
X
Xto run /etc/mungmotd on all your Suns.
X.P
XYou may specify the union of two or more sets by using + as follows:
X
X gsh 750+mc /etc/mungmotd
X
Xwhich will run mungmotd on all 750's and Masscomps.
X.P
XCommonly used sets should be defined in /etc/ghosts.
XFor example, you could add a line that says
X
X pep=manny+moe+jack
X
XAnother way to do that would be to add the word "pep" after each of the host
Xentries:
X
X manny sun3 pep
X.br
X moe sun3 pep
X.br
X jack sun3 pep
X
XHosts and sets of host can also be excluded:
X
X foo=sun-sun2
X
XAny host so excluded will never be included, even if a subsequent set on the
Xline includes it:
X
X foo=abc+def
X bar=xyz-abc+foo
X
Xcomes out to xyz+def.
X
XYou can define private host sets by creating .ghosts in your current directory
Xwith entries just like /etc/ghosts.
XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
Xfrom the last gsh or gcp that didn't succeed everywhere.
X
XOptions include all those defined by rsh, as well as
X
X.IP "\-d" 8
XCauses gsh to collect input till end of file, and then distribute that input
Xto each invokation of rsh.
X.IP "\-h" 8
XRather than print out the command followed by the output, merely prepends the
Xhost name to each line of output.
X.IP "\-s" 8
XDo work silently.
X.PP
XInterrupting with a SIGINT will cause the rsh to the current host to be skipped
Xand execution resumed with the next host.
XTo stop completely, send a SIGQUIT.
X.SH SEE ALSO
Xrsh(1C)
X.SH BUGS
XAll the bugs of rsh, since it calls rsh.
X
XAlso, will not properly return data from the remote execution that contains
Xnull characters.
!STUFFY!FUNK!
echo Extracting eg/g/gcp.man
sed >eg/g/gcp.man <<'!STUFFY!FUNK!' -e 's/X//'
X.\" $Header: gcp.man,v 2.0 88/06/05 00:17:05 root Exp $
X.TH GCP 1C "13 May 1988"
X.SH NAME
Xgcp \- global file copy
X.SH SYNOPSIS
X.B gcp
Xfile1 file2
X.br
X.B gcp
X[
X.B \-r
X] file ... directory
X.SH DESCRIPTION
X.I gcp
Xworks just like rcp(1C) except that you may specify a set of hosts to copy files
Xfrom or to.
XThe host sets are defined in the file /etc/ghosts.
X(An individual host name can be used as a set containing one member.)
XYou can give a command like
X
X gcp /etc/motd sun:
X
Xto copy your /etc/motd file to /etc/motd on all the Suns.
XIf, on the other hand, you say
X
X gcp /a/foo /b/bar sun:/tmp
X
Xthen your files will be copied to /tmp on all the Suns.
XThe general rule is that if you don't specify the destination directory,
Xfiles go to the same directory they are in currently.
X.P
XYou may specify the union of two or more sets by using + as follows:
X
X gcp /a/foo /b/bar 750+mc:
X
Xwhich will copy /a/foo to /a/foo on all 750's and Masscomps, and then copy
X/b/bar to /b/bar on all 750's and Masscomps.
X.P
XCommonly used sets should be defined in /etc/ghosts.
XFor example, you could add a line that says
X
X pep=manny+moe+jack
X
XAnother way to do that would be to add the word "pep" after each of the host
Xentries:
X
X manny sun3 pep
X.br
X moe sun3 pep
X.br
X jack sun3 pep
X
XHosts and sets of host can also be excluded:
X
X foo=sun-sun2
X
XAny host so excluded will never be included, even if a subsequent set on the
Xline includes it:
X
X foo=abc+def
X.br
X bar=xyz-abc+foo
X
Xcomes out to xyz+def.
X
XYou can define private host sets by creating .ghosts in your current directory
Xwith entries just like /etc/ghosts.
XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
Xfrom the last gsh or gcp that didn't succeed everywhere.
X.PP
XInterrupting with a SIGINT will cause the rcp to the current host to be skipped
Xand execution resumed with the next host.
XTo stop completely, send a SIGQUIT.
X.SH SEE ALSO
Xrcp(1C)
X.SH BUGS
XAll the bugs of rcp, since it calls rcp.
!STUFFY!FUNK!
echo Extracting t/op.study
sed >t/op.study <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.study,v 2.0 88/06/05 00:14:45 root Exp $
X
Xprint "1..24\n";
X
X$x = "abc\ndef\n";
Xstudy($x);
X
Xif ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
Xif ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
X
X$* = 1;
Xif ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
X$* = 0;
X
X$_ = '123';
Xstudy;
Xif (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
X
Xif ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
Xif ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
X
Xif ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
Xif ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
X
Xstudy($x);
Xif ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
Xif ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
X
Xif ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
Xif ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
X
X$_ = 'aaabbbccc';
Xstudy;
Xif (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
X print "ok 13\n";
X} else {
X print "not ok 13\n";
X}
Xif (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
X print "ok 14\n";
X} else {
X print "not ok 14\n";
X}
X
Xif (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
X
X$_ = 'aaabccc';
Xstudy;
Xif (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
Xif (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
X
X$_ = 'aaaccc';
Xstudy;
Xif (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
Xif (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
X
X$_ = 'abcdef';
Xstudy;
Xif (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
Xif (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
X
Xif (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
X
Xif (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
X
X$* = 1; # test 3 only tested the optimized version--this one is for real
Xif ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
!STUFFY!FUNK!
echo Extracting t/TEST
sed >t/TEST <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: TEST,v 2.0 88/06/05 00:11:47 root Exp $
X
X# This is written in a peculiar style, since we're trying to avoid
X# most of the constructs we'll be testing for.
X
Xif ($ARGV[0] eq '-v') {
X $verbose = 1;
X shift;
X}
X
Xchdir 't' if -f 't/TEST';
X
Xif ($ARGV[0] eq '') {
X @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
X}
X
Xopen(config,"../config.sh");
Xwhile (<config>) {
X if (/sharpbang='(.*)'/) {
X $sharpbang = ($1 eq '#!');
X last;
X }
X}
X$bad = 0;
Xwhile ($test = shift) {
X if ($test =~ /\.orig$/) {
X next;
X }
X print "$test...";
X if ($sharpbang) {
X open(results,"./$test|") || (print "can't run.\n");
X } else {
X open(script,"$test") || die "Can't run $test.\n";
X $_ = <script>;
X close(script);
X if (/#!..perl(.*)/) {
X $switch = $1;
X } else {
X $switch = '';
X }
X open(results,"./perl$switch $test|") || (print "can't run.\n");
X }
X $ok = 0;
X $next = 0;
X while (<results>) {
X if ($verbose) {
X print $_;
X }
X unless (/^#/) {
X if (/^1\.\.([0-9]+)/) {
X $max = $1;
X $next = 1;
X $ok = 1;
X } else {
X if (/^ok (.*)/ && $1 == $next) {
X $next = $next + 1;
X } else {
X $ok = 0;
X }
X }
X }
X }
X $next = $next - 1;
X if ($ok && $next == $max) {
X print "ok\n";
X } else {
X $next += 1;
X print "FAILED on test $next\n";
X $bad = $bad + 1;
X $_ = $test;
X if (/^base/) {
X die "Failed a basic test--cannot continue.\n";
X }
X }
X}
X
Xif ($bad == 0) {
X if ($ok) {
X print "All tests successful.\n";
X } else {
X die "FAILED--no tests were run for some reason.\n";
X }
X} else {
X if ($bad == 1) {
X die "Failed 1 test.\n";
X } else {
X die "Failed $bad tests.\n";
X }
X}
X($user,$sys,$cuser,$csys) = times;
Xprint sprintf("u=%g s=%g cu=%g cs=%g\n",$user,$sys,$cuser,$csys);
!STUFFY!FUNK!
echo Extracting t/cmd.subval
sed >t/cmd.subval <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cmd.subval,v 2.0 88/06/05 00:12:26 root Exp $
X
Xsub foo1 {
X 'true1';
X if ($_[0]) { 'true2'; }
X}
X
Xsub foo2 {
X 'true1';
X if ($_[0]) { 'true2'; } else { 'true3'; }
X}
X
Xsub foo3 {
X 'true1';
X unless ($_[0]) { 'true2'; }
X}
X
Xsub foo4 {
X 'true1';
X unless ($_[0]) { 'true2'; } else { 'true3'; }
X}
X
Xsub foo5 {
X 'true1';
X 'true2' if $_[0];
X}
X
Xsub foo6 {
X 'true1';
X 'true2' unless $_[0];
X}
X
Xprint "1..22\n";
X
Xif (do foo1(0) eq '') {print "ok 1\n";} else {print "not ok 1\n";}
Xif (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
Xif (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
Xif (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
X
Xif (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
Xif (do foo3(1) eq '') {print "ok 6\n";} else {print "not ok 6\n";}
Xif (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
Xif (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
X
Xif (do foo5(0) eq '') {print "ok 9\n";} else {print "not ok 9\n";}
Xif (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
Xif (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
Xif (do foo6(1) eq '') {print "ok 12\n";} else {print "not ok 12\n";}
X
X# Now test to see that recursion works using a Fibonacci number generator
X
Xsub fib {
X local($arg) = @_;
X local($foo);
X $level++;
X if ($arg <= 2) {
X $foo = 1;
X }
X else {
X $foo = do fib($arg-1) + do fib($arg-2);
X }
X $level--;
X $foo;
X}
X
X@good = (0,1,1,2,3,5,8,13,21,34,55,89);
X
Xfor ($i = 1; $i <= 10; $i++) {
X $foo = $i + 12;
X if (do fib($i) == $good[$i]) {
X print "ok $foo\n";
X }
X else {
X print "not ok $foo\n";
X }
X}
!STUFFY!FUNK!
echo Extracting t/op.list
sed >t/op.list <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.list,v 2.0 88/06/05 00:14:09 root Exp $
X
Xprint "1..18\n";
X
X@foo = (1, 2, 3, 4);
Xif ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
X
X$_ = join(foo,':');
Xif ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
X
X($a,$b,$c,$d) = (1,2,3,4);
Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
X
X($c,$b,$a) = split(/ /,"111 222 333");
Xif ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
X
X($a,$b,$c) = ($c,$b,$a);
Xif ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5\n";}
X
X($a, $b) = ($b, $a);
Xif ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
X
X($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
Xif ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";}
Xif ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";}
Xif ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";}
Xif ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
X
X@foo = (1,2,3,4,5,6,7,8);
X($a, $b, $c, $d) = @foo;
Xprint "#11 $a;$b;$c;$d eq 1;2;3;4\n";
Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
X
X@foo = (1);
Xif (join(':',@foo) eq '1') {print "ok 12\n";} else {print "not ok 12\n";}
X
X@foo = ();
X@foo = 1+2+3;
Xif (join(':',@foo) eq '6') {print "ok 13\n";} else {print "not ok 13\n";}
X
Xfor ($x = 0; $x < 3; $x++) {
X ($a, $b, $c) =
X $x == 0?
X ('ok ', 14, "\n"):
X $x == 1?
X ('ok ', 15, "\n"):
X # default
X ('ok ', 16, "\n");
X
X print $a,$b,$c;
X}
X
X@a = ($x == 12345 || (1,2,3));
Xif (join('',@a) eq '123') {print "ok 17\n";} else {print "not ok 17\n";}
X
X@a = ($x == $x || (4,5,6));
Xif (join('',@a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
!STUFFY!FUNK!
echo Extracting t/op.subst
sed >t/op.subst <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.subst,v 2.0 88/06/05 00:14:49 root Exp $
X
Xprint "1..13\n";
X
X$x = 'foo';
X$_ = "x";
Xs/x/\$x/;
Xprint "#1\t:$_: eq :\$x:\n";
Xif ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";}
X
X$_ = "x";
Xs/x/$x/;
Xprint "#2\t:$_: eq :foo:\n";
Xif ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";}
X
X$_ = "x";
Xs/x/\$x $x/;
Xprint "#3\t:$_: eq :\$x foo:\n";
Xif ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
X
X$b = 'cd';
X($a = 'abcdef') =~ s'(b${b}e)'\n$1';
Xprint "#4\t:$1: eq :bcde:\n";
Xprint "#4\t:$a: eq :a\\n\$1f:\n";
Xif ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
X
X$a = 'abacada';
Xif (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
X {print "ok 5\n";} else {print "not ok 5\n";}
X
Xif (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
X {print "ok 6\n";} else {print "not ok 6\n";}
X
Xif (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
X {print "ok 7\n";} else {print "not ok 7 $a\n";}
X
X$_ = 'ABACADA';
Xif (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8\n";}
X
X$_ = '\\' x 4;
Xif (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
Xs/\\/\\\\/g;
Xif ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10\n";}
X
X$_ = '\/' x 4;
Xif (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
Xs/\//\/\//g;
Xif ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
Xif (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
!STUFFY!FUNK!
echo Extracting eg/van/unvanish
sed >eg/van/unvanish <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: unvanish,v 2.0 88/06/05 00:17:30 root Exp $
X
Xsub it {
X if ($olddir ne '.') {
X chop($pwd = `pwd`) if $pwd eq '';
X (chdir $olddir) || die "Directory $olddir is not accesible";
X }
X unless ($olddir eq '.deleted') {
X if (-d '.deleted') {
X chdir '.deleted' || die "Directory .deleted is not accesible";
X }
X else {
X chop($pwd = `pwd`) if $pwd eq '';
X die "Directory .deleted does not exist" unless $pwd =~ /\.deleted$/;
X }
X }
X print `mv $startfiles$filelist..$force`;
X if ($olddir ne '.') {
X (chdir $pwd) || die "Can't get back to original directory: $pwd";
X }
X}
X
Xif ($#ARGV < 0) {
X open(lastcmd,'.deleted/.lastcmd') ||
X open(lastcmd,'.lastcmd') ||
X die "No previous vanish in this dir";
X $ARGV = <lastcmd>;
X close(lastcmd);
X @ARGV = split(/[\n ]+/,$ARGV);
X}
X
Xwhile ($ARGV[0] =~ /^-/) {
X $_ = shift;
X /^-f/ && ($force = ' >/dev/null 2>&1');
X /^-i/ && ($interactive = 1);
X if (/^-+$/) {
X $startfiles = '- ';
X last;
X }
X}
X
Xwhile ($file = shift) {
X if ($file =~ s|^(.*)/||) {
X $dir = $1;
X }
X else {
X $dir = '.';
X }
X
X if ($dir ne $olddir) {
X do it() if $olddir;
X $olddir = $dir;
X }
X
X if ($interactive) {
X print "unvanish: restore $dir/$file? ";
X next unless <stdin> =~ /^y/i;
X }
X
X $filelist .= $file; $filelist .= ' ';
X
X}
X
Xdo it() if $olddir;
!STUFFY!FUNK!
echo Extracting eg/van/vanish
sed >eg/van/vanish <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: vanish,v 2.0 88/06/05 00:17:36 root Exp $
X
Xsub it {
X if ($olddir ne '.') {
X chop($pwd = `pwd`) if $pwd eq '';
X (chdir $olddir) || die "Directory $olddir is not accesible";
X }
X if (!-d .deleted) {
X print `mkdir .deleted; chmod 775 .deleted`;
X die "You can't remove files from $olddir" if $?;
X }
X $filelist =~ s/ $//;
X $filelist =~ s/#/\\#/g;
X if ($filelist !~ /^[ \t]*$/) {
X open(lastcmd,'>.deleted/.lastcmd');
X print lastcmd $filelist,"\n";
X close(lastcmd);
X print `/bin/mv $startfiles$filelist .deleted$force`;
X }
X if ($olddir ne '.') {
X (chdir $pwd) || die "Can't get back to original directory: $pwd";
X }
X}
X
Xwhile ($ARGV[0] =~ /^-/) {
X $_ = shift;
X /^-f/ && ($force = ' >/dev/null 2>&1');
X /^-i/ && ($interactive = 1);
X if (/^-+$/) {
X $startfiles = '- ';
X last;
X }
X}
X
Xchop($pwd = `pwd`);
X
Xwhile ($file = shift) {
X if ($file =~ s|^(.*)/||) {
X $dir = $1;
X }
X else {
X $dir = '.';
X }
X
X if ($interactive) {
X print "vanish: remove $dir/$file? ";
X next unless <stdin> =~ /^y/i;
X }
X
X if ($file eq '.deleted') {
X print stderr "To delete .deleted (the trashcan) use the 'empty' command.\n";
X next;
X }
X
X if ($dir ne $olddir) {
X do it() if $olddir;
X $olddir = $dir;
X }
X
X $filelist .= $file; $filelist .= ' ';
X}
X
Xdo it() if $olddir;
!STUFFY!FUNK!
echo Extracting eg/scan/scan_df
sed >eg/scan/scan_df <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: scan_df,v 2.0 88/06/05 00:17:56 root Exp $
X
X# This report points out filesystems that are in danger of overflowing.
X
X(chdir '/usr/adm/private/memories') || die "Can't cd.";
X`df >newdf`;
Xopen(Df, 'olddf');
X
Xwhile (<Df>) {
X ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
X next if $fs =~ /:/;
X next if $fs eq '';
X $oldused{$fs} = $used;
X}
X
Xopen(Df, 'newdf') || die "scan_df: can't open newdf";
X
Xwhile (<Df>) {
X ($fs,$kbytes,$used,$avail,$capacity,$mounted_on) = split;
X next if $fs =~ /:/;
X next if $fs eq '';
X $oldused = $oldused{$fs};
X next if ($oldused == $used && $capacity < 99); # inactive filesystem
X if ($capacity >= 90) {
X#if defined(mc300) || defined(mc500) || defined(mc700)
X $_ = substr($_,0,13) . ' ' . substr($_,13,1000);
X $kbytes /= 2; # translate blocks to K
X $used /= 2;
X $oldused /= 2;
X $avail /= 2;
X#endif
X $diff = int($used - $oldused);
X if ($avail < $diff * 2) { # mark specially if in danger
X $mounted_on .= ' *';
X }
X next if $diff < 50 && $mounted_on eq '/';
X $fs =~ s|/dev/||;
X if ($diff >= 0) {
X $diff = '(+' . $diff . ')';
X }
X else {
X $diff = '(' . $diff . ')';
X }
X printf "%-8s%8d%8d %-8s%8d%7s %s\n",
X $fs,$kbytes,$used,$diff,$avail,$capacity,$mounted_on;
X }
X}
X
Xrename('newdf','olddf');
!STUFFY!FUNK!
echo Extracting eg/scan/scan_last
sed >eg/scan/scan_last <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: scan_last,v 2.0 88/06/05 00:17:58 root Exp $
X
X# This reports who was logged on at weird hours
X
X($dy, $mo, $lastdt) = split(/ +/,`date`);
X
Xopen(Last, 'exec last 2>&1 |') || die "scan_last: can't run last";
X
Xwhile (<Last>) {
X#if defined(mc300) || defined(mc500) || defined(mc700)
X $_ = substr($_,0,19) . substr($_,23,100);
X#endif
X next if /^$/;
X (print),next if m|^/|;
X $login = substr($_,0,8);
X $tty = substr($_,10,7);
X $from = substr($_,19,15);
X $day = substr($_,36,3);
X $mo = substr($_,40,3);
X $dt = substr($_,44,2);
X $hr = substr($_,47,2);
X $min = substr($_,50,2);
X $dash = substr($_,53,1);
X $tohr = substr($_,55,2);
X $tomin = substr($_,58,2);
X $durhr = substr($_,63,2);
X $durmin = substr($_,66,2);
X
X next unless $hr;
X next if $login eq 'reboot ';
X next if $login eq 'shutdown';
X
X if ($dt != $lastdt) {
X if ($lastdt < $dt) {
X $seen += $dt - $lastdt;
X }
X else {
X $seen++;
X }
X $lastdt = $dt;
X }
X
X $inat = $hr + $min / 60;
X if ($tohr =~ /^[a-z]/) {
X $outat = 12; # something innocuous
X } else {
X $outat = $tohr + $tomin / 60;
X }
X
X last if $seen + ($inat < 8) > 1;
X
X if ($inat < 5 || $inat > 21 || $outat < 6 || $outat > 23) {
X print;
X }
X}
!STUFFY!FUNK!
echo Extracting makedir.SH
sed >makedir.SH <<'!STUFFY!FUNK!' -e 's/X//'
Xcase $CONFIG in
X'')
X if test ! -f config.sh; then
X ln ../config.sh . || \
X ln ../../config.sh . || \
X ln ../../../config.sh . || \
X (echo "Can't find config.sh."; exit 1)
X fi
X . ./config.sh
X ;;
Xesac
Xcase "$0" in
X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
Xesac
Xecho "Extracting makedir (with variable substitutions)"
X$spitshell >makedir <<!GROK!THIS!
X$startsh
X# $Header: makedir.SH,v 2.0 88/06/05 00:09:13 root Exp $
X#
X# $Log: makedir.SH,v $
X# Revision 2.0 88/06/05 00:09:13 root
X# Baseline version 2.0.
X#
X#
X
Xexport PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$)
X
Xcase \$# in
X 0)
X $echo "makedir pathname filenameflag"
X exit 1
X ;;
Xesac
X
X: guarantee one slash before 1st component
Xcase \$1 in
X /*) ;;
X *) set ./\$1 \$2 ;;
Xesac
X
X: strip last component if it is to be a filename
Xcase X\$2 in
X X1) set \`$echo \$1 | $sed 's:\(.*\)/[^/]*\$:\1:'\` ;;
X *) set \$1 ;;
Xesac
X
X: return reasonable status if nothing to be created
Xif $test -d "\$1" ; then
X exit 0
Xfi
X
Xlist=''
Xwhile true ; do
X case \$1 in
X */*)
X list="\$1 \$list"
X set \`echo \$1 | $sed 's:\(.*\)/:\1 :'\`
X ;;
X *)
X break
X ;;
X esac
Xdone
X
Xset \$list
X
Xfor dir do
X $mkdir \$dir >/dev/null 2>&1
Xdone
X!GROK!THIS!
X$eunicefix makedir
Xchmod +x makedir
!STUFFY!FUNK!
echo Extracting hash.h
sed >hash.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: hash.h,v 2.0 88/06/05 00:09:08 root Exp $
X *
X * $Log: hash.h,v $
X * Revision 2.0 88/06/05 00:09:08 root
X * Baseline version 2.0.
X *
X */
X
X#define FILLPCT 60 /* don't make greater than 99 */
X
X#define COEFFSIZE (16 * 8) /* size of array below */
X#ifdef DOINIT
Xchar coeff[] = {
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
X#else
Xextern char coeff[];
X#endif
X
Xtypedef struct hentry HENT;
X
Xstruct hentry {
X HENT *hent_next;
X char *hent_key;
X STR *hent_val;
X int hent_hash;
X};
X
Xstruct htbl {
X HENT **tbl_array;
X int tbl_max;
X int tbl_fill;
X int tbl_riter; /* current root of iterator */
X HENT *tbl_eiter; /* current entry of iterator */
X};
X
XSTR *hfetch();
Xbool hstore();
XSTR *hdelete();
XHASH *hnew();
Xvoid hclear();
Xvoid hfree();
Xvoid hentfree();
Xint hiterinit();
XHENT *hiternext();
Xchar *hiterkey();
XSTR *hiterval();
!STUFFY!FUNK!
echo Extracting eg/findcp
sed >eg/findcp <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: findcp,v 2.0 88/06/05 00:16:47 root Exp $
X
X# This is a wrapper around the find command that pretends find has a switch
X# of the form -cp host:destination. It presumes your find implements -ls.
X# It uses tar to do the actual copy. If your tar knows about the I switch
X# you may prefer to use findtar, since this one has to do the tar in batches.
X
Xsub copy {
X `tar cf - $list | rsh $desthost cd $destdir '&&' tar xBpf -`;
X}
X
X$sourcedir = $ARGV[0];
Xif ($sourcedir =~ /^\//) {
X $ARGV[0] = '.';
X unless (chdir($sourcedir)) { die "Can't find directory: $sourcedir"; }
X}
X
X$args = join(' ',@ARGV);
Xif ($args =~ s/-cp *([^ ]+)/-ls/) {
X $dest = $1;
X if ($dest =~ /(.*):(.*)/) {
X $desthost = $1;
X $destdir = $2;
X }
X else {
X die "Malformed destination--should be host:directory";
X }
X}
Xelse {
X die("No destination specified");
X}
X
Xopen(find,"find $args |") || die "Can't run find for you.";
X
Xwhile (<find>) {
X @x = split(' ');
X if ($x[2] =~ /^d/) { next;}
X chop($filename = $x[10]);
X if (length($list) > 5000) {
X do copy();
X $list = '';
X }
X else {
X $list .= ' ';
X }
X $list .= $filename;
X}
X
Xif ($list) {
X do copy();
X}
!STUFFY!FUNK!
echo Extracting spat.h
sed >spat.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: spat.h,v 2.0 88/06/05 00:10:58 root Exp $
X *
X * $Log: spat.h,v $
X * Revision 2.0 88/06/05 00:10:58 root
X * Baseline version 2.0.
X *
X */
X
Xstruct scanpat {
X SPAT *spat_next; /* list of all scanpats */
X REGEXP *spat_regexp; /* compiled expression */
X ARG *spat_repl; /* replacement string for subst */
X ARG *spat_runtime; /* compile pattern at runtime */
X STR *spat_short; /* for a fast bypass of execute() */
X bool spat_flags;
X char spat_slen;
X};
X
X#define SPAT_USED 1 /* spat has been used once already */
X#define SPAT_ONCE 2 /* use pattern only once per article */
X#define SPAT_SCANFIRST 4 /* initial constant not anchored */
X#define SPAT_ALL 8 /* initial constant is whole pat */
X#define SPAT_SKIPWHITE 16 /* skip leading whitespace for split */
X#define SPAT_FOLD 32 /* case insensitivity */
X
XEXT SPAT *spat_root; /* list of all spats */
XEXT SPAT *curspat; /* what to do \ interps from */
XEXT SPAT *lastspat; /* what to use in place of null pattern */
X
XEXT char *hint INIT(Nullch); /* hint from cmd_exec to do_match et al */
X
X#define Nullspat Null(SPAT*)
!STUFFY!FUNK!
echo Extracting x2p/hash.h
sed >x2p/hash.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: hash.h,v 2.0 88/06/05 00:15:52 root Exp $
X *
X * $Log: hash.h,v $
X * Revision 2.0 88/06/05 00:15:52 root
X * Baseline version 2.0.
X *
X */
X
X#define FILLPCT 60 /* don't make greater than 99 */
X
X#ifdef DOINIT
Xchar coeff[] = {
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
X#else
Xextern char coeff[];
X#endif
X
Xtypedef struct hentry HENT;
X
Xstruct hentry {
X HENT *hent_next;
X char *hent_key;
X STR *hent_val;
X int hent_hash;
X};
X
Xstruct htbl {
X HENT **tbl_array;
X int tbl_max;
X int tbl_fill;
X int tbl_riter; /* current root of iterator */
X HENT *tbl_eiter; /* current entry of iterator */
X};
X
XSTR *hfetch();
Xbool hstore();
Xbool hdelete();
XHASH *hnew();
Xint hiterinit();
XHENT *hiternext();
Xchar *hiterkey();
XSTR *hiterval();
!STUFFY!FUNK!
echo Extracting t/op.eval
sed >t/op.eval <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.eval,v 2.0 88/06/05 00:13:40 root Exp $
X
Xprint "1..10\n";
X
Xeval 'print "ok 1\n";';
X
Xif ($@ eq '') {print "ok 2\n";} else {print "not ok 2\n";}
X
Xeval "\$foo\n = # this is a comment\n'ok 3';";
Xprint $foo,"\n";
X
Xeval "\$foo\n = # this is a comment\n'ok 4\n';";
Xprint $foo;
X
Xprint eval '
X$foo ='; # this tests for a call through yyerror()
Xif ($@ =~ /line 2/) {print "ok 5\n";} else {print "not ok 5\n";}
X
Xprint eval '$foo = /'; # this tests for a call through fatal()
Xif ($@ =~ /Search/) {print "ok 6\n";} else {print "not ok 6\n";}
X
Xprint eval '"ok 7\n";';
X
X# calculate a factorial with recursive evals
X
X$foo = 5;
X$fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}';
X$ans = eval $fact;
Xif ($ans == 120) {print "ok 8\n";} else {print "not ok 8\n";}
X
X$foo = 5;
X$fact = 'local($foo); $foo <= 1 ? 1 : $foo-- * (eval $fact);';
X$ans = eval $fact;
Xif ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
X
Xopen(try,'>Op.eval');
Xprint try 'print "ok 10\n"; unlink "Op.eval";',"\n";
Xclose try;
X
Xdo 'Op.eval'; print $@;
!STUFFY!FUNK!
echo Extracting eg/scan/scan_sudo
sed >eg/scan/scan_sudo <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: scan_sudo,v 2.0 88/06/05 00:18:01 root Exp $
X
X# Analyze the sudo log.
X
Xchdir('/usr/adm/private/memories') || die "Can't cd.";
X
Xif (open(Oldsudo,'oldsudo')) {
X $maxpos = <Oldsudo>;
X close Oldsudo;
X}
Xelse {
X $maxpos = 0;
X `echo 0 >oldsudo`;
X}
X
Xunless (open(Sudo, '/usr/adm/sudo.log')) {
X print "Somebody removed sudo.log!!!\n" if $maxpos;
X exit 0;
X}
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat(Sudo);
X
Xif ($size < $maxpos) {
X $maxpos = 0;
X print "Somebody reset sudo.log!!!\n";
X}
X
Xseek(Sudo,$maxpos,0);
X
Xwhile (<Sudo>) {
X s/^.* :[ \t]+//;
X s/ipcrm.*/ipcrm/;
X s/kill.*/kill/;
X unless ($seen{$_}++) {
X push(@seen,$_);
X }
X $last = $_;
X}
X$max = tell(Sudo);
X
Xopen(tmp,'|sort >oldsudo.tmp') || die "Can't create tmp file.";
Xwhile ($_ = pop(@seen)) {
X print tmp $_;
X}
Xclose(tmp);
Xopen(tmp,'oldsudo.tmp') || die "Can't reopen tmp file.";
Xwhile (<tmp>) {
X print $seen{$_},":\t",$_;
X}
X
Xprint `(rm -f oldsudo.tmp; echo $max > oldsudo) 2>&1`;
!STUFFY!FUNK!
echo Extracting str.h
sed >str.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.h,v 2.0 88/06/05 00:11:11 root Exp $
X *
X * $Log: str.h,v $
X * Revision 2.0 88/06/05 00:11:11 root
X * Baseline version 2.0.
X *
X */
X
Xstruct string {
X char * str_ptr; /* pointer to malloced string */
X double str_nval; /* numeric value, if any */
X int str_len; /* allocated size */
X int str_cur; /* length of str_ptr as a C string */
X union {
X STR *str_next; /* while free, link to next free str */
X STAB *str_magic; /* while in use, ptr to magic stab, if any */
X } str_link;
X char str_pok; /* state of str_ptr */
X char str_nok; /* state of str_nval */
X char str_rare; /* used by search strings */
X char str_prev; /* also used by search strings */
X};
X
X#define Nullstr Null(STR*)
X
X/* the following macro updates any magic values this str is associated with */
X
X#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x))
X
XEXT STR **tmps_list;
XEXT int tmps_max INIT(-1);
XEXT int tmps_base INIT(-1);
X
Xchar *str_2ptr();
Xdouble str_2num();
XSTR *str_static();
XSTR *str_make();
XSTR *str_nmake();
!STUFFY!FUNK!
echo Extracting regexp.h
sed >regexp.h <<'!STUFFY!FUNK!' -e 's/X//'
X/*
X * Definitions etc. for regexp(3) routines.
X *
X * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
X * not the System V one.
X */
X
X/* $Header: regexp.h,v 2.0 88/06/05 00:10:53 root Exp $
X *
X * $Log: regexp.h,v $
X * Revision 2.0 88/06/05 00:10:53 root
X * Baseline version 2.0.
X *
X */
X
X#define ALIGN
X
X#define NSUBEXP 10
X
Xtypedef struct regexp {
X char *startp[NSUBEXP];
X char *endp[NSUBEXP];
X STR *regstart; /* Internal use only. */
X char *regstclass;
X STR *regmust; /* Internal use only. */
X int regback; /* Can regmust locate first try? */
X char *precomp; /* pre-compilation regular expression */
X char *subbase; /* saved string so \digit works forever */
X char reganch; /* Internal use only. */
X char do_folding; /* do case-insensitive match? */
X char lastparen; /* last paren matched */
X char nparens; /* number of parentheses */
X char program[1]; /* Unwarranted chumminess with compiler. */
X} regexp;
X
Xextern regexp *regcomp();
Xextern int regexec();
Xextern void regsub();
Xextern void regerror();
!STUFFY!FUNK!
echo Extracting t/op.time
sed >t/op.time <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.time,v 2.0 88/06/05 00:14:58 root Exp $
X
Xprint "1..5\n";
X
X($beguser,$begsys) = times;
X
X$beg = time;
X
Xwhile (($now = time) == $beg) {}
X
Xif ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";}
X
Xfor ($i = 0; $i < 100000; $i++) {
X ($nowuser, $nowsys) = times;
X $i = 200000 if $nowuser > $beguser && $nowsys > $begsys;
X last if time - $beg > 20;
X}
X
Xif ($i >= 200000) {print "ok 2\n";} else {print "not ok 2\n";}
X
X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg);
X($xsec,$foo) = localtime($now);
X$localyday = $yday;
X
Xif ($sec != $xsec && $mday && $year)
X {print "ok 3\n";}
Xelse
X {print "not ok 3\n";}
X
X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg);
X($xsec,$foo) = localtime($now);
X
Xif ($sec != $xsec && $mday && $year)
X {print "ok 4\n";}
Xelse
X {print "not ok 4\n";}
X
Xif (index(" :0:1:-1:365:366:-365:-366:",':' . ($localyday - $yday) . ':') > 0)
X {print "ok 5\n";}
Xelse
X {print "not ok 5\n";}
!STUFFY!FUNK!
echo Extracting t/op.do
sed >t/op.do <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.do,v 2.0 88/06/05 00:13:36 root Exp $
X
Xsub foo1
X{
X print $_[0];
X 'value';
X}
X
Xsub foo2
X{
X shift(_);
X print $_[0];
X $x = 'value';
X $x;
X}
X
Xprint "1..15\n";
X
X$_[0] = "not ok 1\n";
X$result = do foo1("ok 1\n");
Xprint "#2\t:$result: eq :value:\n";
Xif ($result EQ 'value') { print "ok 2\n"; } else { print "not ok 2\n"; }
Xif ($_[0] EQ "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; }
X
X$_[0] = "not ok 4\n";
X$result = do foo2("not ok 4\n","ok 4\n","not ok 4\n");
Xprint "#5\t:$result: eq :value:\n";
Xif ($result EQ 'value') { print "ok 5\n"; } else { print "not ok 5\n"; }
Xif ($_[0] EQ "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; }
X
X$result = do{print "ok 7\n"; 'value';};
Xprint "#8\t:$result: eq :value:\n";
Xif ($result EQ 'value') { print "ok 8\n"; } else { print "not ok 8\n"; }
X
Xsub blather {
X print @_;
X}
X
Xdo blather("ok 9\n","ok 10\n");
X@x = ("ok 11\n", "ok 12\n");
X@y = ("ok 14\n", "ok 15\n");
Xdo blather(@x,"ok 13\n",@y);
!STUFFY!FUNK!
echo Extracting t/op.each
sed >t/op.each <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.each,v 2.0 88/06/05 00:13:38 root Exp $
X
Xprint "1..3\n";
X
X$h{'abc'} = 'ABC';
X$h{'def'} = 'DEF';
X$h{'jkl'} = 'JKL';
X$h{'xyz'} = 'XYZ';
X$h{'a'} = 'A';
X$h{'b'} = 'B';
X$h{'c'} = 'C';
X$h{'d'} = 'D';
X$h{'e'} = 'E';
X$h{'f'} = 'F';
X$h{'g'} = 'G';
X$h{'h'} = 'H';
X$h{'i'} = 'I';
X$h{'j'} = 'J';
X$h{'k'} = 'K';
X$h{'l'} = 'L';
X$h{'m'} = 'M';
X$h{'n'} = 'N';
X$h{'o'} = 'O';
X$h{'p'} = 'P';
X$h{'q'} = 'Q';
X$h{'r'} = 'R';
X$h{'s'} = 'S';
X$h{'t'} = 'T';
X$h{'u'} = 'U';
X$h{'v'} = 'V';
X$h{'w'} = 'W';
X$h{'x'} = 'X';
X$h{'y'} = 'Y';
X$h{'z'} = 'Z';
X
X@keys = keys(h);
X@values = values(h);
X
Xif ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
X
Xwhile (($key,$value) = each(h)) {
X if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
X $key =~ y/a-z/A-Z/;
X $i++ if $key eq $value;
X }
X}
X
Xif ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";}
X
X@keys = ('blurfl', keys(h), 'dyick');
Xif ($#keys == 31) {print "ok 3\n";} else {print "not ok 3\n";}
!STUFFY!FUNK!
echo Extracting lib/getopt.pl
sed >lib/getopt.pl <<'!STUFFY!FUNK!' -e 's/X//'
X;# $Header: getopt.pl,v 2.0 88/06/05 00:16:22 root Exp $
X
X;# Process single-character switches with switch clustering. Pass one argument
X;# which is a string containing all switches that take an argument. For each
X;# switch found, sets $opt_x (where x is the switch name) to the value of the
X;# argument, or 1 if no argument. Switches which take an argument don't care
X;# whether there is a space between the switch and the argument.
X
X;# Usage:
X;# do Getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect.
X
Xsub Getopt {
X local($argumentative) = @_;
X local($_,$first,$rest);
X
X while (($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
X ($first,$rest) = ($1,$2);
X if (index($argumentative,$first) >= $[) {
X if ($rest ne '') {
X shift;
X }
X else {
X shift;
X $rest = shift;
X }
X eval "\$opt_$first = \$rest;";
X }
X else {
X eval "\$opt_$first = 1;";
X if ($rest ne '') {
X $ARGV[0] = "-$rest";
X }
X else {
X shift;
X }
X }
X }
X}
!STUFFY!FUNK!
echo Extracting t/comp.script
sed >t/comp.script <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: comp.script,v 2.0 88/06/05 00:12:49 root Exp $
X
Xprint "1..3\n";
X
X$x = `./perl -e 'print "ok\n";'`;
X
Xif ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
X
Xopen(try,">Comp.script") || (die "Can't open temp file.");
Xprint try 'print "ok\n";'; print try "\n";
Xclose try;
X
X$x = `./perl Comp.script`;
X
Xif ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
X
X$x = `./perl <Comp.script`;
X
Xif ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
X
X`/bin/rm -f Comp.script`;
!STUFFY!FUNK!
echo ""
echo "End of kit 14 (of 15)"
cat /dev/null >kit14isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.