home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume20 / perl3.0 / part09 < prev    next >
Text File  |  1989-10-30  |  50KB  |  1,735 lines
  1. Subject:  v20i092:  Perl, a language with features of C/sed/awk/shell/etc, Part09/24
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
  7. Posting-number: Volume 20, Issue 92
  8. Archive-name: perl3.0/part09
  9.  
  10. #! /bin/sh
  11.  
  12. # Make a new directory for the perl sources, cd to it, and run kits 1
  13. # thru 24 through sh.  When all 24 kits have been run, read README.
  14.  
  15. echo "This is perl 3.0 kit 9 (of 24).  If kit 9 is complete, the line"
  16. echo '"'"End of kit 9 (of 24)"'" will echo at the end.'
  17. echo ""
  18. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  19. mkdir  2>/dev/null
  20. echo Extracting perl.man.2
  21. sed >perl.man.2 <<'!STUFFY!FUNK!' -e 's/X//'
  22. X''' Beginning of part 2
  23. X''' $Header: perl.man.2,v 3.0 89/10/18 15:21:37 lwall Locked $
  24. X'''
  25. X''' $Log:    perl.man.2,v $
  26. X''' Revision 3.0  89/10/18  15:21:37  lwall
  27. X''' 3.0 baseline
  28. X''' 
  29. X'''
  30. X.PP
  31. XAlong with the literals and variables mentioned earlier,
  32. Xthe operations in the following section can serve as terms in an expression.
  33. XSome of these operations take a LIST as an argument.
  34. XSuch a list can consist of any combination of scalar arguments or array values;
  35. Xthe array values will be included in the list as if each individual element were
  36. Xinterpolated at that point in the list, forming a longer single-dimensional
  37. Xarray value.
  38. XElements of the LIST should be separated by commas.
  39. XIf an operation is listed both with and without parentheses around its
  40. Xarguments, it means you can either use it as a unary operator or
  41. Xas a function call.
  42. XTo use it as a function call, the next token on the same line must
  43. Xbe a left parenthesis.
  44. X(There may be intervening white space.)
  45. XSuch a function then has highest precedence, as you would expect from
  46. Xa function.
  47. XIf any token other than a left parenthesis follows, then it is a
  48. Xunary operator, with a precedence depending only on whether it is a LIST
  49. Xoperator or not.
  50. XLIST operators have lowest precedence.
  51. XAll other unary operators have a precedence greater than relational operators
  52. Xbut less than arithmetic operators.
  53. XSee the section on Precedence.
  54. X.Ip "/PATTERN/" 8 4
  55. XSee m/PATTERN/.
  56. X.Ip "?PATTERN?" 8 4
  57. XThis is just like the /pattern/ search, except that it matches only once between
  58. Xcalls to the
  59. X.I reset
  60. Xoperator.
  61. XThis is a useful optimization when you only want to see the first occurrence of
  62. Xsomething in each file of a set of files, for instance.
  63. XOnly ?? patterns local to the current package are reset.
  64. X.Ip "accept(NEWSOCKET,GENERICSOCKET)" 8 2
  65. XDoes the same thing that the accept system call does.
  66. XReturns true if it succeeded, false otherwise.
  67. XSee example in section on Interprocess Communication.
  68. X.Ip "atan2(X,Y)" 8 2
  69. XReturns the arctangent of X/Y in the range
  70. X.if t \-\(*p to \(*p.
  71. X.if n \-PI to PI.
  72. X.Ip "bind(SOCKET,NAME)" 8 2
  73. XDoes the same thing that the bind system call does.
  74. XReturns true if it succeeded, false otherwise.
  75. XNAME should be a packed address of the proper type for the socket.
  76. XSee example in section on Interprocess Communication.
  77. X.Ip "chdir(EXPR)" 8 2
  78. X.Ip "chdir EXPR" 8 2
  79. XChanges the working directory to EXPR, if possible.
  80. XIf EXPR is omitted, changes to home directory.
  81. XReturns 1 upon success, 0 otherwise.
  82. XSee example under
  83. X.IR die .
  84. X.Ip "chmod(LIST)" 8 2
  85. X.Ip "chmod LIST" 8 2
  86. XChanges the permissions of a list of files.
  87. XThe first element of the list must be the numerical mode.
  88. XReturns the number of files successfully changed.
  89. X.nf
  90. X
  91. X.ne 2
  92. X    $cnt = chmod 0755, \'foo\', \'bar\';
  93. X    chmod 0755, @executables;
  94. X
  95. X.fi
  96. X.Ip "chop(LIST)" 8 7
  97. X.Ip "chop(VARIABLE)" 8
  98. X.Ip "chop VARIABLE" 8
  99. X.Ip "chop" 8
  100. XChops off the last character of a string and returns the character chopped.
  101. XIt's used primarily to remove the newline from the end of an input record,
  102. Xbut is much more efficient than s/\en// because it neither scans nor copies
  103. Xthe string.
  104. XIf VARIABLE is omitted, chops $_.
  105. XExample:
  106. X.nf
  107. X
  108. X.ne 5
  109. X    while (<>) {
  110. X        chop;    # avoid \en on last field
  111. X        @array = split(/:/);
  112. X        .\|.\|.
  113. X    }
  114. X
  115. X.fi
  116. XYou can actually chop anything that's an lvalue, including an assignment:
  117. X.nf
  118. X
  119. X    chop($cwd = \`pwd\`);
  120. X    chop($answer = <STDIN>);
  121. X
  122. X.fi
  123. XIf you chop a list, each element is chopped.
  124. XOnly the value of the last chop is returned.
  125. X.Ip "chown(LIST)" 8 2
  126. X.Ip "chown LIST" 8 2
  127. XChanges the owner (and group) of a list of files.
  128. XThe first two elements of the list must be the NUMERICAL uid and gid,
  129. Xin that order.
  130. XReturns the number of files successfully changed.
  131. X.nf
  132. X
  133. X.ne 2
  134. X    $cnt = chown $uid, $gid, \'foo\', \'bar\';
  135. X    chown $uid, $gid, @filenames;
  136. X
  137. X.fi
  138. X.ne 23
  139. XHere's an example of looking up non-numeric uids:
  140. X.nf
  141. X
  142. X    print "User: ";
  143. X    $user = <STDIN>;
  144. X    chop($user);
  145. X    print "Files: "
  146. X    $pattern = <STDIN>;
  147. X    chop($pattern);
  148. X    open(pass, \'/etc/passwd\') || die "Can't open passwd: $!\en";
  149. X    while (<pass>) {
  150. X        ($login,$pass,$uid,$gid) = split(/:/);
  151. X        $uid{$login} = $uid;
  152. X        $gid{$login} = $gid;
  153. X    }
  154. X    @ary = <$pattern>;    # get filenames
  155. X    if ($uid{$user} eq \'\') {
  156. X        die "$user not in passwd file";
  157. X    }
  158. X    else {
  159. X        chown $uid{$user}, $gid{$user}, @ary;
  160. X    }
  161. X
  162. X.fi
  163. X.Ip "chroot(FILENAME)" 8 5
  164. X.Ip "chroot FILENAME" 8
  165. XDoes the same as the system call of that name.
  166. XIf you don't know what it does, don't worry about it.
  167. XIf FILENAME is omitted, does chroot to $_.
  168. X.Ip "close(FILEHANDLE)" 8 5
  169. X.Ip "close FILEHANDLE" 8
  170. XCloses the file or pipe associated with the file handle.
  171. XYou don't have to close FILEHANDLE if you are immediately going to
  172. Xdo another open on it, since open will close it for you.
  173. X(See
  174. X.IR open .)
  175. XHowever, an explicit close on an input file resets the line counter ($.), while
  176. Xthe implicit close done by
  177. X.I open
  178. Xdoes not.
  179. XAlso, closing a pipe will wait for the process executing on the pipe to complete,
  180. Xin case you want to look at the output of the pipe afterwards.
  181. XClosing a pipe explicitly also puts the status value of the command into $?.
  182. XExample:
  183. X.nf
  184. X
  185. X.ne 4
  186. X    open(OUTPUT, \'|sort >foo\');    # pipe to sort
  187. X    .\|.\|.    # print stuff to output
  188. X    close OUTPUT;        # wait for sort to finish
  189. X    open(INPUT, \'foo\');    # get sort's results
  190. X
  191. X.fi
  192. XFILEHANDLE may be an expression whose value gives the real filehandle name.
  193. X.Ip "closedir(DIRHANDLE)" 8 5
  194. X.Ip "closedir DIRHANDLE" 8
  195. XCloses a directory opened by opendir().
  196. X.Ip "connect(SOCKET,NAME)" 8 2
  197. XDoes the same thing that the connect system call does.
  198. XReturns true if it succeeded, false otherwise.
  199. XNAME should be a package address of the proper type for the socket.
  200. XSee example in section on Interprocess Communication.
  201. X.Ip "cos(EXPR)" 8 6
  202. X.Ip "cos EXPR" 8 6
  203. XReturns the cosine of EXPR (expressed in radians).
  204. XIf EXPR is omitted takes cosine of $_.
  205. X.Ip "crypt(PLAINTEXT,SALT)" 8 6
  206. XEncrypts a string exactly like the crypt() function in the C library.
  207. XUseful for checking the password file for lousy passwords.
  208. XOnly the guys wearing white hats should do this.
  209. X.Ip "dbmclose(ASSOC_ARRAY)" 8 6
  210. X.Ip "dbmclose ASSOC_ARRAY" 8
  211. XBreaks the binding between a dbm file and an associative array.
  212. XThe values remaining in the associative array are meaningless unless
  213. Xyou happen to want to know what was in the cache for the dbm file.
  214. XThis function is only useful if you have ndbm.
  215. X.Ip "dbmopen(ASSOC,DBNAME,MODE)" 8 6
  216. XThis binds a dbm or ndbm file to an associative array.
  217. XASSOC is the name of the associative array.
  218. X(Unlike normal open, the first argument is NOT a filehandle, even though
  219. Xit looks like one).
  220. XDBNAME is the name of the database (without the .dir or .pag extension).
  221. XIf the database does not exist, it is created with protection specified
  222. Xby MODE (as modified by the umask).
  223. XIf your system only supports the older dbm functions, you may only have one
  224. Xdbmopen in your program.
  225. XIf your system has neither dbm nor ndbm, calling dbmopen produces a fatal
  226. Xerror.
  227. X.Sp
  228. XValues assigned to the associative array prior to the dbmopen are lost.
  229. XA certain number of values from the dbm file are cached in memory.
  230. XBy default this number is 64, but you can increase it by preallocating
  231. Xthat number of garbage entries in the associative array before the dbmopen.
  232. XYou can flush the cache if necessary with the reset command.
  233. X.Sp
  234. XIf you don't have write access to the dbm file, you can only read
  235. Xassociative array variables, not set them.
  236. XIf you want to test whether you can write, either use file tests or
  237. Xtry setting a dummy array entry inside an eval, which will trap the error.
  238. X.Sp
  239. XNote that functions such as keys() and values() may return huge array values
  240. Xwhen used on large dbm files.
  241. XYou may prefer to use the each() function to iterate over large dbm files.
  242. XExample:
  243. X.nf
  244. X
  245. X.ne 6
  246. X    # print out history file offsets
  247. X    dbmopen(HIST,'/usr/lib/news/history',0666);
  248. X    while (($key,$val) = each %HIST) {
  249. X        print $key, ' = ', unpack('L',$val), "\en";
  250. X    }
  251. X    dbmclose(HIST);
  252. X
  253. X.fi
  254. X.Ip "defined(EXPR)" 8 6
  255. X.Ip "defined EXPR" 8
  256. XReturns a boolean value saying whether the lvalue EXPR has a real value
  257. Xor not.
  258. XMany operations return the undefined value under exceptional conditions,
  259. Xsuch as end of file, uninitialized variable, system error and such.
  260. XThis function allows you to distinguish between an undefined null string
  261. Xand a defined null string with operations that might return a real null
  262. Xstring, in particular referencing elements of an array.
  263. XYou may also check to see if arrays or subroutines exist.
  264. XUse on predefined variables is not guaranteed to produce intuitive results.
  265. XExamples:
  266. X.nf
  267. X
  268. X.ne 7
  269. X    print if defined $switch{'D'};
  270. X    print "$val\en" while defined($val = pop(@ary));
  271. X    die "Can't readlink $sym: $!"
  272. X        unless defined($value = readlink $sym);
  273. X    eval '@foo = ()' if defined(@foo);
  274. X    die "No XYZ package defined" unless defined %_XYZ;
  275. X    sub foo { defined &bar ? &bar(@_) : die "No bar"; }
  276. X
  277. X.fi
  278. XSee also undef.
  279. X.Ip "delete $ASSOC{KEY}" 8 6
  280. XDeletes the specified value from the specified associative array.
  281. XReturns the deleted value, or the undefined value if nothing was deleted.
  282. XDeleting from $ENV{} modifies the environment.
  283. XDeleting from an array bound to a dbm file deletes the entry from the dbm
  284. Xfile.
  285. X.Sp
  286. XThe following deletes all the values of an associative array:
  287. X.nf
  288. X
  289. X.ne 3
  290. X    foreach $key (keys %ARRAY) {
  291. X        delete $ARRAY{$key};
  292. X    }
  293. X
  294. X.fi
  295. X(But it would be faster to use the
  296. X.I reset
  297. Xcommand.
  298. XSaying undef %ARRAY is faster yet.)
  299. X.Ip "die(LIST)" 8
  300. X.Ip "die LIST" 8
  301. XPrints the value of LIST to
  302. X.I STDERR
  303. Xand exits with the current value of $!
  304. X(errno).
  305. XIf $! is 0, exits with the value of ($? >> 8) (\`command\` status).
  306. XIf ($? >> 8) is 0, exits with 255.
  307. XEquivalent examples:
  308. X.nf
  309. X
  310. X.ne 3
  311. X    die "Can't cd to spool: $!\en" unless chdir \'/usr/spool/news\';
  312. X
  313. X    chdir \'/usr/spool/news\' || die "Can't cd to spool: $!\en" 
  314. X
  315. X.fi
  316. X.Sp
  317. XIf the value of EXPR does not end in a newline, the current script line
  318. Xnumber and input line number (if any) are also printed, and a newline is
  319. Xsupplied.
  320. XHint: sometimes appending \*(L", stopped\*(R" to your message will cause it to make
  321. Xbetter sense when the string \*(L"at foo line 123\*(R" is appended.
  322. XSuppose you are running script \*(L"canasta\*(R".
  323. X.nf
  324. X
  325. X.ne 7
  326. X    die "/etc/games is no good";
  327. X    die "/etc/games is no good, stopped";
  328. X
  329. Xproduce, respectively
  330. X
  331. X    /etc/games is no good at canasta line 123.
  332. X    /etc/games is no good, stopped at canasta line 123.
  333. X
  334. X.fi
  335. XSee also
  336. X.IR exit .
  337. X.Ip "do BLOCK" 8 4
  338. XReturns the value of the last command in the sequence of commands indicated
  339. Xby BLOCK.
  340. XWhen modified by a loop modifier, executes the BLOCK once before testing the
  341. Xloop condition.
  342. X(On other statements the loop modifiers test the conditional first.)
  343. X.Ip "do SUBROUTINE (LIST)" 8 3
  344. XExecutes a SUBROUTINE declared by a
  345. X.I sub
  346. Xdeclaration, and returns the value
  347. Xof the last expression evaluated in SUBROUTINE.
  348. XIf there is no subroutine by that name, produces a fatal error.
  349. X(You may use the \*(L"defined\*(R" operator to determine if a subroutine
  350. Xexists.)
  351. XIf you pass arrays as part of LIST you may wish to pass the length
  352. Xof the array in front of each array.
  353. X(See the section on subroutines later on.)
  354. XSUBROUTINE may be a scalar variable, in which case the variable contains
  355. Xthe name of the subroutine to execute.
  356. XThe parentheses are required to avoid confusion with the \*(L"do EXPR\*(R"
  357. Xform.
  358. X.Sp
  359. XAs an alternate form, you may call a subroutine by prefixing the name with
  360. Xan ampersand: &foo(@args).
  361. XIf you aren't passing any arguments, you don't have to use parentheses.
  362. XIf you omit the parentheses, no @_ array is passed to the subroutine.
  363. XThe & form is also used to specify subroutines to the defined and undef
  364. Xoperators.
  365. X.Ip "do EXPR" 8 3
  366. XUses the value of EXPR as a filename and executes the contents of the file
  367. Xas a
  368. X.I perl
  369. Xscript.
  370. XIts primary use is to include subroutines from a
  371. X.I perl
  372. Xsubroutine library.
  373. X.nf
  374. X
  375. X    do \'stat.pl\';
  376. X
  377. Xis just like
  378. X
  379. X    eval \`cat stat.pl\`;
  380. X
  381. X.fi
  382. Xexcept that it's more efficient, more concise, keeps track of the current
  383. Xfilename for error messages, and searches all the
  384. X.B \-I
  385. Xlibraries if the file
  386. Xisn't in the current directory (see also the @INC array in Predefined Names).
  387. XIt's the same, however, in that it does reparse the file every time you
  388. Xcall it, so if you are going to use the file inside a loop you might prefer
  389. Xto use \-P and #include, at the expense of a little more startup time.
  390. X(The main problem with #include is that cpp doesn't grok # comments\*(--a
  391. Xworkaround is to use \*(L";#\*(R" for standalone comments.)
  392. XNote that the following are NOT equivalent:
  393. X.nf
  394. X
  395. X.ne 2
  396. X    do $foo;    # eval a file
  397. X    do $foo();    # call a subroutine
  398. X
  399. X.fi
  400. X.Ip "dump LABEL" 8 6
  401. XThis causes an immediate core dump.
  402. XPrimarily this is so that you can use the undump program to turn your
  403. Xcore dump into an executable binary after having initialized all your
  404. Xvariables at the beginning of the program.
  405. XWhen the new binary is executed it will begin by executing a "goto LABEL"
  406. X(with all the restrictions that goto suffers).
  407. XThink of it as a goto with an intervening core dump and reincarnation.
  408. XIf LABEL is omitted, restarts the program from the top.
  409. XWARNING: any files opened at the time of the dump will NOT be open any more
  410. Xwhen the program is reincarnated, with possible resulting confusion on the part
  411. Xof perl.
  412. XSee also \-u.
  413. X.Sp
  414. XExample:
  415. X.nf
  416. X
  417. X.ne 16
  418. X    #!/usr/bin/perl
  419. X    do 'getopt.pl';
  420. X    do 'stat.pl';
  421. X    %days = (
  422. X        'Sun',1,
  423. X        'Mon',2,
  424. X        'Tue',3,
  425. X        'Wed',4,
  426. X        'Thu',5,
  427. X        'Fri',6,
  428. X        'Sat',7);
  429. X
  430. X    dump QUICKSTART if $ARGV[0] eq '-d';
  431. X
  432. X    QUICKSTART:
  433. X    do Getopt('f');
  434. X
  435. X.fi
  436. X.Ip "each(ASSOC_ARRAY)" 8 6
  437. X.Ip "each ASSOC_ARRAY" 8
  438. XReturns a 2 element array consisting of the key and value for the next
  439. Xvalue of an associative array, so that you can iterate over it.
  440. XEntries are returned in an apparently random order.
  441. XWhen the array is entirely read, a null array is returned (which when
  442. Xassigned produces a FALSE (0) value).
  443. XThe next call to each() after that will start iterating again.
  444. XThe iterator can be reset only by reading all the elements from the array.
  445. XYou must not modify the array while iterating over it.
  446. XThere is a single iterator for each associative array, shared by all
  447. Xeach(), keys() and values() function calls in the program.
  448. XThe following prints out your environment like the printenv program, only
  449. Xin a different order:
  450. X.nf
  451. X
  452. X.ne 3
  453. X    while (($key,$value) = each %ENV) {
  454. X        print "$key=$value\en";
  455. X    }
  456. X
  457. X.fi
  458. XSee also keys() and values().
  459. X.Ip "eof(FILEHANDLE)" 8 8
  460. X.Ip "eof()" 8
  461. X.Ip "eof" 8
  462. XReturns 1 if the next read on FILEHANDLE will return end of file, or if
  463. XFILEHANDLE is not open.
  464. XFILEHANDLE may be an expression whose value gives the real filehandle name.
  465. XAn eof without an argument returns the eof status for the last file read.
  466. XEmpty parentheses () may be used to indicate the pseudo file formed of the
  467. Xfiles listed on the command line, i.e. eof() is reasonable to use inside
  468. Xa while (<>) loop to detect the end of only the last file.
  469. XUse eof(ARGV) or eof without the parentheses to test EACH file in a while (<>) loop.
  470. XExamples:
  471. X.nf
  472. X
  473. X.ne 7
  474. X    # insert dashes just before last line of last file
  475. X    while (<>) {
  476. X        if (eof()) {
  477. X            print "\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\|\-\en";
  478. X        }
  479. X        print;
  480. X    }
  481. X
  482. X.ne 7
  483. X    # reset line numbering on each input file
  484. X    while (<>) {
  485. X        print "$.\et$_";
  486. X        if (eof) {    # Not eof().
  487. X            close(ARGV);
  488. X        }
  489. X    }
  490. X
  491. X.fi
  492. X.Ip "eval(EXPR)" 8 6
  493. X.Ip "eval EXPR" 8 6
  494. XEXPR is parsed and executed as if it were a little
  495. X.I perl
  496. Xprogram.
  497. XIt is executed in the context of the current
  498. X.I perl
  499. Xprogram, so that
  500. Xany variable settings, subroutine or format definitions remain afterwards.
  501. XThe value returned is the value of the last expression evaluated, just
  502. Xas with subroutines.
  503. XIf there is a syntax error or runtime error, a null string is returned by
  504. Xeval, and $@ is set to the error message.
  505. XIf there was no error, $@ is null.
  506. XIf EXPR is omitted, evaluates $_.
  507. XThe final semicolon, if any, may be omitted from the expression.
  508. X.Sp
  509. XNote that, since eval traps otherwise-fatal errors, it is useful for
  510. Xdetermining whether a particular feature
  511. X(such as dbmopen or symlink) is implemented.
  512. X.Ip "exec(LIST)" 8 8
  513. X.Ip "exec LIST" 8 6
  514. XIf there is more than one argument in LIST, or if LIST is an array with
  515. Xmore than one value,
  516. Xcalls execvp() with the arguments in LIST.
  517. XIf there is only one scalar argument, the argument is checked for shell metacharacters.
  518. XIf there are any, the entire argument is passed to \*(L"/bin/sh \-c\*(R" for parsing.
  519. XIf there are none, the argument is split into words and passed directly to
  520. Xexecvp(), which is more efficient.
  521. XNote: exec (and system) do not flush your output buffer, so you may need to
  522. Xset $| to avoid lost output.
  523. XExamples:
  524. X.nf
  525. X
  526. X    exec \'/bin/echo\', \'Your arguments are: \', @ARGV;
  527. X    exec "sort $outfile | uniq";
  528. X
  529. X.fi
  530. X.Sp
  531. XIf you don't really want to execute the first argument, but want to lie
  532. Xto the program you are executing about its own name, you can specify
  533. Xthe program you actually want to run by assigning that to a variable and
  534. Xputting the name of the variable in front of the LIST without a comma.
  535. X(This always forces interpretation of the LIST as a multi-valued list, even
  536. Xif there is only a single scalar in the list.)
  537. XExample:
  538. X.nf
  539. X
  540. X.ne 2
  541. X    $shell = '/bin/csh';
  542. X    exec $shell '-sh';        # pretend it's a login shell
  543. X
  544. X.fi
  545. X.Ip "exit(EXPR)" 8 6
  546. X.Ip "exit EXPR" 8
  547. XEvaluates EXPR and exits immediately with that value.
  548. XExample:
  549. X.nf
  550. X
  551. X.ne 2
  552. X    $ans = <STDIN>;
  553. X    exit 0 \|if \|$ans \|=~ \|/\|^[Xx]\|/\|;
  554. X
  555. X.fi
  556. XSee also
  557. X.IR die .
  558. XIf EXPR is omitted, exits with 0 status.
  559. X.Ip "exp(EXPR)" 8 3
  560. X.Ip "exp EXPR" 8
  561. XReturns
  562. X.I e
  563. Xto the power of EXPR.
  564. XIf EXPR is omitted, gives exp($_).
  565. X.Ip "fcntl(FILEHANDLE,FUNCTION,SCALAR)" 8 4
  566. XImplements the fcntl(2) function.
  567. XYou'll probably have to say
  568. X.nf
  569. X
  570. X    do "fcntl.h";    # probably /usr/local/lib/perl/fcntl.h
  571. X
  572. X.fi
  573. Xfirst to get the correct function definitions.
  574. XIf fcntl.h doesn't exist or doesn't have the correct definitions
  575. Xyou'll have to roll
  576. Xyour own, based on your C header files such as <sys/fcntl.h>.
  577. X(There is a perl script called makelib that comes with the perl kit
  578. Xwhich may help you in this.)
  579. XArgument processing and value return works just like ioctl below.
  580. XNote that fcntl will produce a fatal error if used on a machine that doesn't implement
  581. Xfcntl(2).
  582. X.Ip "fileno(FILEHANDLE)" 8 4
  583. XReturns the file descriptor for a filehandle.
  584. XUseful for constructing bitmaps for select().
  585. XIf FILEHANDLE is an expression, the value is taken as the name of
  586. Xthe filehandle.
  587. X.Ip "flock(FILEHANDLE,OPERATION)" 8 4
  588. XCalls flock(2) on FILEHANDLE.
  589. XSee manual page for flock(2) for definition of OPERATION.
  590. XWill produce a fatal error if used on a machine that doesn't implement
  591. Xflock(2).
  592. XHere's a mailbox appender for BSD systems.
  593. X.nf
  594. X
  595. X.ne 20
  596. X    $LOCK_SH = 1;
  597. X    $LOCK_EX = 2;
  598. X    $LOCK_NB = 4;
  599. X    $LOCK_UN = 8;
  600. X
  601. X    sub lock {
  602. X        flock(MBOX,$LOCK_EX);
  603. X        # and, in case someone appended
  604. X        # while we were waiting...
  605. X        seek(MBOX, 0, 2);
  606. X    }
  607. X
  608. X    sub unlock {
  609. X        flock(MBOX,$LOCK_UN);
  610. X    }
  611. X
  612. X    open(MBOX, ">>/usr/spool/mail/$USER")
  613. X        || die "Can't open mailbox: $!";
  614. X
  615. X    do lock();
  616. X    print MBOX $msg,"\en\en";
  617. X    do unlock();
  618. X
  619. X.fi
  620. X.Ip "fork" 8 4
  621. XDoes a fork() call.
  622. XReturns the child pid to the parent process and 0 to the child process.
  623. XNote: unflushed buffers remain unflushed in both processes, which means
  624. Xyou may need to set $| to avoid duplicate output.
  625. X.Ip "getc(FILEHANDLE)" 8 4
  626. X.Ip "getc FILEHANDLE" 8
  627. X.Ip "getc" 8
  628. XReturns the next character from the input file attached to FILEHANDLE, or
  629. Xa null string at EOF.
  630. XIf FILEHANDLE is omitted, reads from STDIN.
  631. X.Ip "getlogin" 8 3
  632. XReturns the current login from /etc/utmp, if any.
  633. XIf null, use getpwuid.
  634. X
  635. X    ($login = getlogin) || (($login) = getpwuid($<));
  636. X
  637. X.Ip "getpeername(SOCKET)" 8 3
  638. XReturns the packed sockaddr address of other end of the SOCKET connection.
  639. X.nf
  640. X
  641. X.ne 4
  642. X    # An internet sockaddr
  643. X    $sockaddr = 'S n a4 x8';
  644. X    $hersockaddr = getpeername(S);
  645. X    ($family, $port, $heraddr) = unpack($sockaddr,$hersockaddr);
  646. X
  647. X.fi
  648. X.Ip "getpgrp(PID)" 8 4
  649. X.Ip "getpgrp PID" 8
  650. XReturns the current process group for the specified PID, 0 for the current
  651. Xprocess.
  652. XWill produce a fatal error if used on a machine that doesn't implement
  653. Xgetpgrp(2).
  654. XIf EXPR is omitted, returns process group of current process.
  655. X.Ip "getppid" 8 4
  656. XReturns the process id of the parent process.
  657. X.Ip "getpriority(WHICH,WHO)" 8 4
  658. XReturns the current priority for a process, a process group, or a user.
  659. X(See getpriority(2).)
  660. XWill produce a fatal error if used on a machine that doesn't implement
  661. Xgetpriority(2).
  662. X.Ip "getpwnam(NAME)" 8
  663. X.Ip "getgrnam(NAME)" 8
  664. X.Ip "gethostbyname(NAME)" 8
  665. X.Ip "getnetbyname(NAME)" 8
  666. X.Ip "getprotobyname(NAME)" 8
  667. X.Ip "getpwuid(UID)" 8
  668. X.Ip "getgrgid(GID)" 8
  669. X.Ip "getservbyname(NAME,PROTO)" 8
  670. X.Ip "gethostbyaddr(ADDR,ADDRTYPE)" 8
  671. X.Ip "getnetbyaddr(ADDR,ADDRTYPE)" 8
  672. X.Ip "getprotobynumber(NUMBER)" 8
  673. X.Ip "getservbyport(PORT,PROTO)" 8
  674. X.Ip "getpwent()" 8
  675. X.Ip "getgrent()" 8
  676. X.Ip "gethostent()" 8
  677. X.Ip "getnetent()" 8
  678. X.Ip "getprotoent()" 8
  679. X.Ip "getservent()" 8
  680. X.Ip "setpwent()" 8
  681. X.Ip "setgrent()" 8
  682. X.Ip "sethostent(STAYOPEN)" 8
  683. X.Ip "setnetent(STAYOPEN)" 8
  684. X.Ip "setprotoent(STAYOPEN)" 8
  685. X.Ip "setservent(STAYOPEN)" 8
  686. X.Ip "endpwent()" 8
  687. X.Ip "endgrent()" 8
  688. X.Ip "endhostent()" 8
  689. X.Ip "endnetent()" 8
  690. X.Ip "endprotoent()" 8
  691. X.Ip "endservent()" 8
  692. XThese routines perform the same functions as their counterparts in the
  693. Xsystem library.
  694. XThe return values from the various get routines are as follows:
  695. X.nf
  696. X
  697. X    ($name,$passwd,$uid,$gid,
  698. X       $quota,$comment,$gcos,$dir,$shell) = getpw.\|.\|.
  699. X    ($name,$passwd,$gid,$members) = getgr.\|.\|.
  700. X    ($name,$aliases,$addrtype,$length,@addrs) = gethost.\|.\|.
  701. X    ($name,$aliases,$addrtype,$net) = getnet.\|.\|.
  702. X    ($name,$aliases,$proto) = getproto.\|.\|.
  703. X    ($name,$aliases,$port,$proto) = getserv.\|.\|.
  704. X
  705. X.fi
  706. XThe $members value returned by getgr.\|.\|. is a space separated list
  707. Xof the login names of the members of the group.
  708. X.Sp
  709. XThe @addrs value returned by the gethost.\|.\|. functions is a list of the
  710. Xraw addresses returned by the corresponding system library call.
  711. XIn the Internet domain, each address is four bytes long and you can unpack
  712. Xit by saying something like:
  713. X.nf
  714. X
  715. X    ($a,$b,$c,$d) = unpack('C4',$addr[0]);
  716. X
  717. X.fi
  718. X.Ip "getsockname(SOCKET)" 8 3
  719. XReturns the packed sockaddr address of this end of the SOCKET connection.
  720. X.nf
  721. X
  722. X.ne 4
  723. X    # An internet sockaddr
  724. X    $sockaddr = 'S n a4 x8';
  725. X    $mysockaddr = getsockname(S);
  726. X    ($family, $port, $myaddr) = unpack($sockaddr,$mysockaddr);
  727. X
  728. X.fi
  729. X.Ip "getsockopt(SOCKET,LEVEL,OPTNAME)" 8 3
  730. XReturns the socket option requested, or undefined if there is an error.
  731. X.Ip "gmtime(EXPR)" 8 4
  732. X.Ip "gmtime EXPR" 8
  733. XConverts a time as returned by the time function to a 9-element array with
  734. Xthe time analyzed for the Greenwich timezone.
  735. XTypically used as follows:
  736. X.nf
  737. X
  738. X.ne 3
  739. X    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
  740. X
  741. X.fi
  742. XAll array elements are numeric, and come straight out of a struct tm.
  743. XIn particular this means that $mon has the range 0.\|.11 and $wday has the
  744. Xrange 0.\|.6.
  745. XIf EXPR is omitted, does gmtime(time).
  746. X.Ip "goto LABEL" 8 6
  747. XFinds the statement labeled with LABEL and resumes execution there.
  748. XCurrently you may only go to statements in the main body of the program
  749. Xthat are not nested inside a do {} construct.
  750. XThis statement is not implemented very efficiently, and is here only to make
  751. Xthe
  752. X.IR sed -to- perl
  753. Xtranslator easier.
  754. XI may change its semantics at any time, consistent with support for translated
  755. X.I sed
  756. Xscripts.
  757. XUse it at your own risk.
  758. XBetter yet, don't use it at all.
  759. X.Ip "grep(EXPR,LIST)" 8 4
  760. XEvaluates EXPR for each element of LIST (locally setting $_ to each element)
  761. Xand returns the array value consisting of those elements for which the
  762. Xexpression evaluated to true.
  763. X.nf
  764. X
  765. X    @foo = grep(!/^#/, @bar);    # weed out comments
  766. X
  767. X.fi
  768. X.Ip "hex(EXPR)" 8 4
  769. X.Ip "hex EXPR" 8
  770. XReturns the decimal value of EXPR interpreted as an hex string.
  771. X(To interpret strings that might start with 0 or 0x see oct().)
  772. XIf EXPR is omitted, uses $_.
  773. X.Ip "ioctl(FILEHANDLE,FUNCTION,SCALAR)" 8 4
  774. XImplements the ioctl(2) function.
  775. XYou'll probably have to say
  776. X.nf
  777. X
  778. X    do "ioctl.h";    # probably /usr/local/lib/perl/ioctl.h
  779. X
  780. X.fi
  781. Xfirst to get the correct function definitions.
  782. XIf ioctl.h doesn't exist or doesn't have the correct definitions
  783. Xyou'll have to roll
  784. Xyour own, based on your C header files such as <sys/ioctl.h>.
  785. X(There is a perl script called makelib that comes with the perl kit
  786. Xwhich may help you in this.)
  787. XSCALAR will be read and/or written depending on the FUNCTION\*(--a pointer
  788. Xto the string value of SCALAR will be passed as the third argument of
  789. Xthe actual ioctl call.
  790. X(If SCALAR has no string value but does have a numeric value, that value
  791. Xwill be passed rather than a pointer to the string value.
  792. XTo guarantee this to be true, add a 0 to the scalar before using it.)
  793. XThe pack() and unpack() functions are useful for manipulating the values
  794. Xof structures used by ioctl().
  795. XThe following example sets the erase character to DEL.
  796. X.nf
  797. X
  798. X.ne 9
  799. X    do 'ioctl.h';
  800. X    $sgttyb_t = "ccccs";        # 4 chars and a short
  801. X    if (ioctl(STDIN,$TIOCGETP,$sgttyb)) {
  802. X        @ary = unpack($sgttyb_t,$sgttyb);
  803. X        $ary[2] = 127;
  804. X        $sgttyb = pack($sgttyb_t,@ary);
  805. X        ioctl(STDIN,$TIOCSETP,$sgttyb)
  806. X            || die "Can't ioctl: $!";
  807. X    }
  808. X
  809. X.fi
  810. XThe return value of ioctl (and fcntl) is as follows:
  811. X.nf
  812. X
  813. X.ne 4
  814. X    if OS returns:\h'|3i'perl returns:
  815. X      -1\h'|3i'  undefined value
  816. X      0\h'|3i'  string "0 but true"
  817. X      anything else\h'|3i'  that number
  818. X
  819. X.fi
  820. XThus perl returns true on success and false on failure, yet you can still
  821. Xeasily determine the actual value returned by the operating system:
  822. X.nf
  823. X
  824. X    ($retval = ioctl(...)) || ($retval = -1);
  825. X    printf "System returned %d\en", $retval;
  826. X.fi
  827. X.Ip "index(STR,SUBSTR)" 8 4
  828. XReturns the position of the first occurrence of SUBSTR in STR, based at 0, or whatever you've
  829. Xset the $[ variable to.
  830. XIf the substring is not found, returns one less than the base, ordinarily \-1.
  831. X.Ip "int(EXPR)" 8 4
  832. X.Ip "int EXPR" 8
  833. XReturns the integer portion of EXPR.
  834. XIf EXPR is omitted, uses $_.
  835. X.Ip "join(EXPR,LIST)" 8 8
  836. X.Ip "join(EXPR,ARRAY)" 8
  837. XJoins the separate strings of LIST or ARRAY into a single string with fields
  838. Xseparated by the value of EXPR, and returns the string.
  839. XExample:
  840. X.nf
  841. X    
  842. X    $_ = join(\|\':\', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
  843. X
  844. X.fi
  845. XSee
  846. X.IR split .
  847. X.Ip "keys(ASSOC_ARRAY)" 8 6
  848. X.Ip "keys ASSOC_ARRAY" 8
  849. XReturns a normal array consisting of all the keys of the named associative
  850. Xarray.
  851. XThe keys are returned in an apparently random order, but it is the same order
  852. Xas either the values() or each() function produces (given that the associative array
  853. Xhas not been modified).
  854. XHere is yet another way to print your environment:
  855. X.nf
  856. X
  857. X.ne 5
  858. X    @keys = keys %ENV;
  859. X    @values = values %ENV;
  860. X    while ($#keys >= 0) {
  861. X        print pop(keys), \'=\', pop(values), "\en";
  862. X    }
  863. X
  864. Xor how about sorted by key:
  865. X
  866. X.ne 3
  867. X    foreach $key (sort(keys %ENV)) {
  868. X        print $key, \'=\', $ENV{$key}, "\en";
  869. X    }
  870. X
  871. X.fi
  872. X.Ip "kill(LIST)" 8 8
  873. X.Ip "kill LIST" 8 2
  874. XSends a signal to a list of processes.
  875. XThe first element of the list must be the signal to send.
  876. XReturns the number of processes successfully signaled.
  877. X.nf
  878. X
  879. X    $cnt = kill 1, $child1, $child2;
  880. X    kill 9, @goners;
  881. X
  882. X.fi
  883. XIf the signal is negative, kills process groups instead of processes.
  884. X(On System V, a negative \fIprocess\fR number will also kill process groups,
  885. Xbut that's not portable.)
  886. XYou may use a signal name in quotes.
  887. X.Ip "last LABEL" 8 8
  888. X.Ip "last" 8
  889. XThe
  890. X.I last
  891. Xcommand is like the
  892. X.I break
  893. Xstatement in C (as used in loops); it immediately exits the loop in question.
  894. XIf the LABEL is omitted, the command refers to the innermost enclosing loop.
  895. XThe
  896. X.I continue
  897. Xblock, if any, is not executed:
  898. X.nf
  899. X
  900. X.ne 4
  901. X    line: while (<STDIN>) {
  902. X        last line if /\|^$/;    # exit when done with header
  903. X        .\|.\|.
  904. X    }
  905. X
  906. X.fi
  907. X.Ip "length(EXPR)" 8 4
  908. X.Ip "length EXPR" 8
  909. XReturns the length in characters of the value of EXPR.
  910. XIf EXPR is omitted, returns length of $_.
  911. X.Ip "link(OLDFILE,NEWFILE)" 8 2
  912. XCreates a new filename linked to the old filename.
  913. XReturns 1 for success, 0 otherwise.
  914. X.Ip "listen(SOCKET,QUEUESIZE)" 8 2
  915. XDoes the same thing that the listen system call does.
  916. XReturns true if it succeeded, false otherwise.
  917. XSee example in section on Interprocess Communication.
  918. X.Ip "local(LIST)" 8 4
  919. XDeclares the listed variables to be local to the enclosing block,
  920. Xsubroutine, eval or \*(L"do\*(R".
  921. XAll the listed elements must be legal lvalues.
  922. XThis operator works by saving the current values of those variables in LIST
  923. Xon a hidden stack and restoring them upon exiting the block, subroutine or eval.
  924. XThis means that called subroutines can also reference the local variable,
  925. Xbut not the global one.
  926. XThe LIST may be assigned to if desired, which allows you to initialize
  927. Xyour local variables.
  928. X(If no initializer is given, all scalars are initialized to the null string
  929. Xand all arrays and associative arrays to the null array.)
  930. XCommonly this is used to name the parameters to a subroutine.
  931. XExamples:
  932. X.nf
  933. X
  934. X.ne 13
  935. X    sub RANGEVAL {
  936. X        local($min, $max, $thunk) = @_;
  937. X        local($result) = \'\';
  938. X        local($i);
  939. X
  940. X        # Presumably $thunk makes reference to $i
  941. X
  942. X        for ($i = $min; $i < $max; $i++) {
  943. X            $result .= eval $thunk;
  944. X        }
  945. X
  946. X        $result;
  947. X    }
  948. X
  949. X.ne 6
  950. X    if ($sw eq \'-v\') {
  951. X        # init local array with global array
  952. X        local(@ARGV) = @ARGV;
  953. X        unshift(\'echo\',@ARGV);
  954. X        system @ARGV;
  955. X    }
  956. X    # @ARGV restored
  957. X
  958. X.ne 6
  959. X    # temporarily add to digits associative array
  960. X    if ($base12) {
  961. X        # (NOTE: not claiming this is efficient!)
  962. X        local(%digits) = (%digits,'t',10,'e',11);
  963. X        do parse_num();
  964. X    }
  965. X
  966. X.fi
  967. XNote that local() is a run-time command, and so gets executed every time
  968. Xthrough a loop, using up more stack storage each time until it's all
  969. Xreleased at once when the loop is exited.
  970. X.Ip "localtime(EXPR)" 8 4
  971. X.Ip "localtime EXPR" 8
  972. XConverts a time as returned by the time function to a 9-element array with
  973. Xthe time analyzed for the local timezone.
  974. XTypically used as follows:
  975. X.nf
  976. X
  977. X.ne 3
  978. X    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  979. X
  980. X.fi
  981. XAll array elements are numeric, and come straight out of a struct tm.
  982. XIn particular this means that $mon has the range 0.\|.11 and $wday has the
  983. Xrange 0.\|.6.
  984. XIf EXPR is omitted, does localtime(time).
  985. X.Ip "log(EXPR)" 8 4
  986. X.Ip "log EXPR" 8
  987. XReturns logarithm (base
  988. X.IR e )
  989. Xof EXPR.
  990. XIf EXPR is omitted, returns log of $_.
  991. X.Ip "lstat(FILEHANDLE)" 8 6
  992. X.Ip "lstat FILEHANDLE" 8
  993. X.Ip "lstat(EXPR)" 8
  994. XDoes the same thing as the stat() function, but stats a symbolic link
  995. Xinstead of the file the symbolic link points to.
  996. XIf symbolic links are unimplemented on your system, a normal stat is done.
  997. X.Ip "m/PATTERN/io" 8 4
  998. X.Ip "/PATTERN/io" 8
  999. XSearches a string for a pattern match, and returns true (1) or false (\'\').
  1000. XIf no string is specified via the =~ or !~ operator,
  1001. Xthe $_ string is searched.
  1002. X(The string specified with =~ need not be an lvalue\*(--it may be the result of an expression evaluation, but remember the =~ binds rather tightly.)
  1003. XSee also the section on regular expressions.
  1004. X.Sp
  1005. XIf / is the delimiter then the initial \*(L'm\*(R' is optional.
  1006. XWith the \*(L'm\*(R' you can use any pair of characters as delimiters.
  1007. XThis is particularly useful for matching Unix path names that contain \*(L'/\*(R'.
  1008. XIf the final delimiter is followed by the optional letter \*(L'i\*(R', the matching is
  1009. Xdone in a case-insensitive manner.
  1010. XPATTERN may contain references to scalar variables, which will be interpolated
  1011. X(and the pattern recompiled) every time the pattern search is evaluated.
  1012. XIf you want such a pattern to be compiled only once, add an \*(L"o\*(R" after
  1013. Xthe trailing delimiter.
  1014. XThis avoids expensive run-time recompilations, and
  1015. Xis useful when the value you are interpolating won't change over the
  1016. Xlife of the script.
  1017. X.Sp
  1018. XIf used in a context that requires an array value, a pattern match returns an
  1019. Xarray consisting of the subexpressions matched by the parentheses in the
  1020. Xpattern,
  1021. Xi.e. ($1, $2, $3.\|.\|.).
  1022. XIt does NOT actually set $1, $2, etc. in this case, nor does it set $+, $`, $&
  1023. Xor $'.
  1024. XIf the match fails, a null array is returned.
  1025. X.Sp
  1026. XExamples:
  1027. X.nf
  1028. X
  1029. X.ne 4
  1030. X    open(tty, \'/dev/tty\');
  1031. X    <tty> \|=~ \|/\|^y\|/i \|&& \|do foo(\|);    # do foo if desired
  1032. X
  1033. X    if (/Version: \|*\|([0\-9.]*\|)\|/\|) { $version = $1; }
  1034. X
  1035. X    next if m#^/usr/spool/uucp#;
  1036. X
  1037. X.ne 5
  1038. X    # poor man's grep
  1039. X    $arg = shift;
  1040. X    while (<>) {
  1041. X        print if /$arg/o;    # compile only once
  1042. X    }
  1043. X
  1044. X    if (($F1, $F2, $Etc) = ($foo =~ /^(\eS+)\es+(\eS+)\es*(.*)/))
  1045. X
  1046. X.fi
  1047. XThis last example splits $foo into the first two words and the remainder
  1048. Xof the line, and assigns those three fields to $F1, $F2 and $Etc.
  1049. XThe conditional is true if any variables were assigned, i.e. if the pattern
  1050. Xmatched.
  1051. X.Ip "mkdir(FILENAME,MODE)" 8 3
  1052. XCreates the directory specified by FILENAME, with permissions specified by
  1053. XMODE (as modified by umask).
  1054. XIf it succeeds it returns 1, otherwise it returns 0 and sets $! (errno).
  1055. !STUFFY!FUNK!
  1056. echo Extracting stab.c
  1057. sed >stab.c <<'!STUFFY!FUNK!' -e 's/X//'
  1058. X/* $Header: stab.c,v 3.0 89/10/18 15:23:23 lwall Locked $
  1059. X *
  1060. X *    Copyright (c) 1989, Larry Wall
  1061. X *
  1062. X *    You may distribute under the terms of the GNU General Public License
  1063. X *    as specified in the README file that comes with the perl 3.0 kit.
  1064. X *
  1065. X * $Log:    stab.c,v $
  1066. X * Revision 3.0  89/10/18  15:23:23  lwall
  1067. X * 3.0 baseline
  1068. X * 
  1069. X */
  1070. X
  1071. X#include "EXTERN.h"
  1072. X#include "perl.h"
  1073. X
  1074. X#include <signal.h>
  1075. X
  1076. X/* This oughta be generated by Configure. */
  1077. X
  1078. Xstatic char *sig_name[] = {
  1079. X    SIG_NAME,0
  1080. X};
  1081. X
  1082. Xextern int errno;
  1083. Xextern int sys_nerr;
  1084. Xextern char *sys_errlist[];
  1085. X
  1086. XSTR *
  1087. Xstab_str(str)
  1088. XSTR *str;
  1089. X{
  1090. X    STAB *stab = str->str_u.str_stab;
  1091. X    register int paren;
  1092. X    register char *s;
  1093. X    register int i;
  1094. X
  1095. X    if (str->str_rare)
  1096. X    return stab_val(stab);
  1097. X
  1098. X    switch (*stab->str_magic->str_ptr) {
  1099. X    case '0': case '1': case '2': case '3': case '4':
  1100. X    case '5': case '6': case '7': case '8': case '9': case '&':
  1101. X    if (curspat) {
  1102. X        paren = atoi(stab_name(stab));
  1103. X      getparen:
  1104. X        if (curspat->spat_regexp &&
  1105. X          paren <= curspat->spat_regexp->nparens &&
  1106. X          (s = curspat->spat_regexp->startp[paren]) ) {
  1107. X        i = curspat->spat_regexp->endp[paren] - s;
  1108. X        if (i >= 0)
  1109. X            str_nset(stab_val(stab),s,i);
  1110. X        else
  1111. X            str_sset(stab_val(stab),&str_undef);
  1112. X        }
  1113. X        else
  1114. X        str_sset(stab_val(stab),&str_undef);
  1115. X    }
  1116. X    break;
  1117. X    case '+':
  1118. X    if (curspat) {
  1119. X        paren = curspat->spat_regexp->lastparen;
  1120. X        goto getparen;
  1121. X    }
  1122. X    break;
  1123. X    case '`':
  1124. X    if (curspat) {
  1125. X        if (curspat->spat_regexp &&
  1126. X          (s = curspat->spat_regexp->subbase) ) {
  1127. X        i = curspat->spat_regexp->startp[0] - s;
  1128. X        if (i >= 0)
  1129. X            str_nset(stab_val(stab),s,i);
  1130. X        else
  1131. X            str_nset(stab_val(stab),"",0);
  1132. X        }
  1133. X        else
  1134. X        str_nset(stab_val(stab),"",0);
  1135. X    }
  1136. X    break;
  1137. X    case '\'':
  1138. X    if (curspat) {
  1139. X        if (curspat->spat_regexp &&
  1140. X          (s = curspat->spat_regexp->endp[0]) ) {
  1141. X        str_set(stab_val(stab),s);
  1142. X        }
  1143. X        else
  1144. X        str_nset(stab_val(stab),"",0);
  1145. X    }
  1146. X    break;
  1147. X    case '.':
  1148. X#ifndef lint
  1149. X    if (last_in_stab) {
  1150. X        str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines);
  1151. X    }
  1152. X#endif
  1153. X    break;
  1154. X    case '?':
  1155. X    str_numset(stab_val(stab),(double)statusvalue);
  1156. X    break;
  1157. X    case '^':
  1158. X    s = stab_io(curoutstab)->top_name;
  1159. X    str_set(stab_val(stab),s);
  1160. X    break;
  1161. X    case '~':
  1162. X    s = stab_io(curoutstab)->fmt_name;
  1163. X    str_set(stab_val(stab),s);
  1164. X    break;
  1165. X#ifndef lint
  1166. X    case '=':
  1167. X    str_numset(stab_val(stab),(double)stab_io(curoutstab)->page_len);
  1168. X    break;
  1169. X    case '-':
  1170. X    str_numset(stab_val(stab),(double)stab_io(curoutstab)->lines_left);
  1171. X    break;
  1172. X    case '%':
  1173. X    str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
  1174. X    break;
  1175. X#endif
  1176. X    case '/':
  1177. X    *tokenbuf = record_separator;
  1178. X    tokenbuf[1] = '\0';
  1179. X    str_nset(stab_val(stab),tokenbuf,rslen);
  1180. X    break;
  1181. X    case '[':
  1182. X    str_numset(stab_val(stab),(double)arybase);
  1183. X    break;
  1184. X    case '|':
  1185. X    str_numset(stab_val(stab),
  1186. X       (double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
  1187. X    break;
  1188. X    case ',':
  1189. X    str_nset(stab_val(stab),ofs,ofslen);
  1190. X    break;
  1191. X    case '\\':
  1192. X    str_nset(stab_val(stab),ors,orslen);
  1193. X    break;
  1194. X    case '#':
  1195. X    str_set(stab_val(stab),ofmt);
  1196. X    break;
  1197. X    case '!':
  1198. X    str_numset(stab_val(stab), (double)errno);
  1199. X    str_set(stab_val(stab),
  1200. X      errno < 0 || errno > sys_nerr ? "(unknown)" : sys_errlist[errno]);
  1201. X    stab_val(stab)->str_nok = 1;    /* what a wonderful hack! */
  1202. X    break;
  1203. X    case '<':
  1204. X    str_numset(stab_val(stab),(double)uid);
  1205. X    break;
  1206. X    case '>':
  1207. X    str_numset(stab_val(stab),(double)euid);
  1208. X    break;
  1209. X    case '(':
  1210. X    s = buf;
  1211. X    (void)sprintf(s,"%d",(int)gid);
  1212. X    goto add_groups;
  1213. X    case ')':
  1214. X    s = buf;
  1215. X    (void)sprintf(s,"%d",(int)egid);
  1216. X      add_groups:
  1217. X    while (*s) s++;
  1218. X#ifdef GETGROUPS
  1219. X#ifndef NGROUPS
  1220. X#define NGROUPS 32
  1221. X#endif
  1222. X    {
  1223. X        GIDTYPE gary[NGROUPS];
  1224. X
  1225. X        i = getgroups(NGROUPS,gary);
  1226. X        while (--i >= 0) {
  1227. X        (void)sprintf(s," %ld", (long)gary[i]);
  1228. X        while (*s) s++;
  1229. X        }
  1230. X    }
  1231. X#endif
  1232. X    str_set(stab_val(stab),buf);
  1233. X    break;
  1234. X    }
  1235. X    return stab_val(stab);
  1236. X}
  1237. X
  1238. Xstabset(mstr,str)
  1239. Xregister STR *mstr;
  1240. XSTR *str;
  1241. X{
  1242. X    STAB *stab = mstr->str_u.str_stab;
  1243. X    char *s;
  1244. X    int i;
  1245. X    int sighandler();
  1246. X
  1247. X    switch (mstr->str_rare) {
  1248. X    case 'E':
  1249. X    setenv(mstr->str_ptr,str_get(str));
  1250. X                /* And you'll never guess what the dog had */
  1251. X    break;            /*   in its mouth... */
  1252. X    case 'S':
  1253. X    s = str_get(str);
  1254. X    i = whichsig(mstr->str_ptr);    /* ...no, a brick */
  1255. X    if (strEQ(s,"IGNORE"))
  1256. X#ifndef lint
  1257. X        (void)signal(i,SIG_IGN);
  1258. X#else
  1259. X        ;
  1260. X#endif
  1261. X    else if (strEQ(s,"DEFAULT") || !*s)
  1262. X        (void)signal(i,SIG_DFL);
  1263. X    else
  1264. X        (void)signal(i,sighandler);
  1265. X    break;
  1266. X#ifdef SOME_DBM
  1267. X    case 'D':
  1268. X    hdbmstore(stab_hash(stab),mstr->str_ptr,mstr->str_cur,str);
  1269. X    break;
  1270. X#endif
  1271. X    case '#':
  1272. X    afill(stab_array(stab), (int)str_gnum(str) - arybase);
  1273. X    break;
  1274. X    case 'X':    /* merely a copy of a * string */
  1275. X    break;
  1276. X    case '*':
  1277. X    s = str_get(str);
  1278. X    if (strnNE(s,"Stab",4) || str->str_cur != sizeof(STBP)) {
  1279. X        if (!*s) {
  1280. X        STBP *stbp;
  1281. X
  1282. X        (void)savenostab(stab);    /* schedule a free of this stab */
  1283. X        if (stab->str_len)
  1284. X            Safefree(stab->str_ptr);
  1285. X        Newz(601,stbp, 1, STBP);
  1286. X        stab->str_ptr = stbp;
  1287. X        stab->str_len = stab->str_cur = sizeof(STBP);
  1288. X        stab->str_pok = 1;
  1289. X        strncpy(stab_magic(stab),"Stab",4);
  1290. X        stab_val(stab) = Str_new(70,0);
  1291. X        stab_line(stab) = line;
  1292. X        }
  1293. X        else
  1294. X        stab = stabent(s,TRUE);
  1295. X        str_sset(str,stab);
  1296. X    }
  1297. X    break;
  1298. X    case 's': {
  1299. X        struct lstring *lstr = (struct lstring*)str;
  1300. X
  1301. X        mstr->str_rare = 0;
  1302. X        str->str_magic = Nullstr;
  1303. X        str_insert(mstr,lstr->lstr_offset,lstr->lstr_len,
  1304. X          str->str_ptr,str->str_cur);
  1305. X    }
  1306. X    break;
  1307. X
  1308. X    case 'v':
  1309. X    do_vecset(mstr,str);
  1310. X    break;
  1311. X
  1312. X    case 0:
  1313. X    switch (*stab->str_magic->str_ptr) {
  1314. X    case '^':
  1315. X        Safefree(stab_io(curoutstab)->top_name);
  1316. X        stab_io(curoutstab)->top_name = s = savestr(str_get(str));
  1317. X        stab_io(curoutstab)->top_stab = stabent(s,TRUE);
  1318. X        break;
  1319. X    case '~':
  1320. X        Safefree(stab_io(curoutstab)->fmt_name);
  1321. X        stab_io(curoutstab)->fmt_name = s = savestr(str_get(str));
  1322. X        stab_io(curoutstab)->fmt_stab = stabent(s,TRUE);
  1323. X        break;
  1324. X    case '=':
  1325. X        stab_io(curoutstab)->page_len = (long)str_gnum(str);
  1326. X        break;
  1327. X    case '-':
  1328. X        stab_io(curoutstab)->lines_left = (long)str_gnum(str);
  1329. X        if (stab_io(curoutstab)->lines_left < 0L)
  1330. X        stab_io(curoutstab)->lines_left = 0L;
  1331. X        break;
  1332. X    case '%':
  1333. X        stab_io(curoutstab)->page = (long)str_gnum(str);
  1334. X        break;
  1335. X    case '|':
  1336. X        stab_io(curoutstab)->flags &= ~IOF_FLUSH;
  1337. X        if (str_gnum(str) != 0.0) {
  1338. X        stab_io(curoutstab)->flags |= IOF_FLUSH;
  1339. X        }
  1340. X        break;
  1341. X    case '*':
  1342. X        i = (int)str_gnum(str);
  1343. X        multiline = (i != 0);
  1344. X        break;
  1345. X    case '/':
  1346. X        record_separator = *str_get(str);
  1347. X        rslen = str->str_cur;
  1348. X        break;
  1349. X    case '\\':
  1350. X        if (ors)
  1351. X        Safefree(ors);
  1352. X        ors = savestr(str_get(str));
  1353. X        orslen = str->str_cur;
  1354. X        break;
  1355. X    case ',':
  1356. X        if (ofs)
  1357. X        Safefree(ofs);
  1358. X        ofs = savestr(str_get(str));
  1359. X        ofslen = str->str_cur;
  1360. X        break;
  1361. X    case '#':
  1362. X        if (ofmt)
  1363. X        Safefree(ofmt);
  1364. X        ofmt = savestr(str_get(str));
  1365. X        break;
  1366. X    case '[':
  1367. X        arybase = (int)str_gnum(str);
  1368. X        break;
  1369. X    case '?':
  1370. X        statusvalue = (unsigned short)str_gnum(str);
  1371. X        break;
  1372. X    case '!':
  1373. X        errno = (int)str_gnum(str);        /* will anyone ever use this? */
  1374. X        break;
  1375. X    case '<':
  1376. X        uid = (int)str_gnum(str);
  1377. X#ifdef SETREUID
  1378. X        if (delaymagic) {
  1379. X        delaymagic |= DM_REUID;
  1380. X        break;                /* don't do magic till later */
  1381. X        }
  1382. X#endif /* SETREUID */
  1383. X#ifdef SETRUID
  1384. X        if (setruid((UIDTYPE)uid) < 0)
  1385. X        uid = (int)getuid();
  1386. X#else
  1387. X#ifdef SETREUID
  1388. X        if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
  1389. X        uid = (int)getuid();
  1390. X#else
  1391. X        fatal("setruid() not implemented");
  1392. X#endif
  1393. X#endif
  1394. X        break;
  1395. X    case '>':
  1396. X        euid = (int)str_gnum(str);
  1397. X#ifdef SETREUID
  1398. X        if (delaymagic) {
  1399. X        delaymagic |= DM_REUID;
  1400. X        break;                /* don't do magic till later */
  1401. X        }
  1402. X#endif /* SETREUID */
  1403. X#ifdef SETEUID
  1404. X        if (seteuid((UIDTYPE)euid) < 0)
  1405. X        euid = (int)geteuid();
  1406. X#else
  1407. X#ifdef SETREUID
  1408. X        if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
  1409. X        euid = (int)geteuid();
  1410. X#else
  1411. X        fatal("seteuid() not implemented");
  1412. X#endif
  1413. X#endif
  1414. X        break;
  1415. X    case '(':
  1416. X        gid = (int)str_gnum(str);
  1417. X#ifdef SETREGID
  1418. X        if (delaymagic) {
  1419. X        delaymagic |= DM_REGID;
  1420. X        break;                /* don't do magic till later */
  1421. X        }
  1422. X#endif /* SETREGID */
  1423. X#ifdef SETRGID
  1424. X        (void)setrgid((GIDTYPE)gid);
  1425. X#else
  1426. X#ifdef SETREGID
  1427. X        (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
  1428. X#else
  1429. X        fatal("setrgid() not implemented");
  1430. X#endif
  1431. X#endif
  1432. X        break;
  1433. X    case ')':
  1434. X        egid = (int)str_gnum(str);
  1435. X#ifdef SETREGID
  1436. X        if (delaymagic) {
  1437. X        delaymagic |= DM_REGID;
  1438. X        break;                /* don't do magic till later */
  1439. X        }
  1440. X#endif /* SETREGID */
  1441. X#ifdef SETEGID
  1442. X        (void)setegid((GIDTYPE)egid);
  1443. X#else
  1444. X#ifdef SETREGID
  1445. X        (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
  1446. X#else
  1447. X        fatal("setegid() not implemented");
  1448. X#endif
  1449. X#endif
  1450. X        break;
  1451. X    case ':':
  1452. X        chopset = str_get(str);
  1453. X        break;
  1454. X    }
  1455. X    break;
  1456. X    }
  1457. X}
  1458. X
  1459. Xwhichsig(sig)
  1460. Xchar *sig;
  1461. X{
  1462. X    register char **sigv;
  1463. X
  1464. X    for (sigv = sig_name+1; *sigv; sigv++)
  1465. X    if (strEQ(sig,*sigv))
  1466. X        return sigv - sig_name;
  1467. X#ifdef SIGCLD
  1468. X    if (strEQ(sig,"CHLD"))
  1469. X    return SIGCLD;
  1470. X#endif
  1471. X#ifdef SIGCHLD
  1472. X    if (strEQ(sig,"CLD"))
  1473. X    return SIGCHLD;
  1474. X#endif
  1475. X    return 0;
  1476. X}
  1477. X
  1478. Xsighandler(sig)
  1479. Xint sig;
  1480. X{
  1481. X    STAB *stab;
  1482. X    ARRAY *savearray;
  1483. X    STR *str;
  1484. X    char *oldfile = filename;
  1485. X    int oldsave = savestack->ary_fill;
  1486. X    ARRAY *oldstack = stack;
  1487. X    SUBR *sub;
  1488. X
  1489. X    stab = stabent(
  1490. X    str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
  1491. X      TRUE)), TRUE);
  1492. X    sub = stab_sub(stab);
  1493. X    if (!sub && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  1494. X    if (sig_name[sig][1] == 'H')
  1495. X        stab = stabent(str_get(hfetch(stab_hash(sigstab),"CLD",3,TRUE)),
  1496. X          TRUE);
  1497. X    else
  1498. X        stab = stabent(str_get(hfetch(stab_hash(sigstab),"CHLD",4,TRUE)),
  1499. X          TRUE);
  1500. X    sub = stab_sub(stab);    /* gag */
  1501. X    }
  1502. X    if (!sub) {
  1503. X    if (dowarn)
  1504. X        warn("SIG%s handler \"%s\" not defined.\n",
  1505. X        sig_name[sig], stab_name(stab) );
  1506. X    return;
  1507. X    }
  1508. X    savearray = stab_xarray(defstab);
  1509. X    stab_xarray(defstab) = stack = anew(defstab);
  1510. X    stack->ary_flags = 0;
  1511. X    str = Str_new(71,0);
  1512. X    str_set(str,sig_name[sig]);
  1513. X    (void)apush(stab_xarray(defstab),str);
  1514. X    sub->depth++;
  1515. X    if (sub->depth >= 2) {    /* save temporaries on recursion? */
  1516. X    if (sub->depth == 100 && dowarn)
  1517. X        warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
  1518. X    savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
  1519. X    }
  1520. X    filename = sub->filename;
  1521. X
  1522. X    (void)cmd_exec(sub->cmd,G_SCALAR,1);        /* so do it already */
  1523. X
  1524. X    sub->depth--;    /* assuming no longjumps out of here */
  1525. X    str_free(stack->ary_array[0]);    /* free the one real string */
  1526. X    afree(stab_xarray(defstab));  /* put back old $_[] */
  1527. X    stab_xarray(defstab) = savearray;
  1528. X    stack = oldstack;
  1529. X    filename = oldfile;
  1530. X    if (savestack->ary_fill > oldsave)
  1531. X    restorelist(oldsave);
  1532. X}
  1533. X
  1534. XSTAB *
  1535. Xaadd(stab)
  1536. Xregister STAB *stab;
  1537. X{
  1538. X    if (!stab_xarray(stab))
  1539. X    stab_xarray(stab) = anew(stab);
  1540. X    return stab;
  1541. X}
  1542. X
  1543. XSTAB *
  1544. Xhadd(stab)
  1545. Xregister STAB *stab;
  1546. X{
  1547. X    if (!stab_xhash(stab))
  1548. X    stab_xhash(stab) = hnew(COEFFSIZE);
  1549. X    return stab;
  1550. X}
  1551. X
  1552. XSTAB *
  1553. Xstabent(name,add)
  1554. Xregister char *name;
  1555. Xint add;
  1556. X{
  1557. X    register STAB *stab;
  1558. X    register STBP *stbp;
  1559. X    int len;
  1560. X    register char *namend;
  1561. X    HASH *stash;
  1562. X    char *sawquote = Nullch;
  1563. X    char *prevquote = Nullch;
  1564. X    bool global = FALSE;
  1565. X
  1566. X    if (isascii(*name) && isupper(*name)) {
  1567. X    if (*name > 'I') {
  1568. X        if (*name == 'S' && (
  1569. X          strEQ(name, "SIG") ||
  1570. X          strEQ(name, "STDIN") ||
  1571. X          strEQ(name, "STDOUT") ||
  1572. X          strEQ(name, "STDERR") ))
  1573. X        global = TRUE;
  1574. X    }
  1575. X    else if (*name > 'E') {
  1576. X        if (*name == 'I' && strEQ(name, "INC"))
  1577. X        global = TRUE;
  1578. X    }
  1579. X    else if (*name >= 'A') {
  1580. X        if (*name == 'E' && strEQ(name, "ENV"))
  1581. X        global = TRUE;
  1582. X    }
  1583. X    else if (*name == 'A' && (
  1584. X      strEQ(name, "ARGV") ||
  1585. X      strEQ(name, "ARGVOUT") ))
  1586. X        global = TRUE;
  1587. X    }
  1588. X    for (namend = name; *namend; namend++) {
  1589. X    if (*namend == '\'' && namend[1])
  1590. X        prevquote = sawquote, sawquote = namend;
  1591. X    }
  1592. X    if (sawquote == name && name[1]) {
  1593. X    stash = defstash;
  1594. X    sawquote = Nullch;
  1595. X    name++;
  1596. X    }
  1597. X    else if (!isalpha(*name) || global)
  1598. X    stash = defstash;
  1599. X    else
  1600. X    stash = curstash;
  1601. X    if (sawquote) {
  1602. X    char tmpbuf[256];
  1603. X    char *s, *d;
  1604. X
  1605. X    *sawquote = '\0';
  1606. X    if (s = prevquote) {
  1607. X        strncpy(tmpbuf,name,s-name+1);
  1608. X        d = tmpbuf+(s-name+1);
  1609. X        *d++ = '_';
  1610. X        strcpy(d,s+1);
  1611. X    }
  1612. X    else {
  1613. X        *tmpbuf = '_';
  1614. X        strcpy(tmpbuf+1,name);
  1615. X    }
  1616. X    stab = stabent(tmpbuf,TRUE);
  1617. X    if (!(stash = stab_xhash(stab)))
  1618. X        stash = stab_xhash(stab) = hnew(0);
  1619. X    name = sawquote+1;
  1620. X    *sawquote = '\'';
  1621. X    }
  1622. X    len = namend - name;
  1623. X    stab = (STAB*)hfetch(stash,name,len,add);
  1624. X    if (!stab)
  1625. X    return Nullstab;
  1626. X    if (stab->str_pok) {
  1627. X    stab->str_pok |= SP_MULTI;
  1628. X    return stab;
  1629. X    }
  1630. X    else {
  1631. X    if (stab->str_len)
  1632. X        Safefree(stab->str_ptr);
  1633. X    Newz(602,stbp, 1, STBP);
  1634. X    stab->str_ptr = stbp;
  1635. X    stab->str_len = stab->str_cur = sizeof(STBP);
  1636. X    stab->str_pok = 1;
  1637. X    strncpy(stab_magic(stab),"Stab",4);
  1638. X    stab_val(stab) = Str_new(72,0);
  1639. X    stab_line(stab) = line;
  1640. X    str_magic(stab,stab,'*',name,len);
  1641. X    return stab;
  1642. X    }
  1643. X}
  1644. X
  1645. XSTIO *
  1646. Xstio_new()
  1647. X{
  1648. X    STIO *stio;
  1649. X
  1650. X    Newz(603,stio,1,STIO);
  1651. X    stio->page_len = 60;
  1652. X    return stio;
  1653. X}
  1654. X
  1655. Xstab_check(min,max)
  1656. Xint min;
  1657. Xregister int max;
  1658. X{
  1659. X    register HENT *entry;
  1660. X    register int i;
  1661. X    register STAB *stab;
  1662. X
  1663. X    for (i = min; i <= max; i++) {
  1664. X    for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  1665. X        stab = (STAB*)entry->hent_val;
  1666. X        if (stab->str_pok & SP_MULTI)
  1667. X        continue;
  1668. X        line = stab_line(stab);
  1669. X        warn("Possible typo: \"%s\"", stab_name(stab));
  1670. X    }
  1671. X    }
  1672. X}
  1673. X
  1674. Xstatic int gensym = 0;
  1675. X
  1676. XSTAB *
  1677. Xgenstab()
  1678. X{
  1679. X    (void)sprintf(tokenbuf,"_GEN_%d",gensym++);
  1680. X    return stabent(tokenbuf,TRUE);
  1681. X}
  1682. X
  1683. X/* hopefully this is only called on local symbol table entries */
  1684. X
  1685. Xvoid
  1686. Xstab_clear(stab)
  1687. Xregister STAB *stab;
  1688. X{
  1689. X    STIO *stio;
  1690. X    SUBR *sub;
  1691. X
  1692. X    afree(stab_xarray(stab));
  1693. X    (void)hfree(stab_xhash(stab));
  1694. X    str_free(stab_val(stab));
  1695. X    if (stio = stab_io(stab)) {
  1696. X    do_close(stab,FALSE);
  1697. X    Safefree(stio->top_name);
  1698. X    Safefree(stio->fmt_name);
  1699. X    }
  1700. X    if (sub = stab_sub(stab)) {
  1701. X    afree(sub->tosave);
  1702. X    cmd_free(sub->cmd);
  1703. X    }
  1704. X    Safefree(stab->str_ptr);
  1705. X    stab->str_ptr = Null(STBP*);
  1706. X    stab->str_len = 0;
  1707. X    stab->str_cur = 0;
  1708. X}
  1709. X
  1710. !STUFFY!FUNK!
  1711. echo ""
  1712. echo "End of kit 9 (of 24)"
  1713. cat /dev/null >kit9isdone
  1714. run=''
  1715. config=''
  1716. for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24; do
  1717.     if test -f kit${iskit}isdone; then
  1718.     run="$run $iskit"
  1719.     else
  1720.     todo="$todo $iskit"
  1721.     fi
  1722. done
  1723. case $todo in
  1724.     '')
  1725.     echo "You have run all your kits.  Please read README and then type Configure."
  1726.     chmod 755 Configure
  1727.     ;;
  1728.     *)  echo "You have run$run."
  1729.     echo "You still need to run$todo."
  1730.     ;;
  1731. esac
  1732. : Someone might mail this, so...
  1733. exit
  1734.  
  1735.