perl 3.0 beta kit [7/23]
Larry Wall
lwall at jato.Jpl.Nasa.Gov
Sun Sep 3 11:55:10 AEST 1989
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 23 through sh. When all 23 kits have been run, read README.
echo "This is perl 3.0 kit 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
More information about the Alt.sources
mailing list