perl 3.0 beta kit [23/23]
Larry Wall
lwall at jato.Jpl.Nasa.Gov
Mon Sep 4 05:00:21 AEST 1989
#! /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 at 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 at 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, at 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 at foo = ("hi \n","there\n","!\n");
X at bar = @foo;
Xchop(@bar);
Xprint join('', at bar) eq 'hi there!' ? "ok 3\n" : "not ok 3\n";
X
X$foo = "\n";
Xchop($foo, at foo);
Xprint join('',$foo, at 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 at harry = ('dog','cat','x','Cain','Abel');
X at 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(' ', at 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(' ', at 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 at 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 at 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 at x = ("ok","12\nok","13\nok");
X at y = ("15\nok","16");
Xprint @x,"14\nok", at 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 at 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 at ops = <op.*>;
X$list = join(' ', at 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(' ', at 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 at ary = (1,-100,127,128,32767,12345,123456,"abcdef");
X$foo = pack($format, at ary);
X at ary2 = unpack($format,$foo);
X
Xprint ($#ary == $#ary2 ? "ok 1\n" : "not ok 1\n");
X
X$out1=join(':', at ary);
X$out2=join(':', at 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 at x = (1, 2, 3);
Xif (join(':', at 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 at a = (1,2,3);
X$cnt1 = unshift(a,0);
X
Xif (join(' ', at 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(' ', at 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 at x = (1,2,3);
Xpush(@x, at x);
Xif (join(':', at x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
Xpush(x,4);
Xif (join(':', at 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
More information about the Alt.sources
mailing list