lwall@jato.Jpl.Nasa.Gov (Larry Wall) (09/03/89)
#! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 23 through sh. When all 23 kits have been run, read README. echo "This is perl 3.0 kit 7 (of 23). If kit 7 is complete, the line" echo '"'"End of kit 7 (of 23)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir lib 2>/dev/null echo Extracting perl.man.3 sed >perl.man.3 <<'!STUFFY!FUNK!' -e 's/X//' X''' Beginning of part 3 X''' $Header$ X''' X''' $Log$ 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 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, \'\' 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: $!\n"; 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. 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 "ord(EXPR)" 8 4 X.Ip "ord EXPR" 8 XReturns the ascii value of the first character of EXPR. 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. 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 "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). X.Ip "recv(FILEHANDLE,SCALAR,LEN,FLAGS)" 8 4 XReceives a message on a socket. XAttempts to receive LENGTH bytes of data into variable SCALAR from the specified XFILEHANDLE. 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 EXPR" 8 3 XReturns from a subroutine with the value specified. XIf no EXPR is given, returns with the value of $_. 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 "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). 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 "select(FILEHANDLE)" 8 3 XSets the current default filehandle for output. 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 XSelect happens to return TRUE if the file is currently open and FALSE otherwise, Xbut this has no effect on its operation. XFILEHANDLE may be an expression whose value gives the name of the actual filehandle. 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(FILEHANDLE,MSG,FLAGS,TO)" 8 4 X.Ip "send(FILEHANDLE,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 so 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 "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. 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 "sin(EXPR)" 8 4 X.Ip "sin EXPR" 8 XReturns the sine of EXPR (expressed in radians). 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 "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. X.Ip "srand(EXPR)" 8 4 X.Ip "srand EXPR" 8 XSets the random number seed for the X.I rand Xoperator. 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 "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 "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. 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; 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 current execution context is looking for an array value. XReturns false if the context is looking for a scalar. XMost useful in subroutines. 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 stab.c sed >stab.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: stab.c,v 2.0.1.7 88/11/22 01:15:37 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 */ 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_nset(stab_val(stab),"",0); X } X else X str_nset(stab_val(stab),"",0); 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)getgid()); X goto add_groups; X case ')': X s = buf; X (void)sprintf(s,"%d",(int)getegid()); 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 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(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 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 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#ifdef SETRGID X (void)setrgid((GIDTYPE)str_gnum(str)); X#else X#ifdef SETREGID X (void)setregid((GIDTYPE)str_gnum(str), (GIDTYPE)-1); X#else X fatal("setrgid() not implemented"); X#endif X#endif X break; X case ')': X#ifdef SETEGID X (void)setegid((GIDTYPE)str_gnum(str)); X#else X#ifdef SETREGID X (void)setregid((GIDTYPE)-1, (GIDTYPE)str_gnum(str)); 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(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(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_flags(stab) & SF_MULTI) X continue; X if (i == 'A' && strEQ(stab_name(stab), "ARGV")) X continue; X if (i == 'E' && strEQ(stab_name(stab), "ENV")) X continue; X if (i == 'S' && strEQ(stab_name(stab), "SIG")) X continue; X if (i == 'I' && strEQ(stab_name(stab), "INC")) 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 Extracting lib/getopt.pl sed >lib/getopt.pl <<'!STUFFY!FUNK!' -e 's/X//' X;# $Header: getopt.pl,v 2.0 88/06/05 00:16:22 root Exp $ X X;# Process single-character switches with switch clustering. Pass one argument X;# which is a string containing all switches that take an argument. For each X;# switch found, sets $opt_x (where x is the switch name) to the value of the X;# argument, or 1 if no argument. Switches which take an argument don't care X;# whether there is a space between the switch and the argument. X X;# Usage: X;# do Getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. X Xsub Getopt { X local($argumentative) = @_; X local($_,$first,$rest); X X while (($_ = $ARGV[0]) =~ /^-(.)(.*)/) { X ($first,$rest) = ($1,$2); X if (index($argumentative,$first) >= $[) { X if ($rest ne '') { X shift; X } X else { X shift; X $rest = shift; X } X eval "\$opt_$first = \$rest;"; X } X else { X eval "\$opt_$first = 1;"; X if ($rest ne '') { X $ARGV[0] = "-$rest"; X } X else { X shift; X } X } X } X} X X1; !STUFFY!FUNK! echo "" echo "End of kit 7 (of 23)" cat /dev/null >kit7isdone run='' config='' for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23; do if test -f kit${iskit}isdone; then run="$run $iskit" else todo="$todo $iskit" fi done case $todo in '') echo "You have run all your kits. Please read README and then type Configure." chmod 755 Configure ;; *) echo "You have run$run." echo "You still need to run$todo." ;; esac : Someone might mail this, so... exit