rsalz@bbn.com (Rich Salz) (07/13/88)
Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Posting-number: Volume 15, Issue 104
Archive-name: perl2/part15
#! /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 15 (of 15). If kit 15 is complete, the line"
echo '"'"End of kit 15 (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/comp.term
sed >t/comp.term <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: comp.term,v 2.0 88/06/05 00:12:52 root Exp $
X
X# tests that aren't important enough for base.term
X
Xprint "1..10\n";
X
X$x = "\\n";
Xprint "#1\t:$x: eq " . ':\n:' . "\n";
Xif ($x eq '\n') {print "ok 1\n";} else {print "not ok 1\n";}
X
X$x = "#2\t:$x: eq :\\n:\n";
Xprint $x;
Xunless (index($x,'\\\\')>0) {print "ok 2\n";} else {print "not ok 2\n";}
X
Xif (length('\\\\') == 2) {print "ok 3\n";} else {print "not ok 3\n";}
X
X$one = 'a';
X
Xif (length("\\n") == 2) {print "ok 4\n";} else {print "not ok 4\n";}
Xif (length("\\\n") == 2) {print "ok 5\n";} else {print "not ok 5\n";}
Xif (length("$one\\n") == 3) {print "ok 6\n";} else {print "not ok 6\n";}
Xif (length("$one\\\n") == 3) {print "ok 7\n";} else {print "not ok 7\n";}
Xif (length("\\n$one") == 3) {print "ok 8\n";} else {print "not ok 8\n";}
Xif (length("\\\n$one") == 3) {print "ok 9\n";} else {print "not ok 9\n";}
Xif (length("\\${one}") == 2) {print "ok 10\n";} else {print "not ok 10\n";}
X
!STUFFY!FUNK!
echo Extracting t/cmd.for
sed >t/cmd.for <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cmd.for,v 2.0 88/06/05 00:12:19 root Exp $
X
Xprint "1..7\n";
X
Xfor ($i = 0; $i <= 10; $i++) {
X $x[$i] = $i;
X}
X$y = $x[10];
Xprint "#1 :$y: eq :10:\n";
X$y = join(' ', @x);
Xprint "#1 :$y: eq :0 1 2 3 4 5 6 7 8 9 10:\n";
Xif (join(' ', @x) eq '0 1 2 3 4 5 6 7 8 9 10') {
X print "ok 1\n";
X} else {
X print "not ok 1\n";
X}
X
X$i = $c = 0;
Xfor (;;) {
X $c++;
X last if $i++ > 10;
X}
Xif ($c == 12) {print "ok 2\n";} else {print "not ok 2\n";}
X
X$foo = 3210;
X@ary = (1,2,3,4,5);
Xforeach $foo (@ary) {
X $foo *= 2;
X}
Xif (join('',@ary) eq '246810') {print "ok 3\n";} else {print "not ok 3\n";}
X
Xfor (@ary) {
X s/(.*)/ok $1\n/;
X}
X
Xprint $ary[1];
X
X# test for internal scratch array generation
X# this also tests that $foo was restored to 3210 after test 3
Xfor (split(' ','a b c d e')) {
X $foo .= $_;
X}
Xif ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5\n";}
X
Xforeach $foo (("ok 6\n","ok 7\n")) {
X print $foo;
X}
!STUFFY!FUNK!
echo Extracting t/op.repeat
sed >t/op.repeat <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.repeat,v 2.0 88/06/05 00:14:31 root Exp $
X
Xprint "1..11\n";
X
X# compile time
X
Xif ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";}
Xif ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";}
Xif ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";}
X
Xif ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";}
X
X# run time
X
X$a = '-';
Xif ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";}
Xif ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";}
Xif ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";}
X
X$a = 'ab';
Xif ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";}
X
X$a = 'xyz';
X$a x= 2;
Xif ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";}
X$a x= 1;
Xif ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";}
X$a x= 0;
Xif ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";}
X
!STUFFY!FUNK!
echo Extracting t/io.argv
sed >t/io.argv <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: io.argv,v 2.0 88/06/05 00:12:55 root Exp $
X
Xprint "1..5\n";
X
Xopen(try, '>Io.argv.tmp') || (die "Can't open temp file.");
Xprint try "a line\n";
Xclose try;
X
X$x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`;
X
Xif ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";}
X
X$x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`;
X
Xif ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
X
X$x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
X
Xif ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3\n";}
X
X@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp');
Xwhile (<>) {
X $y .= $. . $_;
X if (eof()) {
X if ($. == 3) {print "ok 4\n";} else {print "not ok 4\n";}
X }
X}
X
Xif ($y eq "1a line\n2a line\n3a line\n")
X {print "ok 5\n";}
Xelse
X {print "not ok 5\n";}
X
X`/bin/rm -f Io.argv.tmp`;
!STUFFY!FUNK!
echo Extracting handy.h
sed >handy.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: handy.h,v 2.0 88/06/05 00:09:03 root Exp $
X *
X * $Log: handy.h,v $
X * Revision 2.0 88/06/05 00:09:03 root
X * Baseline version 2.0.
X *
X */
X
X#ifdef NULL
X#undef NULL
X#endif
X#define NULL 0
X#define Null(type) ((type)NULL)
X#define Nullch Null(char*)
X#define Nullfp Null(FILE*)
X
X#define bool char
X#define TRUE (1)
X#define FALSE (0)
X
X#define Ctl(ch) (ch & 037)
X
X#define strNE(s1,s2) (strcmp(s1,s2))
X#define strEQ(s1,s2) (!strcmp(s1,s2))
X#define strLT(s1,s2) (strcmp(s1,s2) < 0)
X#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
X#define strGT(s1,s2) (strcmp(s1,s2) > 0)
X#define strGE(s1,s2) (strcmp(s1,s2) >= 0)
X#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
X#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
X
X#define MEM_SIZE unsigned int
X
X/* Line numbers are unsigned, 16 bits. */
Xtypedef unsigned short line_t;
X#ifdef lint
X#define NOLINE ((line_t)0)
X#else
X#define NOLINE ((line_t) 65535)
X#endif
X
!STUFFY!FUNK!
echo Extracting eg/changes
sed >eg/changes <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: changes,v 2.0 88/06/05 00:16:41 root Exp $
X
X($dir, $days) = @ARGV;
X$dir = '/' if $dir eq '';
X$days = '14' if $days eq '';
X
X# Masscomps do things differently from Suns
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
Xopen(Find, "find $dir -mtime -$days -print |") ||
X die "changes: can't run find";
X#else
Xopen(Find, "find $dir \\( -fstype nfs -prune \\) -o -mtime -$days -ls |") ||
X die "changes: can't run find";
X#endif
X
Xwhile (<Find>) {
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
X $x = `/bin/ls -ild $_`;
X $_ = $x;
X ($inode,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
X = split(' ');
X#else
X ($inode,$blocks,$perm,$links,$owner,$group,$size,$month,$day,$time,$name)
X = split(' ');
X#endif
X
X printf("%10s%3s %-8s %-8s%9s %3s %2s %s\n",
X $perm,$links,$owner,$group,$size,$month,$day,$name);
X}
X
!STUFFY!FUNK!
echo Extracting x2p/str.h
sed >x2p/str.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.h,v 2.0 88/06/05 00:16:05 root Exp $
X *
X * $Log: str.h,v $
X * Revision 2.0 88/06/05 00:16:05 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 } str_link;
X char str_pok; /* state of str_ptr */
X char str_nok; /* state of str_nval */
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 long tmps_max INIT(-1);
X
Xchar *str_2ptr();
Xdouble str_2num();
XSTR *str_static();
XSTR *str_make();
XSTR *str_nmake();
Xchar *str_gets();
!STUFFY!FUNK!
echo Extracting eg/myrup
sed >eg/myrup <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: myrup,v 2.0 88/06/05 00:16:51 root Exp $
X
X# This was a customization of ruptime requested by someone here who wanted
X# to be able to find the least loaded machine easily. It uses the
X# /etc/ghosts file that's defined for gsh and gcp to prune down the
X# number of entries to those hosts we have administrative control over.
X
Xprint "node load (u)\n------- --------\n";
X
Xopen(ghosts,'/etc/ghosts') || die "Can't open /etc/ghosts";
Xline: while (<ghosts>) {
X next line if /^#/;
X next line if /^$/;
X next line if /=/;
X ($host) = split;
X $wanted{$host} = 1;
X}
X
Xopen(ruptime,'ruptime|') || die "Can't run ruptime";
Xopen(sort,'|sort +1n');
X
Xwhile (<ruptime>) {
X ($host,$upness,$foo,$users,$foo,$foo,$load) = split(/[\s,]+/);
X if ($wanted{$host} && $upness eq 'up') {
X printf sort "%s\t%s (%d)\n", $host, $load, $users;
X }
X}
!STUFFY!FUNK!
echo Extracting t/op.regexp
sed >t/op.regexp <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.regexp,v 2.0 88/06/05 00:14:27 root Exp $
X
Xopen(TESTS,'re_tests') || open(TESTS,'t/re_tests') || die "Can't open re_tests";
Xwhile (<TESTS>) { }
X$numtests = $.;
Xclose(TESTS);
X
Xprint "1..$numtests\n";
Xopen(TESTS,'re_tests') || open(TESTS,'t/re_tests') || die "Can't open re_tests";
Xwhile (<TESTS>) {
X ($pat, $subject, $result, $repl, $expect) = split(/[\t\n]/,$_);
X $input = join(':',$pat,$subject,$result,$repl,$expect);
X eval "\$match = (\$subject =~ \$pat); \$got = \"$repl\";";
X if ($result eq 'c') {
X if ($@ ne '') {print "ok $.\n";} else {print "not ok $.\n";}
X }
X elsif ($result eq 'n') {
X if (!$match) {print "ok $.\n";} else {print "not ok $. $input => $got\n";}
X }
X else {
X if ($match && $got eq $expect) {
X print "ok $.\n";
X }
X else {
X print "not ok $. $input => $got\n";
X }
X }
X}
Xclose(TESTS);
!STUFFY!FUNK!
echo Extracting eg/g/ghosts
sed >eg/g/ghosts <<'!STUFFY!FUNK!' -e 's/X//'
X# This first section gives alternate sets defined in terms of the sets given
X# by the second section. The order is important--all references must be
X# forward references.
X
XNnd=sun-nd
Xall=sun+mc+vax
Xbaseline=sun+mc
Xsun=sun2+sun3
Xvax=750+8600
Xpep=manny+moe+jack
X
X# This second section defines the basic sets. Each host should have a line
X# that specifies which sets it is a member of. Extra sets should be separated
X# by white space. (The first section isn't strictly necessary, since all sets
X# could be defined in the second section, but then it wouldn't be so readable.)
X
Xbasvax 8600 src
Xcdb0 sun3 sys
Xcdb1 sun3 sys
Xcdb2 sun3 sys
Xchief sun3 src
Xtis0 sun3
Xmanny sun3 sys
Xmoe sun3 sys
Xjack sun3 sys
Xdisney sun3 sys
Xhuey sun3 nd
Xdewey sun3 nd
Xlouie sun3 nd
Xbizet sun2 src sys
Xgif0 mc src
Xmc0 mc
Xdtv0 mc
!STUFFY!FUNK!
echo Extracting t/base.term
sed >t/base.term <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: base.term,v 2.0 88/06/05 00:12:13 root Exp $
X
Xprint "1..6\n";
X
X# check "" interpretation
X
X$x = "\n";
Xif ($x lt ' ') {print "ok 1\n";} else {print "not ok 1\n";}
X
X# check `` processing
X
X$x = `echo hi there`;
Xif ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";}
X
X# check $#array
X
X$x[0] = 'foo';
X$x[1] = 'foo';
X$tmp = $#x;
Xprint "#3\t:$tmp: == :1:\n";
Xif ($#x == '1') {print "ok 3\n";} else {print "not ok 3\n";}
X
X# check numeric literal
X
X$x = 1;
Xif ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";}
X
X# check <> pseudoliteral
X
Xopen(try, "/dev/null") || (die "Can't open /dev/null.");
Xif (<try> eq '') {print "ok 5\n";} else {print "not ok 5\n";}
X
Xopen(try, "../Makefile") || (die "Can't open ../Makefile.");
Xif (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";}
!STUFFY!FUNK!
echo Extracting t/comp.multiline
sed >t/comp.multiline <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: comp.multiline,v 2.0 88/06/05 00:12:44 root Exp $
X
Xprint "1..5\n";
X
Xopen(try,'>Comp.try') || (die "Can't open temp file.");
X
X$x = 'now is the time
Xfor all good men
Xto come to.
X';
X
X$y = 'now is the time' . "\n" .
X'for all good men' . "\n" .
X'to come to.' . "\n";
X
Xif ($x eq $y) {print "ok 1\n";} else {print "not ok 1\n";}
X
Xprint try $x;
Xclose try;
X
Xopen(try,'Comp.try') || (die "Can't reopen temp file.");
X$count = 0;
X$z = '';
Xwhile (<try>) {
X $z .= $_;
X $count = $count + 1;
X}
X
Xif ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";}
X
Xif ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";}
X
X$_ = `cat Comp.try`;
X
Xif (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
X`/bin/rm -f Comp.try`;
X
Xif ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";}
!STUFFY!FUNK!
echo Extracting t/op.magic
sed >t/op.magic <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.magic,v 2.0 88/06/05 00:14:11 root Exp $
X
X$| = 1; # command buffering
X
Xprint "1..4\n";
X
Xeval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval
Xif (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
X
X$! = 0;
Xopen(foo,'ajslkdfpqjsjfkslkjdflksd');
Xif ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";}
X
X# the next tests are embedded inside system simply because sh spits out
X# a newline onto stderr when a child process kills itself with SIGINT.
X
Xsystem './perl',
X'-e', '$| = 1; # command buffering',
X
X'-e', '$SIG{"INT"} = "ok3"; kill 2,$$;',
X'-e', '$SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";',
X'-e', '$SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";',
X
X'-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "INT"; }';
!STUFFY!FUNK!
echo Extracting eg/van/empty
sed >eg/van/empty <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: empty,v 2.0 88/06/05 00:17:39 root Exp $
X
X# This script empties a trashcan.
X
X$recursive = shift if $ARGV[0] eq '-r';
X
X@ARGV = '.' if $#ARGV < 0;
X
Xchop($pwd = `pwd`);
X
Xdir: foreach $dir (@ARGV) {
X unless (chdir $dir) {
X print stderr "Can't find directory $dir\n";
X next dir;
X }
X if ($recursive) {
X do cmd('find . -name .deleted -exec /bin/rm -rf {} ;');
X }
X else {
X if (-d '.deleted') {
X do cmd('rm -rf .deleted');
X }
X else {
X if ($dir eq '.' && $pwd =~ m|/\.deleted$|) {
X chdir '..';
X do cmd('rm -rf .deleted');
X }
X else {
X print stderr "No trashcan found in directory $dir\n";
X }
X }
X }
X}
Xcontinue {
X chdir $pwd;
X}
X
X# force direct execution with no shell
X
Xsub cmd {
X system split(' ',join(' ',@_));
X}
X
!STUFFY!FUNK!
echo Extracting t/comp.cpp
sed >t/comp.cpp <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl -P
X
X# $Header: comp.cpp,v 2.0 88/06/05 00:12:37 root Exp $
X
Xprint "1..3\n";
X
X#this is a comment
X#define MESS "ok 1\n"
Xprint MESS;
X
X#If you capitalize, it's a comment.
X#ifdef MESS
X print "ok 2\n";
X#else
X print "not ok 2\n";
X#endif
X
Xopen(try,">Comp.cpp.tmp") || die "Can't open temp perl file.";
Xprint try '$ok = "not ok 3\n";'; print try "\n";
Xprint try "#include <Comp.cpp.inc>\n";
Xprint try "#ifdef OK\n";
Xprint try '$ok = OK;'; print try "\n";
Xprint try "#endif\n";
Xprint try 'print $ok;'; print try "\n";
Xclose try;
X
Xopen(try,">Comp.cpp.inc") || (die "Can't open temp include file.");
Xprint try '#define OK "ok 3\n"'; print try "\n";
Xclose try;
X
X$pwd=`pwd`;
X$pwd =~ s/\n//;
X$x = `./perl -P -I$pwd Comp.cpp.tmp`;
Xprint $x;
X`/bin/rm -f Comp.cpp.tmp Comp.cpp.inc`;
!STUFFY!FUNK!
echo Extracting t/base.lex
sed >t/base.lex <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: base.lex,v 2.0 88/06/05 00:12:06 root Exp $
X
Xprint "1..7\n";
X
X$ # this is the register <space>
X= 'x';
X
Xprint "#1 :$ : eq :x:\n";
Xif ($ eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
X
X$x = $#; # this is the register $#
X
Xif ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";}
X
X$x = $#x;
X
Xif ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";}
X
X$x = '\\'; # ';
X
Xif (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
X
Xeval 'while (0) {
X print "foo\n";
X}
X/^/ && (print "ok 5\n");
X';
X
Xeval '$foo{1} / 1;';
Xif (!$@) {print "ok 6\n";} else {print "not ok 6\n";}
X
Xeval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
X
X$foo = int($foo * 100 + .5);
Xif ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7\n";}
!STUFFY!FUNK!
echo Extracting eg/scan/scan_ps
sed >eg/scan/scan_ps <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -P
X
X# $Header: scan_ps,v 2.0 88/06/05 00:17:51 root Exp $
X
X# This looks for looping processes.
X
X#if defined(mc300) || defined(mc500) || defined(mc700)
Xopen(Ps, '/bin/ps -el|') || die "scan_ps: can't run ps";
X
Xwhile (<Ps>) {
X next if /rwhod/;
X print if index(' T', substr($_,62,1)) < 0;
X}
X#else
Xopen(Ps, '/bin/ps auxww|') || die "scan_ps: can't run ps";
X
Xwhile (<Ps>) {
X next if /dataserver/;
X next if /nfsd/;
X next if /update/;
X next if /ypserv/;
X next if /rwhod/;
X next if /routed/;
X next if /pagedaemon/;
X#ifdef vax
X ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$start,$time) = split;
X#else
X ($user,$pid,$cpu,$mem,$sz,$rss,$tt,$stat,$time) = split;
X#endif
X print if length($time) > 4;
X}
X#endif
!STUFFY!FUNK!
echo Extracting t/op.delete
sed >t/op.delete <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.delete,v 2.0 88/06/05 00:13:30 root Exp $
X
Xprint "1..6\n";
X
X$foo{1} = 'a';
X$foo{2} = 'b';
X$foo{3} = 'c';
X
X$foo = delete $foo{2};
X
Xif ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1\n";}
Xif ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2\n";}
Xif ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
Xif ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
X
X$foo = join('',values(foo));
Xif ($foo eq 'ac' || $foo eq 'ca') {print "ok 5\n";} else {print "not ok 5\n";}
X
Xforeach $key (keys(foo)) {
X delete $foo{$key};
X}
X
X$foo{'foo'} = 'x';
X$foo{'bar'} = 'y';
X
X$foo = join('',values(foo));
Xif ($foo eq 'xy' || $foo eq 'yx') {print "ok 6\n";} else {print "not ok 6\n";}
!STUFFY!FUNK!
echo Extracting eg/scan/scan_passwd
sed >eg/scan/scan_passwd <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: scan_passwd,v 2.0 88/06/05 00:17:49 root Exp $
X
X# This scans passwd file for security holes.
X
Xopen(Pass,'/etc/passwd') || die "Can't open passwd file";
X# $dotriv = (`date` =~ /^Mon/);
X$dotriv = 1;
X
Xwhile (<Pass>) {
X ($login,$pass,$uid,$gid,$gcos,$home,$shell) = split(/:/);
X if ($shell eq '') {
X print "Short: $_";
X }
X next if /^[+]/;
X if ($pass eq '') {
X if (index(":sync:lpq:+:", ":$login:") < 0) {
X print "No pass: $login\t$gcos\n";
X }
X }
X elsif ($dotriv && crypt($login,substr($pass,0,2)) eq $pass) {
X print "Trivial: $login\t$gcos\n";
X }
X if ($uid == 0) {
X if ($login !~ /^.?root$/ && $pass ne '*') {
X print "Extra root: $_";
X }
X }
X}
!STUFFY!FUNK!
echo Extracting t/op.exp
sed >t/op.exp <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.exp,v 2.0 88/06/05 00:13:48 root Exp $
X
Xprint "1..6\n";
X
X# compile time evaluation
X
X$s = sqrt(2);
Xif (substr($s,0,5) eq '1.414') {print "ok 1\n";} else {print "not ok 1\n";}
X
X$s = exp(1);
Xif (substr($s,0,7) eq '2.71828') {print "ok 2\n";} else {print "not ok 2\n";}
X
Xif (exp(log(1)) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
X
X# run time evaluation
X
X$x1 = 1;
X$x2 = 2;
X$s = sqrt($x2);
Xif (substr($s,0,5) eq '1.414') {print "ok 4\n";} else {print "not ok 4\n";}
X
X$s = exp($x1);
Xif (substr($s,0,7) eq '2.71828') {print "ok 5\n";} else {print "not ok 5\n";}
X
Xif (exp(log($x1)) == 1) {print "ok 6\n";} else {print "not ok 6\n";}
!STUFFY!FUNK!
echo Extracting x2p/handy.h
sed >x2p/handy.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: handy.h,v 2.0 88/06/05 00:15:47 root Exp $
X *
X * $Log: handy.h,v $
X * Revision 2.0 88/06/05 00:15:47 root
X * Baseline version 2.0.
X *
X */
X
X#define Null(type) ((type)0)
X#define Nullch Null(char*)
X#define Nullfp Null(FILE*)
X
X#define bool char
X#define TRUE (1)
X#define FALSE (0)
X
X#define Ctl(ch) (ch & 037)
X
X#define strNE(s1,s2) (strcmp(s1,s2))
X#define strEQ(s1,s2) (!strcmp(s1,s2))
X#define strLT(s1,s2) (strcmp(s1,s2) < 0)
X#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
X#define strGT(s1,s2) (strcmp(s1,s2) > 0)
X#define strGE(s1,s2) (strcmp(s1,s2) >= 0)
X#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
X#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
!STUFFY!FUNK!
echo Extracting t/op.exec
sed >t/op.exec <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.exec,v 2.0 88/06/05 00:13:46 root Exp $
X
X$| = 1; # flush stdout
Xprint "1..8\n";
X
Xprint "not ok 1\n" if system "echo ok \\1"; # shell interpreted
Xprint "not ok 2\n" if system "echo ok 2"; # split and directly called
Xprint "not ok 3\n" if system "echo", "ok", "3"; # directly called
X
Xif (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
X
Xif ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
Xprint "ok 5\n";
X
Xif ((system "lskdfj") == 255 << 8) {print "ok 6\n";} else {print "not ok 6\n";}
X
Xunless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
X
Xexec "echo","ok","8";
!STUFFY!FUNK!
echo Extracting x2p/util.h
sed >x2p/util.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: util.h,v 2.0 88/06/05 00:16:10 root Exp $
X *
X * $Log: util.h,v $
X * Revision 2.0 88/06/05 00:16:10 root
X * Baseline version 2.0.
X *
X */
X
X/* is the string for makedir a directory name or a filename? */
X
X#define MD_DIR 0
X#define MD_FILE 1
X
Xvoid util_init();
Xint doshell();
Xchar *safemalloc();
Xchar *saferealloc();
Xchar *safecpy();
Xchar *safecat();
Xchar *cpytill();
Xchar *cpy2();
Xchar *instr();
X#ifdef SETUIDGID
X int eaccess();
X#endif
Xchar *getwd();
Xvoid cat();
Xvoid prexit();
Xchar *get_a_line();
Xchar *savestr();
Xint makedir();
Xvoid setenv();
Xint envix();
Xvoid notincl();
Xchar *getval();
Xvoid growstr();
Xvoid setdef();
!STUFFY!FUNK!
echo Extracting lib/stat.pl
sed >lib/stat.pl <<'!STUFFY!FUNK!' -e 's/X//'
X;# $Header: stat.pl,v 2.0 88/06/05 00:16:29 root Exp $
X
X;# Usage:
X;# @ary = stat(foo);
X;# $st_dev = @ary[$ST_DEV];
X;#
X$ST_DEV = 0 + $[;
X$ST_INO = 1 + $[;
X$ST_MODE = 2 + $[;
X$ST_NLINK = 3 + $[;
X$ST_UID = 4 + $[;
X$ST_GID = 5 + $[;
X$ST_RDEV = 6 + $[;
X$ST_SIZE = 7 + $[;
X$ST_ATIME = 8 + $[;
X$ST_MTIME = 9 + $[;
X$ST_CTIME = 10 + $[;
X$ST_BLKSIZE = 11 + $[;
X$ST_BLOCKS = 12 + $[;
X
X;# Usage:
X;# do Stat('foo'); # sets st_* as a side effect
X;#
Xsub Stat {
X ($st_dev,$st_ino,$st_mode,$st_nlink,$st_uid,$st_gid,$st_rdev,$st_size,
X $st_atime,$st_mtime,$st_ctime,$st_blksize,$st_blocks) = stat(shift(@_));
X}
!STUFFY!FUNK!
echo Extracting t/op.goto
sed >t/op.goto <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.goto,v 2.0 88/06/05 00:13:58 root Exp $
X
Xprint "1..3\n";
X
Xwhile (0) {
X $foo = 1;
X label1:
X $foo = 2;
X goto label2;
X} continue {
X $foo = 0;
X goto label4;
X label3:
X $foo = 4;
X goto label4;
X}
Xgoto label1;
X
X$foo = 3;
X
Xlabel2:
Xprint "#1\t:$foo: == 2\n";
Xif ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
Xgoto label3;
X
Xlabel4:
Xprint "#2\t:$foo: == 4\n";
Xif ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
X
X$x = `./perl -e 'goto foo;' 2>&1`;
Xprint "#3\t/label/ in :$x";
Xif ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
!STUFFY!FUNK!
echo Extracting eg/shmkill
sed >eg/shmkill <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: shmkill,v 2.0 88/06/05 00:16:59 root Exp $
X
X# A script to call from crontab periodically when people are leaving shared
X# memory sitting around unattached.
X
Xopen(ipcs,'ipcs -m -o|') || die "Can't run ipcs";
X
Xwhile (<ipcs>) {
X $tmp = index($_,'NATTCH');
X $pos = $tmp if $tmp >= 0;
X if (/^m/) {
X ($m,$id,$key,$mode,$owner,$group,$attach) = split;
X if ($attach != substr($_,$pos,6)) {
X die "Different ipcs format--can't parse!";
X }
X if ($attach == 0) {
X push(@goners,'-m',$id);
X }
X }
X}
X
Xexec 'ipcrm', @goners if $#goners >= 0;
!STUFFY!FUNK!
echo Extracting t/op.flip
sed >t/op.flip <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.flip,v 2.0 88/06/05 00:13:51 root Exp $
X
Xprint "1..8\n";
X
X@a = (1,2,3,4,5,6,7,8,9,10,11,12);
X
Xwhile ($_ = shift(a)) {
X if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; }
X $y .= /1/../2/;
X}
X
Xif ($z eq '5E0') {print "ok 6\n";} else {print "not ok 6\n";}
X
Xif ($y eq '12E0123E0') {print "ok 7\n";} else {print "not ok 7\n";}
X
X@a = ('a','b','c','d','e','f','g');
X
Xopen(of,'../Makefile');
Xwhile (<of>) {
X (3 .. 5) && $foo .= $_;
X}
X$x = ($foo =~ y/\n/\n/);
X
Xif ($x eq 3) {print "ok 8\n";} else {print "not ok 8 $x:$foo:\n";}
!STUFFY!FUNK!
echo Extracting eg/dus
sed >eg/dus <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: dus,v 2.0 88/06/05 00:16:44 root Exp $
X
X# This script does a du -s on any directories in the current directory that
X# are not mount points for another filesystem.
X
X($mydev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat('.');
X
Xopen(ls,'ls -F1|');
X
Xwhile (<ls>) {
X chop;
X next unless s|/$||;
X ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat($_);
X next unless $dev == $mydev;
X push(@ary,$_);
X}
X
Xexec 'du', '-s', @ary;
!STUFFY!FUNK!
echo Extracting t/cmd.mod
sed >t/cmd.mod <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cmd.mod,v 2.0 88/06/05 00:12:23 root Exp $
X
Xprint "1..6\n";
X
Xprint "ok 1\n" if 1;
Xprint "not ok 1\n" unless 1;
X
Xprint "ok 2\n" unless 0;
Xprint "not ok 2\n" if 0;
X
X1 && (print "not ok 3\n") if 0;
X1 && (print "ok 3\n") if 1;
X0 || (print "not ok 4\n") if 0;
X0 || (print "ok 4\n") if 1;
X
X$x = 0;
Xdo {$x[$x] = $x;} while ($x++) < 10;
Xif (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') {
X print "ok 5\n";
X} else {
X print "not ok 5\n";
X}
X
X$x = 15;
X$x = 10 while $x < 10;
Xif ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
!STUFFY!FUNK!
echo Extracting t/io.dup
sed >t/io.dup <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: io.dup,v 2.0 88/06/05 00:12:57 root Exp $
X
Xprint "1..6\n";
X
Xprint "ok 1\n";
X
Xopen(dupout,">&stdout");
Xopen(duperr,">&stderr");
X
Xopen(stdout,">Io.dup") || die "Can't open stdout";
Xopen(stderr,">&stdout") || die "Can't open stderr";
X
Xselect(stderr); $| = 1;
Xselect(stdout); $| = 1;
X
Xprint stdout "ok 2\n";
Xprint stderr "ok 3\n";
Xsystem 'echo ok 4';
Xsystem 'echo ok 5 1>&2';
X
Xclose(stdout);
Xclose(stderr);
X
Xopen(stdout,">&dupout");
Xopen(stderr,">&duperr");
X
Xsystem 'cat Io.dup';
Xunlink 'Io.dup';
X
Xprint stdout "ok 6\n";
!STUFFY!FUNK!
echo Extracting t/cmd.elsif
sed >t/cmd.elsif <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cmd.elsif,v 2.0 88/06/05 00:12:16 root Exp $
X
Xsub foo {
X if ($_[0] == 1) {
X 1;
X }
X elsif ($_[0] == 2) {
X 2;
X }
X elsif ($_[0] == 3) {
X 3;
X }
X else {
X 4;
X }
X}
X
Xprint "1..4\n";
X
Xif (($x = do foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1\n";}
Xif (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2\n";}
Xif (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3\n";}
Xif (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4\n";}
!STUFFY!FUNK!
echo Extracting util.h
sed >util.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: util.h,v 2.0 88/06/05 00:15:15 root Exp $
X *
X * $Log: util.h,v $
X * Revision 2.0 88/06/05 00:15:15 root
X * Baseline version 2.0.
X *
X */
X
Xint *screamfirst INIT(Null(int*));
Xint *screamnext INIT(Null(int*));
Xint *screamcount INIT(Null(int*));
X
Xchar *safemalloc();
Xchar *saferealloc();
Xchar *cpytill();
Xchar *instr();
Xchar *bminstr();
Xchar *fbminstr();
Xchar *screaminstr();
Xvoid bmcompile();
Xvoid fbmcompile();
Xchar *get_a_line();
Xchar *savestr();
Xvoid setenv();
Xint envix();
Xvoid growstr();
!STUFFY!FUNK!
echo Extracting eg/findtar
sed >eg/findtar <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: findtar,v 2.0 88/06/05 00:16:49 root Exp $
X
X# findtar takes find-style arguments and spits out a tarfile on stdout.
X# It won't work unless your find supports -ls and your tar the I flag.
X
X$args = join(' ',@ARGV);
Xopen(find,"/usr/bin/find $args -ls |") || die "Can't run find for you.";
X
Xopen(tar,"| /bin/tar cIf - -") || die "Can't run tar for you.";
X
Xwhile (<find>) {
X @x = split(' ');
X if ($x[2] =~ /^d/) { print tar '-d ';}
X print tar $x[10],"\n";
X}
!STUFFY!FUNK!
echo Extracting t/comp.decl
sed >t/comp.decl <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: comp.decl,v 2.0 88/06/05 00:12:40 root Exp $
X
X# check to see if subroutine declarations work everwhere
X
Xsub one {
X print "ok 1\n";
X}
Xformat one =
Xok 5
X.
X
Xprint "1..7\n";
X
Xdo one();
Xdo two();
X
Xsub two {
X print "ok 2\n";
X}
Xformat two =
X@<<<
X$foo
X.
X
Xif ($x eq $x) {
X sub three {
X print "ok 3\n";
X }
X do three();
X}
X
Xdo four();
X$~ = 'one';
Xwrite;
X$~ = 'two';
X$foo = "ok 6";
Xwrite;
X$~ = 'three';
Xwrite;
X
Xformat three =
Xok 7
X.
X
Xsub four {
X print "ok 4\n";
X}
!STUFFY!FUNK!
echo Extracting form.h
sed >form.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: form.h,v 2.0 88/06/05 00:09:01 root Exp $
X *
X * $Log: form.h,v $
X * Revision 2.0 88/06/05 00:09:01 root
X * Baseline version 2.0.
X *
X */
X
X#define F_NULL 0
X#define F_LEFT 1
X#define F_RIGHT 2
X#define F_CENTER 3
X#define F_LINES 4
X
Xstruct formcmd {
X struct formcmd *f_next;
X ARG *f_expr;
X char *f_pre;
X short f_presize;
X short f_size;
X char f_type;
X char f_flags;
X};
X
X#define FC_CHOP 1
X#define FC_NOBLANK 2
X#define FC_MORE 4
X
X#define Nullfcmd Null(FCMD*)
!STUFFY!FUNK!
echo Extracting t/op.append
sed >t/op.append <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.append,v 2.0 88/06/05 00:13:16 root Exp $
X
Xprint "1..3\n";
X
X$a = 'ab' . 'c'; # compile time
X$b = 'def';
X
X$c = $a . $b;
Xprint "#1\t:$c: eq :abcdef:\n";
Xif ($c eq 'abcdef') {print "ok 1\n";} else {print "not ok 1\n";}
X
X$c .= 'xyz';
Xprint "#2\t:$c: eq :abcdefxyz:\n";
Xif ($c eq 'abcdefxyz') {print "ok 2\n";} else {print "not ok 2\n";}
X
X$_ = $a;
X$_ .= $b;
Xprint "#3\t:$_: eq :abcdef:\n";
Xif ($_ eq 'abcdef') {print "ok 3\n";} else {print "not ok 3\n";}
!STUFFY!FUNK!
echo Extracting t/io.print
sed >t/io.print <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: io.print,v 2.0 88/06/05 00:13:11 root Exp $
X
Xprint "1..16\n";
X
X$foo = 'stdout';
Xprint $foo "ok 1\n";
X
Xprint "ok 2\n","ok 3\n","ok 4\n";
Xprint stdout "ok 5\n";
X
Xopen(foo,">-");
Xprint foo "ok 6\n";
X
Xprintf "ok %d\n",7;
Xprintf("ok %d\n",8);
X
X@a = ("ok %d%c",9,ord("\n"));
Xprintf @a;
X
X$a[1] = 10;
Xprintf stdout @a;
X
X$, = ' ';
X$\ = "\n";
X
Xprint "ok","11";
X
X@x = ("ok","12\nok","13\nok");
X@y = ("15\nok","16");
Xprint @x,"14\nok",@y;
!STUFFY!FUNK!
echo Extracting t/io.inplace
sed >t/io.inplace <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl -i.bak
X
X# $Header: io.inplace,v 2.0 88/06/05 00:13:02 root Exp $
X
Xprint "1..2\n";
X
X@ARGV = ('.a','.b','.c');
X`echo foo | tee .a .b .c`;
Xwhile (<>) {
X s/foo/bar/;
X}
Xcontinue {
X print;
X}
X
Xif (`cat .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";}
Xif (`cat .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
X
Xunlink '.a', '.b', '.c', '.a.bak', '.b.bak', '.c.bak';
!STUFFY!FUNK!
echo Extracting eg/van/vanexp
sed >eg/van/vanexp <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: vanexp,v 2.0 88/06/05 00:17:34 root Exp $
X
X# This is for running from a find at night to expire old .deleteds
X
X$can = $ARGV[0];
X
Xexit 1 unless $can =~ /.deleted$/;
X
X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
X $blksize,$blocks) = stat($can);
X
Xexit 0 unless $size;
X
Xif (time - $mtime > 2 * 24 * 60 * 60) {
X `/bin/rm -rf $can`;
X}
Xelse {
X `find $can -ctime +2 -exec rm -f {} \;`;
X}
!STUFFY!FUNK!
echo Extracting array.h
sed >array.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: array.h,v 2.0 88/06/05 00:08:21 root Exp $
X *
X * $Log: array.h,v $
X * Revision 2.0 88/06/05 00:08:21 root
X * Baseline version 2.0.
X *
X */
X
Xstruct atbl {
X STR **ary_array;
X STR *ary_magic;
X int ary_max;
X int ary_fill;
X int ary_index;
X};
X
XSTR *afetch();
Xbool astore();
Xbool adelete();
XSTR *apop();
XSTR *ashift();
Xvoid afree();
Xvoid aclear();
Xbool apush();
Xint alen();
XARRAY *anew();
!STUFFY!FUNK!
echo Extracting t/op.int
sed >t/op.int <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.int,v 2.0 88/06/05 00:14:01 root Exp $
X
Xprint "1..4\n";
X
X# compile time evaluation
X
Xif (int(1.234) == 1) {print "ok 1\n";} else {print "not ok 1\n";}
X
Xif (int(-1.234) == -1) {print "ok 2\n";} else {print "not ok 2\n";}
X
X# run time evaluation
X
X$x = 1.234;
Xif (int($x) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
Xif (int(-$x) == -1) {print "ok 4\n";} else {print "not ok 4\n";}
!STUFFY!FUNK!
echo Extracting t/base.cond
sed >t/base.cond <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: base.cond,v 2.0 88/06/05 00:11:52 root Exp $
X
X# make sure conditional operators work
X
Xprint "1..4\n";
X
X$x = '0';
X
X$x eq $x && (print "ok 1\n");
X$x ne $x && (print "not ok 1\n");
X$x eq $x || (print "not ok 2\n");
X$x ne $x || (print "ok 2\n");
X
X$x == $x && (print "ok 3\n");
X$x != $x && (print "not ok 3\n");
X$x == $x || (print "not ok 4\n");
X$x != $x || (print "ok 4\n");
!STUFFY!FUNK!
echo Extracting perlsh
sed >perlsh <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# Poor man's perl shell.
X
X# Simply type two carriage returns every time you want to evaluate.
X# Note that it must be a complete perl statement--don't type double
X# carriage return in the middle of a loop.
X
X$/ = ''; # set paragraph mode
X$SHlinesep = "\n";
Xwhile ($SHcmd = <>) {
X $/ = $SHlinesep;
X eval $SHcmd; print $@ || "\n";
X $SHlinesep = $/; $/ = '';
X}
!STUFFY!FUNK!
echo Extracting eg/nih
sed >eg/nih <<'!STUFFY!FUNK!' -e 's/X//'
Xeval "exec /usr/bin/perl -Spi.bak $0 $*"
X if $running_under_some_shell;
X
X# $Header: nih,v 2.0 88/06/05 00:16:54 root Exp $
X
X# This script makes #! scripts directly executable on machines that don't
X# support #!. It edits in place any scripts mentioned on the command line.
X
Xs|^#!(.*)|#!$1\neval "exec $1 -S \$0 \$*"\n\tif \$running_under_some_shell;|
X if $. == 1;
!STUFFY!FUNK!
echo Extracting t/op.join
sed >t/op.join <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.join,v 2.0 88/06/05 00:14:05 root Exp $
X
Xprint "1..3\n";
X
X@x = (1, 2, 3);
Xif (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
X
Xif (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";}
X
Xif (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";}
!STUFFY!FUNK!
echo Extracting lib/importenv.pl
sed >lib/importenv.pl <<'!STUFFY!FUNK!' -e 's/X//'
X;# $Header: importenv.pl,v 2.0 88/06/05 00:16:17 root Exp $
X
X;# This file, when interpreted, pulls the environment into normal variables.
X;# Usage:
X;# do 'importenv.pl';
X;# or
X;# #include <importenv.pl>
X
Xlocal($tmp,$key) = '';
X
Xforeach $key (keys(ENV)) {
X $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;
X}
Xeval $tmp;
!STUFFY!FUNK!
echo Extracting t/op.chop
sed >t/op.chop <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.chop,v 2.0 88/06/05 00:13:22 root Exp $
X
Xprint "1..2\n";
X
X# optimized
X
X$_ = 'abc';
X$c = do foo();
Xif ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1\n";}
X
X# unoptimized
X
X$_ = 'abc';
X$c = chop($_);
Xif ($c . $_ eq 'cab') {print "ok 2\n";} else {print "not ok 2\n";}
X
Xsub foo {
X chop;
X}
!STUFFY!FUNK!
echo Extracting version.c
sed >version.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: version.c,v 2.0 88/06/05 00:15:21 root Exp $
X *
X * $Log: version.c,v $
X * Revision 2.0 88/06/05 00:15:21 root
X * Baseline version 2.0.
X *
X */
X
X#include "patchlevel.h"
X
X/* Print out the version number. */
X
Xversion()
X{
X extern char rcsid[];
X
X printf("%s\r\nPatch level: %d\r\n", rcsid, PATCHLEVEL);
X}
!STUFFY!FUNK!
echo Extracting t/io.pipe
sed >t/io.pipe <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: io.pipe,v 2.0 88/06/05 00:13:05 root Exp $
X
X$| = 1;
Xprint "1..4\n";
X
Xopen(PIPE, "|-") || (exec 'tr', '[A-Z]', '[a-z]');
Xprint PIPE "OK 1\n";
Xprint PIPE "ok 2\n";
Xclose PIPE;
X
Xif (open(PIPE, "-|")) {
X while(<PIPE>) {
X print;
X }
X}
Xelse {
X print stdout "ok 3\n";
X exec 'echo', 'ok 4';
X}
!STUFFY!FUNK!
echo Extracting t/op.unshift
sed >t/op.unshift <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.unshift,v 2.0 88/06/05 00:15:00 root Exp $
X
Xprint "1..2\n";
X
X@a = (1,2,3);
X$cnt1 = unshift(a,0);
X
Xif (join(' ',@a) eq '0 1 2 3') {print "ok 1\n";} else {print "not ok 1\n";}
X$cnt2 = unshift(a,3,2,1);
Xif (join(' ',@a) eq '3 2 1 0 1 2 3') {print "ok 2\n";} else {print "not ok 2\n";}
X
X
!STUFFY!FUNK!
echo Extracting t/op.oct
sed >t/op.oct <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.oct,v 2.0 88/06/05 00:14:14 root Exp $
X
Xprint "1..3\n";
X
Xif (oct('01234') == 01234) {print "ok 1\n";} else {print "not ok 1\n";}
Xif (oct('0x1234') == 0x1234) {print "ok 2\n";} else {print "not ok 2\n";}
Xif (hex('01234') == 0x1234) {print "ok 3\n";} else {print "not ok 3\n";}
!STUFFY!FUNK!
echo Extracting t/op.push
sed >t/op.push <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.push,v 2.0 88/06/05 00:14:23 root Exp $
X
Xprint "1..2\n";
X
X@x = (1,2,3);
Xpush(@x,@x);
Xif (join(x,':') eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
Xpush(x,4);
Xif (join(x,':') eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
!STUFFY!FUNK!
echo Extracting t/op.ord
sed >t/op.ord <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.ord,v 2.0 88/06/05 00:14:17 root Exp $
X
Xprint "1..2\n";
X
X# compile time evaluation
X
Xif (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";}
X
X# run time evaluation
X
X$x = 'ABC';
Xif (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";}
!STUFFY!FUNK!
echo Extracting t/op.fork
sed >t/op.fork <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.fork,v 2.0 88/06/05 00:13:53 root Exp $
X
X$| = 1;
Xprint "1..2\n";
X
Xif ($cid = fork) {
X sleep 2;
X if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";}
X}
Xelse {
X $| = 1;
X print "ok 1\n";
X sleep 10;
X}
!STUFFY!FUNK!
echo Extracting t/base.if
sed >t/base.if <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: base.if,v 2.0 88/06/05 00:12:02 root Exp $
X
Xprint "1..2\n";
X
X# first test to see if we can run the tests.
X
X$x = 'test';
Xif ($x eq $x) { print "ok 1\n"; } else { print "not ok 1\n";}
Xif ($x ne $x) { print "not ok 2\n"; } else { print "ok 2\n";}
!STUFFY!FUNK!
echo Extracting t/base.pat
sed >t/base.pat <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: base.pat,v 2.0 88/06/05 00:12:08 root Exp $
X
Xprint "1..2\n";
X
X# first test to see if we can run the tests.
X
X$_ = 'test';
Xif (/^test/) { print "ok 1\n"; } else { print "not ok 1\n";}
Xif (/^foo/) { print "not ok 2\n"; } else { print "ok 2\n";}
!STUFFY!FUNK!
echo Extracting x2p/EXTERN.h
sed >x2p/EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: EXTERN.h,v 2.0 88/06/05 00:15:24 root Exp $
X *
X * $Log: EXTERN.h,v $
X * Revision 2.0 88/06/05 00:15:24 root
X * Baseline version 2.0.
X *
X */
X
X#undef EXT
X#define EXT extern
X
X#undef INIT
X#define INIT(x)
X
X#undef DOINIT
!STUFFY!FUNK!
echo Extracting t/op.sprintf
sed >t/op.sprintf <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.sprintf,v 2.0 88/06/05 00:14:40 root Exp $
X
Xprint "1..1\n";
X
X$x = sprintf("%3s %-4s foo %5d%c%3.1f","hi",123,456,65,3.0999);
Xif ($x eq ' hi 123 foo 456A3.1') {print "ok 1\n";} else {print "not ok 1\n";}
!STUFFY!FUNK!
echo Extracting x2p/INTERN.h
sed >x2p/INTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: INTERN.h,v 2.0 88/06/05 00:15:27 root Exp $
X *
X * $Log: INTERN.h,v $
X * Revision 2.0 88/06/05 00:15:27 root
X * Baseline version 2.0.
X *
X */
X
X#undef EXT
X#define EXT
X
X#undef INIT
X#define INIT(x) = x
X
X#define DOINIT
!STUFFY!FUNK!
echo Extracting INTERN.h
sed >INTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: INTERN.h,v 2.0 88/06/05 00:07:49 root Exp $
X *
X * $Log: INTERN.h,v $
X * Revision 2.0 88/06/05 00:07:49 root
X * Baseline version 2.0.
X *
X */
X
X#undef EXT
X#define EXT
X
X#undef INIT
X#define INIT(x) = x
X
X#define DOINIT
!STUFFY!FUNK!
echo Extracting eg/ADB
sed >eg/ADB <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: ADB,v 2.0 88/06/05 00:16:39 root Exp $
X
X# This script is only useful when used in your crash directory.
X
X$num = shift;
Xexec 'adb', '-k', "vmunix.$num", "vmcore.$num";
!STUFFY!FUNK!
echo Extracting t/op.sleep
sed >t/op.sleep <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.sleep,v 2.0 88/06/05 00:14:35 root Exp $
X
Xprint "1..1\n";
X
X$x = sleep 2;
Xif ($x == 2) {print "ok 1\n";} else {print "not ok 1\n";}
!STUFFY!FUNK!
echo Extracting eg/rmfrom
sed >eg/rmfrom <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl -n
X
X# $Header: rmfrom,v 2.0 88/06/05 00:16:57 root Exp $
X
X# A handy (but dangerous) script to put after a find ... -print.
X
Xchop; unlink;
!STUFFY!FUNK!
echo ""
echo "End of kit 15 (of 15)"
cat /dev/null >kit15isdone
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.