Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/unix/volume20/perl3.0/part08

Internet Message Format | 1989-10-30 | 48.7 KB

Subject:  v20i091:  Perl, a language with features of C/sed/awk/shell/etc, Part08/24
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

Submitted-by: Larry Wall <[e-mail]>
Posting-number: Volume 20, Issue 91
Archive-name: perl3.0/part08

#! /bin/sh

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

echo "This is perl 3.0 kit 8 (of 24).  If kit 8 is complete, the line"
echo '"'"End of kit 8 (of 24)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir t 2>/dev/null
echo Extracting perl.man.3
sed >perl.man.3 <<'!STUFFY!FUNK!' -e 's/X//'
X''' Beginning of part 3
X''' $Header: perl.man.3,v 3.0 89/10/18 15:21:46 lwall Locked $
X'''
X''' $Log:    perl.man.3,v $
X''' Revision 3.0  89/10/18  15:21:46  lwall
X''' 3.0 baseline
X'''
X.Ip "next LABEL" 8 8
X.Ip "next" 8
XThe
X.I next
Xcommand is like the
X.I continue
Xstatement in C; it starts the next iteration of the loop:
X.nf
X
X.ne 4
X    line: while (<STDIN>) {
X        next line if /\|^#/;    # discard comments
X        .\|.\|.
X    }
X
X.fi
XNote that if there were a
X.I continue
Xblock on the above, it would get executed even on discarded lines.
XIf the LABEL is omitted, the command refers to the innermost enclosing loop.
X.Ip "oct(EXPR)" 8 4
X.Ip "oct EXPR" 8
XReturns the decimal value of EXPR interpreted as an octal string.
X(If EXPR happens to start off with 0x, interprets it as a hex string instead.)
XThe following will handle decimal, octal and hex in the standard notation:
X.nf
X
X    $val = oct($val) if $val =~ /^0/;
X
X.fi
XIf EXPR is omitted, uses $_.
X.Ip "open(FILEHANDLE,EXPR)" 8 8
X.Ip "open(FILEHANDLE)" 8
X.Ip "open FILEHANDLE" 8
XOpens the file whose filename is given by EXPR, and associates it with
XFILEHANDLE.
XIf FILEHANDLE is an expression, its value is used as the name of the
Xreal filehandle wanted.
XIf EXPR is omitted, the scalar variable of the same name as the FILEHANDLE
Xcontains the filename.
XIf the filename begins with \*(L"<\*(R" or nothing, the file is opened for
Xinput.
XIf the filename begins with \*(L">\*(R", the file is opened for output.
XIf the filename begins with \*(L">>\*(R", the file is opened for appending.
X(You can put a \'+\' in front of the \'>\' or \'<\' to indicate that you
Xwant both read and write access to the file.)
XIf the filename begins with \*(L"|\*(R", the filename is interpreted
Xas a command to which output is to be piped, and if the filename ends
Xwith a \*(L"|\*(R", the filename is interpreted as command which pipes
Xinput to us.
X(You may not have a command that pipes both in and out.)
XOpening \'\-\' opens
X.I STDIN
Xand opening \'>\-\' opens
X.IR STDOUT .
XOpen returns non-zero upon success, the undefined value otherwise.
XIf the open involved a pipe, the return value happens to be the pid
Xof the subprocess.
XExamples:
X.nf
X
X.ne 3
X    $article = 100;
X    open article || die "Can't find article $article: $!\en";
X    while (<article>) {\|.\|.\|.
X
X    open(LOG, \'>>/usr/spool/news/twitlog\'\|);    # (log is reserved)
X
X    open(article, "caesar <$article |"\|);        # decrypt article
X
X    open(extract, "|sort >/tmp/Tmp$$"\|);        # $$ is our process#
X
X.ne 7
X    # process argument list of files along with any includes
X
X    foreach $file (@ARGV) {
X        do process($file, \'fh00\');    # no pun intended
X    }
X
X    sub process {
X        local($filename, $input) = @_;
X        $input++;        # this is a string increment
X        unless (open($input, $filename)) {
X            print STDERR "Can't open $filename: $!\en";
X            return;
X        }
X        while (<$input>) {        # note the use of indirection
X            if (/^#include "(.*)"/) {
X                do process($1, $input);
X                next;
X            }
X            .\|.\|.        # whatever
X        }
X    }
X
X.fi
XYou may also, in the Bourne shell tradition, specify an EXPR beginning
Xwith \*(L">&\*(R", in which case the rest of the string
Xis interpreted as the name of a filehandle
X(or file descriptor, if numeric) which is to be duped and opened.
XHere is a script that saves, redirects, and restores
X.I STDOUT
Xand
X.IR STDIN :
X.nf
X
X.ne 21
X    #!/usr/bin/perl
X    open(SAVEOUT, ">&STDOUT");
X    open(SAVEERR, ">&STDERR");
X
X    open(STDOUT, ">foo.out") || die "Can't redirect stdout";
X    open(STDERR, ">&STDOUT") || die "Can't dup stdout";
X
X    select(STDERR); $| = 1;        # make unbuffered
X    select(STDOUT); $| = 1;        # make unbuffered
X
X    print STDOUT "stdout 1\en";    # this works for
X    print STDERR "stderr 1\en";     # subprocesses too
X
X    close(STDOUT);
X    close(STDERR);
X
X    open(STDOUT, ">&SAVEOUT");
X    open(STDERR, ">&SAVEERR");
X
X    print STDOUT "stdout 2\en";
X    print STDERR "stderr 2\en";
X
X.fi
XIf you open a pipe on the command \*(L"\-\*(R", i.e. either \*(L"|\-\*(R" or \*(L"\-|\*(R",
Xthen there is an implicit fork done, and the return value of open
Xis the pid of the child within the parent process, and 0 within the child
Xprocess.
X(Use defined($pid) to determine if the open was successful.)
XThe filehandle behaves normally for the parent, but i/o to that
Xfilehandle is piped from/to the
X.IR STDOUT / STDIN
Xof the child process.
XIn the child process the filehandle isn't opened\*(--i/o happens from/to
Xthe new
X.I STDOUT
Xor
X.IR STDIN .
XTypically this is used like the normal piped open when you want to exercise
Xmore control over just how the pipe command gets executed, such as when
Xyou are running setuid, and don't want to have to scan shell commands
Xfor metacharacters.
XThe following pairs are equivalent:
X.nf
X
X.ne 5
X    open(FOO, "|tr \'[a\-z]\' \'[A\-Z]\'");
X    open(FOO, "|\-") || exec \'tr\', \'[a\-z]\', \'[A\-Z]\';
X
X    open(FOO, "cat \-n $file|");
X    open(FOO, "\-|") || exec \'cat\', \'\-n\', $file;
X
X.fi
XExplicitly closing any piped filehandle causes the parent process to wait for the
Xchild to finish, and returns the status value in $?.
X.Ip "opendir(DIRHANDLE,EXPR)" 8 3
XOpens a directory named EXPR for processing by readdir(), telldir(), seekdir(),
Xrewinddir() and closedir().
XReturns true if successful.
XDIRHANDLEs have their own namespace separate from FILEHANDLEs.
X.Ip "ord(EXPR)" 8 4
X.Ip "ord EXPR" 8
XReturns the ascii value of the first character of EXPR.
XIf EXPR is omitted, uses $_.
X.Ip "pack(TEMPLATE,LIST)" 8 4
XTakes an array or list of values and packs it into a binary structure,
Xreturning the string containing the structure.
XThe TEMPLATE is a sequence of characters that give the order and type
Xof values, as follows:
X.nf
X
X    A    An ascii string, will be space padded.
X    a    An ascii string, will be null padded.
X    c    A native char value.
X    C    An unsigned char value.
X    s    A signed short value.
X    S    An unsigned short value.
X    i    A signed integer value.
X    I    An unsigned integer value.
X    l    A signed long value.
X    L    An unsigned long value.
X    n    A short in \*(L"network\*(R" order.
X    N    A long in \*(L"network\*(R" order.
X    p    A pointer to a string.
X    x    A null byte.
X
X.fi
XEach letter may optionally be followed by a number which gives a repeat
Xcount.
XWith all types except "a" and "A" the pack function will gobble up that many values
Xfrom the LIST.
XThe "a" and "A" types gobble just one value, but pack it as a string that long,
Xpadding with nulls or spaces as necessary.
X(When unpacking, "A" strips trailing spaces and nulls, but "a" does not.)
XExamples:
X.nf
X
X    $foo = pack("cccc",65,66,67,68);
X    # foo eq "ABCD"
X    $foo = pack("c4",65,66,67,68);
X    # same thing
X
X    $foo = pack("ccxxcc",65,66,67,68);
X    # foo eq "AB\e0\e0CD"
X
X    $foo = pack("s2",1,2);
X    # "\e1\e0\e2\e0" on little-endian
X    # "\e0\e1\e0\e2" on big-endian
X
X    $foo = pack("a4","abcd","x","y","z");
X    # "abcd"
X
X    $foo = pack("aaaa","abcd","x","y","z");
X    # "axyz"
X
X    $foo = pack("a14","abcdefg");
X    # "abcdefg\e0\e0\e0\e0\e0\e0\e0"
X
X    $foo = pack("i9pl", gmtime());
X    # a real struct tm (on my system anyway)
X
X.fi
XThe same template may generally also be used in the unpack function.
X.Ip "pop(ARRAY)" 8
X.Ip "pop ARRAY" 8 6
XPops and returns the last value of the array, shortening the array by 1.
XHas the same effect as
X.nf
X
X    $tmp = $ARRAY[$#ARRAY\-\|\-];
X
X.fi
XIf there are no elements in the array, returns the undefined value.
X.Ip "print(FILEHANDLE LIST)" 8 10
X.Ip "print(LIST)" 8
X.Ip "print FILEHANDLE LIST" 8
X.Ip "print LIST" 8
X.Ip "print" 8
XPrints a string or a comma-separated list of strings.
XReturns non-zero if successful.
XFILEHANDLE may be a scalar variable name, in which case the variable contains
Xthe name of the filehandle, thus introducing one level of indirection.
XIf FILEHANDLE is omitted, prints by default to standard output (or to the
Xlast selected output channel\*(--see select()).
XIf LIST is also omitted, prints $_ to
X.IR STDOUT .
XTo set the default output channel to something other than
X.I STDOUT
Xuse the select operation.
X.Ip "printf(FILEHANDLE LIST)" 8 10
X.Ip "printf(LIST)" 8
X.Ip "printf FILEHANDLE LIST" 8
X.Ip "printf LIST" 8
XEquivalent to a \*(L"print FILEHANDLE sprintf(LIST)\*(R".
X.Ip "push(ARRAY,LIST)" 8 7
XTreats ARRAY (@ is optional) as a stack, and pushes the values of LIST
Xonto the end of ARRAY.
XThe length of ARRAY increases by the length of LIST.
XHas the same effect as
X.nf
X
X    for $value (LIST) {
X        $ARRAY[++$#ARRAY] = $value;
X    }
X
X.fi
Xbut is more efficient.
X.Ip "q/STRING/" 8 5
X.Ip "qq/STRING/" 8
XThese are not really functions, but simply syntactic sugar to let you
Xavoid putting too many backslashes into quoted strings.
XThe q operator is a generalized single quote, and the qq operator a
Xgeneralized double quote.
XAny delimiter can be used in place of /, including newline.
XIf the delimiter is an opening bracket or parenthesis, the final delimiter
Xwill be the corresponding closing bracket or parenthesis.
X(Embedded occurrences of the closing bracket need to be backslashed as usual.)
XExamples:
X.nf
X
X.ne 5
X    $foo = q!I said, "You said, \'She said it.\'"!;
X    $bar = q(\'This is it.\');
X    $_ .= qq
X*** The previous line contains the naughty word "$&".\en
X        if /(ibm|apple|awk)/;      # :-)
X
X.fi
X.Ip "rand(EXPR)" 8 8
X.Ip "rand EXPR" 8
X.Ip "rand" 8
XReturns a random fractional number between 0 and the value of EXPR.
X(EXPR should be positive.)
XIf EXPR is omitted, returns a value between 0 and 1.
XSee also srand().
X.Ip "read(FILEHANDLE,SCALAR,LENGTH)" 8 5
XAttempts to read LENGTH bytes of data into variable SCALAR from the specified
XFILEHANDLE.
XReturns the number of bytes actually read.
XSCALAR will be grown or shrunk to the length actually read.
X.Ip "readdir(DIRHANDLE)" 8 3
XReturns the next directory entry for a directory opened by opendir().
XIf used in an array context, returns all the rest of the entries in the
Xdirectory.
XIf there are no more entries, returns an undefined value in a scalar context
Xor a null list in an array context.
X.Ip "readlink(EXPR)" 8 6
X.Ip "readlink EXPR" 8
XReturns the value of a symbolic link, if symbolic links are implemented.
XIf not, gives a fatal error.
XIf there is some system error, returns the undefined value and sets $! (errno).
XIf EXPR is omitted, uses $_.
X.Ip "recv(SOCKET,SCALAR,LEN,FLAGS)" 8 4
XReceives a message on a socket.
XAttempts to receive LENGTH bytes of data into variable SCALAR from the specified
XSOCKET filehandle.
XReturns the address of the sender, or the undefined value if there's an error.
XSCALAR will be grown or shrunk to the length actually read.
XTakes the same flags as the system call of the same name.
X.Ip "redo LABEL" 8 8
X.Ip "redo" 8
XThe
X.I redo
Xcommand restarts the loop block without evaluating the conditional again.
XThe
X.I continue
Xblock, if any, is not executed.
XIf the LABEL is omitted, the command refers to the innermost enclosing loop.
XThis command is normally used by programs that want to lie to themselves
Xabout what was just input:
X.nf
X
X.ne 16
X    # a simpleminded Pascal comment stripper
X    # (warning: assumes no { or } in strings)
X    line: while (<STDIN>) {
X        while (s|\|({.*}.*\|){.*}|$1 \||) {}
X        s|{.*}| \||;
X        if (s|{.*| \||) {
X            $front = $_;
X            while (<STDIN>) {
X                if (\|/\|}/\|) {    # end of comment?
X                    s|^|$front{|;
X                    redo line;
X                }
X            }
X        }
X        print;
X    }
X
X.fi
X.Ip "rename(OLDNAME,NEWNAME)" 8 2
XChanges the name of a file.
XReturns 1 for success, 0 otherwise.
XWill not work across filesystem boundaries.
X.Ip "reset(EXPR)" 8 6
X.Ip "reset EXPR" 8
X.Ip "reset" 8
XGenerally used in a
X.I continue
Xblock at the end of a loop to clear variables and reset ?? searches
Xso that they work again.
XThe expression is interpreted as a list of single characters (hyphens allowed
Xfor ranges).
XAll variables and arrays beginning with one of those letters are reset to
Xtheir pristine state.
XIf the expression is omitted, one-match searches (?pattern?) are reset to
Xmatch again.
XOnly resets variables or searches in the current package.
XAlways returns 1.
XExamples:
X.nf
X
X.ne 3
X    reset \'X\';    \h'|2i'# reset all X variables
X    reset \'a\-z\';\h'|2i'# reset lower case variables
X    reset;    \h'|2i'# just reset ?? searches
X
X.fi
XNote: resetting \*(L"A\-Z\*(R" is not recommended since you'll wipe out your ARGV and ENV
Xarrays.
X.Sp
XThe use of reset on dbm associative arrays does not change the dbm file.
X(It does, however, flush any entries cached by perl, which may be useful if
Xyou are sharing the dbm file.
XThen again, maybe not.)
X.Ip "return LIST" 8 3
XReturns from a subroutine with the value specified.
X(Note that a subroutine can automatically return
Xthe value of the last expression evaluated.
XThat's the preferred method\*(--use of an explicit
X.I return
Xis a bit slower.)
X.Ip "reverse(LIST)" 8 4
X.Ip "reverse LIST" 8
XReturns an array value consisting of the elements of LIST in the opposite order.
X.Ip "rewinddir(DIRHANDLE)" 8 5
X.Ip "rewinddir DIRHANDLE" 8
XSets the current position to the beginning of the directory for the readdir() routine on DIRHANDLE.
X.Ip "rindex(STR,SUBSTR)" 8 4
XWorks just like index except that it
Xreturns the position of the LAST occurrence of SUBSTR in STR.
X.Ip "rmdir(FILENAME)" 8 4
X.Ip "rmdir FILENAME" 8
XDeletes the directory specified by FILENAME if it is empty.
XIf it succeeds it returns 1, otherwise it returns 0 and sets $! (errno).
XIf FILENAME is omitted, uses $_.
X.Ip "s/PATTERN/REPLACEMENT/gieo" 8 3
XSearches a string for a pattern, and if found, replaces that pattern with the
Xreplacement text and returns the number of substitutions made.
XOtherwise it returns false (0).
XThe \*(L"g\*(R" is optional, and if present, indicates that all occurrences
Xof the pattern are to be replaced.
XThe \*(L"i\*(R" is also optional, and if present, indicates that matching
Xis to be done in a case-insensitive manner.
XThe \*(L"e\*(R" is likewise optional, and if present, indicates that
Xthe replacement string is to be evaluated as an expression rather than just
Xas a double-quoted string.
XAny delimiter may replace the slashes; if single quotes are used, no
Xinterpretation is done on the replacement string (the e modifier overrides
Xthis, however).
XIf no string is specified via the =~ or !~ operator,
Xthe $_ string is searched and modified.
X(The string specified with =~ must be a scalar variable, an array element,
Xor an assignment to one of those, i.e. an lvalue.)
XIf the pattern contains a $ that looks like a variable rather than an
Xend-of-string test, the variable will be interpolated into the pattern at
Xrun-time.
XIf you only want the pattern compiled once the first time the variable is
Xinterpolated, add an \*(L"o\*(R" at the end.
XSee also the section on regular expressions.
XExamples:
X.nf
X
X    s/\|\e\|bgreen\e\|b/mauve/g;        # don't change wintergreen
X
X    $path \|=~ \|s|\|/usr/bin|\|/usr/local/bin|;
X
X    s/Login: $foo/Login: $bar/; # run-time pattern
X
X    ($foo = $bar) =~ s/bar/foo/;
X
X    $_ = \'abc123xyz\';
X    s/\ed+/$&*2/e;        # yields \*(L'abc246xyz\*(R'
X    s/\ed+/sprintf("%5d",$&)/e;    # yields \*(L'abc  246xyz\*(R'
X    s/\ew/$& x 2/eg;        # yields \*(L'aabbcc  224466xxyyzz\*(R'
X
X    s/\|([^ \|]*\|) *\|([^ \|]*\|)\|/\|$2 $1/;    # reverse 1st two fields
X
X.fi
X(Note the use of $ instead of \|\e\| in the last example.  See section
Xon regular expressions.)
X.Ip "seek(FILEHANDLE,POSITION,WHENCE)" 8 3
XRandomly positions the file pointer for FILEHANDLE, just like the fseek()
Xcall of stdio.
XFILEHANDLE may be an expression whose value gives the name of the filehandle.
XReturns 1 upon success, 0 otherwise.
X.Ip "seekdir(DIRHANDLE,POS)" 8 3
XSets the current position for the readdir() routine on DIRHANDLE.
XPOS must be a value returned by seekdir().
XHas the same caveats about possible directory compaction as the corresponding
Xsystem library routine.
X.Ip "select(FILEHANDLE)" 8 3
X.Ip "select" 8 3
XReturns the currently selected filehandle.
XSets the current default filehandle for output, if FILEHANDLE is supplied.
XThis has two effects: first, a
X.I write
Xor a
X.I print
Xwithout a filehandle will default to this FILEHANDLE.
XSecond, references to variables related to output will refer to this output
Xchannel.
XFor example, if you have to set the top of form format for more than
Xone output channel, you might do the following:
X.nf
X
X.ne 4
X    select(REPORT1);
X    $^ = \'report1_top\';
X    select(REPORT2);
X    $^ = \'report2_top\';
X
X.fi
XFILEHANDLE may be an expression whose value gives the name of the actual filehandle.
XThus:
X.nf
X
X    $oldfh = select(STDERR); $| = 1; select($oldfh);
X
X.fi
X.Ip "select(RBITS,WBITS,EBITS,TIMEOUT)" 8 3
XThis calls the select system call with the bitmasks specified, which can
Xbe constructed using fileno() and vec(), along these lines:
X.nf
X
X    $rin = $win = $ein = '';
X    vec($rin,fileno(STDIN),1) = 1;
X    vec($win,fileno(STDOUT),1) = 1;
X    $ein = $rin | $win;
X
X.fi
XIf you want to select on many filehandles you might wish to write a subroutine:
X.nf
X
X    sub fhbits {
X        local(@fhlist) = split(' ',$_[0]);
X        local($bits);
X        for (@fhlist) {
X        vec($bits,fileno($_),1) = 1;
X        }
X        $bits;
X    }
X    $rin = &fhbits('STDIN TTY SOCK');
X
X.fi
XThe usual idiom is:
X.nf
X
X    ($nfound,$timeleft) =
X      select($rout=$rin, $wout=$win, $eout=$ein, $timeout);
X
Xor to block until something becomes ready:
X
X    $nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
X
X.fi
XAny of the bitmasks can also be undef.
XThe timeout, if specified, is in seconds, which may be fractional.
X.Ip "setpgrp(PID,PGRP)" 8 4
XSets the current process group for the specified PID, 0 for the current
Xprocess.
XWill produce a fatal error if used on a machine that doesn't implement
Xsetpgrp(2).
X.Ip "send(SOCKET,MSG,FLAGS,TO)" 8 4
X.Ip "send(SOCKET,MSG,FLAGS)" 8
XSends a message on a socket.
XTakes the same flags as the system call of the same name.
XOn unconnected sockets you must specify a destination to send TO.
XReturns the number of characters sent, or the undefined value if
Xthere is an error.
X.Ip "setpriority(WHICH,WHO,PRIORITY)" 8 4
XSets the current priority for a process, a process group, or a user.
X(See setpriority(2).)
XWill produce a fatal error if used on a machine that doesn't implement
Xsetpriority(2).
X.Ip "setsockopt(SOCKET,LEVEL,OPTNAME,OPTVAL)" 8 3
XSets the socket option requested.
XReturns undefined if there is an error.
XOPTVAL may be specified as undef if you don't want to pass an argument.
X.Ip "shift(ARRAY)" 8 6
X.Ip "shift ARRAY" 8
X.Ip "shift" 8
XShifts the first value of the array off and returns it,
Xshortening the array by 1 and moving everything down.
XIf there are no elements in the array, returns the undefined value.
XIf ARRAY is omitted, shifts the @ARGV array in the main program, and the @_
Xarray in subroutines.
XSee also unshift(), push() and pop().
XShift() and unshift() do the same thing to the left end of an array that push()
Xand pop() do to the right end.
X.Ip "shutdown(SOCKET,HOW)" 8 3
XShuts down a socket connection in the manner indicated by HOW, which has
Xthe same interpretation as in the system call of the same name.
X.Ip "sin(EXPR)" 8 4
X.Ip "sin EXPR" 8
XReturns the sine of EXPR (expressed in radians).
XIf EXPR is omitted, returns sine of $_.
X.Ip "sleep(EXPR)" 8 6
X.Ip "sleep EXPR" 8
X.Ip "sleep" 8
XCauses the script to sleep for EXPR seconds, or forever if no EXPR.
XMay be interrupted by sending the process a SIGALARM.
XReturns the number of seconds actually slept.
X.Ip "socket(SOCKET,DOMAIN,TYPE,PROTOCOL)" 8 3
XOpens a socket of the specified kind and attaches it to filehandle SOCKET.
XDOMAIN, TYPE and PROTOCOL are specified the same as for the system call
Xof the same name.
XYou may need to run makelib on sys/socket.h to get the proper values handy
Xin a perl library file.
XReturn true if successful.
XSee the example in the section on Interprocess Communication.
X.Ip "socketpair(SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL)" 8 3
XCreates an unnamed pair of sockets in the specified domain, of the specified
Xtype.
XDOMAIN, TYPE and PROTOCOL are specified the same as for the system call
Xof the same name.
XIf unimplemented, yields a fatal error.
XReturn true if successful.
X.Ip "sort(SUBROUTINE LIST)" 8 9
X.Ip "sort(LIST)" 8
X.Ip "sort SUBROUTINE LIST" 8
X.Ip "sort LIST" 8
XSorts the LIST and returns the sorted array value.
XNonexistent values of arrays are stripped out.
XIf SUBROUTINE is omitted, sorts in standard string comparison order.
XIf SUBROUTINE is specified, gives the name of a subroutine that returns
Xan integer less than, equal to, or greater than 0,
Xdepending on how the elements of the array are to be ordered.
XIn the interests of efficiency the normal calling code for subroutines
Xis bypassed, with the following effects: the subroutine may not be a recursive
Xsubroutine, and the two elements to be compared are passed into the subroutine
Xnot via @_ but as $a and $b (see example below).
XThey are passed by reference so don't modify $a and $b.
XSUBROUTINE may be a scalar variable name, in which case the value provides
Xthe name of the subroutine to use.
XExamples:
X.nf
X
X.ne 4
X    sub byage {
X        $age{$a} - $age{$b};    # presuming integers
X    }
X    @sortedclass = sort byage @class;
X
X.ne 9
X    sub reverse { $a lt $b ? 1 : $a gt $b ? \-1 : 0; }
X    @harry = (\'dog\',\'cat\',\'x\',\'Cain\',\'Abel\');
X    @george = (\'gone\',\'chased\',\'yz\',\'Punished\',\'Axed\');
X    print sort @harry;
X        # prints AbelCaincatdogx
X    print sort reverse @harry;
X        # prints xdogcatCainAbel
X    print sort @george, \'to\', @harry;
X        # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
X
X.fi
X.Ip "split(/PATTERN/,EXPR,LIMIT)" 8 8
X.Ip "split(/PATTERN/,EXPR)" 8 8
X.Ip "split(/PATTERN/)" 8
X.Ip "split" 8
XSplits a string into an array of strings, and returns it.
X(If not in an array context, returns the number of fields found and splits
Xinto the @_ array.)
XIf EXPR is omitted, splits the $_ string.
XIf PATTERN is also omitted, splits on whitespace (/[\ \et\en]+/).
XAnything matching PATTERN is taken to be a delimiter separating the fields.
X(Note that the delimiter may be longer than one character.)
XIf LIMIT is specified, splits into no more than that many fields (though it
Xmay split into fewer).
XIf LIMIT is unspecified, trailing null fields are stripped (which
Xpotential users of pop() would do well to remember).
XA pattern matching the null string (not to be confused with a null pattern,
Xwhich is one member of the set of patterns matching a null string)
Xwill split the value of EXPR into separate characters at each point it
Xmatches that way.
XFor example:
X.nf
X
X    print join(\':\', split(/ */, \'hi there\'));
X
X.fi
Xproduces the output \*(L'h:i:t:h:e:r:e\*(R'.
X.P
XThe NUM parameter can be used to partially split a line
X.nf
X
X    ($login, $passwd, $remainder) = split(\|/\|:\|/\|, $_, 3);
X
X.fi
X(When assigning to a list, if NUM is omitted, perl supplies a NUM one
Xlarger than the number of variables in the list, to avoid unnecessary work.
XFor the list above NUM would have been 4 by default.
XIn time critical applications it behooves you not to split into
Xmore fields than you really need.)
X.Sp
XIf the PATTERN contains parentheses, additional array elements are created
Xfrom each matching substring in the delimiter.
X.Sp
X    split(/([,-])/,"1-10,20");
X.Sp
Xproduces the array value
X.Sp
X    (1,'-',10,',',20)
X.Sp
XThe pattern /PATTERN/ may be replaced with an expression to specify patterns
Xthat vary at runtime.
X(To do runtime compilation only once, use /$variable/o.)
XAs a special case, specifying a space (\'\ \') will split on white space
Xjust as split with no arguments does, but leading white space does NOT
Xproduce a null first field.
XThus, split(\'\ \') can be used to emulate
X.IR awk 's
Xdefault behavior, whereas
Xsplit(/\ /) will give you as many null initial fields as there are
Xleading spaces.
X.Sp
XExample:
X.nf
X
X.ne 5
X    open(passwd, \'/etc/passwd\');
X    while (<passwd>) {
X.ie t \{\
X        ($login, $passwd, $uid, $gid, $gcos, $home, $shell) = split(\|/\|:\|/\|);
X'br\}
X.el \{\
X        ($login, $passwd, $uid, $gid, $gcos, $home, $shell)
X            = split(\|/\|:\|/\|);
X'br\}
X        .\|.\|.
X    }
X
X.fi
X(Note that $shell above will still have a newline on it.  See chop().)
XSee also
X.IR join .
X.Ip "sprintf(FORMAT,LIST)" 8 4
XReturns a string formatted by the usual printf conventions.
XThe * character is not supported.
X.Ip "sqrt(EXPR)" 8 4
X.Ip "sqrt EXPR" 8
XReturn the square root of EXPR.
XIf EXPR is omitted, returns square root of $_.
X.Ip "srand(EXPR)" 8 4
X.Ip "srand EXPR" 8
XSets the random number seed for the
X.I rand
Xoperator.
XIf EXPR is omitted, does srand(time).
X.Ip "stat(FILEHANDLE)" 8 6
X.Ip "stat FILEHANDLE" 8
X.Ip "stat(EXPR)" 8
XReturns a 13-element array giving the statistics for a file, either the file
Xopened via FILEHANDLE, or named by EXPR.
XTypically used as follows:
X.nf
X
X.ne 3
X    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
X       $atime,$mtime,$ctime,$blksize,$blocks)
X           = stat($filename);
X
X.fi
XIf stat is passed the special filehandle consisting of an underline,
Xno stat is done, but the current contents of the stat structure from
Xthe last stat or filetest are returned.
XExample:
X.nf
X
X.ne 3
X    if (-x $file && (($d) = stat(_)) && $d < 0) {
X        print "$file is executable NFS file\en";
X    }
X
X.fi
X.Ip "study(SCALAR)" 8 6
X.Ip "study SCALAR" 8
X.Ip "study"
XTakes extra time to study SCALAR ($_ if unspecified) in anticipation of
Xdoing many pattern matches on the string before it is next modified.
XThis may or may not save time, depending on the nature and number of patterns
Xyou are searching on, and on the distribution of character frequencies in
Xthe string to be searched\*(--you probably want to compare runtimes with and
Xwithout it to see which runs faster.
XThose loops which scan for many short constant strings (including the constant
Xparts of more complex patterns) will benefit most.
XYou may have only one study active at a time\*(--if you study a different
Xscalar the first is \*(L"unstudied\*(R".
X(The way study works is this: a linked list of every character in the string
Xto be searched is made, so we know, for example, where all the \*(L'k\*(R' characters
Xare.
XFrom each search string, the rarest character is selected, based on some
Xstatic frequency tables constructed from some C programs and English text.
XOnly those places that contain this \*(L"rarest\*(R" character are examined.)
X.Sp
XFor example, here is a loop which inserts index producing entries before any line
Xcontaining a certain pattern:
X.nf
X
X.ne 8
X    while (<>) {
X        study;
X        print ".IX foo\en" if /\ebfoo\eb/;
X        print ".IX bar\en" if /\ebbar\eb/;
X        print ".IX blurfl\en" if /\ebblurfl\eb/;
X        .\|.\|.
X        print;
X    }
X
X.fi
XIn searching for /\ebfoo\eb/, only those locations in $_ that contain \*(L'f\*(R'
Xwill be looked at, because \*(L'f\*(R' is rarer than \*(L'o\*(R'.
XIn general, this is a big win except in pathological cases.
XThe only question is whether it saves you more time than it took to build
Xthe linked list in the first place.
X.Sp
XNote that if you have to look for strings that you don't know till runtime,
Xyou can build an entire loop as a string and eval that to avoid recompiling
Xall your patterns all the time.
XTogether with setting $/ to input entire files as one record, this can
Xbe very fast, often faster than specialized programs like fgrep.
XThe following scans a list of files (@files)
Xfor a list of words (@words), and prints out the names of those files that
Xcontain a match:
X.nf
X
X.ne 12
X    $search = \'while (<>) { study;\';
X    foreach $word (@words) {
X        $search .= "++\e$seen{\e$ARGV} if /\eb$word\eb/;\en";
X    }
X    $search .= "}";
X    @ARGV = @files;
X    $/ = "\e177";        # something that doesn't occur
X    eval $search;        # this screams
X    $/ = "\en";        # put back to normal input delim
X    foreach $file (sort keys(%seen)) {
X        print $file, "\en";
X    }
X
X.fi
X.Ip "substr(EXPR,OFFSET,LEN)" 8 2
XExtracts a substring out of EXPR and returns it.
XFirst character is at offset 0, or whatever you've set $[ to.
XIf OFFSET is negative, starts that far from the end of the string.
XYou can use the substr() function as an lvalue, in which case EXPR must
Xbe an lvalue.
XIf you assign something shorter than LEN, the string will shrink, and
Xif you assign something longer than LEN, the string will grow to accomodate it.
XTo keep the string the same length you may need to pad or chop your value using
Xsprintf().
X.Ip "syscall(LIST)" 8 6
X.Ip "syscall LIST" 8
XCalls the system call specified as the first element of the list, passing
Xthe remaining elements as arguments to the system call.
XIf unimplemented, produces a fatal error.
XThe arguments are interpreted as follows: if a given argument is numeric,
Xthe argument is passed as an int.
XIf not, the pointer to the string value is passed.
XYou are responsible to make sure a string is pre-extended long enough
Xto receive any result that might be written into a string.
XIf your integer arguments are not literals and have never been interpreted
Xin a numeric context, you may need to add 0 to them to force them to look
Xlike numbers.
X.nf
X
X    do 'syscall.h';        # may need to run makelib
X    syscall(&SYS_write, fileno(STDOUT), "hi there\en", 9);
X
X.fi
X.Ip "system(LIST)" 8 6
X.Ip "system LIST" 8
XDoes exactly the same thing as \*(L"exec LIST\*(R" except that a fork
Xis done first, and the parent process waits for the child process to complete.
XNote that argument processing varies depending on the number of arguments.
XThe return value is the exit status of the program as returned by the wait()
Xcall.
XTo get the actual exit value divide by 256.
XSee also
X.IR exec .
X.Ip "symlink(OLDFILE,NEWFILE)" 8 2
XCreates a new filename symbolically linked to the old filename.
XReturns 1 for success, 0 otherwise.
XOn systems that don't support symbolic links, produces a fatal error at
Xrun time.
XTo check for that, use eval:
X.nf
X
X    $symlink_exists = (eval \'symlink("","");\', $@ eq \'\');
X
X.fi
X.Ip "tell(FILEHANDLE)" 8 6
X.Ip "tell FILEHANDLE" 8 6
X.Ip "tell" 8
XReturns the current file position for FILEHANDLE.
XFILEHANDLE may be an expression whose value gives the name of the actual
Xfilehandle.
XIf FILEHANDLE is omitted, assumes the file last read.
X.Ip "telldir(DIRHANDLE)" 8 5
X.Ip "telldir DIRHANDLE" 8
XReturns the current position of the readdir() routines on DIRHANDLE.
XValue may be given to seekdir() to access a particular location in
Xa directory.
XHas the same caveats about possible directory compaction as the corresponding
Xsystem library routine.
X.Ip "time" 8 4
XReturns the number of non-leap seconds since January 1, 1970, UTC.
XSuitable for feeding to gmtime() and localtime().
X.Ip "times" 8 4
XReturns a four-element array giving the user and system times, in seconds, for this
Xprocess and the children of this process.
X.Sp
X    ($user,$system,$cuser,$csystem) = times;
X.Sp
X.Ip "tr/SEARCHLIST/REPLACEMENTLIST/" 8 5
X.Ip "y/SEARCHLIST/REPLACEMENTLIST/" 8
XTranslates all occurrences of the characters found in the search list with
Xthe corresponding character in the replacement list.
XIt returns the number of characters replaced.
XIf no string is specified via the =~ or !~ operator,
Xthe $_ string is translated.
X(The string specified with =~ must be a scalar variable, an array element,
Xor an assignment to one of those, i.e. an lvalue.)
XFor
X.I sed
Xdevotees,
X.I y
Xis provided as a synonym for
X.IR tr .
XExamples:
X.nf
X
X    $ARGV[1] \|=~ \|y/A\-Z/a\-z/;    \h'|3i'# canonicalize to lower case
X
X    $cnt = tr/*/*/;        \h'|3i'# count the stars in $_
X
X    ($HOST = $host) =~ tr/a\-z/A\-Z/;
X
X    y/\e001\-@[\-_{\-\e177/ /;    \h'|3i'# change non-alphas to space
X
X.fi
X.Ip "umask(EXPR)" 8 4
X.Ip "umask EXPR" 8
XSets the umask for the process and returns the old one.
XIf EXPR is omitted, merely returns current umask.
X.Ip "undef(EXPR)" 8 6
X.Ip "undef EXPR" 8
X.Ip "undef" 8
XUndefines the value of EXPR, which must be an lvalue.
XUse only on a scalar value, an entire array, or a subroutine name (using &).
X(Undef will probably not do what you expect on most predefined variables or
Xdbm array values.)
XAlways returns the undefined value.
XYou can omit the EXPR, in which case nothing is undefined, but you still
Xget an undefined value that you could, for instance, return from a subroutine.
XExamples:
X.nf
X
X.ne 6
X    undef $foo;
X    undef $bar{'blurfl'};
X    undef @ary;
X    undef %assoc;
X    undef &mysub;
X    return (wantarray ? () : undef) if $they_blew_it;
X
X.fi
X.Ip "unlink(LIST)" 8 4
X.Ip "unlink LIST" 8
XDeletes a list of files.
XReturns the number of files successfully deleted.
X.nf
X
X.ne 2
X    $cnt = unlink \'a\', \'b\', \'c\';
X    unlink @goners;
X    unlink <*.bak>;
X
X.fi
XNote: unlink will not delete directories unless you are superuser and the
X.B \-U
Xflag is supplied to
X.IR perl .
XEven if these conditions are met, be warned that unlinking a directory
Xcan inflict damage on your filesystem.
XUse rmdir instead.
X.Ip "unpack(TEMPLATE,EXPR)" 8 4
XUnpack does the reverse of pack: it takes a string representing
Xa structure and expands it out into an array value, returning the array
Xvalue.
XThe TEMPLATE has the same format as in the pack function.
XHere's a subroutine that does substring:
X.nf
X
X.ne 4
X    sub substr {
X        local($what,$where,$howmuch) = @_;
X        unpack("x$where a$howmuch", $what);
X    }
X
X.ne 3
Xand then there's
X
X    sub ord { unpack("c",$_[0]); }
X
X.fi
X.Ip "unshift(ARRAY,LIST)" 8 4
XDoes the opposite of a
X.IR shift .
XOr the opposite of a
X.IR push ,
Xdepending on how you look at it.
XPrepends list to the front of the array, and returns the number of elements
Xin the new array.
X.nf
X
X    unshift(ARGV, \'\-e\') unless $ARGV[0] =~ /^\-/;
X
X.fi
X.Ip "utime(LIST)" 8 2
X.Ip "utime LIST" 8 2
XChanges the access and modification times on each file of a list of files.
XThe first two elements of the list must be the NUMERICAL access and
Xmodification times, in that order.
XReturns the number of files successfully changed.
XThe inode modification time of each file is set to the current time.
XExample of a \*(L"touch\*(R" command:
X.nf
X
X.ne 3
X    #!/usr/bin/perl
X    $now = time;
X    utime $now, $now, @ARGV;
X
X.fi
X.Ip "values(ASSOC_ARRAY)" 8 6
X.Ip "values ASSOC_ARRAY" 8
XReturns a normal array consisting of all the values of the named associative
Xarray.
XThe values are returned in an apparently random order, but it is the same order
Xas either the keys() or each() function would produce on the same array.
XSee also keys() and each().
X.Ip "vec(EXPR,OFFSET,BITS)" 8 2
XTreats a string as a vector of unsigned integers, and returns the value
Xof the bitfield specified.
XMay also be assigned to.
XBITS must be a power of two from 1 to 32.
X.Sp
XVectors created with vec() can also be manipulated with the logical operators
X|, & and ^,
Xwhich will assume a bit vector operation is desired when both operands are
Xstrings.
XThis interpretation is not enabled unless there is at least one vec() in
Xyour program, to protect older programs.
X.Ip "wait" 8 6
XWaits for a child process to terminate and returns the pid of the deceased
Xprocess.
XThe status is returned in $?.
X.Ip "wantarray" 8 4
XReturns true if the context of the currently executing subroutine
Xis looking for an array value.
XReturns false if the context is looking for a scalar.
X.nf
X
X    return wantarray ? () : undef;
X
X.fi
X.Ip "warn(LIST)" 8 4
X.Ip "warn LIST" 8
XProduces a message on STDERR just like \*(L"die\*(R", but doesn't exit.
X.Ip "write(FILEHANDLE)" 8 6
X.Ip "write(EXPR)" 8
X.Ip "write(\|)" 8
XWrites a formatted record (possibly multi-line) to the specified file,
Xusing the format associated with that file.
XBy default the format for a file is the one having the same name is the
Xfilehandle, but the format for the current output channel (see
X.IR select )
Xmay be set explicitly
Xby assigning the name of the format to the $~ variable.
X.Sp
XTop of form processing is handled automatically:
Xif there is insufficient room on the current page for the formatted
Xrecord, the page is advanced, a special top-of-page format is used
Xto format the new page header, and then the record is written.
XBy default the top-of-page format is \*(L"top\*(R", but it
Xmay be set to the
Xformat of your choice by assigning the name to the $^ variable.
X.Sp
XIf FILEHANDLE is unspecified, output goes to the current default output channel,
Xwhich starts out as
X.I STDOUT
Xbut may be changed by the
X.I select
Xoperator.
XIf the FILEHANDLE is an EXPR, then the expression is evaluated and the
Xresulting string is used to look up the name of the FILEHANDLE at run time.
XFor more on formats, see the section on formats later on.
X.Sp
XNote that write is NOT the opposite of read.
!STUFFY!FUNK!
echo Extracting perl.h
sed >perl.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: perl.h,v 3.0 89/10/18 15:21:21 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:    perl.h,v $
X * Revision 3.0  89/10/18  15:21:21  lwall
X * 3.0 baseline
X *
X */
X
X#ifndef lint
X#define DEBUGGING
X#endif
X
X#define VOIDUSED 1
X#include "config.h"
X
X#ifdef IAMSUID
X#   ifndef TAINT
X#    define TAINT
X#   endif
X#endif
X
X#ifdef MEMCPY
Xextern char *memcpy(), *memset();
X#define bcopy(s1,s2,l) memcpy(s2,s1,l)
X#define bzero(s,l) memset(s,0,l)
X#endif
X#ifndef BCMP        /* prefer bcmp slightly 'cuz it doesn't order */
X#define bcmp(s1,s2,l) memcmp(s1,s2,l)
X#endif
X
X#include <stdio.h>
X#include <ctype.h>
X#include <setjmp.h>
X#include <sys/param.h>    /* if this needs types.h we're still wrong */
X
X#ifndef _TYPES_        /* If types.h defines this it's easy. */
X#ifndef major        /* Does everyone's types.h define this? */
X#include <sys/types.h>
X#endif
X#endif
X
X#include <sys/stat.h>
X
X#ifdef TMINSYS
X#include <sys/time.h>
X#else
X#ifdef I_SYSTIME
X#include <sys/time.h>
X#else
X#include <time.h>
X#endif
X#endif
X
X#include <sys/times.h>
X
X#ifdef I_SYSIOCTL
X#ifndef _IOCTL_
X#include <sys/ioctl.h>
X#endif
X#endif
X
X#if defined(mc300) || defined(mc500) || defined(mc700)    /* MASSCOMP */
X#ifdef SOCKETPAIR
X#undef SOCKETPAIR
X#endif
X#ifdef NDBM
X#undef NDBM
X#endif
X#endif
X
X#ifdef NDBM
X#include <ndbm.h>
X#define SOME_DBM
X#else
X#ifdef ODBM
X#ifdef NULL
X#undef NULL        /* suppress redefinition message */
X#endif
X#include <dbm.h>
X#ifdef NULL
X#undef NULL
X#endif
X#define NULL 0        /* silly thing is, we don't even use this */
X#define SOME_DBM
X#define dbm_fetch(db,dkey) fetch(dkey)
X#define dbm_delete(db,dkey) delete(dkey)
X#define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent)
X#define dbm_close(db) dbmclose()
X#define dbm_firstkey(db) firstkey()
X#endif /* ODBM */
X#endif /* NDBM */
X#ifdef SOME_DBM
XEXT char *dbmkey;
XEXT int dbmlen;
X#endif
X
X#if INTSIZE == 2
X#define htoni htons
X#define ntohi ntohs
X#else
X#define htoni htonl
X#define ntohi ntohl
X#endif
X
X#ifdef I_DIRENT
X#include <dirent.h>
X#define DIRENT dirent
X#else
X#ifdef I_SYSDIR
X#include <sys/dir.h>
X#define DIRENT direct
X#endif
X#endif
X
Xtypedef struct arg ARG;
Xtypedef struct cmd CMD;
Xtypedef struct formcmd FCMD;
Xtypedef struct scanpat SPAT;
Xtypedef struct stio STIO;
Xtypedef struct sub SUBR;
Xtypedef struct string STR;
Xtypedef struct atbl ARRAY;
Xtypedef struct htbl HASH;
Xtypedef struct regexp REGEXP;
Xtypedef struct stabptrs STBP;
Xtypedef struct stab STAB;
X
X#include "handy.h"
X#include "regexp.h"
X#include "str.h"
X#include "util.h"
X#include "form.h"
X#include "stab.h"
X#include "spat.h"
X#include "arg.h"
X#include "cmd.h"
X#include "array.h"
X#include "hash.h"
X
X#if defined(iAPX286) || defined(M_I286) || defined(I80286)
X#   define I286
X#endif
X
X#ifndef    __STDC__
X#ifdef CHARSPRINTF
X    char *sprintf();
X#else
X    int sprintf();
X#endif
X#endif
X
XEXT char *Yes INIT("1");
XEXT char *No INIT("");
X
X/* "gimme" values */
X
X/* Note: cmd.c assumes that it can use && to produce one of these values! */
X#define G_SCALAR 0
X#define G_ARRAY 1
X
X#ifdef CRIPPLED_CC
Xint str_true();
X#else /* !CRIPPLED_CC */
X#define str_true(str) (Str = (str), \
X    (Str->str_pok ? \
X        ((*Str->str_ptr > '0' || \
X          Str->str_cur > 1 || \
X          (Str->str_cur && *Str->str_ptr != '0')) ? 1 : 0) \
X    : \
X        (Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
X#endif /* CRIPPLED_CC */
X
X#ifdef DEBUGGING
X#define str_peek(str) (Str = (str), \
X    (Str->str_pok ? \
X        Str->str_ptr : \
X        (Str->str_nok ? \
X        (sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
X            (char*)tokenbuf) : \
X        "" )))
X#endif
X
X#ifdef CRIPPLED_CC
Xchar *str_get();
X#else
X#ifdef TAINT
X#define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
X    (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
X#else
X#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
X#endif /* TAINT */
X#endif /* CRIPPLED_CC */
X
X#ifdef CRIPPLED_CC
Xdouble str_gnum();
X#else /* !CRIPPLED_CC */
X#ifdef TAINT
X#define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
X    (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
X#else /* !TAINT */
X#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
X#endif /* TAINT*/
X#endif /* CRIPPLED_CC */
XEXT STR *Str;
X
X#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
X
X#define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
X
X#ifndef BYTEORDER
X#define BYTEORDER 01234
X#endif
X
X#ifndef HTONL
X#if BYTEORDER != 04321
X#define HTONS
X#define HTONL
X#define NTOHS
X#define NTOHL
X#define MYSWAP
X#define htons my_swap
X#define htonl my_htonl
X#define ntohs my_swap
X#define ntohl my_ntohl
X#endif
X#else
X#if BYTEORDER == 04321
X#undef HTONS
X#undef HTONL
X#undef NTOHS
X#undef NTOHL
X#endif
X#endif
X
XCMD *add_label();
XCMD *block_head();
XCMD *append_line();
XCMD *make_acmd();
XCMD *make_ccmd();
XCMD *make_icmd();
XCMD *invert();
XCMD *addcond();
XCMD *addloop();
XCMD *wopt();
XCMD *over();
X
XSTAB *stabent();
XSTAB *genstab();
X
XARG *stab2arg();
XARG *op_new();
XARG *make_op();
XARG *make_match();
XARG *make_split();
XARG *rcatmaybe();
XARG *listish();
XARG *maybelistish();
XARG *localize();
XARG *fixeval();
XARG *jmaybe();
XARG *l();
XARG *fixl();
XARG *mod_match();
XARG *make_list();
XARG *cmd_to_arg();
XARG *addflags();
XARG *hide_ary();
XARG *cval_to_arg();
X
XSTR *str_new();
XSTR *stab_str();
X
Xint do_each();
Xint do_subr();
Xint do_match();
Xint do_unpack();
Xint eval();        /* this evaluates expressions */
Xint do_eval();        /* this evaluates eval operator */
Xint do_assign();
X
XSUBR *make_sub();
X
XFCMD *load_format();
X
Xchar *scanpat();
Xchar *scansubst();
Xchar *scantrans();
Xchar *scanstr();
Xchar *scanreg();
Xchar *str_append_till();
Xchar *str_gets();
Xchar *str_grow();
X
Xbool do_open();
Xbool do_close();
Xbool do_print();
Xbool do_aprint();
Xbool do_exec();
Xbool do_aexec();
X
Xint do_subst();
Xint cando();
Xint ingroup();
X
Xvoid str_replace();
Xvoid str_inc();
Xvoid str_dec();
Xvoid str_free();
Xvoid stab_clear();
Xvoid do_join();
Xvoid do_sprintf();
Xvoid do_accept();
Xvoid do_vecset();
Xvoid savelist();
Xvoid saveitem();
Xvoid saveint();
Xvoid savelong();
Xvoid savesptr();
Xvoid savehptr();
Xvoid restorelist();
XHASH *savehash();
XARRAY *saveary();
X
XEXT line_t line INIT(0);
XEXT line_t subline INIT(0);
XEXT STR *subname INIT(Nullstr);
XEXT int arybase INIT(0);
X
Xstruct outrec {
X    line_t  o_lines;
X    char    *o_str;
X    int     o_len;
X};
X
XEXT struct outrec outrec;
XEXT struct outrec toprec;
X
XEXT STAB *stdinstab INIT(Nullstab);
XEXT STAB *last_in_stab INIT(Nullstab);
XEXT STAB *defstab INIT(Nullstab);
XEXT STAB *argvstab INIT(Nullstab);
XEXT STAB *envstab INIT(Nullstab);
XEXT STAB *sigstab INIT(Nullstab);
XEXT STAB *defoutstab INIT(Nullstab);
XEXT STAB *curoutstab INIT(Nullstab);
XEXT STAB *argvoutstab INIT(Nullstab);
XEXT STAB *incstab INIT(Nullstab);
XEXT STAB *leftstab INIT(Nullstab);
XEXT STAB *amperstab INIT(Nullstab);
XEXT STAB *rightstab INIT(Nullstab);
XEXT STAB *DBstab INIT(Nullstab);
XEXT STAB *DBsub INIT(Nullstab);
X
XEXT HASH *defstash;        /* main symbol table */
XEXT HASH *curstash;        /* symbol table for current package */
XEXT HASH *debstash;        /* symbol table for perldb package */
X
XEXT STR *curstname;        /* name of current package */
X
XEXT STR *freestrroot INIT(Nullstr);
XEXT STR *lastretstr INIT(Nullstr);
XEXT STR *DBsingle INIT(Nullstr);
X
XEXT int lastspbase;
XEXT int lastsize;
X
XEXT char *filename;
XEXT char *origfilename;
XEXT FILE *rsfp;
XEXT char buf[1024];
XEXT char *bufptr;
XEXT char *oldbufptr;
XEXT char *oldoldbufptr;
XEXT char *bufend;
X
XEXT STR *linestr INIT(Nullstr);
X
XEXT char record_separator INIT('\n');
XEXT int rslen INIT(1);
XEXT char *ofs INIT(Nullch);
XEXT int ofslen INIT(0);
XEXT char *ors INIT(Nullch);
XEXT int orslen INIT(0);
XEXT char *ofmt INIT(Nullch);
XEXT char *inplace INIT(Nullch);
XEXT char *nointrp INIT("");
X
XEXT bool preprocess INIT(FALSE);
XEXT bool minus_n INIT(FALSE);
XEXT bool minus_p INIT(FALSE);
XEXT bool minus_a INIT(FALSE);
XEXT bool doswitches INIT(FALSE);
XEXT bool dowarn INIT(FALSE);
XEXT bool allstabs INIT(FALSE);    /* init all customary symbols in symbol table?*/
XEXT bool sawampersand INIT(FALSE);    /* must save all match strings */
XEXT bool sawstudy INIT(FALSE);        /* do fbminstr on all strings */
XEXT bool sawi INIT(FALSE);        /* study must assume case insensitive */
XEXT bool sawvec INIT(FALSE);
X
XEXT int csh INIT(0);        /* 1 if /bin/csh is there, -1 if not */
X
X#ifdef TAINT
XEXT bool tainted INIT(FALSE);        /* using variables controlled by $< */
X#endif
X
X#define TMPPATH "/tmp/perl-eXXXXXX"
XEXT char *e_tmpname;
XEXT FILE *e_fp INIT(Nullfp);
X
XEXT char tokenbuf[256];
XEXT int expectterm INIT(TRUE);        /* how to interpret ambiguous tokens */
XEXT int in_eval INIT(FALSE);        /* trap fatal errors? */
XEXT int multiline INIT(0);        /* $*--do strings hold >1 line? */
XEXT int forkprocess;            /* so do_open |- can return proc# */
XEXT int do_undump INIT(0);        /* -u or dump seen? */
XEXT int error_count INIT(0);        /* how many errors so far, max 10 */
XEXT int multi_start INIT(0);        /* 1st line of multi-line string */
XEXT int multi_end INIT(0);        /* last line of multi-line string */
XEXT int multi_open INIT(0);        /* delimiter of said string */
XEXT int multi_close INIT(0);        /* delimiter of said string */
X
XFILE *popen();
X/* char *str_get(); */
XSTR *interp();
Xvoid free_arg();
XSTIO *stio_new();
X
XEXT struct stat statbuf;
XEXT struct stat statcache;
XSTAB *statstab INIT(Nullstab);
XSTR *statname;
XEXT struct tms timesbuf;
XEXT int uid;
XEXT int euid;
XEXT int gid;
XEXT int egid;
XUIDTYPE getuid();
XUIDTYPE geteuid();
XGIDTYPE getgid();
XGIDTYPE getegid();
XEXT int unsafe;
X
X#ifdef DEBUGGING
XEXT int debug INIT(0);
XEXT int dlevel INIT(0);
XEXT int dlmax INIT(128);
XEXT char *debname;
XEXT char *debdelim;
X#define YYDEBUG 1
Xextern int yydebug;
X#endif
XEXT int perldb INIT(0);
X
XEXT line_t cmdline INIT(NOLINE);
X
XEXT STR str_undef;
XEXT STR str_no;
XEXT STR str_yes;
X
X/* runtime control stuff */
X
XEXT struct loop {
X    char *loop_label;        /* what the loop was called, if anything */
X    int loop_sp;        /* stack pointer to copy stuff down to */
X    jmp_buf loop_env;
X} *loop_stack;
X
XEXT int loop_ptr INIT(-1);
XEXT int loop_max INIT(128);
X
XEXT jmp_buf top_env;
XEXT jmp_buf eval_env;
X
XEXT char *goto_targ INIT(Nullch);    /* cmd_exec gets strange when set */
X
XEXT ARRAY *stack;        /* THE STACK */
X
XEXT ARRAY *savestack;        /* to save non-local values on */
X
XEXT ARRAY *tosave;        /* strings to save on recursive subroutine */
X
XEXT ARRAY *lineary;        /* lines of script for debugger */
X
XEXT ARRAY *pidstatary;        /* keep pids and statuses by fd for mypopen */
X
Xdouble atof();
Xlong time();
Xstruct tm *gmtime(), *localtime();
Xchar *mktemp();
Xchar *index(), *rindex();
Xchar *strcpy(), *strcat();
X
X#ifdef EUNICE
X#define UNLINK unlnk
Xint unlnk();
X#else
X#define UNLINK unlink
X#endif
X
X#ifndef SETREUID
X#ifdef SETRESUID
X#define setreuid(r,e) setresuid(r,e,-1)
X#define SETREUID
X#endif
X#endif
X#ifndef SETREGID
X#ifdef SETRESGID
X#define setregid(r,e) setresgid(r,e,-1)
X#define SETREGID
X#endif
X#endif
!STUFFY!FUNK!
echo Extracting t/op.sleep
sed >t/op.sleep <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.sleep,v 3.0 89/10/18 15:31:15 lwall Locked $
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 ""
echo "End of kit 8 (of 24)"
cat /dev/null >kit8isdone
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; 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... dowic cxp