lwall@jato.Jpl.Nasa.Gov (Larry Wall) (09/04/89)
#! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 23 through sh. When all 23 kits have been run, read README. echo "This is perl 3.0 kit 23 (of 23). If kit 23 is complete, the line" echo '"'"End of kit 23 (of 23)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir eg/g eg/van eg lib t x2p 2>/dev/null 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!\n"; X } X if ($attach == 0) { X push(@goners,'-m',$id); X } X } X} X Xexec 'ipcrm', @goners if $#goners >= 0; !STUFFY!FUNK! echo Extracting eg/muck.man sed >eg/muck.man <<'!STUFFY!FUNK!' -e 's/X//' X.\" $Header: muck.man,v 2.0 88/06/05 00:17:23 root Exp $ X.TH MUCK 1 "10 Jan 1989" X.SH NAME Xmuck \- make usage checker X.SH SYNOPSIS X.B muck X[options] X.SH DESCRIPTION X.I muck Xlooks at your current makefile and complains if you've left out any dependencies Xbetween .o and .h files. XIt also complains about extraneous dependencies. X.PP XYou can use the -f FILENAME option to specify an alternate name for your Xmakefile. XThe -v option is a little more verbose about what muck is mucking around Xwith at the moment. X.SH SEE ALSO Xmake(1) X.SH BUGS XOnly knows about .h, .c and .o files. !STUFFY!FUNK! echo Extracting server sed >server <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X$pat = 'S n C4 x8'; X$inet = 2; X$echo = 7; X$smtp = 25; X$nntp = 119; X X$this = pack($pat,$inet,2345, 0,0,0,0); Xselect(NS); $| = 1; select(stdout); X Xif (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; } Xif (bind(S,$this)) { print "bind ok\n"; } else { die $!; } Xif (listen(S,5)) { print "listen ok\n"; } else { die $!; } Xfor (;;) { X print "Listening again\n"; X if ($addr = accept(NS,S)) { print "accept ok\n"; } else { die $!; } X X @ary = unpack($pat,$addr); X $, = ' '; X print @ary; print "\n"; X X while (<NS>) { X print; X print NS; X } X} !STUFFY!FUNK! echo Extracting lib/dumpvar.pl sed >lib/dumpvar.pl <<'!STUFFY!FUNK!' -e 's/X//' Xpackage dumpvar; X Xsub main'dumpvar { X ($package) = @_; X local(*stab) = eval("*_$package"); X while (($key,$val) = each(%stab)) { X { X local(*entry) = $val; X eval <<'.' if defined $entry; Xprint "\$$key = '$entry'\n"; X. X eval <<'.' if defined @entry; Xprint "\@$key = (\n"; Xforeach $num ($[ .. $#entry) { X print " $num\t'",$entry[$num],"'\n"; X} Xprint ")\n"; X. X eval <<'.' if $key ne "_$package" && defined %entry; Xprint "\%$key = (\n"; Xforeach $key (sort keys(%entry)) { X print " $key\t'",$entry{$key},"'\n"; X} Xprint ")\n"; X. X } X } X} !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 gettest sed >gettest <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X while (($name,$aliases,$addrtype,$length,@addrs) = gethostent) { X print $name,' ',$aliases, X sprintf(" %d.%d.%d.%d\n",unpack('CCCC',$addrs[0])); X last if $i++ > 50; X } X <stdin>; X while (($name,$aliases,$addrtype,$net) = getnetent) { X print "$name $aliases $addrtype ",sprintf("%08lx",$net),"\n"; X } X <stdin>; X while (($name,$aliases,$proto) = getprotoent) { X print "$name $aliases $proto\n"; X } X <stdin>; X while (($name,$aliases,$port,$proto) = getservent) { X print "$name $aliases $port $proto\n"; X } X !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..4\n"; X X# optimized X X$_ = 'abc'; X$c = do foo(); Xif ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1 $c$_\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} X X@foo = ("hi \n","there\n","!\n"); X@bar = @foo; Xchop(@bar); Xprint join('',@bar) eq 'hi there!' ? "ok 3\n" : "not ok 3\n"; X X$foo = "\n"; Xchop($foo,@foo); Xprint join('',$foo,@foo) eq 'hi there!' ? "ok 4\n" : "not ok 4\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 '$x'\n";} Xif (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";} Xif (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";} Xif (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";} !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 Extracting t/op.sort sed >t/op.sort <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header$ X Xprint "1..3\n"; X Xsub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; } X X@harry = ('dog','cat','x','Cain','Abel'); X@george = ('gone','chased','yz','Punished','Axed'); X X$x = join('', sort @harry); Xprint ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n"); X X$x = join('', sort reverse @harry); Xprint ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n"); X X$x = join('', sort @george, 'to', @harry); Xprint ($x eq 'AbelAxedCainPunishedcatchaseddoggonetoxyz'?"ok 3\n":"not ok 3\n"); !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 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 eg/down sed >eg/down <<'!STUFFY!FUNK!' -e 's/X//' X#!/usr/bin/perl X X$| = 1; Xif ($#ARGV >= 0) { X $cmd = join(' ',@ARGV); X} Xelse { X print "Command: "; X $cmd = <stdin>; X chop($cmd); X while ($cmd =~ s/\\$//) { X print "+ "; X $cmd .= <stdin>; X chop($cmd); X } X} X$cwd = `pwd`; chop($cwd); X Xopen(FIND,'find . -type d -print|') || die "Can't run find"; X Xwhile (<FIND>) { X chop; X unless (chdir $_) { X print stderr "Can't cd to $_\n"; X next; X } X print "\t--> ",$_,"\n"; X system $cmd; X chdir $cwd; X} !STUFFY!FUNK! echo Extracting eg/who sed >eg/who <<'!STUFFY!FUNK!' -e 's/X//' X#!/usr/bin/perl X# This assumes your /etc/utmp file looks like ours Xopen(utmp,'/etc/utmp'); X@mo = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); Xwhile (read(utmp,$utmp,36)) { X ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp); X if ($name) { X $host = "($host)" if $host; X ($sec,$min,$hour,$mday,$mon) = localtime($time); X printf "%-9s%-8s%s %2d %02d:%02d %s\n", X $name,$line,$mo[$mon],$mday,$hour,$min,$host; X } X} !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 t/op.glob sed >t/op.glob <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header$ X Xprint "1..4\n"; X X@ops = <op.*>; X$list = join(' ',@ops); X Xchop($otherway = `echo op.*`); X Xprint $list eq $otherway ? "ok 1\n" : "not ok 1\n$list\n$otherway\n"; X Xprint $/ eq "\n" ? "ok 2\n" : "not ok 2\n"; X Xwhile (<jskdfjskdfj* op.* jskdjfjkosvk*>) { X $not = "not " unless $_ eq shift @ops; X $not = "not at all " if $/ eq "\0"; X} Xprint "${not}ok 3\n"; X Xprint $/ eq "\n" ? "ok 4\n" : "not ok 4\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 * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. 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 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 * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. 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 eg/g/ged sed >eg/g/ged <<'!STUFFY!FUNK!' -e 's/X//' X#!/usr/bin/perl X X# $Header: ged,v 2.0 88/06/05 00:17:08 root Exp $ X X# Does inplace edits on a set of files on a set of machines. X# X# Typical invokation: X# X# ged vax+sun /etc/passwd X# s/Freddy/Freddie/; X# ^D X# X X$class = shift; X$files = join(' ',@ARGV); X Xdie "Usage: ged class files <perlcmds\n" unless $files; X Xexec "gsh", $class, "-d", "perl -pi.bak - $files"; X Xdie "Couldn't execute gsh for some reason, stopped"; !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/op.mkdir sed >t/op.mkdir <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header$ X Xprint "1..7\n"; X X`rm -rf blurfl`; X Xprint (mkdir('blurfl',0666) ? "ok 1\n" : "not ok 1\n"); Xprint (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\n"); Xprint ($! == 17 ? "ok 3\n" : "not ok 3\n"); Xprint (-d 'blurfl' ? "ok 4\n" : "not ok 4\n"); Xprint (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n"); Xprint (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n"); Xprint ($! == 2 ? "ok 7\n" : "not ok 7\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 t/op.pack sed >t/op.pack <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header$ X Xprint "1..3\n"; X X$format = "c2x5CCxsila6"; X@ary = (1,-100,127,128,32767,12345,123456,"abcdef"); X$foo = pack($format,@ary); X@ary2 = unpack($format,$foo); X Xprint ($#ary == $#ary2 ? "ok 1\n" : "not ok 1\n"); X X$out1=join(':',@ary); X$out2=join(':',@ary2); Xprint ($out1 eq $out2 ? "ok 2\n" : "not ok 2\n"); X Xprint ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n"); !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 EXTERN.h sed >EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: EXTERN.h,v 2.0 88/06/05 00:07:46 root Exp $ X * X * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. X * X * $Log: EXTERN.h,v $ 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 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 * Copyright (c) 1989, Larry Wall X * X * You may distribute under the terms of the GNU General Public License X * as specified in the README file that comes with the perl 3.0 kit. X * X * $Log: INTERN.h,v $ 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 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; X X1; !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 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.1.1 88/08/03 22:45:14 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/op.cond sed >t/op.cond <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.cond,v 2.0 88/06/05 00:13:26 root Exp $ X Xprint "1..4\n"; X Xprint 1 ? "ok 1\n" : "not ok 1\n"; # compile time Xprint 0 ? "not ok 2\n" : "ok 2\n"; X X$x = 1; Xprint $x ? "ok 3\n" : "not ok 3\n"; # run time Xprint !$x ? "not ok 4\n" : "ok 4\n"; !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.1.1 88/09/07 17:04:35 lwall Locked $ 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 '$x'\n";} !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 "" echo "End of kit 23 (of 23)" cat /dev/null >kit23isdone run='' config='' for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23; 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