Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume18/perl/part36

Internet Message Format | 1991-04-20 | 42.6 KB

From: [e-mail] (Larry Wall)
Newsgroups: comp.sources.misc
Subject: v18i054:  perl - The perl programming language, Part36/36
Message-ID: <[e-mail]>
Date: 19 Apr 91 01:50:19 GMT
Approved: [e-mail]
X-Checksum-Snefru: 8d9245f6 f3b5cf17 dd001411 a93566c4

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 18, Issue 54
Archive-name: perl/part36

[There are 36 kits for perl version 4.0.]

#! /bin/sh

# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 36 through sh.  When all 36 kits have been run, read README.

echo "This is perl 4.0 kit 36 (of 36).  If kit 36 is complete, the line"
echo '"'"End of kit 36 (of 36)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg eg/g eg/van h2pl h2pl/eg hints lib msdos os2 os2/eg t t/base t/cmd t/comp t/io t/op usub x2p 2>/dev/null
echo Extracting t/comp/cpp.t
sed >t/comp/cpp.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl -P
X
X# $Header: cpp.t,v 4.0 91/03/20 01:50:05 lwall Locked $
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.";
X
X($prog = <<'END') =~ s/X//g;
XX$ok = "not ok 3\n";
XX#include "Comp.cpp.inc"
XX#ifdef OK
XX$ok = OK;
XX#endif
XXprint $ok;
XEND
Xprint TRY $prog;
Xclose TRY;
X
Xopen(TRY,">Comp.cpp.inc") || (die "Can't open temp include file.");
Xprint TRY '#define OK "ok 3\n"' . "\n";
Xclose TRY;
X
X$pwd=`pwd`;
X$pwd =~ s/\n//;
X$x = `./perl -P Comp.cpp.tmp`;
Xprint $x;
Xunlink "Comp.cpp.tmp", "Comp.cpp.inc";
!STUFFY!FUNK!
echo Extracting t/comp/package.t
sed >t/comp/package.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
Xprint "1..7\n";
X
X$blurfl = 123;
X$foo = 3;
X
Xpackage XYZ;
X
X$bar = 4;
X
X{
X    package ABC;
X    $blurfl = 5;
X    $main'a = $'b;
X}
X
X$ABC'dyick = 6;
X
X$xyz = 2;
X
X$main = join(':', sort(keys _main));
X$XYZ = join(':', sort(keys _XYZ));
X$ABC = join(':', sort(keys _ABC));
X
Xprint $XYZ eq 'ABC:XYZ:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$XYZ'\n";
Xprint $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2\n";
Xprint $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
Xpackage ABC;
Xprint $blurfl == 5 ? "ok 4\n" : "not ok 4\n";
Xeval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
Xeval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
Xprint $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
!STUFFY!FUNK!
echo Extracting array.h
sed >array.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: array.h,v 4.0 91/03/20 01:03:44 lwall Locked $
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:    array.h,v $
X * Revision 4.0  91/03/20  01:03:44  lwall
X * 4.0 baseline.
X *
X */
X
Xstruct atbl {
X    STR    **ary_array;
X    STR **ary_alloc;
X    STR *ary_magic;
X    int ary_max;
X    int ary_fill;
X    char ary_flags;
X};
X
X#define ARF_REAL 1    /* free old entries */
X
XSTR *afetch();
Xbool astore();
XSTR *apop();
XSTR *ashift();
Xvoid afree();
Xvoid aclear();
Xbool apush();
Xint alen();
XARRAY *anew();
XARRAY *afake();
!STUFFY!FUNK!
echo Extracting t/cmd/mod.t
sed >t/cmd/mod.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: mod.t,v 4.0 91/03/20 01:49:33 lwall Locked $
X
Xprint "1..7\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";}
X
Xopen(foo,'TEST') || open(foo,'t/TEST');
X$x = 0;
X$x++ while <foo>;
Xprint $x > 50 && $x < 1000 ? "ok 7\n" : "not ok 7\n";
!STUFFY!FUNK!
echo Extracting t/op/exp.t
sed >t/op/exp.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: exp.t,v 4.0 91/03/20 01:52:31 lwall Locked $
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 t/op/exec.t
sed >t/op/exec.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: exec.t,v 4.0 91/03/20 01:52:25 lwall Locked $
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 client
sed >client <<'!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$test = 2345;
X
X$SIG{'INT'} = 'dokill';
X
X$this = pack($pat,$inet,0,   128,149,13,43);
X$that = pack($pat,$inet,$test,127,0,0,1);
X
Xif (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; }
Xif (bind(S,$this)) { print "bind ok\n"; } else { die $!; }
Xif (connect(S,$that)) { print "connect ok\n"; } else { die $!; }
X
Xselect(S); $| = 1; select(stdout);
X
Xif ($child = fork) {
X    while (<STDIN>) {
X    print S;
X    }
X    sleep 3;
X    do dokill();
X}
Xelse {
X    while (<S>) {
X    print;
X    }
X}
X
Xsub dokill { kill 9,$child if $child; }
!STUFFY!FUNK!
echo Extracting t/op/goto.t
sed >t/op/goto.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: goto.t,v 4.0 91/03/20 01:52:52 lwall Locked $
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 t/op/pack.t
sed >t/op/pack.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: pack.t,v 4.0 91/03/20 01:53:57 lwall Locked $
X
Xprint "1..3\n";
X
X$format = "c2x5CCxsdila6";
X# Need the expression in here to force ary[5] to be numeric.  This avoids
X# test2 failing because ary2 goes str->numeric->str and ary doesn't.
X@ary = (1,-100,127,128,32767,987.654321098 / 100.0,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/shmkill
sed >eg/shmkill <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: shmkill,v 4.0 91/03/20 01:14:20 lwall Locked $
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 4.0 91/03/20 01:11:04 lwall Locked $
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 h2pl/cbreak.pl
sed >h2pl/cbreak.pl <<'!STUFFY!FUNK!' -e 's/X//'
X$sgttyb_t   = 'C4 S';
X
Xsub cbreak {
X    &set_cbreak(1);
X}
X
Xsub cooked {
X    &set_cbreak(0);
X}
X
Xsub set_cbreak {
X    local($on) = @_;
X
X    require 'sizeof.ph';
X    require 'sys/ioctl.ph';
X
X    ioctl(STDIN,&TIOCGETP,$sgttyb)
X        || die "Can't ioctl TIOCGETP: $!";
X
X    @ary = unpack($sgttyb_t,$sgttyb);
X    if ($on) {
X        $ary[4] |= &CBREAK;
X        $ary[4] &= ~&ECHO;
X    } else {
X        $ary[4] &= ~&CBREAK;
X        $ary[4] |= &ECHO;
X    }
X    $sgttyb = pack($sgttyb_t,@ary);
X    ioctl(STDIN,&TIOCSETP,$sgttyb)
X            || die "Can't ioctl TIOCSETP: $!";
X
X}
X
X1;
!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 t/op/flip.t
sed >t/op/flip.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: flip.t,v 4.0 91/03/20 01:52:36 lwall Locked $
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 4.0 91/03/20 01:09:20 lwall Locked $
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 lib/abbrev.pl
sed >lib/abbrev.pl <<'!STUFFY!FUNK!' -e 's/X//'
X;# Usage:
X;#    %foo = ();
X;#    &abbrev(*foo,LIST);
X;#    ...
X;#    $long = $foo{$short};
X
Xpackage abbrev;
X
Xsub main'abbrev {
X    local(*domain) = @_;
X    shift(@_);
X    @cmp = @_;
X    local($[) = 0;
X    foreach $name (@_) {
X    @extra = split(//,$name);
X    $abbrev = shift(@extra);
X    $len = 1;
X    foreach $cmp (@cmp) {
X        next if $cmp eq $name;
X        while (substr($cmp,0,$len) eq $abbrev) {
X        $abbrev .= shift(@extra);
X        ++$len;
X        }
X    }
X    $domain{$abbrev} = $name;
X    while ($#extra >= 0) {
X        $abbrev .= shift(@extra);
X        $domain{$abbrev} = $name;
X    }
X    }
X}
X
X1;
!STUFFY!FUNK!
echo Extracting t/op/chop.t
sed >t/op/chop.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: chop.t,v 4.0 91/03/20 01:51:42 lwall Locked $
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 h2pl/cbreak2.pl
sed >h2pl/cbreak2.pl <<'!STUFFY!FUNK!' -e 's/X//'
X$sgttyb_t   = 'C4 S';
X
Xsub cbreak {
X    &set_cbreak(1);
X}
X
Xsub cooked {
X    &set_cbreak(0);
X}
X
Xsub set_cbreak {
X    local($on) = @_;
X
X    require 'sys/ioctl.pl';
X
X    ioctl(STDIN,$TIOCGETP,$sgttyb)
X        || die "Can't ioctl TIOCGETP: $!";
X
X    @ary = unpack($sgttyb_t,$sgttyb);
X    if ($on) {
X        $ary[4] |= $CBREAK;
X        $ary[4] &= ~$ECHO;
X    } else {
X        $ary[4] &= ~$CBREAK;
X        $ary[4] |= $ECHO;
X    }
X    $sgttyb = pack($sgttyb_t,@ary);
X    ioctl(STDIN,$TIOCSETP,$sgttyb)
X            || die "Can't ioctl TIOCSETP: $!";
X
X}
X
X1;
!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/io/dup.t
sed >t/io/dup.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: dup.t,v 4.0 91/03/20 01:50:49 lwall Locked $
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 os2/perl.cs
sed >os2/perl.cs <<'!STUFFY!FUNK!' -e 's/X//'
X(-W1 -Od -Olt -DDEBUGGING -Gt2048
Xarray.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
Xhash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
X)
X(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
X(-W1 -Od -Olt -I. -Ios2
Xos2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c os2\alarm.c
X)
X
X; link with this library if you have GNU gdbm for OS/2
X; remember to enable the NDBM symbol in config.h before compiling
Xlgdbm.lib
Xsetargv.obj
Xos2\perl.def
Xos2\perl.bad
Xperl.exe
X
X-AL -LB -S0x8000
!STUFFY!FUNK!
echo Extracting t/cmd/elsif.t
sed >t/cmd/elsif.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: elsif.t,v 4.0 91/03/20 01:49:21 lwall Locked $
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.t
sed >t/comp/script.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: script.t,v 4.0 91/03/20 01:50:26 lwall Locked $
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/comp/decl.t
sed >t/comp/decl.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: decl.t,v 4.0 91/03/20 01:50:09 lwall Locked $
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.t
sed >t/op/append.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: append.t,v 4.0 91/03/20 01:51:23 lwall Locked $
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 t/op/glob.t
sed >t/op/glob.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: glob.t,v 4.0 91/03/20 01:52:49 lwall Locked $
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 t/op/mkdir.t
sed >t/op/mkdir.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: mkdir.t,v 4.0 91/03/20 01:53:39 lwall Locked $
X
Xprint "1..7\n";
X
X`rm -rf blurfl`;
X
Xprint (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
Xprint (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
Xprint ($! =~ /exist/ ? "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 ($! =~ /such|exist/ ? "ok 7\n" : "not ok 7\n");
!STUFFY!FUNK!
echo Extracting t/io/inplace.t
sed >t/io/inplace.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X$^I = '.bak';
X
X# $Header: inplace.t,v 4.0 91/03/20 01:50:59 lwall Locked $
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 t/io/print.t
sed >t/io/print.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: print.t,v 4.0 91/03/20 01:51:08 lwall Locked $
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 eg/van/vanexp
sed >eg/van/vanexp <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: vanexp,v 4.0 91/03/20 01:15:54 lwall Locked $
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 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 eg/g/ged
sed >eg/g/ged <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: ged,v 4.0 91/03/20 01:10:22 lwall Locked $
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 x2p/EXTERN.h
sed >x2p/EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: EXTERN.h,v 4.0 91/03/20 01:56:53 lwall Locked $
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 4.0  91/03/20  01:56:53  lwall
X * 4.0 baseline.
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 EXTERN.h
sed >EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: EXTERN.h,v 4.0 91/03/20 00:58:26 lwall Locked $
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 4.0  91/03/20  00:58:26  lwall
X * 4.0 baseline.
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 os2/perlsh.cmd
sed >os2/perlsh.cmd <<'!STUFFY!FUNK!' -e 's/X//'
Xextproc perl -x
X#!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
Xprint "Perl shell\n> ";
X
X$/ = '';    # set paragraph mode
X$SHlinesep = "\n";
X
Xwhile ($SHcmd = <>) {
X    $/ = $SHlinesep;
X    eval $SHcmd; print $@ || "\n> ";
X    $SHlinesep = $/; $/ = '';
X}
!STUFFY!FUNK!
echo Extracting x2p/INTERN.h
sed >x2p/INTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: INTERN.h,v 4.0 91/03/20 01:56:58 lwall Locked $
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 4.0  91/03/20  01:56:58  lwall
X * 4.0 baseline.
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 4.0 91/03/20 00:58:35 lwall Locked $
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 4.0  91/03/20  00:58:35  lwall
X * 4.0 baseline.
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 os2/mktemp.c
sed >os2/mktemp.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* MKTEMP.C using TMP environment variable */
X
X#include <stdio.h>
X#include <stdlib.h>
X#include <string.h>
X#include <io.h>
X
Xvoid Mktemp(char *file)
X{
X  char fname[32], *tmp;
X
X  tmp = getenv("TMP");
X
X  if ( tmp != NULL )
X  {
X    strcpy(fname, file);
X    strcpy(file, tmp);
X
X    if ( file[strlen(file) - 1] != '\\' )
X      strcat(file, "\\");
X
X    strcat(file, fname);
X  }
X
X  mktemp(file);
X}
X
X/* End of MKTEMP.C */
!STUFFY!FUNK!
echo Extracting t/op/int.t
sed >t/op/int.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: int.t,v 4.0 91/03/20 01:53:08 lwall Locked $
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 h2pl/eg/sizeof.ph
sed >h2pl/eg/sizeof.ph <<'!STUFFY!FUNK!' -e 's/X//'
X$sizeof{'char'} = 1;
X$sizeof{'int'} = 4;
X$sizeof{'long'} = 4;
X$sizeof{'struct arpreq'} = 36;
X$sizeof{'struct ifconf'} = 8;
X$sizeof{'struct ifreq'} = 32;
X$sizeof{'struct ltchars'} = 6;
X$sizeof{'struct pcntl'} = 116;
X$sizeof{'struct rtentry'} = 52;
X$sizeof{'struct sgttyb'} = 6;
X$sizeof{'struct tchars'} = 6;
X$sizeof{'struct ttychars'} = 14;
X$sizeof{'struct winsize'} = 8;
X$sizeof{'struct termios'} = 132;
!STUFFY!FUNK!
echo Extracting t/base/cond.t
sed >t/base/cond.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cond.t,v 4.0 91/03/20 01:48:54 lwall Locked $
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 usub/Makefile
sed >usub/Makefile <<'!STUFFY!FUNK!' -e 's/X//'
XSRC = /usr/local/src/perl
XGLOBINCS =
XLOCINCS =
XLIBS = -lcurses -ltermlib
X
Xcurseperl: $(SRC)/uperl.o usersub.o curses.o
X    cc $(SRC)/uperl.o usersub.o curses.o $(LIBS) -lm -o curseperl
X
Xusersub.o: usersub.c
X    cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g usersub.c
X
Xcurses.o: curses.c
X    cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g curses.c
X
Xcurses.c: curses.mus
X    mus curses.mus >curses.c
!STUFFY!FUNK!
echo Extracting lib/flush.pl
sed >lib/flush.pl <<'!STUFFY!FUNK!' -e 's/X//'
X;# Usage: &flush(FILEHANDLE)
X;# flushes the named filehandle
X
X;# Usage: &printflush(FILEHANDLE, "prompt: ")
X;# prints arguments and flushes filehandle
X
Xsub flush {
X    local($old) = select(shift);
X    $| = 1;
X    print "";
X    $| = 0;
X    select($old);
X}
X
Xsub printflush {
X    local($old) = select(shift);
X    $| = 1;
X    print @_;
X    $| = 0;
X    select($old);
X}
X
X1;
!STUFFY!FUNK!
echo Extracting t/op/groups.t
sed >t/op/groups.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
Xif (! -x '/usr/ucb/groups') {
X    print "1..0\n";
X    exit 0;
X}
X
Xprint "1..1\n";
X
Xfor (split(' ', $()) {
X    next if $seen{$_}++;
X    push(@gr, (getgrgid($_))[0]);
X}
X$gr1 = join(' ',sort @gr);
X$gr2 = join(' ', sort split(' ',`groups`));
X#print "gr1 is <$gr1>\n";
X#print "gr2 is <$gr2>\n";
Xprint +($gr1 eq $gr2) ? "ok 1\n" : "not ok 1\n";
!STUFFY!FUNK!
echo Extracting lib/importenv.pl
sed >lib/importenv.pl <<'!STUFFY!FUNK!' -e 's/X//'
X;# $Header: importenv.pl,v 4.0 91/03/20 01:25:28 lwall Locked $
X
X;# This file, when interpreted, pulls the environment into normal variables.
X;# Usage:
X;#    require '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.t
sed >t/op/join.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: join.t,v 4.0 91/03/20 01:53:17 lwall Locked $
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 usub/usersub.c
sed >usub/usersub.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: usersub.c,v 4.0 91/03/20 01:56:34 lwall Locked $
X *
X * $Log:    usersub.c,v $
X * Revision 4.0  91/03/20  01:56:34  lwall
X * 4.0 baseline.
X *
X * Revision 3.0.1.1  90/08/09  04:06:10  lwall
X * patch19: Initial revision
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
Xint
Xuserinit()
X{
X    init_curses();
X}
X
!STUFFY!FUNK!
echo Extracting h2pl/eg/sysexits.pl
sed >h2pl/eg/sysexits.pl <<'!STUFFY!FUNK!' -e 's/X//'
X$EX_OK = 0x0;
X$EX__BASE = 0x40;
X$EX_USAGE = 0x40;
X$EX_DATAERR = 0x41;
X$EX_NOINPUT = 0x42;
X$EX_NOUSER = 0x43;
X$EX_NOHOST = 0x44;
X$EX_UNAVAILABLE = 0x45;
X$EX_SOFTWARE = 0x46;
X$EX_OSERR = 0x47;
X$EX_OSFILE = 0x48;
X$EX_CANTCREAT = 0x49;
X$EX_IOERR = 0x4A;
X$EX_TEMPFAIL = 0x4B;
X$EX_PROTOCOL = 0x4C;
X$EX_NOPERM = 0x4D;
!STUFFY!FUNK!
echo Extracting t/op/unshift.t
sed >t/op/unshift.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: unshift.t,v 4.0 91/03/20 01:55:21 lwall Locked $
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.t
sed >t/op/oct.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: oct.t,v 4.0 91/03/20 01:53:43 lwall Locked $
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 os2/eg/syscalls.pl
sed >os2/eg/syscalls.pl <<'!STUFFY!FUNK!' -e 's/X//'
X# OS/2 syscall values
X
X$OS2_GetVersion = 0;
X$OS2_Shutdown = 1;
X$OS2_Beep = 2;
X$OS2_PhysicalDisk = 3;
X$OS2_Config = 4;
X$OS2_IOCtl = 5;
X$OS2_QCurDisk = 6;
X$OS2_SelectDisk = 7;
X$OS2_SetMaxFH = 8;
X$OS2_Sleep = 9;
X$OS2_StartSession = 10;
X$OS2_StopSession = 11;
X$OS2_SelectSession = 12;
X1;
!STUFFY!FUNK!
echo Extracting t/op/ord.t
sed >t/op/ord.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: ord.t,v 4.0 91/03/20 01:53:50 lwall Locked $
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 msdos/glob.c
sed >msdos/glob.c <<'!STUFFY!FUNK!' -e 's/X//'
X/*
X * Globbing for MS-DOS.  Relies on the expansion done by the library
X * startup code. (dds)
X */
X
X#include <stdio.h>
X#include <string.h>
X
Xmain(int argc, char *argv[])
X{
X    register i;
X
X    for (i = 1; i < argc; i++) {
X        fputs(strlwr(argv[i]), stdout);
X        putchar(0);
X    }
X}
!STUFFY!FUNK!
echo Extracting t/base/if.t
sed >t/base/if.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: if.t,v 4.0 91/03/20 01:49:03 lwall Locked $
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.t
sed >t/base/pat.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: pat.t,v 4.0 91/03/20 01:49:12 lwall Locked $
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 t/op/cond.t
sed >t/op/cond.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cond.t,v 4.0 91/03/20 01:51:47 lwall Locked $
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 h2pl/getioctlsizes
sed >h2pl/getioctlsizes <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
Xopen (IOCTLS,'/usr/include/sys/ioctl.h') || die "ioctl open failed";
X
Xwhile (<IOCTLS>) {
X    if (/^\s*#\s*define\s+\w+\s+_IO(R|W|WR)\(\w+,\s*\w+,\s*([^)]+)/) {
X    $need{$2}++;
X    }
X}
X
Xforeach $key ( sort keys %need ) {
X    print $key,"\n";
X}
!STUFFY!FUNK!
echo Extracting os2/eg/alarm.pl
sed >os2/eg/alarm.pl <<'!STUFFY!FUNK!' -e 's/X//'
Xsub handler {
X  local($sig) = @_;
X  print "Caught a SIG$sig -- shutting down\n";
X  exit(0);
X}
X
X$SIG{'INT'} = 'handler';
X$SIG{'QUIT'} = 'handler';
X$SIG{'ALRM'} = 'handler';
X
Xprint "Starting execution ...\n";
Xalarm(10);
X
Xwhile ( <> ) {
X}
Xprint "Normal exit.\n";
!STUFFY!FUNK!
echo Extracting t/op/sprintf.t
sed >t/op/sprintf.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: sprintf.t,v 4.0 91/03/20 01:54:46 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 4.0 91/03/20 01:08:34 lwall Locked $
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 hints/sunos_4_0_1.sh
sed >hints/sunos_4_0_1.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xecho ': work around botch in SunOS 4.0.1 and 4.0.2'    >>../perl.h
Xecho '#ifndef fputs'                    >>../perl.h
Xecho '#define fputs(str,fp) fprintf(fp,"%s",str)'    >>../perl.h
Xecho '#endif'                        >>../perl.h
!STUFFY!FUNK!
echo Extracting hints/sunos_4_0_2.sh
sed >hints/sunos_4_0_2.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xecho ': work around botch in SunOS 4.0.1 and 4.0.2'    >>../perl.h
Xecho '#ifndef fputs'                    >>../perl.h
Xecho '#define fputs(str,fp) fprintf(fp,"%s",str)'    >>../perl.h
Xecho '#endif'                        >>../perl.h
!STUFFY!FUNK!
echo Extracting h2pl/tcbreak
sed >h2pl/tcbreak <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
Xrequire 'cbreak.pl';
X
X&cbreak;
X
X$| = 1;
X
Xprint "gimme a char: ";
X
X$c = getc;
X
Xprint "$c\n";
X
Xprintf "you gave me `%s', which is 0x%02x\n", $c, ord($c);
X
X&cooked;
!STUFFY!FUNK!
echo Extracting t/op/sleep.t
sed >t/op/sleep.t <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: sleep.t,v 4.0 91/03/20 01:54:34 lwall Locked $
X
Xprint "1..1\n";
X
X$x = sleep 2;
Xif ($x >= 2 && $x <= 10) {print "ok 1\n";} else {print "not ok 1 $x\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 4.0 91/03/20 01:12:02 lwall Locked $
X
X# A handy (but dangerous) script to put after a find ... -print.
X
Xchop; unlink;
!STUFFY!FUNK!
echo Extracting hints/hpux.sh
sed >hints/hpux.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xd_syscall=$undef
Xecho " "
Xecho "NOTE: regression test op.read may fail due to an NFS bug in HP/UX."
Xecho "If so, don't worry about it."
!STUFFY!FUNK!
echo Extracting hints/sgi.sh
sed >hints/sgi.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='-O0'
Xusemymalloc='y'
Xmallocsrc='malloc.c'
Xmallocobj='malloc.o'
Xccflags="$ccflags -Uf_next"
Xd_voidsig=define
Xd_vfork=undef
!STUFFY!FUNK!
echo Extracting os2/a2p.cs
sed >os2/a2p.cs <<'!STUFFY!FUNK!' -e 's/X//'
X(-W1 -Od -Ocgelt a2p.y{a2py.c})
X(-W1 -Od -Ocgelt hash.c str.c util.c walk.c)
X
Xsetargv.obj
X..\os2\a2p.def
Xa2p.exe
X
X-AL -LB -S0x9000
!STUFFY!FUNK!
echo Extracting os2/selfrun.cmd
sed >os2/selfrun.cmd <<'!STUFFY!FUNK!' -e 's/X//'
Xextproc perl -x
X#!perl
X
Xprintf "
XThis is a self-running perl script using the
Xextproc feature of the OS/2 command processor.
X"
!STUFFY!FUNK!
echo Extracting os2/perlglob.cs
sed >os2/perlglob.cs <<'!STUFFY!FUNK!' -e 's/X//'
Xos2\glob.c
X(-DPERLGLOB os2\director.c)
X
Xsetargv.obj
Xos2\perlglob.def
Xos2\perlglob.bad
Xperlglob.exe
X
X-AS -LB -S0x1000
!STUFFY!FUNK!
echo Extracting os2/selfrun.bat
sed >os2/selfrun.bat <<'!STUFFY!FUNK!' -e 's/X//'
X@echo off
Xperl -x %0.bat
Xgoto exit
X#!perl
X
Xprintf "
XThis is a self-running perl script for DOS.
X
X"
X
X__END__
X:exit
!STUFFY!FUNK!
echo Extracting hints/mips.sh
sed >hints/mips.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='-g'
Xd_volatile=undef
Xd_castneg=undef
Xcc=cc
Xlibpth="/usr/lib/cmplrs/cc $libpth"
Xgroupstype=int
!STUFFY!FUNK!
echo Extracting os2/perl.bad
sed >os2/perl.bad <<'!STUFFY!FUNK!' -e 's/X//'
XDOSMAKEPIPE
XDOSCWAIT
XDOSKILLPROCESS
XDOSFLAGPROCESS
XDOSSETPRTY
XDOSGETPRTY
XDOSQFSATTACH
XDOSCREATETHREAD
!STUFFY!FUNK!
echo Extracting hints/next.sh
sed >hints/next.sh <<'!STUFFY!FUNK!' -e 's/X//'
X: Just disable defaulting to -fpcc-struct-return, since gcc is native compiler.
Xccflags="$ccflags "
!STUFFY!FUNK!
echo Extracting os2/perlglob.def
sed >os2/perlglob.def <<'!STUFFY!FUNK!' -e 's/X//'
XNAME PERLGLOB WINDOWCOMPAT NEWFILES
XDESCRIPTION 'Filename globbing for PERL - for MS-DOS and OS/2'
!STUFFY!FUNK!
echo Extracting os2/a2p.def
sed >os2/a2p.def <<'!STUFFY!FUNK!' -e 's/X//'
XNAME AWK2PERL WINDOWCOMPAT NEWFILES
XDESCRIPTION 'AWK to PERL translator - for MS-DOS and OS/2'
!STUFFY!FUNK!
echo Extracting hints/sco_3.sh
sed >hints/sco_3.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xyacc='/usr/bin/yacc -Sm11000'
Xlibswanted=`echo $libswanted | sed 's/ x / /'`
Xi_varargs=undef
!STUFFY!FUNK!
echo Extracting os2/perl.def
sed >os2/perl.def <<'!STUFFY!FUNK!' -e 's/X//'
XNAME PERL WINDOWCOMPAT NEWFILES
XDESCRIPTION 'PERL 3.0 - for MS-DOS and OS/2'
!STUFFY!FUNK!
echo Extracting hints/sco_2_3_2.sh
sed >hints/sco_2_3_2.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xyacc='/usr/bin/yacc -m25000'
Xlibswanted=`echo $libswanted | sed 's/ x / /'`
!STUFFY!FUNK!
echo Extracting hints/sco_2_3_3.sh
sed >hints/sco_2_3_3.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xyacc='/usr/bin/yacc -m25000'
Xlibswanted=`echo $libswanted | sed 's/ x / /'`
!STUFFY!FUNK!
echo Extracting Wishlist
sed >Wishlist <<'!STUFFY!FUNK!' -e 's/X//'
Xbuilt-in cpp
Xperl to C translator
Xmulti-threading
!STUFFY!FUNK!
echo Extracting os2/alarm.h
sed >os2/alarm.h <<'!STUFFY!FUNK!' -e 's/X//'
X#define SIGALRM SIGUSR1
Xunsigned alarm(unsigned);
!STUFFY!FUNK!
echo Extracting hints/aux.sh
sed >hints/aux.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='-O'
Xccflags="$ccflags -B/usr/lib/bin/'
!STUFFY!FUNK!
echo Extracting hints/ultrix_3.sh
sed >hints/ultrix_3.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xccflags="$ccflags -DLANGUAGE_C"
Xd_waitpid=$undef
!STUFFY!FUNK!
echo Extracting hints/ncr_tower.sh
sed >hints/ncr_tower.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xccflags="$ccflags -W2,-Sl,2000"
Xd_mkdir=$undef
!STUFFY!FUNK!
echo Extracting hints/hp9000_400.sh
sed >hints/hp9000_400.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='+O1'
Xccflags="$ccflags -Wc,-Nw500"
!STUFFY!FUNK!
echo Extracting hints/ultrix_4.sh
sed >hints/ultrix_4.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xccflags="$ccflags -DLANGUAGE_C -Olimit 2900"
!STUFFY!FUNK!
echo Extracting hints/hp9000_300.sh
sed >hints/hp9000_300.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='+O1'
Xccflags="$ccflags -Wc,-Nw500"
!STUFFY!FUNK!
echo Extracting hints/sco_2_3_1.sh
sed >hints/sco_2_3_1.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xyacc='/usr/bin/yacc -m25000'
Xi_dirent=undef
!STUFFY!FUNK!
echo Extracting hints/sco_2_3_0.sh
sed >hints/sco_2_3_0.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xyacc='/usr/bin/yacc -m25000'
Xi_dirent=undef
!STUFFY!FUNK!
echo Extracting hints/sunos_3_4.sh
sed >hints/sunos_3_4.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xusemymalloc=n
Xmallocsrc=''
Xmallocobj=''
!STUFFY!FUNK!
echo Extracting hints/sunos_3_5.sh
sed >hints/sunos_3_5.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xusemymalloc=n
Xmallocsrc=''
Xmallocobj=''
!STUFFY!FUNK!
echo Extracting hints/aix_rt.sh
sed >hints/aix_rt.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xccflags="$ccflags -a -DCRIPPLED_CC"
!STUFFY!FUNK!
echo Extracting hints/fps.sh
sed >hints/fps.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xccflags="$ccflags -J -DBADSWITCH"
!STUFFY!FUNK!
echo Extracting hints/osf_1.sh
sed >hints/osf_1.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xccflags="$ccflags -D_BSD"
!STUFFY!FUNK!
echo Extracting hints/i386.sh
sed >hints/i386.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xldflags='-L/usr/ucblib'
!STUFFY!FUNK!
echo Extracting hints/apollo_C6_7.sh
sed >hints/apollo_C6_7.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='-opt 2'
!STUFFY!FUNK!
echo Extracting hints/genix.sh
sed >hints/genix.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xi_varargs=undef
!STUFFY!FUNK!
echo Extracting hints/dynix.sh
sed >hints/dynix.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xd_castneg=undef
!STUFFY!FUNK!
echo Extracting hints/3b2.sh
sed >hints/3b2.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='-g'
!STUFFY!FUNK!
echo Extracting hints/dnix.sh
sed >hints/dnix.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='-g'
!STUFFY!FUNK!
echo Extracting hints/aix_rs.sh
sed >hints/aix_rs.sh <<'!STUFFY!FUNK!' -e 's/X//'
Xoptimize='-g'
!STUFFY!FUNK!
echo Extracting os2/perlglob.bad
sed >os2/perlglob.bad <<'!STUFFY!FUNK!' -e 's/X//'
XDOSQFSATTACH
!STUFFY!FUNK!
echo " "
echo "End of kit 36 (of 36)"
cat /dev/null >kit36isdone
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 24 25 26 27 28 29 30 31 32 33 34 35 36; 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."
    for combo in *:AA; do
        if test -f "$combo"; then
        realfile=`basename $combo :AA`
        cat $realfile:[A-Z][A-Z] >$realfile
        rm -rf $realfile:[A-Z][A-Z]
        fi
    done
    rm -rf kit*isdone
    chmod 755 Configure
    ;;
    *)  echo "You have run$run."
    echo "You still need to run$todo."
    ;;
esac
: Someone might mail this, so...
exit

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].