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

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

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

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

#! /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 9 (of 24).  If kit 9 is complete, the line"
echo '"'"End of kit 9 (of 24)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir  2>/dev/null
echo Extracting perl.man.2
sed >perl.man.2 <<'!STUFFY!FUNK!' -e 's/X//'
X''' Beginning of part 2
X''' $Header: perl.man.2,v 3.0 89/10/18 15:21:37 lwall Locked $
X'''
X''' $Log:    perl.man.2,v $
X''' Revision 3.0  89/10/18  15:21:37  lwall
X''' 3.0 baseline
X'''
X'''
X.PP
XAlong with the literals and variables mentioned earlier,
Xthe operations in the following section can serve as terms in an expression.
XSome of these operations take a LIST as an argument.
XSuch a list can consist of any combination of scalar arguments or array values;
Xthe array values will be included in the list as if each individual element were
Xinterpolated at that point in the list, forming a longer single-dimensional
Xarray value.
XElements of the LIST should be separated by commas.
XIf an operation is listed both with and without parentheses around its
Xarguments, it means you can either use it as a unary operator or
Xas a function call.
XTo use it as a function call, the next token on the same line must
Xbe a left parenthesis.
X(There may be intervening white space.)
XSuch a function then has highest precedence, as you would expect from
Xa function.
XIf any token other than a left parenthesis follows, then it is a
Xunary operator, with a precedence depending only on whether it is a LIST
Xoperator or not.
XLIST operators have lowest precedence.
XAll other unary operators have a precedence greater than relational operators
Xbut less than arithmetic operators.
XSee the section on Precedence.
X.Ip "/PATTERN/" 8 4
XSee m/PATTERN/.
X.Ip "?PATTERN?" 8 4
XThis is just like the /pattern/ search, except that it matches only once between
Xcalls to the
X.I reset
Xoperator.
XThis is a useful optimization when you only want to see the first occurrence of
Xsomething in each file of a set of files, for instance.
XOnly ?? patterns local to the current package are reset.
X.Ip "accept(NEWSOCKET,GENERICSOCKET)" 8 2
XDoes the same thing that the accept system call does.
XReturns true if it succeeded, false otherwise.
XSee example in section on Interprocess Communication.
X.Ip "atan2(X,Y)" 8 2
XReturns the arctangent of X/Y in the range
X.if t \-\(*p to \(*p.
X.if n \-PI to PI.
X.Ip "bind(SOCKET,NAME)" 8 2
XDoes the same thing that the bind system call does.
XReturns true if it succeeded, false otherwise.
XNAME should be a packed address of the proper type for the socket.
XSee example in section on Interprocess Communication.
X.Ip "chdir(EXPR)" 8 2
X.Ip "chdir EXPR" 8 2
XChanges the working directory to EXPR, if possible.
XIf EXPR is omitted, changes to home directory.
XReturns 1 upon success, 0 otherwise.
XSee example under
X.IR die .
X.Ip "chmod(LIST)" 8 2
X.Ip "chmod LIST" 8 2
XChanges the permissions of a list of files.
XThe first element of the list must be the numerical mode.
XReturns the number of files successfully changed.
X.nf
X
X.ne 2
X    $cnt = chmod 0755, \'foo\', \'bar\';
X    chmod 0755, @executables;
X
X.fi
X.Ip "chop(LIST)" 8 7
X.Ip "chop(VARIABLE)" 8
X.Ip "chop VARIABLE" 8
X.Ip "chop" 8
XChops off the last character of a string and returns the character chopped.
XIt's used primarily to remove the newline from the end of an input record,
Xbut is much more efficient than s/\en// because it neither scans nor copies
Xthe string.
XIf VARIABLE is omitted, chops $_.
XExample:
X.nf
X
X.ne 5
X    while (<>) {
X        chop;    # avoid \en on last field
X        @array = split(/:/);
X        .\|.\|.
X    }
X
X.fi
XYou can actually chop anything that's an lvalue, including an assignment:
X.nf
X
X    chop($cwd = \`pwd\`);
X    chop($answer = <STDIN>);
X
X.fi
XIf you chop a list, each element is chopped.
XOnly the value of the last chop is returned.
X.Ip "chown(LIST)" 8 2
X.Ip "chown LIST" 8 2
XChanges the owner (and group) of a list of files.
XThe first two elements of the list must be the NUMERICAL uid and gid,
Xin that order.
XReturns the number of files successfully changed.
X.nf
X
X.ne 2
X    $cnt = chown $uid, $gid, \'foo\', \'bar\';
X    chown $uid, $gid, @filenames;
X
X.fi
X.ne 23
XHere's an example of looking up non-numeric uids:
X.nf
X
X    print "User: ";
X    $user = <STDIN>;
X    chop($user);
X    print "Files: "
X    $pattern = <STDIN>;
X    chop($pattern);
X    open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\en";
X    while (<pass>) {
X        ($login,$pass,$uid,$gid) = split(/:/);
X        $uid{$login} = $uid;
X        $gid{$login} = $gid;
X    }
X    @ary = <$pattern>;    # get filenames
X    if ($uid{$user} eq \'\') {
X        die "$user not in passwd file";
X    }
X    else {
X        chown $uid{$user}, $gid{$user}, @ary;
X    }
X
X.fi
X.Ip "chroot(FILENAME)" 8 5
X.Ip "chroot FILENAME" 8
XDoes the same as the system call of that name.
XIf you don't know what it does, don't worry about it.
XIf FILENAME is omitted, does chroot to $_.
X.Ip "close(FILEHANDLE)" 8 5
X.Ip "close FILEHANDLE" 8
XCloses the file or pipe associated with the file handle.
XYou don't have to close FILEHANDLE if you are immediately going to
Xdo another open on it, since open will close it for you.
X(See
X.IR open .)
XHowever, an explicit close on an input file resets the line counter ($.), while
Xthe implicit close done by
X.I open
Xdoes not.
XAlso, closing a pipe will wait for the process executing on the pipe to complete,
Xin case you want to look at the output of the pipe afterwards.
XClosing a pipe explicitly also puts the status value of the command into $?.
XExample:
X.nf
X
X.ne 4
X    open(OUTPUT, \'|sort >foo\');    # pipe to sort
X    .\|.\|.    # print stuff to output
X    close OUTPUT;        # wait for sort to finish
X    open(INPUT, \'foo\');    # get sort's results
X
X.fi
XFILEHANDLE may be an expression whose value gives the real filehandle name.
X.Ip "closedir(DIRHANDLE)" 8 5
X.Ip "closedir DIRHANDLE" 8
XCloses a directory opened by opendir().
X.Ip "connect(SOCKET,NAME)" 8 2
XDoes the same thing that the connect system call does.
XReturns true if it succeeded, false otherwise.
XNAME should be a package address of the proper type for the socket.
XSee example in section on Interprocess Communication.
X.Ip "cos(EXPR)" 8 6
X.Ip "cos EXPR" 8 6
XReturns the cosine of EXPR (expressed in radians).
XIf EXPR is omitted takes cosine of $_.
X.Ip "crypt(PLAINTEXT,SALT)" 8 6
XEncrypts a string exactly like the crypt() function in the C library.
XUseful for checking the password file for lousy passwords.
XOnly the guys wearing white hats should do this.
X.Ip "dbmclose(ASSOC_ARRAY)" 8 6
X.Ip "dbmclose ASSOC_ARRAY" 8
XBreaks the binding between a dbm file and an associative array.
XThe values remaining in the associative array are meaningless unless
Xyou happen to want to know what was in the cache for the dbm file.
XThis function is only useful if you have ndbm.
X.Ip "dbmopen(ASSOC,DBNAME,MODE)" 8 6
XThis binds a dbm or ndbm file to an associative array.
XASSOC is the name of the associative array.
X(Unlike normal open, the first argument is NOT a filehandle, even though
Xit looks like one).
XDBNAME is the name of the database (without the .dir or .pag extension).
XIf the database does not exist, it is created with protection specified
Xby MODE (as modified by the umask).
XIf your system only supports the older dbm functions, you may only have one
Xdbmopen in your program.
XIf your system has neither dbm nor ndbm, calling dbmopen produces a fatal
Xerror.
X.Sp
XValues assigned to the associative array prior to the dbmopen are lost.
XA certain number of values from the dbm file are cached in memory.
XBy default this number is 64, but you can increase it by preallocating
Xthat number of garbage entries in the associative array before the dbmopen.
XYou can flush the cache if necessary with the reset command.
X.Sp
XIf you don't have write access to the dbm file, you can only read
Xassociative array variables, not set them.
XIf you want to test whether you can write, either use file tests or
Xtry setting a dummy array entry inside an eval, which will trap the error.
X.Sp
XNote that functions such as keys() and values() may return huge array values
Xwhen used on large dbm files.
XYou may prefer to use the each() function to iterate over large dbm files.
XExample:
X.nf
X
X.ne 6
X    # print out history file offsets
X    dbmopen(HIST,'/usr/lib/news/history',0666);
X    while (($key,$val) = each %HIST) {
X        print $key, ' = ', unpack('L',$val), "\en";
X    }
X    dbmclose(HIST);
X
X.fi
X.Ip "defined(EXPR)" 8 6
X.Ip "defined EXPR" 8
XReturns a boolean value saying whether the lvalue EXPR has a real value
Xor not.
XMany operations return the undefined value under exceptional conditions,
Xsuch as end of file, uninitialized variable, system error and such.
XThis function allows you to distinguish between an undefined null string
Xand a defined null string with operations that might return a real null
Xstring, in particular referencing elements of an array.
XYou may also check to see if arrays or subroutines exist.
XUse on predefined variables is not guaranteed to produce intuitive results.
XExamples:
X.nf
X
X.ne 7
X    print if defined $switch{'D'};
X    print "$val\en" while defined($val = pop(@ary));
X    die "Can't readlink $sym: $!"
X        unless defined($value = readlink $sym);
X    eval '@foo = ()' if defined(@foo);
X    die "No XYZ package defined" unless defined %_XYZ;
X    sub foo { defined &bar ? &bar(@_) : die "No bar"; }
X
X.fi
XSee also undef.
X.Ip "delete $ASSOC{KEY}" 8 6
XDeletes the specified value from the specified associative array.
XReturns the deleted value, or the undefined value if nothing was deleted.
XDeleting from $ENV{} modifies the environment.
XDeleting from an array bound to a dbm file deletes the entry from the dbm
Xfile.
X.Sp
XThe following deletes all the values of an associative array:
X.nf
X
X.ne 3
X    foreach $key (keys %ARRAY) {
X        delete $ARRAY{$key};
X    }
X
X.fi
X(But it would be faster to use the
X.I reset
Xcommand.
XSaying undef %ARRAY is faster yet.)
X.Ip "die(LIST)" 8
X.Ip "die LIST" 8
XPrints the value of LIST to
X.I STDERR
Xand exits with the current value of $!
X(errno).
XIf $! is 0, exits with the value of ($? >> 8) (\`command\` status).
XIf ($? >> 8) is 0, exits with 255.
XEquivalent examples:
X.nf
X
X.ne 3
X    die "Can't cd to spool: $!\en" unless chdir \'/usr/spool/news\';
X
X    chdir \'/usr/spool/news\' || die "Can't cd to spool: $!\en"
X
X.fi
X.Sp
XIf the value of EXPR does not end in a newline, the current script line
Xnumber and input line number (if any) are also printed, and a newline is
Xsupplied.
XHint: sometimes appending \*(L", stopped\*(R" to your message will cause it to make
Xbetter sense when the string \*(L"at foo line 123\*(R" is appended.
XSuppose you are running script \*(L"canasta\*(R".
X.nf
X
X.ne 7
X    die "/etc/games is no good";
X    die "/etc/games is no good, stopped";
X
Xproduce, respectively
X
X    /etc/games is no good at canasta line 123.
X    /etc/games is no good, stopped at canasta line 123.
X
X.fi
XSee also
X.IR exit .
X.Ip "do BLOCK" 8 4
XReturns the value of the last command in the sequence of commands indicated
Xby BLOCK.
XWhen modified by a loop modifier, executes the BLOCK once before testing the
Xloop condition.
X(On other statements the loop modifiers test the conditional first.)
X.Ip "do SUBROUTINE (LIST)" 8 3
XExecutes a SUBROUTINE declared by a
X.I sub
Xdeclaration, and returns the value
Xof the last expression evaluated in SUBROUTINE.
XIf there is no subroutine by that name, produces a fatal error.
X(You may use the \*(L"defined\*(R" operator to determine if a subroutine
Xexists.)
XIf you pass arrays as part of LIST you may wish to pass the length
Xof the array in front of each array.
X(See the section on subroutines later on.)
XSUBROUTINE may be a scalar variable, in which case the variable contains
Xthe name of the subroutine to execute.
XThe parentheses are required to avoid confusion with the \*(L"do EXPR\*(R"
Xform.
X.Sp
XAs an alternate form, you may call a subroutine by prefixing the name with
Xan ampersand: &foo(@args).
XIf you aren't passing any arguments, you don't have to use parentheses.
XIf you omit the parentheses, no @_ array is passed to the subroutine.
XThe & form is also used to specify subroutines to the defined and undef
Xoperators.
X.Ip "do EXPR" 8 3
XUses the value of EXPR as a filename and executes the contents of the file
Xas a
X.I perl
Xscript.
XIts primary use is to include subroutines from a
X.I perl
Xsubroutine library.
X.nf
X
X    do \'stat.pl\';
X
Xis just like
X
X    eval \`cat stat.pl\`;
X
X.fi
Xexcept that it's more efficient, more concise, keeps track of the current
Xfilename for error messages, and searches all the
X.B \-I
Xlibraries if the file
Xisn't in the current directory (see also the @INC array in Predefined Names).
XIt's the same, however, in that it does reparse the file every time you
Xcall it, so if you are going to use the file inside a loop you might prefer
Xto use \-P and #include, at the expense of a little more startup time.
X(The main problem with #include is that cpp doesn't grok # comments\*(--a
Xworkaround is to use \*(L";#\*(R" for standalone comments.)
XNote that the following are NOT equivalent:
X.nf
X
X.ne 2
X    do $foo;    # eval a file
X    do $foo();    # call a subroutine
X
X.fi
X.Ip "dump LABEL" 8 6
XThis causes an immediate core dump.
XPrimarily this is so that you can use the undump program to turn your
Xcore dump into an executable binary after having initialized all your
Xvariables at the beginning of the program.
XWhen the new binary is executed it will begin by executing a "goto LABEL"
X(with all the restrictions that goto suffers).
XThink of it as a goto with an intervening core dump and reincarnation.
XIf LABEL is omitted, restarts the program from the top.
XWARNING: any files opened at the time of the dump will NOT be open any more
Xwhen the program is reincarnated, with possible resulting confusion on the part
Xof perl.
XSee also \-u.
X.Sp
XExample:
X.nf
X
X.ne 16
X    #!/usr/bin/perl
X    do 'getopt.pl';
X    do 'stat.pl';
X    %days = (
X        'Sun',1,
X        'Mon',2,
X        'Tue',3,
X        'Wed',4,
X        'Thu',5,
X        'Fri',6,
X        'Sat',7);
X
X    dump QUICKSTART if $ARGV[0] eq '-d';
X
X    QUICKSTART:
X    do Getopt('f');
X
X.fi
X.Ip "each(ASSOC_ARRAY)" 8 6
X.Ip "each ASSOC_ARRAY" 8
XReturns a 2 element array consisting of the key and value for the next
Xvalue of an associative array, so that you can iterate over it.
XEntries are returned in an apparently random order.
XWhen the array is entirely read, a null array is returned (which when
Xassigned produces a FALSE (0) value).
XThe next call to each() after that will start iterating again.
XThe iterator can be reset only by reading all the elements from the array.
XYou must not modify the array while iterating over it.
XThere is a single iterator for each associative array, shared by all
Xeach(), keys() and values() function calls in the program.
XThe following prints out your environment like the printenv program, only
Xin a different order:
X.nf
X
X.ne 3
X    while (($key,$value) = each %ENV) {
X        print "$key=$value\en";
X    }
X
X.fi
XSee also keys() and values().
X.Ip "eof(FILEHANDLE)" 8 8
X.Ip "eof()" 8
X.Ip "eof" 8
XReturns 1 if the next read on FILEHANDLE will return end of file, or if
XFILEHANDLE is not open.
XFILEHANDLE may be an expression whose value gives the real filehandle name.
XAn eof without an argument returns the eof status for the last file read.
XEmpty parentheses () may be used to indicate the pseudo file formed of the
Xfiles listed on the command line, i.e. eof() is reasonable to use inside
Xa while (<>) loop to detect the end of only the last file.
XUse eof(ARGV) or eof without the parentheses to test EACH file in a while (<>) loop.
XExamples:
X.nf
X
X.ne 7
X    # insert dashes just before last line of last file
X    while (<>) {
X        if (eof()) {
X            print "\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\en";
X        }
X        print;
X    }
X
X.ne 7
X    # reset line numbering on each input file
X    while (<>) {
X        print "$.\et$_";
X        if (eof) {    # Not eof().
X            close(ARGV);
X        }
X    }
X
X.fi
X.Ip "eval(EXPR)" 8 6
X.Ip "eval EXPR" 8 6
XEXPR is parsed and executed as if it were a little
X.I perl
Xprogram.
XIt is executed in the context of the current
X.I perl
Xprogram, so that
Xany variable settings, subroutine or format definitions remain afterwards.
XThe value returned is the value of the last expression evaluated, just
Xas with subroutines.
XIf there is a syntax error or runtime error, a null string is returned by
Xeval, and $@ is set to the error message.
XIf there was no error, $@ is null.
XIf EXPR is omitted, evaluates $_.
XThe final semicolon, if any, may be omitted from the expression.
X.Sp
XNote that, since eval traps otherwise-fatal errors, it is useful for
Xdetermining whether a particular feature
X(such as dbmopen or symlink) is implemented.
X.Ip "exec(LIST)" 8 8
X.Ip "exec LIST" 8 6
XIf there is more than one argument in LIST, or if LIST is an array with
Xmore than one value,
Xcalls execvp() with the arguments in LIST.
XIf there is only one scalar argument, the argument is checked for shell metacharacters.
XIf there are any, the entire argument is passed to \*(L"/bin/sh \-c\*(R" for parsing.
XIf there are none, the argument is split into words and passed directly to
Xexecvp(), which is more efficient.
XNote: exec (and system) do not flush your output buffer, so you may need to
Xset $| to avoid lost output.
XExamples:
X.nf
X
X    exec \'/bin/echo\', \'Your arguments are: \', @ARGV;
X    exec "sort $outfile | uniq";
X
X.fi
X.Sp
XIf you don't really want to execute the first argument, but want to lie
Xto the program you are executing about its own name, you can specify
Xthe program you actually want to run by assigning that to a variable and
Xputting the name of the variable in front of the LIST without a comma.
X(This always forces interpretation of the LIST as a multi-valued list, even
Xif there is only a single scalar in the list.)
XExample:
X.nf
X
X.ne 2
X    $shell = '/bin/csh';
X    exec $shell '-sh';        # pretend it's a login shell
X
X.fi
X.Ip "exit(EXPR)" 8 6
X.Ip "exit EXPR" 8
XEvaluates EXPR and exits immediately with that value.
XExample:
X.nf
X
X.ne 2
X    $ans = <STDIN>;
X    exit 0 \|if \|$ans \|=~ \|/\|^[Xx]\|/\|;
X
X.fi
XSee also
X.IR die .
XIf EXPR is omitted, exits with 0 status.
X.Ip "exp(EXPR)" 8 3
X.Ip "exp EXPR" 8
XReturns
X.I e
Xto the power of EXPR.
XIf EXPR is omitted, gives exp($_).
X.Ip "fcntl(FILEHANDLE,FUNCTION,SCALAR)" 8 4
XImplements the fcntl(2) function.
XYou'll probably have to say
X.nf
X
X    do "fcntl.h";    # probably /usr/local/lib/perl/fcntl.h
X
X.fi
Xfirst to get the correct function definitions.
XIf fcntl.h doesn't exist or doesn't have the correct definitions
Xyou'll have to roll
Xyour own, based on your C header files such as <sys/fcntl.h>.
X(There is a perl script called makelib that comes with the perl kit
Xwhich may help you in this.)
XArgument processing and value return works just like ioctl below.
XNote that fcntl will produce a fatal error if used on a machine that doesn't implement
Xfcntl(2).
X.Ip "fileno(FILEHANDLE)" 8 4
XReturns the file descriptor for a filehandle.
XUseful for constructing bitmaps for select().
XIf FILEHANDLE is an expression, the value is taken as the name of
Xthe filehandle.
X.Ip "flock(FILEHANDLE,OPERATION)" 8 4
XCalls flock(2) on FILEHANDLE.
XSee manual page for flock(2) for definition of OPERATION.
XWill produce a fatal error if used on a machine that doesn't implement
Xflock(2).
XHere's a mailbox appender for BSD systems.
X.nf
X
X.ne 20
X    $LOCK_SH = 1;
X    $LOCK_EX = 2;
X    $LOCK_NB = 4;
X    $LOCK_UN = 8;
X
X    sub lock {
X        flock(MBOX,$LOCK_EX);
X        # and, in case someone appended
X        # while we were waiting...
X        seek(MBOX, 0, 2);
X    }
X
X    sub unlock {
X        flock(MBOX,$LOCK_UN);
X    }
X
X    open(MBOX, ">>/usr/spool/mail/$USER")
X        || die "Can't open mailbox: $!";
X
X    do lock();
X    print MBOX $msg,"\en\en";
X    do unlock();
X
X.fi
X.Ip "fork" 8 4
XDoes a fork() call.
XReturns the child pid to the parent process and 0 to the child process.
XNote: unflushed buffers remain unflushed in both processes, which means
Xyou may need to set $| to avoid duplicate output.
X.Ip "getc(FILEHANDLE)" 8 4
X.Ip "getc FILEHANDLE" 8
X.Ip "getc" 8
XReturns the next character from the input file attached to FILEHANDLE, or
Xa null string at EOF.
XIf FILEHANDLE is omitted, reads from STDIN.
X.Ip "getlogin" 8 3
XReturns the current login from /etc/utmp, if any.
XIf null, use getpwuid.
X
X    ($login = getlogin) || (($login) = getpwuid($<));
X
X.Ip "getpeername(SOCKET)" 8 3
XReturns the packed sockaddr address of other end of the SOCKET connection.
X.nf
X
X.ne 4
X    # An internet sockaddr
X    $sockaddr = 'S n a4 x8';
X    $hersockaddr = getpeername(S);
X    ($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
X
X.fi
X.Ip "getpgrp(PID)" 8 4
X.Ip "getpgrp PID" 8
XReturns 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
Xgetpgrp(2).
XIf EXPR is omitted, returns process group of current process.
X.Ip "getppid" 8 4
XReturns the process id of the parent process.
X.Ip "getpriority(WHICH,WHO)" 8 4
XReturns the current priority for a process, a process group, or a user.
X(See getpriority(2).)
XWill produce a fatal error if used on a machine that doesn't implement
Xgetpriority(2).
X.Ip "getpwnam(NAME)" 8
X.Ip "getgrnam(NAME)" 8
X.Ip "gethostbyname(NAME)" 8
X.Ip "getnetbyname(NAME)" 8
X.Ip "getprotobyname(NAME)" 8
X.Ip "getpwuid(UID)" 8
X.Ip "getgrgid(GID)" 8
X.Ip "getservbyname(NAME,PROTO)" 8
X.Ip "gethostbyaddr(ADDR,ADDRTYPE)" 8
X.Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8
X.Ip "getprotobynumber(NUMBER)" 8
X.Ip "getservbyport(PORT,PROTO)" 8
X.Ip "getpwent()" 8
X.Ip "getgrent()" 8
X.Ip "gethostent()" 8
X.Ip "getnetent()" 8
X.Ip "getprotoent()" 8
X.Ip "getservent()" 8
X.Ip "setpwent()" 8
X.Ip "setgrent()" 8
X.Ip "sethostent(STAYOPEN)" 8
X.Ip "setnetent(STAYOPEN)" 8
X.Ip "setprotoent(STAYOPEN)" 8
X.Ip "setservent(STAYOPEN)" 8
X.Ip "endpwent()" 8
X.Ip "endgrent()" 8
X.Ip "endhostent()" 8
X.Ip "endnetent()" 8
X.Ip "endprotoent()" 8
X.Ip "endservent()" 8
XThese routines perform the same functions as their counterparts in the
Xsystem library.
XThe return values from the various get routines are as follows:
X.nf
X
X    ($name,$passwd,$uid,$gid,
X       $quota,$comment,$gcos,$dir,$shell) = getpw.\|.\|.
X    ($name,$passwd,$gid,$members) = getgr.\|.\|.
X    ($name,$aliases,$addrtype,$length,@addrs) = gethost.\|.\|.
X    ($name,$aliases,$addrtype,$net) = getnet.\|.\|.
X    ($name,$aliases,$proto) = getproto.\|.\|.
X    ($name,$aliases,$port,$proto) = getserv.\|.\|.
X
X.fi
XThe $members value returned by getgr.\|.\|. is a space separated list
Xof the login names of the members of the group.
X.Sp
XThe @addrs value returned by the gethost.\|.\|. functions is a list of the
Xraw addresses returned by the corresponding system library call.
XIn the Internet domain, each address is four bytes long and you can unpack
Xit by saying something like:
X.nf
X
X    ($a,$b,$c,$d) = unpack('C4',$addr[0]);
X
X.fi
X.Ip "getsockname(SOCKET)" 8 3
XReturns the packed sockaddr address of this end of the SOCKET connection.
X.nf
X
X.ne 4
X    # An internet sockaddr
X    $sockaddr = 'S n a4 x8';
X    $mysockaddr = getsockname(S);
X    ($family, $port, $myaddr) = unpack($sockaddr,$mysockaddr);
X
X.fi
X.Ip "getsockopt(SOCKET,LEVEL,OPTNAME)" 8 3
XReturns the socket option requested, or undefined if there is an error.
X.Ip "gmtime(EXPR)" 8 4
X.Ip "gmtime EXPR" 8
XConverts a time as returned by the time function to a 9-element array with
Xthe time analyzed for the Greenwich timezone.
XTypically used as follows:
X.nf
X
X.ne 3
X    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
X
X.fi
XAll array elements are numeric, and come straight out of a struct tm.
XIn particular this means that $mon has the range 0.\|.11 and $wday has the
Xrange 0.\|.6.
XIf EXPR is omitted, does gmtime(time).
X.Ip "goto LABEL" 8 6
XFinds the statement labeled with LABEL and resumes execution there.
XCurrently you may only go to statements in the main body of the program
Xthat are not nested inside a do {} construct.
XThis statement is not implemented very efficiently, and is here only to make
Xthe
X.IR sed -to- perl
Xtranslator easier.
XI may change its semantics at any time, consistent with support for translated
X.I sed
Xscripts.
XUse it at your own risk.
XBetter yet, don't use it at all.
X.Ip "grep(EXPR,LIST)" 8 4
XEvaluates EXPR for each element of LIST (locally setting $_ to each element)
Xand returns the array value consisting of those elements for which the
Xexpression evaluated to true.
X.nf
X
X    @foo = grep(!/^#/, @bar);    # weed out comments
X
X.fi
X.Ip "hex(EXPR)" 8 4
X.Ip "hex EXPR" 8
XReturns the decimal value of EXPR interpreted as an hex string.
X(To interpret strings that might start with 0 or 0x see oct().)
XIf EXPR is omitted, uses $_.
X.Ip "ioctl(FILEHANDLE,FUNCTION,SCALAR)" 8 4
XImplements the ioctl(2) function.
XYou'll probably have to say
X.nf
X
X    do "ioctl.h";    # probably /usr/local/lib/perl/ioctl.h
X
X.fi
Xfirst to get the correct function definitions.
XIf ioctl.h doesn't exist or doesn't have the correct definitions
Xyou'll have to roll
Xyour own, based on your C header files such as <sys/ioctl.h>.
X(There is a perl script called makelib that comes with the perl kit
Xwhich may help you in this.)
XSCALAR will be read and/or written depending on the FUNCTION\*(--a pointer
Xto the string value of SCALAR will be passed as the third argument of
Xthe actual ioctl call.
X(If SCALAR has no string value but does have a numeric value, that value
Xwill be passed rather than a pointer to the string value.
XTo guarantee this to be true, add a 0 to the scalar before using it.)
XThe pack() and unpack() functions are useful for manipulating the values
Xof structures used by ioctl().
XThe following example sets the erase character to DEL.
X.nf
X
X.ne 9
X    do 'ioctl.h';
X    $sgttyb_t = "ccccs";        # 4 chars and a short
X    if (ioctl(STDIN,$TIOCGETP,$sgttyb)) {
X        @ary = unpack($sgttyb_t,$sgttyb);
X        $ary[2] = 127;
X        $sgttyb = pack($sgttyb_t,@ary);
X        ioctl(STDIN,$TIOCSETP,$sgttyb)
X            || die "Can't ioctl: $!";
X    }
X
X.fi
XThe return value of ioctl (and fcntl) is as follows:
X.nf
X
X.ne 4
X    if OS returns:\h'|3i'perl returns:
X      -1\h'|3i'  undefined value
X      0\h'|3i'  string "0 but true"
X      anything else\h'|3i'  that number
X
X.fi
XThus perl returns true on success and false on failure, yet you can still
Xeasily determine the actual value returned by the operating system:
X.nf
X
X    ($retval = ioctl(...)) || ($retval = -1);
X    printf "System returned %d\en", $retval;
X.fi
X.Ip "index(STR,SUBSTR)" 8 4
XReturns the position of the first occurrence of SUBSTR in STR, based at 0, or whatever you've
Xset the $[ variable to.
XIf the substring is not found, returns one less than the base, ordinarily \-1.
X.Ip "int(EXPR)" 8 4
X.Ip "int EXPR" 8
XReturns the integer portion of EXPR.
XIf EXPR is omitted, uses $_.
X.Ip "join(EXPR,LIST)" 8 8
X.Ip "join(EXPR,ARRAY)" 8
XJoins the separate strings of LIST or ARRAY into a single string with fields
Xseparated by the value of EXPR, and returns the string.
XExample:
X.nf
X
X    $_ = join(\|\':\', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
X
X.fi
XSee
X.IR split .
X.Ip "keys(ASSOC_ARRAY)" 8 6
X.Ip "keys ASSOC_ARRAY" 8
XReturns a normal array consisting of all the keys of the named associative
Xarray.
XThe keys are returned in an apparently random order, but it is the same order
Xas either the values() or each() function produces (given that the associative array
Xhas not been modified).
XHere is yet another way to print your environment:
X.nf
X
X.ne 5
X    @keys = keys %ENV;
X    @values = values %ENV;
X    while ($#keys >= 0) {
X        print pop(keys), \'=\', pop(values), "\en";
X    }
X
Xor how about sorted by key:
X
X.ne 3
X    foreach $key (sort(keys %ENV)) {
X        print $key, \'=\', $ENV{$key}, "\en";
X    }
X
X.fi
X.Ip "kill(LIST)" 8 8
X.Ip "kill LIST" 8 2
XSends a signal to a list of processes.
XThe first element of the list must be the signal to send.
XReturns the number of processes successfully signaled.
X.nf
X
X    $cnt = kill 1, $child1, $child2;
X    kill 9, @goners;
X
X.fi
XIf the signal is negative, kills process groups instead of processes.
X(On System V, a negative \fIprocess\fR number will also kill process groups,
Xbut that's not portable.)
XYou may use a signal name in quotes.
X.Ip "last LABEL" 8 8
X.Ip "last" 8
XThe
X.I last
Xcommand is like the
X.I break
Xstatement in C (as used in loops); it immediately exits the loop in question.
XIf the LABEL is omitted, the command refers to the innermost enclosing loop.
XThe
X.I continue
Xblock, if any, is not executed:
X.nf
X
X.ne 4
X    line: while (<STDIN>) {
X        last line if /\|^$/;    # exit when done with header
X        .\|.\|.
X    }
X
X.fi
X.Ip "length(EXPR)" 8 4
X.Ip "length EXPR" 8
XReturns the length in characters of the value of EXPR.
XIf EXPR is omitted, returns length of $_.
X.Ip "link(OLDFILE,NEWFILE)" 8 2
XCreates a new filename linked to the old filename.
XReturns 1 for success, 0 otherwise.
X.Ip "listen(SOCKET,QUEUESIZE)" 8 2
XDoes the same thing that the listen system call does.
XReturns true if it succeeded, false otherwise.
XSee example in section on Interprocess Communication.
X.Ip "local(LIST)" 8 4
XDeclares the listed variables to be local to the enclosing block,
Xsubroutine, eval or \*(L"do\*(R".
XAll the listed elements must be legal lvalues.
XThis operator works by saving the current values of those variables in LIST
Xon a hidden stack and restoring them upon exiting the block, subroutine or eval.
XThis means that called subroutines can also reference the local variable,
Xbut not the global one.
XThe LIST may be assigned to if desired, which allows you to initialize
Xyour local variables.
X(If no initializer is given, all scalars are initialized to the null string
Xand all arrays and associative arrays to the null array.)
XCommonly this is used to name the parameters to a subroutine.
XExamples:
X.nf
X
X.ne 13
X    sub RANGEVAL {
X        local($min, $max, $thunk) = @_;
X        local($result) = \'\';
X        local($i);
X
X        # Presumably $thunk makes reference to $i
X
X        for ($i = $min; $i < $max; $i++) {
X            $result .= eval $thunk;
X        }
X
X        $result;
X    }
X
X.ne 6
X    if ($sw eq \'-v\') {
X        # init local array with global array
X        local(@ARGV) = @ARGV;
X        unshift(\'echo\',@ARGV);
X        system @ARGV;
X    }
X    # @ARGV restored
X
X.ne 6
X    # temporarily add to digits associative array
X    if ($base12) {
X        # (NOTE: not claiming this is efficient!)
X        local(%digits) = (%digits,'t',10,'e',11);
X        do parse_num();
X    }
X
X.fi
XNote that local() is a run-time command, and so gets executed every time
Xthrough a loop, using up more stack storage each time until it's all
Xreleased at once when the loop is exited.
X.Ip "localtime(EXPR)" 8 4
X.Ip "localtime EXPR" 8
XConverts a time as returned by the time function to a 9-element array with
Xthe time analyzed for the local timezone.
XTypically used as follows:
X.nf
X
X.ne 3
X    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
X
X.fi
XAll array elements are numeric, and come straight out of a struct tm.
XIn particular this means that $mon has the range 0.\|.11 and $wday has the
Xrange 0.\|.6.
XIf EXPR is omitted, does localtime(time).
X.Ip "log(EXPR)" 8 4
X.Ip "log EXPR" 8
XReturns logarithm (base
X.IR e )
Xof EXPR.
XIf EXPR is omitted, returns log of $_.
X.Ip "lstat(FILEHANDLE)" 8 6
X.Ip "lstat FILEHANDLE" 8
X.Ip "lstat(EXPR)" 8
XDoes the same thing as the stat() function, but stats a symbolic link
Xinstead of the file the symbolic link points to.
XIf symbolic links are unimplemented on your system, a normal stat is done.
X.Ip "m/PATTERN/io" 8 4
X.Ip "/PATTERN/io" 8
XSearches a string for a pattern match, and returns true (1) or false (\'\').
XIf no string is specified via the =~ or !~ operator,
Xthe $_ string is searched.
X(The string specified with =~ need not be an lvalue\*(--it may be the result of an expression evaluation, but remember the =~ binds rather tightly.)
XSee also the section on regular expressions.
X.Sp
XIf / is the delimiter then the initial \*(L'm\*(R' is optional.
XWith the \*(L'm\*(R' you can use any pair of characters as delimiters.
XThis is particularly useful for matching Unix path names that contain \*(L'/\*(R'.
XIf the final delimiter is followed by the optional letter \*(L'i\*(R', the matching is
Xdone in a case-insensitive manner.
XPATTERN may contain references to scalar variables, which will be interpolated
X(and the pattern recompiled) every time the pattern search is evaluated.
XIf you want such a pattern to be compiled only once, add an \*(L"o\*(R" after
Xthe trailing delimiter.
XThis avoids expensive run-time recompilations, and
Xis useful when the value you are interpolating won't change over the
Xlife of the script.
X.Sp
XIf used in a context that requires an array value, a pattern match returns an
Xarray consisting of the subexpressions matched by the parentheses in the
Xpattern,
Xi.e. ($1, $2, $3.\|.\|.).
XIt does NOT actually set $1, $2, etc. in this case, nor does it set $+, $`, $&
Xor $'.
XIf the match fails, a null array is returned.
X.Sp
XExamples:
X.nf
X
X.ne 4
X    open(tty, \'/dev/tty\');
X    <tty> \|=~ \|/\|^y\|/i \|&& \|do foo(\|);    # do foo if desired
X
X    if (/Version: \|*\|([0\-9.]*\|)\|/\|) { $version = $1; }
X
X    next if m#^/usr/spool/uucp#;
X
X.ne 5
X    # poor man's grep
X    $arg = shift;
X    while (<>) {
X        print if /$arg/o;    # compile only once
X    }
X
X    if (($F1, $F2, $Etc) = ($foo =~ /^(\eS+)\es+(\eS+)\es*(.*)/))
X
X.fi
XThis last example splits $foo into the first two words and the remainder
Xof the line, and assigns those three fields to $F1, $F2 and $Etc.
XThe conditional is true if any variables were assigned, i.e. if the pattern
Xmatched.
X.Ip "mkdir(FILENAME,MODE)" 8 3
XCreates the directory specified by FILENAME, with permissions specified by
XMODE (as modified by umask).
XIf it succeeds it returns 1, otherwise it returns 0 and sets $! (errno).
!STUFFY!FUNK!
echo Extracting stab.c
sed >stab.c <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: stab.c,v 3.0 89/10/18 15:23:23 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:    stab.c,v $
X * Revision 3.0  89/10/18  15:23:23  lwall
X * 3.0 baseline
X *
X */
X
X#include "EXTERN.h"
X#include "perl.h"
X
X#include <signal.h>
X
X/* This oughta be generated by Configure. */
X
Xstatic char *sig_name[] = {
X    SIG_NAME,0
X};
X
Xextern int errno;
Xextern int sys_nerr;
Xextern char *sys_errlist[];
X
XSTR *
Xstab_str(str)
XSTR *str;
X{
X    STAB *stab = str->str_u.str_stab;
X    register int paren;
X    register char *s;
X    register int i;
X
X    if (str->str_rare)
X    return stab_val(stab);
X
X    switch (*stab->str_magic->str_ptr) {
X    case '0': case '1': case '2': case '3': case '4':
X    case '5': case '6': case '7': case '8': case '9': case '&':
X    if (curspat) {
X        paren = atoi(stab_name(stab));
X      getparen:
X        if (curspat->spat_regexp &&
X          paren <= curspat->spat_regexp->nparens &&
X          (s = curspat->spat_regexp->startp[paren]) ) {
X        i = curspat->spat_regexp->endp[paren] - s;
X        if (i >= 0)
X            str_nset(stab_val(stab),s,i);
X        else
X            str_sset(stab_val(stab),&str_undef);
X        }
X        else
X        str_sset(stab_val(stab),&str_undef);
X    }
X    break;
X    case '+':
X    if (curspat) {
X        paren = curspat->spat_regexp->lastparen;
X        goto getparen;
X    }
X    break;
X    case '`':
X    if (curspat) {
X        if (curspat->spat_regexp &&
X          (s = curspat->spat_regexp->subbase) ) {
X        i = curspat->spat_regexp->startp[0] - s;
X        if (i >= 0)
X            str_nset(stab_val(stab),s,i);
X        else
X            str_nset(stab_val(stab),"",0);
X        }
X        else
X        str_nset(stab_val(stab),"",0);
X    }
X    break;
X    case '\'':
X    if (curspat) {
X        if (curspat->spat_regexp &&
X          (s = curspat->spat_regexp->endp[0]) ) {
X        str_set(stab_val(stab),s);
X        }
X        else
X        str_nset(stab_val(stab),"",0);
X    }
X    break;
X    case '.':
X#ifndef lint
X    if (last_in_stab) {
X        str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
X    }
X#endif
X    break;
X    case '?':
X    str_numset(stab_val(stab),(double)statusvalue);
X    break;
X    case '^':
X    s = stab_io(curoutstab)->top_name;
X    str_set(stab_val(stab),s);
X    break;
X    case '~':
X    s = stab_io(curoutstab)->fmt_name;
X    str_set(stab_val(stab),s);
X    break;
X#ifndef lint
X    case '=':
X    str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
X    break;
X    case '-':
X    str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
X    break;
X    case '%':
X    str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
X    break;
X#endif
X    case '/':
X    *tokenbuf = record_separator;
X    tokenbuf[1] = '\0';
X    str_nset(stab_val(stab),tokenbuf,rslen);
X    break;
X    case '[':
X    str_numset(stab_val(stab),(double)arybase);
X    break;
X    case '|':
X    str_numset(stab_val(stab),
X       (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
X    break;
X    case ',':
X    str_nset(stab_val(stab),ofs,ofslen);
X    break;
X    case '\\':
X    str_nset(stab_val(stab),ors,orslen);
X    break;
X    case '#':
X    str_set(stab_val(stab),ofmt);
X    break;
X    case '!':
X    str_numset(stab_val(stab), (double)errno);
X    str_set(stab_val(stab),
X      errno < 0 || errno > sys_nerr ? "(unknown)" : sys_errlist[errno]);
X    stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
X    break;
X    case '<':
X    str_numset(stab_val(stab),(double)uid);
X    break;
X    case '>':
X    str_numset(stab_val(stab),(double)euid);
X    break;
X    case '(':
X    s = buf;
X    (void)sprintf(s,"%d",(int)gid);
X    goto add_groups;
X    case ')':
X    s = buf;
X    (void)sprintf(s,"%d",(int)egid);
X      add_groups:
X    while (*s) s++;
X#ifdef GETGROUPS
X#ifndef NGROUPS
X#define NGROUPS 32
X#endif
X    {
X        GIDTYPE gary[NGROUPS];
X
X        i = getgroups(NGROUPS,gary);
X        while (--i >= 0) {
X        (void)sprintf(s," %ld", (long)gary[i]);
X        while (*s) s++;
X        }
X    }
X#endif
X    str_set(stab_val(stab),buf);
X    break;
X    }
X    return stab_val(stab);
X}
X
Xstabset(mstr,str)
Xregister STR *mstr;
XSTR *str;
X{
X    STAB *stab = mstr->str_u.str_stab;
X    char *s;
X    int i;
X    int sighandler();
X
X    switch (mstr->str_rare) {
X    case 'E':
X    setenv(mstr->str_ptr,str_get(str));
X                /* And you'll never guess what the dog had */
X    break;            /*   in its mouth... */
X    case 'S':
X    s = str_get(str);
X    i = whichsig(mstr->str_ptr);    /* ...no, a brick */
X    if (strEQ(s,"IGNORE"))
X#ifndef lint
X        (void)signal(i,SIG_IGN);
X#else
X        ;
X#endif
X    else if (strEQ(s,"DEFAULT") || !*s)
X        (void)signal(i,SIG_DFL);
X    else
X        (void)signal(i,sighandler);
X    break;
X#ifdef SOME_DBM
X    case 'D':
X    hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
X    break;
X#endif
X    case '#':
X    afill(stab_array(stab), (int)str_gnum(str) - arybase);
X    break;
X    case 'X':    /* merely a copy of a * string */
X    break;
X    case '*':
X    s = str_get(str);
X    if (strnNE(s,"Stab",4) || str->str_cur != sizeof(STBP)) {
X        if (!*s) {
X        STBP *stbp;
X
X        (void)savenostab(stab);    /* schedule a free of this stab */
X        if (stab->str_len)
X            Safefree(stab->str_ptr);
X        Newz(601,stbp, 1, STBP);
X        stab->str_ptr = stbp;
X        stab->str_len = stab->str_cur = sizeof(STBP);
X        stab->str_pok = 1;
X        strncpy(stab_magic(stab),"Stab",4);
X        stab_val(stab) = Str_new(70,0);
X        stab_line(stab) = line;
X        }
X        else
X        stab = stabent(s,TRUE);
X        str_sset(str,stab);
X    }
X    break;
X    case 's': {
X        struct lstring *lstr = (struct lstring*)str;
X
X        mstr->str_rare = 0;
X        str->str_magic = Nullstr;
X        str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
X          str->str_ptr,str->str_cur);
X    }
X    break;
X
X    case 'v':
X    do_vecset(mstr,str);
X    break;
X
X    case 0:
X    switch (*stab->str_magic->str_ptr) {
X    case '^':
X        Safefree(stab_io(curoutstab)->top_name);
X        stab_io(curoutstab)->top_name = s = savestr(str_get(str));
X        stab_io(curoutstab)->top_stab = stabent(s,TRUE);
X        break;
X    case '~':
X        Safefree(stab_io(curoutstab)->fmt_name);
X        stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
X        stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
X        break;
X    case '=':
X        stab_io(curoutstab)->page_len = (long)str_gnum(str);
X        break;
X    case '-':
X        stab_io(curoutstab)->lines_left = (long)str_gnum(str);
X        if (stab_io(curoutstab)->lines_left < 0L)
X        stab_io(curoutstab)->lines_left = 0L;
X        break;
X    case '%':
X        stab_io(curoutstab)->page = (long)str_gnum(str);
X        break;
X    case '|':
X        stab_io(curoutstab)->flags &= ~IOF_FLUSH;
X        if (str_gnum(str) != 0.0) {
X        stab_io(curoutstab)->flags |= IOF_FLUSH;
X        }
X        break;
X    case '*':
X        i = (int)str_gnum(str);
X        multiline = (i != 0);
X        break;
X    case '/':
X        record_separator = *str_get(str);
X        rslen = str->str_cur;
X        break;
X    case '\\':
X        if (ors)
X        Safefree(ors);
X        ors = savestr(str_get(str));
X        orslen = str->str_cur;
X        break;
X    case ',':
X        if (ofs)
X        Safefree(ofs);
X        ofs = savestr(str_get(str));
X        ofslen = str->str_cur;
X        break;
X    case '#':
X        if (ofmt)
X        Safefree(ofmt);
X        ofmt = savestr(str_get(str));
X        break;
X    case '[':
X        arybase = (int)str_gnum(str);
X        break;
X    case '?':
X        statusvalue = (unsigned short)str_gnum(str);
X        break;
X    case '!':
X        errno = (int)str_gnum(str);        /* will anyone ever use this? */
X        break;
X    case '<':
X        uid = (int)str_gnum(str);
X#ifdef SETREUID
X        if (delaymagic) {
X        delaymagic |= DM_REUID;
X        break;                /* don't do magic till later */
X        }
X#endif /* SETREUID */
X#ifdef SETRUID
X        if (setruid((UIDTYPE)uid) < 0)
X        uid = (int)getuid();
X#else
X#ifdef SETREUID
X        if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
X        uid = (int)getuid();
X#else
X        fatal("setruid() not implemented");
X#endif
X#endif
X        break;
X    case '>':
X        euid = (int)str_gnum(str);
X#ifdef SETREUID
X        if (delaymagic) {
X        delaymagic |= DM_REUID;
X        break;                /* don't do magic till later */
X        }
X#endif /* SETREUID */
X#ifdef SETEUID
X        if (seteuid((UIDTYPE)euid) < 0)
X        euid = (int)geteuid();
X#else
X#ifdef SETREUID
X        if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
X        euid = (int)geteuid();
X#else
X        fatal("seteuid() not implemented");
X#endif
X#endif
X        break;
X    case '(':
X        gid = (int)str_gnum(str);
X#ifdef SETREGID
X        if (delaymagic) {
X        delaymagic |= DM_REGID;
X        break;                /* don't do magic till later */
X        }
X#endif /* SETREGID */
X#ifdef SETRGID
X        (void)setrgid((GIDTYPE)gid);
X#else
X#ifdef SETREGID
X        (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
X#else
X        fatal("setrgid() not implemented");
X#endif
X#endif
X        break;
X    case ')':
X        egid = (int)str_gnum(str);
X#ifdef SETREGID
X        if (delaymagic) {
X        delaymagic |= DM_REGID;
X        break;                /* don't do magic till later */
X        }
X#endif /* SETREGID */
X#ifdef SETEGID
X        (void)setegid((GIDTYPE)egid);
X#else
X#ifdef SETREGID
X        (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
X#else
X        fatal("setegid() not implemented");
X#endif
X#endif
X        break;
X    case ':':
X        chopset = str_get(str);
X        break;
X    }
X    break;
X    }
X}
X
Xwhichsig(sig)
Xchar *sig;
X{
X    register char **sigv;
X
X    for (sigv = sig_name+1; *sigv; sigv++)
X    if (strEQ(sig,*sigv))
X        return sigv - sig_name;
X#ifdef SIGCLD
X    if (strEQ(sig,"CHLD"))
X    return SIGCLD;
X#endif
X#ifdef SIGCHLD
X    if (strEQ(sig,"CLD"))
X    return SIGCHLD;
X#endif
X    return 0;
X}
X
Xsighandler(sig)
Xint sig;
X{
X    STAB *stab;
X    ARRAY *savearray;
X    STR *str;
X    char *oldfile = filename;
X    int oldsave = savestack->ary_fill;
X    ARRAY *oldstack = stack;
X    SUBR *sub;
X
X    stab = stabent(
X    str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
X      TRUE)), TRUE);
X    sub = stab_sub(stab);
X    if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
X    if (sig_name[sig][1] == 'H')
X        stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
X          TRUE);
X    else
X        stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
X          TRUE);
X    sub = stab_sub(stab);    /* gag */
X    }
X    if (!sub) {
X    if (dowarn)
X        warn("SIG%s handler \"%s\" not defined.\n",
X        sig_name[sig], stab_name(stab) );
X    return;
X    }
X    savearray = stab_xarray(defstab);
X    stab_xarray(defstab) = stack = anew(defstab);
X    stack->ary_flags = 0;
X    str = Str_new(71,0);
X    str_set(str,sig_name[sig]);
X    (void)apush(stab_xarray(defstab),str);
X    sub->depth++;
X    if (sub->depth >= 2) {    /* save temporaries on recursion? */
X    if (sub->depth == 100 && dowarn)
X        warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
X    savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
X    }
X    filename = sub->filename;
X
X    (void)cmd_exec(sub->cmd,G_SCALAR,1);        /* so do it already */
X
X    sub->depth--;    /* assuming no longjumps out of here */
X    str_free(stack->ary_array[0]);    /* free the one real string */
X    afree(stab_xarray(defstab));  /* put back old $_[] */
X    stab_xarray(defstab) = savearray;
X    stack = oldstack;
X    filename = oldfile;
X    if (savestack->ary_fill > oldsave)
X    restorelist(oldsave);
X}
X
XSTAB *
Xaadd(stab)
Xregister STAB *stab;
X{
X    if (!stab_xarray(stab))
X    stab_xarray(stab) = anew(stab);
X    return stab;
X}
X
XSTAB *
Xhadd(stab)
Xregister STAB *stab;
X{
X    if (!stab_xhash(stab))
X    stab_xhash(stab) = hnew(COEFFSIZE);
X    return stab;
X}
X
XSTAB *
Xstabent(name,add)
Xregister char *name;
Xint add;
X{
X    register STAB *stab;
X    register STBP *stbp;
X    int len;
X    register char *namend;
X    HASH *stash;
X    char *sawquote = Nullch;
X    char *prevquote = Nullch;
X    bool global = FALSE;
X
X    if (isascii(*name) && isupper(*name)) {
X    if (*name > 'I') {
X        if (*name == 'S' && (
X          strEQ(name, "SIG") ||
X          strEQ(name, "STDIN") ||
X          strEQ(name, "STDOUT") ||
X          strEQ(name, "STDERR") ))
X        global = TRUE;
X    }
X    else if (*name > 'E') {
X        if (*name == 'I' && strEQ(name, "INC"))
X        global = TRUE;
X    }
X    else if (*name >= 'A') {
X        if (*name == 'E' && strEQ(name, "ENV"))
X        global = TRUE;
X    }
X    else if (*name == 'A' && (
X      strEQ(name, "ARGV") ||
X      strEQ(name, "ARGVOUT") ))
X        global = TRUE;
X    }
X    for (namend = name; *namend; namend++) {
X    if (*namend == '\'' && namend[1])
X        prevquote = sawquote, sawquote = namend;
X    }
X    if (sawquote == name && name[1]) {
X    stash = defstash;
X    sawquote = Nullch;
X    name++;
X    }
X    else if (!isalpha(*name) || global)
X    stash = defstash;
X    else
X    stash = curstash;
X    if (sawquote) {
X    char tmpbuf[256];
X    char *s, *d;
X
X    *sawquote = '\0';
X    if (s = prevquote) {
X        strncpy(tmpbuf,name,s-name+1);
X        d = tmpbuf+(s-name+1);
X        *d++ = '_';
X        strcpy(d,s+1);
X    }
X    else {
X        *tmpbuf = '_';
X        strcpy(tmpbuf+1,name);
X    }
X    stab = stabent(tmpbuf,TRUE);
X    if (!(stash = stab_xhash(stab)))
X        stash = stab_xhash(stab) = hnew(0);
X    name = sawquote+1;
X    *sawquote = '\'';
X    }
X    len = namend - name;
X    stab = (STAB*)hfetch(stash,name,len,add);
X    if (!stab)
X    return Nullstab;
X    if (stab->str_pok) {
X    stab->str_pok |= SP_MULTI;
X    return stab;
X    }
X    else {
X    if (stab->str_len)
X        Safefree(stab->str_ptr);
X    Newz(602,stbp, 1, STBP);
X    stab->str_ptr = stbp;
X    stab->str_len = stab->str_cur = sizeof(STBP);
X    stab->str_pok = 1;
X    strncpy(stab_magic(stab),"Stab",4);
X    stab_val(stab) = Str_new(72,0);
X    stab_line(stab) = line;
X    str_magic(stab,stab,'*',name,len);
X    return stab;
X    }
X}
X
XSTIO *
Xstio_new()
X{
X    STIO *stio;
X
X    Newz(603,stio,1,STIO);
X    stio->page_len = 60;
X    return stio;
X}
X
Xstab_check(min,max)
Xint min;
Xregister int max;
X{
X    register HENT *entry;
X    register int i;
X    register STAB *stab;
X
X    for (i = min; i <= max; i++) {
X    for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
X        stab = (STAB*)entry->hent_val;
X        if (stab->str_pok & SP_MULTI)
X        continue;
X        line = stab_line(stab);
X        warn("Possible typo: \"%s\"", stab_name(stab));
X    }
X    }
X}
X
Xstatic int gensym = 0;
X
XSTAB *
Xgenstab()
X{
X    (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
X    return stabent(tokenbuf,TRUE);
X}
X
X/* hopefully this is only called on local symbol table entries */
X
Xvoid
Xstab_clear(stab)
Xregister STAB *stab;
X{
X    STIO *stio;
X    SUBR *sub;
X
X    afree(stab_xarray(stab));
X    (void)hfree(stab_xhash(stab));
X    str_free(stab_val(stab));
X    if (stio = stab_io(stab)) {
X    do_close(stab,FALSE);
X    Safefree(stio->top_name);
X    Safefree(stio->fmt_name);
X    }
X    if (sub = stab_sub(stab)) {
X    afree(sub->tosave);
X    cmd_free(sub->cmd);
X    }
X    Safefree(stab->str_ptr);
X    stab->str_ptr = Null(STBP*);
X    stab->str_len = 0;
X    stab->str_cur = 0;
X}
X
!STUFFY!FUNK!
echo ""
echo "End of kit 9 (of 24)"
cat /dev/null >kit9isdone
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...
exit