home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / pp_sys.c < prev    next >
C/C++ Source or Header  |  1996-03-25  |  76KB  |  4,061 lines
  1. /*    pp_sys.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * But only a short way ahead its floor and the walls on either side were
  12.  * cloven by a great fissure, out of which the red glare came, now leaping
  13.  * up, now dying down into darkness; and all the while far below there was
  14.  * a rumour and a trouble as of great engines throbbing and labouring.
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19.  
  20. /* XXX Omit this -- it causes too much grief on mixed systems.
  21.    Next time, I should force broken systems to unset i_unistd in
  22.    hint files.
  23. */
  24. #if 0
  25. # ifdef I_UNISTD
  26. #  include <unistd.h>
  27. # endif
  28. #endif
  29.  
  30. /* Put this after #includes because fork and vfork prototypes may
  31.    conflict.
  32. */
  33. #ifndef HAS_VFORK
  34. #   define vfork fork
  35. #endif
  36.  
  37. #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
  38. # include <sys/socket.h>
  39. # include <netdb.h>
  40. # ifndef ENOTSOCK
  41. #  ifdef I_NET_ERRNO
  42. #   include <net/errno.h>
  43. #  endif
  44. # endif
  45. #endif
  46.  
  47. #ifdef HAS_SELECT
  48. #ifdef I_SYS_SELECT
  49. #ifndef I_SYS_TIME
  50. #include <sys/select.h>
  51. #endif
  52. #endif
  53. #endif
  54.  
  55. #ifdef HOST_NOT_FOUND
  56. extern int h_errno;
  57. #endif
  58.  
  59. #ifdef HAS_PASSWD
  60. # ifdef I_PWD
  61. #  include <pwd.h>
  62. # else
  63.     struct passwd *getpwnam _((char *));
  64.     struct passwd *getpwuid _((Uid_t));
  65. # endif
  66.   struct passwd *getpwent _((void));
  67. #endif
  68.  
  69. #ifdef HAS_GROUP
  70. # ifdef I_GRP
  71. #  include <grp.h>
  72. # else
  73.     struct group *getgrnam _((char *));
  74.     struct group *getgrgid _((Gid_t));
  75. # endif
  76.     struct group *getgrent _((void));
  77. #endif
  78.  
  79. #ifdef I_UTIME
  80. #include <utime.h>
  81. #endif
  82. #ifdef I_FCNTL
  83. #include <fcntl.h>
  84. #endif
  85. #ifdef I_SYS_FILE
  86. #include <sys/file.h>
  87. #endif
  88.  
  89. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  90. static int dooneliner _((char *cmd, char *filename));
  91. #endif
  92. /* Pushy I/O. */
  93.  
  94. PP(pp_backtick)
  95. {
  96.     dSP; dTARGET;
  97.     FILE *fp;
  98.     char *tmps = POPp;
  99.     TAINT_PROPER("``");
  100.     fp = my_popen(tmps, "r");
  101.     if (fp) {
  102.     sv_setpv(TARG, "");    /* note that this preserves previous buffer */
  103.     if (GIMME == G_SCALAR) {
  104.         while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
  105.         /*SUPPRESS 530*/
  106.         ;
  107.         XPUSHs(TARG);
  108.     }
  109.     else {
  110.         SV *sv;
  111.  
  112.         for (;;) {
  113.         sv = NEWSV(56, 80);
  114.         if (sv_gets(sv, fp, 0) == Nullch) {
  115.             SvREFCNT_dec(sv);
  116.             break;
  117.         }
  118.         XPUSHs(sv_2mortal(sv));
  119.         if (SvLEN(sv) - SvCUR(sv) > 20) {
  120.             SvLEN_set(sv, SvCUR(sv)+1);
  121.             Renew(SvPVX(sv), SvLEN(sv), char);
  122.         }
  123.         }
  124.     }
  125.     statusvalue = FIXSTATUS(my_pclose(fp));
  126.     }
  127.     else {
  128.     statusvalue = -1;
  129.     if (GIMME == G_SCALAR)
  130.         RETPUSHUNDEF;
  131.     }
  132.  
  133.     RETURN;
  134. }
  135.  
  136. PP(pp_glob)
  137. {
  138.     OP *result;
  139.     ENTER;
  140.  
  141.     SAVESPTR(last_in_gv);    /* We don't want this to be permanent. */
  142.     last_in_gv = (GV*)*stack_sp--;
  143.  
  144.     SAVESPTR(rs);        /* This is not permanent, either. */
  145.     rs = sv_2mortal(newSVpv("", 1));
  146. #ifndef DOSISH
  147. #ifndef CSH
  148.     *SvPVX(rs) = '\n';
  149. #endif    /* !CSH */
  150. #endif    /* !MSDOS */
  151.  
  152.     result = do_readline();
  153.     LEAVE;
  154.     return result;
  155. }
  156.  
  157. PP(pp_indread)
  158. {
  159.     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
  160.     return do_readline();
  161. }
  162.  
  163. PP(pp_rcatline)
  164. {
  165.     last_in_gv = cGVOP->op_gv;
  166.     return do_readline();
  167. }
  168.  
  169. PP(pp_warn)
  170. {
  171.     dSP; dMARK;
  172.     char *tmps;
  173.     if (SP - MARK != 1) {
  174.     dTARGET;
  175.     do_join(TARG, &sv_no, MARK, SP);
  176.     tmps = SvPV(TARG, na);
  177.     SP = MARK + 1;
  178.     }
  179.     else {
  180.     tmps = SvPV(TOPs, na);
  181.     }
  182.     if (!tmps || !*tmps) {
  183.     SV *error = GvSV(errgv);
  184.     (void)SvUPGRADE(error, SVt_PV);
  185.     if (SvPOK(error) && SvCUR(error))
  186.         sv_catpv(error, "\t...caught");
  187.     tmps = SvPV(error, na);
  188.     }
  189.     if (!tmps || !*tmps)
  190.     tmps = "Warning: something's wrong";
  191.     warn("%s", tmps);
  192.     RETSETYES;
  193. }
  194.  
  195. PP(pp_die)
  196. {
  197.     dSP; dMARK;
  198.     char *tmps;
  199.     if (SP - MARK != 1) {
  200.     dTARGET;
  201.     do_join(TARG, &sv_no, MARK, SP);
  202.     tmps = SvPV(TARG, na);
  203.     SP = MARK + 1;
  204.     }
  205.     else {
  206.     tmps = SvPV(TOPs, na);
  207.     }
  208.     if (!tmps || !*tmps) {
  209.     SV *error = GvSV(errgv);
  210.     (void)SvUPGRADE(error, SVt_PV);
  211.     if (SvPOK(error) && SvCUR(error))
  212.         sv_catpv(error, "\t...propagated");
  213.     tmps = SvPV(error, na);
  214.     }
  215.     if (!tmps || !*tmps)
  216.     tmps = "Died";
  217.     DIE("%s", tmps);
  218. }
  219.  
  220. /* I/O. */
  221.  
  222. PP(pp_open)
  223. {
  224.     dSP; dTARGET;
  225.     GV *gv;
  226.     SV *sv;
  227.     char *tmps;
  228.     STRLEN len;
  229.  
  230.     if (MAXARG > 1)
  231.     sv = POPs;
  232.     else if (SvTYPE(TOPs) == SVt_PVGV)
  233.     sv = GvSV(TOPs);
  234.     else
  235.     DIE(no_usym, "filehandle");
  236.     gv = (GV*)POPs;
  237.     tmps = SvPV(sv, len);
  238.     if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) {
  239.     IoLINES(GvIOp(gv)) = 0;
  240.     PUSHi( (I32)forkprocess );
  241.     }
  242.     else if (forkprocess == 0)        /* we are a new child */
  243.     PUSHi(0);
  244.     else
  245.     RETPUSHUNDEF;
  246.     RETURN;
  247. }
  248.  
  249. PP(pp_close)
  250. {
  251.     dSP;
  252.     GV *gv;
  253.  
  254.     if (MAXARG == 0)
  255.     gv = defoutgv;
  256.     else
  257.     gv = (GV*)POPs;
  258.     EXTEND(SP, 1);
  259.     PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
  260.     RETURN;
  261. }
  262.  
  263. PP(pp_pipe_op)
  264. {
  265.     dSP;
  266. #ifdef HAS_PIPE
  267.     GV *rgv;
  268.     GV *wgv;
  269.     register IO *rstio;
  270.     register IO *wstio;
  271.     int fd[2];
  272.  
  273.     wgv = (GV*)POPs;
  274.     rgv = (GV*)POPs;
  275.  
  276.     if (!rgv || !wgv)
  277.     goto badexit;
  278.  
  279.     if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
  280.     DIE(no_usym, "filehandle");
  281.     rstio = GvIOn(rgv);
  282.     wstio = GvIOn(wgv);
  283.  
  284.     if (IoIFP(rstio))
  285.     do_close(rgv, FALSE);
  286.     if (IoIFP(wstio))
  287.     do_close(wgv, FALSE);
  288.  
  289.     if (pipe(fd) < 0)
  290.     goto badexit;
  291.  
  292.     IoIFP(rstio) = fdopen(fd[0], "r");
  293.     IoOFP(wstio) = fdopen(fd[1], "w");
  294.     IoIFP(wstio) = IoOFP(wstio);
  295.     IoTYPE(rstio) = '<';
  296.     IoTYPE(wstio) = '>';
  297.  
  298.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  299.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  300.     else close(fd[0]);
  301.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  302.     else close(fd[1]);
  303.     goto badexit;
  304.     }
  305.  
  306.     RETPUSHYES;
  307.  
  308. badexit:
  309.     RETPUSHUNDEF;
  310. #else
  311.     DIE(no_func, "pipe");
  312. #endif
  313. }
  314.  
  315. PP(pp_fileno)
  316. {
  317.     dSP; dTARGET;
  318.     GV *gv;
  319.     IO *io;
  320.     FILE *fp;
  321.     if (MAXARG < 1)
  322.     RETPUSHUNDEF;
  323.     gv = (GV*)POPs;
  324.     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
  325.     RETPUSHUNDEF;
  326.     PUSHi(fileno(fp));
  327.     RETURN;
  328. }
  329.  
  330. PP(pp_umask)
  331. {
  332.     dSP; dTARGET;
  333.     int anum;
  334.  
  335. #ifdef HAS_UMASK
  336.     if (MAXARG < 1) {
  337.     anum = umask(0);
  338.     (void)umask(anum);
  339.     }
  340.     else
  341.     anum = umask(POPi);
  342.     TAINT_PROPER("umask");
  343.     XPUSHi(anum);
  344. #else
  345.     DIE(no_func, "Unsupported function umask");
  346. #endif
  347.     RETURN;
  348. }
  349.  
  350. PP(pp_binmode)
  351. {
  352.     dSP;
  353.     GV *gv;
  354.     IO *io;
  355.     FILE *fp;
  356.  
  357.     if (MAXARG < 1)
  358.     RETPUSHUNDEF;
  359.  
  360.     gv = (GV*)POPs;
  361.  
  362.     EXTEND(SP, 1);
  363.     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
  364.     RETSETUNDEF;
  365.  
  366. #ifdef DOSISH
  367. #ifdef atarist
  368.     if (!Fflush(fp) && (fp->_flag |= _IOBIN))
  369.     RETPUSHYES;
  370.     else
  371.     RETPUSHUNDEF;
  372. #else
  373.     if (setmode(fileno(fp), OP_BINARY) != -1)
  374.     RETPUSHYES;
  375.     else
  376.     RETPUSHUNDEF;
  377. #endif
  378. #else
  379.     RETPUSHYES;
  380. #endif
  381. }
  382.  
  383. PP(pp_tie)
  384. {
  385.     dSP;
  386.     SV *varsv;
  387.     HV* stash;
  388.     GV *gv;
  389.     BINOP myop;
  390.     SV *sv;
  391.     SV **mark = stack_base + ++*markstack_ptr;    /* reuse in entersub */
  392.     I32 markoff = mark - stack_base - 1;
  393.     char *methname;
  394.  
  395.     varsv = mark[0];
  396.     if (SvTYPE(varsv) == SVt_PVHV)
  397.     methname = "TIEHASH";
  398.     else if (SvTYPE(varsv) == SVt_PVAV)
  399.     methname = "TIEARRAY";
  400.     else if (SvTYPE(varsv) == SVt_PVGV)
  401.     methname = "TIEHANDLE";
  402.     else
  403.     methname = "TIESCALAR";
  404.  
  405.     stash = gv_stashsv(mark[1], FALSE);
  406.     if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
  407.     DIE("Can't locate object method \"%s\" via package \"%s\"",
  408.         methname, SvPV(mark[1],na));
  409.  
  410.     Zero(&myop, 1, BINOP);
  411.     myop.op_last = (OP *) &myop;
  412.     myop.op_next = Nullop;
  413.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  414.  
  415.     ENTER;
  416.     SAVESPTR(op);
  417.     op = (OP *) &myop;
  418.  
  419.     XPUSHs(gv);
  420.     PUTBACK;
  421.  
  422.     if (op = pp_entersub())
  423.         runops();
  424.     SPAGAIN;
  425.  
  426.     sv = TOPs;
  427.     if (sv_isobject(sv)) {
  428.     if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
  429.         sv_unmagic(varsv, 'P');
  430.         sv_magic(varsv, sv, 'P', Nullch, 0);
  431.     }
  432.     else {
  433.         sv_unmagic(varsv, 'q');
  434.         sv_magic(varsv, sv, 'q', Nullch, 0);
  435.     }
  436.     }
  437.     LEAVE;
  438.     SP = stack_base + markoff;
  439.     PUSHs(sv);
  440.     RETURN;
  441. }
  442.  
  443. PP(pp_untie)
  444. {
  445.     dSP;
  446.     if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
  447.     sv_unmagic(TOPs, 'P');
  448.     else
  449.     sv_unmagic(TOPs, 'q');
  450.     RETSETYES;
  451. }
  452.  
  453. PP(pp_tied)
  454. {
  455.     dSP;
  456.     SV * sv ;
  457.     MAGIC * mg ;
  458.  
  459.     sv = POPs;
  460.     if (SvMAGICAL(sv)) {
  461.         if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
  462.             mg = mg_find(sv, 'P') ;
  463.         else
  464.             mg = mg_find(sv, 'q') ;
  465.  
  466.         if (mg)  {
  467.             PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; 
  468.             RETURN ;
  469.     }
  470.     }
  471.  
  472.     RETPUSHUNDEF;
  473. }
  474.  
  475. PP(pp_dbmopen)
  476. {
  477.     dSP;
  478.     HV *hv;
  479.     dPOPPOPssrl;
  480.     HV* stash;
  481.     GV *gv;
  482.     BINOP myop;
  483.     SV *sv;
  484.  
  485.     hv = (HV*)POPs;
  486.  
  487.     sv = sv_mortalcopy(&sv_no);
  488.     sv_setpv(sv, "AnyDBM_File");
  489.     stash = gv_stashsv(sv, FALSE);
  490.     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
  491.     PUTBACK;
  492.     perl_require_pv("AnyDBM_File.pm");
  493.     SPAGAIN;
  494.     if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
  495.         DIE("No dbm on this machine");
  496.     }
  497.  
  498.     Zero(&myop, 1, BINOP);
  499.     myop.op_last = (OP *) &myop;
  500.     myop.op_next = Nullop;
  501.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  502.  
  503.     ENTER;
  504.     SAVESPTR(op);
  505.     op = (OP *) &myop;
  506.     PUTBACK;
  507.     pp_pushmark();
  508.  
  509.     EXTEND(sp, 5);
  510.     PUSHs(sv);
  511.     PUSHs(left);
  512.     if (SvIV(right))
  513.     PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
  514.     else
  515.     PUSHs(sv_2mortal(newSViv(O_RDWR)));
  516.     PUSHs(right);
  517.     PUSHs(gv);
  518.     PUTBACK;
  519.  
  520.     if (op = pp_entersub())
  521.         runops();
  522.     SPAGAIN;
  523.  
  524.     if (!sv_isobject(TOPs)) {
  525.     sp--;
  526.     op = (OP *) &myop;
  527.     PUTBACK;
  528.     pp_pushmark();
  529.  
  530.     PUSHs(sv);
  531.     PUSHs(left);
  532.     PUSHs(sv_2mortal(newSViv(O_RDONLY)));
  533.     PUSHs(right);
  534.     PUSHs(gv);
  535.     PUTBACK;
  536.  
  537.     if (op = pp_entersub())
  538.         runops();
  539.     SPAGAIN;
  540.     }
  541.  
  542.     if (sv_isobject(TOPs))
  543.     sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
  544.     LEAVE;
  545.     RETURN;
  546. }
  547.  
  548. PP(pp_dbmclose)
  549. {
  550.     return pp_untie(ARGS);
  551. }
  552.  
  553. PP(pp_sselect)
  554. {
  555.     dSP; dTARGET;
  556. #ifdef HAS_SELECT
  557.     register I32 i;
  558.     register I32 j;
  559.     register char *s;
  560.     register SV *sv;
  561.     double value;
  562.     I32 maxlen = 0;
  563.     I32 nfound;
  564.     struct timeval timebuf;
  565.     struct timeval *tbuf = &timebuf;
  566.     I32 growsize;
  567.     char *fd_sets[4];
  568. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  569.     I32 masksize;
  570.     I32 offset;
  571.     I32 k;
  572.  
  573. #   if BYTEORDER & 0xf0000
  574. #    define ORDERBYTE (0x88888888 - BYTEORDER)
  575. #   else
  576. #    define ORDERBYTE (0x4444 - BYTEORDER)
  577. #   endif
  578.  
  579. #endif
  580.  
  581.     SP -= 4;
  582.     for (i = 1; i <= 3; i++) {
  583.     if (!SvPOK(SP[i]))
  584.         continue;
  585.     j = SvCUR(SP[i]);
  586.     if (maxlen < j)
  587.         maxlen = j;
  588.     }
  589.  
  590. #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
  591. #ifdef __linux__
  592.     growsize = sizeof(fd_set);
  593. #else
  594.     growsize = maxlen;        /* little endians can use vecs directly */
  595. #endif
  596. #else
  597. #ifdef NFDBITS
  598.  
  599. #ifndef NBBY
  600. #define NBBY 8
  601. #endif
  602.  
  603.     masksize = NFDBITS / NBBY;
  604. #else
  605.     masksize = sizeof(long);    /* documented int, everyone seems to use long */
  606. #endif
  607.     growsize = maxlen + (masksize - (maxlen % masksize));
  608.     Zero(&fd_sets[0], 4, char*);
  609. #endif
  610.  
  611.     sv = SP[4];
  612.     if (SvOK(sv)) {
  613.     value = SvNV(sv);
  614.     if (value < 0.0)
  615.         value = 0.0;
  616.     timebuf.tv_sec = (long)value;
  617.     value -= (double)timebuf.tv_sec;
  618.     timebuf.tv_usec = (long)(value * 1000000.0);
  619.     }
  620.     else
  621.     tbuf = Null(struct timeval*);
  622.  
  623.     for (i = 1; i <= 3; i++) {
  624.     sv = SP[i];
  625.     if (!SvOK(sv)) {
  626.         fd_sets[i] = 0;
  627.         continue;
  628.     }
  629.     else if (!SvPOK(sv))
  630.         SvPV_force(sv,na);    /* force string conversion */
  631.     j = SvLEN(sv);
  632.     if (j < growsize) {
  633.         Sv_Grow(sv, growsize);
  634.     }
  635.     j = SvCUR(sv);
  636.     s = SvPVX(sv) + j;
  637.     while (++j <= growsize) {
  638.         *s++ = '\0';
  639.     }
  640.  
  641. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  642.     s = SvPVX(sv);
  643.     New(403, fd_sets[i], growsize, char);
  644.     for (offset = 0; offset < growsize; offset += masksize) {
  645.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  646.         fd_sets[i][j+offset] = s[(k % masksize) + offset];
  647.     }
  648. #else
  649.     fd_sets[i] = SvPVX(sv);
  650. #endif
  651.     }
  652.  
  653.     nfound = select(
  654.     maxlen * 8,
  655.     (Select_fd_set_t) fd_sets[1],
  656.     (Select_fd_set_t) fd_sets[2],
  657.     (Select_fd_set_t) fd_sets[3],
  658.     tbuf);
  659.     for (i = 1; i <= 3; i++) {
  660.     if (fd_sets[i]) {
  661.         sv = SP[i];
  662. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  663.         s = SvPVX(sv);
  664.         for (offset = 0; offset < growsize; offset += masksize) {
  665.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  666.             s[(k % masksize) + offset] = fd_sets[i][j+offset];
  667.         }
  668.         Safefree(fd_sets[i]);
  669. #endif
  670.         SvSETMAGIC(sv);
  671.     }
  672.     }
  673.  
  674.     PUSHi(nfound);
  675.     if (GIMME == G_ARRAY && tbuf) {
  676.     value = (double)(timebuf.tv_sec) +
  677.         (double)(timebuf.tv_usec) / 1000000.0;
  678.     PUSHs(sv = sv_mortalcopy(&sv_no));
  679.     sv_setnv(sv, value);
  680.     }
  681.     RETURN;
  682. #else
  683.     DIE("select not implemented");
  684. #endif
  685. }
  686.  
  687. void
  688. setdefout(gv)
  689. GV *gv;
  690. {
  691.     if (gv)
  692.     (void)SvREFCNT_inc(gv);
  693.     if (defoutgv)
  694.     SvREFCNT_dec(defoutgv);
  695.     defoutgv = gv;
  696. }
  697.  
  698. PP(pp_select)
  699. {
  700.     dSP; dTARGET;
  701.     GV *newdefout, *egv;
  702.     HV *hv;
  703.  
  704.     newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
  705.  
  706.     egv = GvEGV(defoutgv);
  707.     if (!egv)
  708.     egv = defoutgv;
  709.     hv = GvSTASH(egv);
  710.     if (! hv)
  711.     XPUSHs(&sv_undef);
  712.     else {
  713.     GV **gvp = hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
  714.     if (gvp && *gvp == egv)
  715.         gv_efullname(TARG, defoutgv);
  716.     else
  717.         sv_setsv(TARG, sv_2mortal(newRV(egv)));
  718.     XPUSHTARG;
  719.     }
  720.  
  721.     if (newdefout) {
  722.     if (!GvIO(newdefout))
  723.         gv_IOadd(newdefout);
  724.     setdefout(newdefout);
  725.     }
  726.  
  727.     RETURN;
  728. }
  729.  
  730. PP(pp_getc)
  731. {
  732.     dSP; dTARGET;
  733.     GV *gv;
  734.  
  735.     if (MAXARG <= 0)
  736.     gv = stdingv;
  737.     else
  738.     gv = (GV*)POPs;
  739.     if (!gv)
  740.     gv = argvgv;
  741.     if (!gv || do_eof(gv)) /* make sure we have fp with something */
  742.     RETPUSHUNDEF;
  743.     TAINT_IF(1);
  744.     sv_setpv(TARG, " ");
  745.     *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
  746.     PUSHTARG;
  747.     RETURN;
  748. }
  749.  
  750. PP(pp_read)
  751. {
  752.     return pp_sysread(ARGS);
  753. }
  754.  
  755. static OP *
  756. doform(cv,gv,retop)
  757. CV *cv;
  758. GV *gv;
  759. OP *retop;
  760. {
  761.     register CONTEXT *cx;
  762.     I32 gimme = GIMME;
  763.     AV* padlist = CvPADLIST(cv);
  764.     SV** svp = AvARRAY(padlist);
  765.  
  766.     ENTER;
  767.     SAVETMPS;
  768.  
  769.     push_return(retop);
  770.     PUSHBLOCK(cx, CXt_SUB, stack_sp);
  771.     PUSHFORMAT(cx);
  772.     SAVESPTR(curpad);
  773.     curpad = AvARRAY((AV*)svp[1]);
  774.  
  775.     setdefout(gv);        /* locally select filehandle so $% et al work */
  776.     return CvSTART(cv);
  777. }
  778.  
  779. PP(pp_enterwrite)
  780. {
  781.     dSP;
  782.     register GV *gv;
  783.     register IO *io;
  784.     GV *fgv;
  785.     CV *cv;
  786.  
  787.     if (MAXARG == 0)
  788.     gv = defoutgv;
  789.     else {
  790.     gv = (GV*)POPs;
  791.     if (!gv)
  792.         gv = defoutgv;
  793.     }
  794.     EXTEND(SP, 1);
  795.     io = GvIO(gv);
  796.     if (!io) {
  797.     RETPUSHNO;
  798.     }
  799.     if (IoFMT_GV(io))
  800.     fgv = IoFMT_GV(io);
  801.     else
  802.     fgv = gv;
  803.  
  804.     cv = GvFORM(fgv);
  805.  
  806.     if (!cv) {
  807.     if (fgv) {
  808.         SV *tmpsv = sv_newmortal();
  809.         gv_efullname(tmpsv, gv);
  810.         DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
  811.     }
  812.     DIE("Not a format reference");
  813.     }
  814.     IoFLAGS(io) &= ~IOf_DIDTOP;
  815.  
  816.     return doform(cv,gv,op->op_next);
  817. }
  818.  
  819. PP(pp_leavewrite)
  820. {
  821.     dSP;
  822.     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
  823.     register IO *io = GvIOp(gv);
  824.     FILE *ofp = IoOFP(io);
  825.     FILE *fp;
  826.     SV **newsp;
  827.     I32 gimme;
  828.     register CONTEXT *cx;
  829.  
  830.     DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
  831.       (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
  832.     if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
  833.     formtarget != toptarget)
  834.     {
  835.     GV *fgv;
  836.     CV *cv;
  837.     if (!IoTOP_GV(io)) {
  838.         GV *topgv;
  839.         char tmpbuf[256];
  840.  
  841.         if (!IoTOP_NAME(io)) {
  842.         if (!IoFMT_NAME(io))
  843.             IoFMT_NAME(io) = savepv(GvNAME(gv));
  844.         sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
  845.         topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
  846.         if ((topgv && GvFORM(topgv)) ||
  847.           !gv_fetchpv("top",FALSE,SVt_PVFM))
  848.             IoTOP_NAME(io) = savepv(tmpbuf);
  849.         else
  850.             IoTOP_NAME(io) = savepv("top");
  851.         }
  852.         topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
  853.         if (!topgv || !GvFORM(topgv)) {
  854.         IoLINES_LEFT(io) = 100000000;
  855.         goto forget_top;
  856.         }
  857.         IoTOP_GV(io) = topgv;
  858.     }
  859.     if (IoFLAGS(io) & IOf_DIDTOP) {    /* Oh dear.  It still doesn't fit. */
  860.         I32 lines = IoLINES_LEFT(io);
  861.         char *s = SvPVX(formtarget);
  862.         if (lines <= 0)        /* Yow, header didn't even fit!!! */
  863.         goto forget_top;
  864.         while (lines-- > 0) {
  865.         s = strchr(s, '\n');
  866.         if (!s)
  867.             break;
  868.         s++;
  869.         }
  870.         if (s) {
  871.         fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
  872.         sv_chop(formtarget, s);
  873.         FmLINES(formtarget) -= IoLINES_LEFT(io);
  874.         }
  875.     }
  876.     if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
  877.         fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
  878.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  879.     IoPAGE(io)++;
  880.     formtarget = toptarget;
  881.     IoFLAGS(io) |= IOf_DIDTOP;
  882.     fgv = IoTOP_GV(io);
  883.     if (!fgv)
  884.         DIE("bad top format reference");
  885.     cv = GvFORM(fgv);
  886.     if (!cv) {
  887.         SV *tmpsv = sv_newmortal();
  888.         gv_efullname(tmpsv, fgv);
  889.         DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
  890.     }
  891.     return doform(cv,gv,op);
  892.     }
  893.  
  894.   forget_top:
  895.     POPBLOCK(cx,curpm);
  896.     POPFORMAT(cx);
  897.     LEAVE;
  898.  
  899.     fp = IoOFP(io);
  900.     if (!fp) {
  901.     if (dowarn) {
  902.         if (IoIFP(io))
  903.         warn("Filehandle only opened for input");
  904.         else
  905.         warn("Write on closed filehandle");
  906.     }
  907.     PUSHs(&sv_no);
  908.     }
  909.     else {
  910.     if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
  911.         if (dowarn)
  912.         warn("page overflow");
  913.     }
  914.     if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
  915.         ferror(fp))
  916.         PUSHs(&sv_no);
  917.     else {
  918.         FmLINES(formtarget) = 0;
  919.         SvCUR_set(formtarget, 0);
  920.         *SvEND(formtarget) = '\0';
  921.         if (IoFLAGS(io) & IOf_FLUSH)
  922.         (void)Fflush(fp);
  923.         PUSHs(&sv_yes);
  924.     }
  925.     }
  926.     formtarget = bodytarget;
  927.     PUTBACK;
  928.     return pop_return();
  929. }
  930.  
  931. PP(pp_prtf)
  932. {
  933.     dSP; dMARK; dORIGMARK;
  934.     GV *gv;
  935.     IO *io;
  936.     FILE *fp;
  937.     SV *sv = NEWSV(0,0);
  938.  
  939.     if (op->op_flags & OPf_STACKED)
  940.     gv = (GV*)*++MARK;
  941.     else
  942.     gv = defoutgv;
  943.     if (!(io = GvIO(gv))) {
  944.     if (dowarn) {
  945.         gv_fullname(sv,gv);
  946.         warn("Filehandle %s never opened", SvPV(sv,na));
  947.     }
  948.     SETERRNO(EBADF,RMS$_IFI);
  949.     goto just_say_no;
  950.     }
  951.     else if (!(fp = IoOFP(io))) {
  952.     if (dowarn)  {
  953.         gv_fullname(sv,gv);
  954.         if (IoIFP(io))
  955.         warn("Filehandle %s opened only for input", SvPV(sv,na));
  956.         else
  957.         warn("printf on closed filehandle %s", SvPV(sv,na));
  958.     }
  959.     SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  960.     goto just_say_no;
  961.     }
  962.     else {
  963.     do_sprintf(sv, SP - MARK, MARK + 1);
  964.     if (!do_print(sv, fp))
  965.         goto just_say_no;
  966.  
  967.     if (IoFLAGS(io) & IOf_FLUSH)
  968.         if (Fflush(fp) == EOF)
  969.         goto just_say_no;
  970.     }
  971.     SvREFCNT_dec(sv);
  972.     SP = ORIGMARK;
  973.     PUSHs(&sv_yes);
  974.     RETURN;
  975.  
  976.   just_say_no:
  977.     SvREFCNT_dec(sv);
  978.     SP = ORIGMARK;
  979.     PUSHs(&sv_undef);
  980.     RETURN;
  981. }
  982.  
  983. PP(pp_sysopen)
  984. {
  985.     dSP;
  986.     GV *gv;
  987.     SV *sv;
  988.     char *tmps;
  989.     STRLEN len;
  990.     int mode, perm;
  991.  
  992.     if (MAXARG > 3)
  993.     perm = POPi;
  994.     else
  995.     perm = 0666;
  996.     mode = POPi;
  997.     sv = POPs;
  998.     gv = (GV *)POPs;
  999.  
  1000.     tmps = SvPV(sv, len);
  1001.     if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
  1002.     IoLINES(GvIOp(gv)) = 0;
  1003.     PUSHs(&sv_yes);
  1004.     }
  1005.     else {
  1006.     PUSHs(&sv_undef);
  1007.     }
  1008.     RETURN;
  1009. }
  1010.  
  1011. PP(pp_sysread)
  1012. {
  1013.     dSP; dMARK; dORIGMARK; dTARGET;
  1014.     int offset;
  1015.     GV *gv;
  1016.     IO *io;
  1017.     char *buffer;
  1018.     int length;
  1019.     int bufsize;
  1020.     SV *bufsv;
  1021.     STRLEN blen;
  1022.  
  1023.     gv = (GV*)*++MARK;
  1024.     if (!gv)
  1025.     goto say_undef;
  1026.     bufsv = *++MARK;
  1027.     buffer = SvPV_force(bufsv, blen);
  1028.     length = SvIVx(*++MARK);
  1029.     if (length < 0)
  1030.     DIE("Negative length");
  1031.     SETERRNO(0,0);
  1032.     if (MARK < SP)
  1033.     offset = SvIVx(*++MARK);
  1034.     else
  1035.     offset = 0;
  1036.     io = GvIO(gv);
  1037.     if (!io || !IoIFP(io))
  1038.     goto say_undef;
  1039. #ifdef HAS_SOCKET
  1040.     if (op->op_type == OP_RECV) {
  1041.     bufsize = sizeof buf;
  1042.     buffer = SvGROW(bufsv, length+1);
  1043.     length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
  1044.         (struct sockaddr *)buf, &bufsize);
  1045.     if (length < 0)
  1046.         RETPUSHUNDEF;
  1047.     SvCUR_set(bufsv, length);
  1048.     *SvEND(bufsv) = '\0';
  1049.     (void)SvPOK_only(bufsv);
  1050.     SvSETMAGIC(bufsv);
  1051.     if (tainting)
  1052.         sv_magic(bufsv, Nullsv, 't', Nullch, 0);
  1053.     SP = ORIGMARK;
  1054.     sv_setpvn(TARG, buf, bufsize);
  1055.     PUSHs(TARG);
  1056.     RETURN;
  1057.     }
  1058. #else
  1059.     if (op->op_type == OP_RECV)
  1060.     DIE(no_sock_func, "recv");
  1061. #endif
  1062.     buffer = SvGROW(bufsv, length+offset+1);
  1063.     if (op->op_type == OP_SYSREAD) {
  1064.     length = read(fileno(IoIFP(io)), buffer+offset, length);
  1065.     }
  1066.     else
  1067. #ifdef HAS_SOCKET__bad_code_maybe
  1068.     if (IoTYPE(io) == 's') {
  1069.     bufsize = sizeof buf;
  1070.     length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
  1071.         (struct sockaddr *)buf, &bufsize);
  1072.     }
  1073.     else
  1074. #endif
  1075.     length = fread(buffer+offset, 1, length, IoIFP(io));
  1076.     if (length < 0)
  1077.     goto say_undef;
  1078.     SvCUR_set(bufsv, length+offset);
  1079.     *SvEND(bufsv) = '\0';
  1080.     (void)SvPOK_only(bufsv);
  1081.     SvSETMAGIC(bufsv);
  1082.     if (tainting)
  1083.     sv_magic(bufsv, Nullsv, 't', Nullch, 0);
  1084.     SP = ORIGMARK;
  1085.     PUSHi(length);
  1086.     RETURN;
  1087.  
  1088.   say_undef:
  1089.     SP = ORIGMARK;
  1090.     RETPUSHUNDEF;
  1091. }
  1092.  
  1093. PP(pp_syswrite)
  1094. {
  1095.     return pp_send(ARGS);
  1096. }
  1097.  
  1098. PP(pp_send)
  1099. {
  1100.     dSP; dMARK; dORIGMARK; dTARGET;
  1101.     GV *gv;
  1102.     IO *io;
  1103.     int offset;
  1104.     SV *bufsv;
  1105.     char *buffer;
  1106.     int length;
  1107.     STRLEN blen;
  1108.  
  1109.     gv = (GV*)*++MARK;
  1110.     if (!gv)
  1111.     goto say_undef;
  1112.     bufsv = *++MARK;
  1113.     buffer = SvPV(bufsv, blen);
  1114.     length = SvIVx(*++MARK);
  1115.     if (length < 0)
  1116.     DIE("Negative length");
  1117.     SETERRNO(0,0);
  1118.     io = GvIO(gv);
  1119.     if (!io || !IoIFP(io)) {
  1120.     length = -1;
  1121.     if (dowarn) {
  1122.         if (op->op_type == OP_SYSWRITE)
  1123.         warn("Syswrite on closed filehandle");
  1124.         else
  1125.         warn("Send on closed socket");
  1126.     }
  1127.     }
  1128.     else if (op->op_type == OP_SYSWRITE) {
  1129.     if (MARK < SP)
  1130.         offset = SvIVx(*++MARK);
  1131.     else
  1132.         offset = 0;
  1133.     if (length > blen - offset)
  1134.         length = blen - offset;
  1135.     length = write(fileno(IoIFP(io)), buffer+offset, length);
  1136.     }
  1137. #ifdef HAS_SOCKET
  1138.     else if (SP > MARK) {
  1139.     char *sockbuf;
  1140.     STRLEN mlen;
  1141.     sockbuf = SvPVx(*++MARK, mlen);
  1142.     length = sendto(fileno(IoIFP(io)), buffer, blen, length,
  1143.                 (struct sockaddr *)sockbuf, mlen);
  1144.     }
  1145.     else
  1146.     length = send(fileno(IoIFP(io)), buffer, blen, length);
  1147. #else
  1148.     else
  1149.     DIE(no_sock_func, "send");
  1150. #endif
  1151.     if (length < 0)
  1152.     goto say_undef;
  1153.     SP = ORIGMARK;
  1154.     PUSHi(length);
  1155.     RETURN;
  1156.  
  1157.   say_undef:
  1158.     SP = ORIGMARK;
  1159.     RETPUSHUNDEF;
  1160. }
  1161.  
  1162. PP(pp_recv)
  1163. {
  1164.     return pp_sysread(ARGS);
  1165. }
  1166.  
  1167. PP(pp_eof)
  1168. {
  1169.     dSP;
  1170.     GV *gv;
  1171.  
  1172.     if (MAXARG <= 0)
  1173.     gv = last_in_gv;
  1174.     else
  1175.     gv = last_in_gv = (GV*)POPs;
  1176.     PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
  1177.     RETURN;
  1178. }
  1179.  
  1180. PP(pp_tell)
  1181. {
  1182.     dSP; dTARGET;
  1183.     GV *gv;
  1184.  
  1185.     if (MAXARG <= 0)
  1186.     gv = last_in_gv;
  1187.     else
  1188.     gv = last_in_gv = (GV*)POPs;
  1189.     PUSHi( do_tell(gv) );
  1190.     RETURN;
  1191. }
  1192.  
  1193. PP(pp_seek)
  1194. {
  1195.     dSP;
  1196.     GV *gv;
  1197.     int whence = POPi;
  1198.     long offset = POPl;
  1199.  
  1200.     gv = last_in_gv = (GV*)POPs;
  1201.     PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
  1202.     RETURN;
  1203. }
  1204.  
  1205. PP(pp_truncate)
  1206. {
  1207.     dSP;
  1208.     Off_t len = (Off_t)POPn;
  1209.     int result = 1;
  1210.     GV *tmpgv;
  1211.  
  1212.     SETERRNO(0,0);
  1213. #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
  1214. #ifdef HAS_TRUNCATE
  1215.     if (op->op_flags & OPf_SPECIAL) {
  1216.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1217.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1218.       ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1219.         result = 0;
  1220.     }
  1221.     else if (truncate(POPp, len) < 0)
  1222.     result = 0;
  1223. #else
  1224.     if (op->op_flags & OPf_SPECIAL) {
  1225.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1226.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1227.       chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1228.         result = 0;
  1229.     }
  1230.     else {
  1231.     int tmpfd;
  1232.  
  1233.     if ((tmpfd = open(POPp, 0)) < 0)
  1234.         result = 0;
  1235.     else {
  1236.         if (chsize(tmpfd, len) < 0)
  1237.         result = 0;
  1238.         close(tmpfd);
  1239.     }
  1240.     }
  1241. #endif
  1242.  
  1243.     if (result)
  1244.     RETPUSHYES;
  1245.     if (!errno)
  1246.     SETERRNO(EBADF,RMS$_IFI);
  1247.     RETPUSHUNDEF;
  1248. #else
  1249.     DIE("truncate not implemented");
  1250. #endif
  1251. }
  1252.  
  1253. PP(pp_fcntl)
  1254. {
  1255.     return pp_ioctl(ARGS);
  1256. }
  1257.  
  1258. PP(pp_ioctl)
  1259. {
  1260.     dSP; dTARGET;
  1261.     SV *argsv = POPs;
  1262.     unsigned int func = U_I(POPn);
  1263.     int optype = op->op_type;
  1264.     char *s;
  1265.     int retval;
  1266.     GV *gv = (GV*)POPs;
  1267.     IO *io = GvIOn(gv);
  1268.  
  1269.     if (!io || !argsv || !IoIFP(io)) {
  1270.     SETERRNO(EBADF,RMS$_IFI);    /* well, sort of... */
  1271.     RETPUSHUNDEF;
  1272.     }
  1273.  
  1274.     if (SvPOK(argsv) || !SvNIOK(argsv)) {
  1275.     STRLEN len;
  1276.     s = SvPV_force(argsv, len);
  1277.     retval = IOCPARM_LEN(func);
  1278.     if (len < retval) {
  1279.         s = Sv_Grow(argsv, retval+1);
  1280.         SvCUR_set(argsv, retval);
  1281.     }
  1282.  
  1283.     s[SvCUR(argsv)] = 17;    /* a little sanity check here */
  1284.     }
  1285.     else {
  1286.     retval = SvIV(argsv);
  1287. #ifdef DOSISH
  1288.     s = (char*)(long)retval;    /* ouch */
  1289. #else
  1290.     s = (char*)retval;        /* ouch */
  1291. #endif
  1292.     }
  1293.  
  1294.     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
  1295.  
  1296.     if (optype == OP_IOCTL)
  1297. #ifdef HAS_IOCTL
  1298.     retval = ioctl(fileno(IoIFP(io)), func, s);
  1299. #else
  1300.     DIE("ioctl is not implemented");
  1301. #endif
  1302.     else
  1303. #if defined(DOSISH) && !defined(OS2)
  1304.     DIE("fcntl is not implemented");
  1305. #else
  1306. #   ifdef HAS_FCNTL
  1307. #     if defined(OS2) && defined(__EMX__)
  1308.     retval = fcntl(fileno(IoIFP(io)), func, (int)s);
  1309. #     else
  1310.     retval = fcntl(fileno(IoIFP(io)), func, s);
  1311. #     endif 
  1312. #   else
  1313.     DIE("fcntl is not implemented");
  1314. #   endif
  1315. #endif
  1316.  
  1317.     if (SvPOK(argsv)) {
  1318.     if (s[SvCUR(argsv)] != 17)
  1319.         DIE("Possible memory corruption: %s overflowed 3rd argument",
  1320.         op_name[optype]);
  1321.     s[SvCUR(argsv)] = 0;        /* put our null back */
  1322.     SvSETMAGIC(argsv);        /* Assume it has changed */
  1323.     }
  1324.  
  1325.     if (retval == -1)
  1326.     RETPUSHUNDEF;
  1327.     if (retval != 0) {
  1328.     PUSHi(retval);
  1329.     }
  1330.     else {
  1331.     PUSHp("0 but true", 10);
  1332.     }
  1333.     RETURN;
  1334. }
  1335.  
  1336. PP(pp_flock)
  1337. {
  1338.     dSP; dTARGET;
  1339.     I32 value;
  1340.     int argtype;
  1341.     GV *gv;
  1342.     FILE *fp;
  1343.  
  1344. #if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
  1345. #  define flock lockf_emulate_flock
  1346. #endif
  1347.  
  1348. #if defined(HAS_FLOCK) || defined(flock)
  1349.     argtype = POPi;
  1350.     if (MAXARG <= 0)
  1351.     gv = last_in_gv;
  1352.     else
  1353.     gv = (GV*)POPs;
  1354.     if (gv && GvIO(gv))
  1355.     fp = IoIFP(GvIOp(gv));
  1356.     else
  1357.     fp = Nullfp;
  1358.     if (fp) {
  1359.     value = (I32)(flock(fileno(fp), argtype) >= 0);
  1360.     }
  1361.     else
  1362.     value = 0;
  1363.     PUSHi(value);
  1364.     RETURN;
  1365. #else
  1366.     DIE(no_func, "flock()");
  1367. #endif
  1368. }
  1369.  
  1370. /* Sockets. */
  1371.  
  1372. PP(pp_socket)
  1373. {
  1374.     dSP;
  1375. #ifdef HAS_SOCKET
  1376.     GV *gv;
  1377.     register IO *io;
  1378.     int protocol = POPi;
  1379.     int type = POPi;
  1380.     int domain = POPi;
  1381.     int fd;
  1382.  
  1383.     gv = (GV*)POPs;
  1384.  
  1385.     if (!gv) {
  1386.     SETERRNO(EBADF,LIB$_INVARG);
  1387.     RETPUSHUNDEF;
  1388.     }
  1389.  
  1390.     io = GvIOn(gv);
  1391.     if (IoIFP(io))
  1392.     do_close(gv, FALSE);
  1393.  
  1394.     TAINT_PROPER("socket");
  1395.     fd = socket(domain, type, protocol);
  1396.     if (fd < 0)
  1397.     RETPUSHUNDEF;
  1398.     IoIFP(io) = fdopen(fd, "r");    /* stdio gets confused about sockets */
  1399.     IoOFP(io) = fdopen(fd, "w");
  1400.     IoTYPE(io) = 's';
  1401.     if (!IoIFP(io) || !IoOFP(io)) {
  1402.     if (IoIFP(io)) fclose(IoIFP(io));
  1403.     if (IoOFP(io)) fclose(IoOFP(io));
  1404.     if (!IoIFP(io) && !IoOFP(io)) close(fd);
  1405.     RETPUSHUNDEF;
  1406.     }
  1407.  
  1408.     RETPUSHYES;
  1409. #else
  1410.     DIE(no_sock_func, "socket");
  1411. #endif
  1412. }
  1413.  
  1414. PP(pp_sockpair)
  1415. {
  1416.     dSP;
  1417. #ifdef HAS_SOCKETPAIR
  1418.     GV *gv1;
  1419.     GV *gv2;
  1420.     register IO *io1;
  1421.     register IO *io2;
  1422.     int protocol = POPi;
  1423.     int type = POPi;
  1424.     int domain = POPi;
  1425.     int fd[2];
  1426.  
  1427.     gv2 = (GV*)POPs;
  1428.     gv1 = (GV*)POPs;
  1429.     if (!gv1 || !gv2)
  1430.     RETPUSHUNDEF;
  1431.  
  1432.     io1 = GvIOn(gv1);
  1433.     io2 = GvIOn(gv2);
  1434.     if (IoIFP(io1))
  1435.     do_close(gv1, FALSE);
  1436.     if (IoIFP(io2))
  1437.     do_close(gv2, FALSE);
  1438.  
  1439.     TAINT_PROPER("socketpair");
  1440.     if (socketpair(domain, type, protocol, fd) < 0)
  1441.     RETPUSHUNDEF;
  1442.     IoIFP(io1) = fdopen(fd[0], "r");
  1443.     IoOFP(io1) = fdopen(fd[0], "w");
  1444.     IoTYPE(io1) = 's';
  1445.     IoIFP(io2) = fdopen(fd[1], "r");
  1446.     IoOFP(io2) = fdopen(fd[1], "w");
  1447.     IoTYPE(io2) = 's';
  1448.     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
  1449.     if (IoIFP(io1)) fclose(IoIFP(io1));
  1450.     if (IoOFP(io1)) fclose(IoOFP(io1));
  1451.     if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
  1452.     if (IoIFP(io2)) fclose(IoIFP(io2));
  1453.     if (IoOFP(io2)) fclose(IoOFP(io2));
  1454.     if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
  1455.     RETPUSHUNDEF;
  1456.     }
  1457.  
  1458.     RETPUSHYES;
  1459. #else
  1460.     DIE(no_sock_func, "socketpair");
  1461. #endif
  1462. }
  1463.  
  1464. PP(pp_bind)
  1465. {
  1466.     dSP;
  1467. #ifdef HAS_SOCKET
  1468.     SV *addrsv = POPs;
  1469.     char *addr;
  1470.     GV *gv = (GV*)POPs;
  1471.     register IO *io = GvIOn(gv);
  1472.     STRLEN len;
  1473.  
  1474.     if (!io || !IoIFP(io))
  1475.     goto nuts;
  1476.  
  1477.     addr = SvPV(addrsv, len);
  1478.     TAINT_PROPER("bind");
  1479.     if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1480.     RETPUSHYES;
  1481.     else
  1482.     RETPUSHUNDEF;
  1483.  
  1484. nuts:
  1485.     if (dowarn)
  1486.     warn("bind() on closed fd");
  1487.     SETERRNO(EBADF,SS$_IVCHAN);
  1488.     RETPUSHUNDEF;
  1489. #else
  1490.     DIE(no_sock_func, "bind");
  1491. #endif
  1492. }
  1493.  
  1494. PP(pp_connect)
  1495. {
  1496.     dSP;
  1497. #ifdef HAS_SOCKET
  1498.     SV *addrsv = POPs;
  1499.     char *addr;
  1500.     GV *gv = (GV*)POPs;
  1501.     register IO *io = GvIOn(gv);
  1502.     STRLEN len;
  1503.  
  1504.     if (!io || !IoIFP(io))
  1505.     goto nuts;
  1506.  
  1507.     addr = SvPV(addrsv, len);
  1508.     TAINT_PROPER("connect");
  1509.     if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1510.     RETPUSHYES;
  1511.     else
  1512.     RETPUSHUNDEF;
  1513.  
  1514. nuts:
  1515.     if (dowarn)
  1516.     warn("connect() on closed fd");
  1517.     SETERRNO(EBADF,SS$_IVCHAN);
  1518.     RETPUSHUNDEF;
  1519. #else
  1520.     DIE(no_sock_func, "connect");
  1521. #endif
  1522. }
  1523.  
  1524. PP(pp_listen)
  1525. {
  1526.     dSP;
  1527. #ifdef HAS_SOCKET
  1528.     int backlog = POPi;
  1529.     GV *gv = (GV*)POPs;
  1530.     register IO *io = GvIOn(gv);
  1531.  
  1532.     if (!io || !IoIFP(io))
  1533.     goto nuts;
  1534.  
  1535.     if (listen(fileno(IoIFP(io)), backlog) >= 0)
  1536.     RETPUSHYES;
  1537.     else
  1538.     RETPUSHUNDEF;
  1539.  
  1540. nuts:
  1541.     if (dowarn)
  1542.     warn("listen() on closed fd");
  1543.     SETERRNO(EBADF,SS$_IVCHAN);
  1544.     RETPUSHUNDEF;
  1545. #else
  1546.     DIE(no_sock_func, "listen");
  1547. #endif
  1548. }
  1549.  
  1550. PP(pp_accept)
  1551. {
  1552.     dSP; dTARGET;
  1553. #ifdef HAS_SOCKET
  1554.     GV *ngv;
  1555.     GV *ggv;
  1556.     register IO *nstio;
  1557.     register IO *gstio;
  1558.     struct sockaddr saddr;    /* use a struct to avoid alignment problems */
  1559.     int len = sizeof saddr;
  1560.     int fd;
  1561.  
  1562.     ggv = (GV*)POPs;
  1563.     ngv = (GV*)POPs;
  1564.  
  1565.     if (!ngv)
  1566.     goto badexit;
  1567.     if (!ggv)
  1568.     goto nuts;
  1569.  
  1570.     gstio = GvIO(ggv);
  1571.     if (!gstio || !IoIFP(gstio))
  1572.     goto nuts;
  1573.  
  1574.     nstio = GvIOn(ngv);
  1575.     if (IoIFP(nstio))
  1576.     do_close(ngv, FALSE);
  1577.  
  1578.     fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
  1579.     if (fd < 0)
  1580.     goto badexit;
  1581.     IoIFP(nstio) = fdopen(fd, "r");
  1582.     IoOFP(nstio) = fdopen(fd, "w");
  1583.     IoTYPE(nstio) = 's';
  1584.     if (!IoIFP(nstio) || !IoOFP(nstio)) {
  1585.     if (IoIFP(nstio)) fclose(IoIFP(nstio));
  1586.     if (IoOFP(nstio)) fclose(IoOFP(nstio));
  1587.     if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
  1588.     goto badexit;
  1589.     }
  1590.  
  1591.     PUSHp((char *)&saddr, len);
  1592.     RETURN;
  1593.  
  1594. nuts:
  1595.     if (dowarn)
  1596.     warn("accept() on closed fd");
  1597.     SETERRNO(EBADF,SS$_IVCHAN);
  1598.  
  1599. badexit:
  1600.     RETPUSHUNDEF;
  1601.  
  1602. #else
  1603.     DIE(no_sock_func, "accept");
  1604. #endif
  1605. }
  1606.  
  1607. PP(pp_shutdown)
  1608. {
  1609.     dSP; dTARGET;
  1610. #ifdef HAS_SOCKET
  1611.     int how = POPi;
  1612.     GV *gv = (GV*)POPs;
  1613.     register IO *io = GvIOn(gv);
  1614.  
  1615.     if (!io || !IoIFP(io))
  1616.     goto nuts;
  1617.  
  1618.     PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
  1619.     RETURN;
  1620.  
  1621. nuts:
  1622.     if (dowarn)
  1623.     warn("shutdown() on closed fd");
  1624.     SETERRNO(EBADF,SS$_IVCHAN);
  1625.     RETPUSHUNDEF;
  1626. #else
  1627.     DIE(no_sock_func, "shutdown");
  1628. #endif
  1629. }
  1630.  
  1631. PP(pp_gsockopt)
  1632. {
  1633. #ifdef HAS_SOCKET
  1634.     return pp_ssockopt(ARGS);
  1635. #else
  1636.     DIE(no_sock_func, "getsockopt");
  1637. #endif
  1638. }
  1639.  
  1640. PP(pp_ssockopt)
  1641. {
  1642.     dSP;
  1643. #ifdef HAS_SOCKET
  1644.     int optype = op->op_type;
  1645.     SV *sv;
  1646.     int fd;
  1647.     unsigned int optname;
  1648.     unsigned int lvl;
  1649.     GV *gv;
  1650.     register IO *io;
  1651.     int aint;
  1652.  
  1653.     if (optype == OP_GSOCKOPT)
  1654.     sv = sv_2mortal(NEWSV(22, 257));
  1655.     else
  1656.     sv = POPs;
  1657.     optname = (unsigned int) POPi;
  1658.     lvl = (unsigned int) POPi;
  1659.  
  1660.     gv = (GV*)POPs;
  1661.     io = GvIOn(gv);
  1662.     if (!io || !IoIFP(io))
  1663.     goto nuts;
  1664.  
  1665.     fd = fileno(IoIFP(io));
  1666.     switch (optype) {
  1667.     case OP_GSOCKOPT:
  1668.     SvGROW(sv, 257);
  1669.     (void)SvPOK_only(sv);
  1670.     SvCUR_set(sv,256);
  1671.     *SvEND(sv) ='\0';
  1672.     aint = SvCUR(sv);
  1673.     if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
  1674.         goto nuts2;
  1675.     SvCUR_set(sv,aint);
  1676.     *SvEND(sv) ='\0';
  1677.     PUSHs(sv);
  1678.     break;
  1679.     case OP_SSOCKOPT: {
  1680.         STRLEN len = 0;
  1681.         char *buf = 0;
  1682.         if (SvPOKp(sv))
  1683.         buf = SvPV(sv, len);
  1684.         else if (SvOK(sv)) {
  1685.         aint = (int)SvIV(sv);
  1686.         buf = (char*)&aint;
  1687.         len = sizeof(int);
  1688.         }
  1689.         if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
  1690.         goto nuts2;
  1691.         PUSHs(&sv_yes);
  1692.     }
  1693.     break;
  1694.     }
  1695.     RETURN;
  1696.  
  1697. nuts:
  1698.     if (dowarn)
  1699.     warn("[gs]etsockopt() on closed fd");
  1700.     SETERRNO(EBADF,SS$_IVCHAN);
  1701. nuts2:
  1702.     RETPUSHUNDEF;
  1703.  
  1704. #else
  1705.     DIE(no_sock_func, "setsockopt");
  1706. #endif
  1707. }
  1708.  
  1709. PP(pp_getsockname)
  1710. {
  1711. #ifdef HAS_SOCKET
  1712.     return pp_getpeername(ARGS);
  1713. #else
  1714.     DIE(no_sock_func, "getsockname");
  1715. #endif
  1716. }
  1717.  
  1718. PP(pp_getpeername)
  1719. {
  1720.     dSP;
  1721. #ifdef HAS_SOCKET
  1722.     int optype = op->op_type;
  1723.     SV *sv;
  1724.     int fd;
  1725.     GV *gv = (GV*)POPs;
  1726.     register IO *io = GvIOn(gv);
  1727.     int aint;
  1728.  
  1729.     if (!io || !IoIFP(io))
  1730.     goto nuts;
  1731.  
  1732.     sv = sv_2mortal(NEWSV(22, 257));
  1733.     (void)SvPOK_only(sv);
  1734.     SvCUR_set(sv,256);
  1735.     *SvEND(sv) ='\0';
  1736.     aint = SvCUR(sv);
  1737.     fd = fileno(IoIFP(io));
  1738.     switch (optype) {
  1739.     case OP_GETSOCKNAME:
  1740.     if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
  1741.         goto nuts2;
  1742.     break;
  1743.     case OP_GETPEERNAME:
  1744.     if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
  1745.         goto nuts2;
  1746.     break;
  1747.     }
  1748.     SvCUR_set(sv,aint);
  1749.     *SvEND(sv) ='\0';
  1750.     PUSHs(sv);
  1751.     RETURN;
  1752.  
  1753. nuts:
  1754.     if (dowarn)
  1755.     warn("get{sock, peer}name() on closed fd");
  1756.     SETERRNO(EBADF,SS$_IVCHAN);
  1757. nuts2:
  1758.     RETPUSHUNDEF;
  1759.  
  1760. #else
  1761.     DIE(no_sock_func, "getpeername");
  1762. #endif
  1763. }
  1764.  
  1765. /* Stat calls. */
  1766.  
  1767. PP(pp_lstat)
  1768. {
  1769.     return pp_stat(ARGS);
  1770. }
  1771.  
  1772. PP(pp_stat)
  1773. {
  1774.     dSP;
  1775.     GV *tmpgv;
  1776.     I32 max = 13;
  1777.  
  1778.     if (op->op_flags & OPf_REF) {
  1779.     tmpgv = cGVOP->op_gv;
  1780.       do_fstat:
  1781.     if (tmpgv != defgv) {
  1782.         laststype = OP_STAT;
  1783.         statgv = tmpgv;
  1784.         sv_setpv(statname, "");
  1785.         if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1786.           Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
  1787.         max = 0;
  1788.         laststatval = -1;
  1789.         }
  1790.     }
  1791.     else if (laststatval < 0)
  1792.         max = 0;
  1793.     }
  1794.     else {
  1795.     SV* sv = POPs;
  1796.     if (SvTYPE(sv) == SVt_PVGV) {
  1797.         tmpgv = (GV*)sv;
  1798.         goto do_fstat;
  1799.     }
  1800.     else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
  1801.         tmpgv = (GV*)SvRV(sv);
  1802.         goto do_fstat;
  1803.     }
  1804.     sv_setpv(statname, SvPV(sv,na));
  1805.     statgv = Nullgv;
  1806. #ifdef HAS_LSTAT
  1807.     laststype = op->op_type;
  1808.     if (op->op_type == OP_LSTAT)
  1809.         laststatval = lstat(SvPV(statname, na), &statcache);
  1810.     else
  1811. #endif
  1812.         laststatval = Stat(SvPV(statname, na), &statcache);
  1813.     if (laststatval < 0) {
  1814.         if (dowarn && strchr(SvPV(statname, na), '\n'))
  1815.         warn(warn_nl, "stat");
  1816.         max = 0;
  1817.     }
  1818.     }
  1819.  
  1820.     EXTEND(SP, 13);
  1821.     if (GIMME != G_ARRAY) {
  1822.     if (max)
  1823.         RETPUSHYES;
  1824.     else
  1825.         RETPUSHUNDEF;
  1826.     }
  1827.     if (max) {
  1828.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
  1829.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
  1830.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
  1831.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
  1832.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
  1833.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
  1834.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
  1835.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
  1836.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
  1837.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
  1838.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
  1839. #ifdef USE_STAT_BLOCKS
  1840.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
  1841.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
  1842. #else
  1843.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1844.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1845. #endif
  1846.     }
  1847.     RETURN;
  1848. }
  1849.  
  1850. PP(pp_ftrread)
  1851. {
  1852.     I32 result = my_stat(ARGS);
  1853.     dSP;
  1854.     if (result < 0)
  1855.     RETPUSHUNDEF;
  1856.     if (cando(S_IRUSR, 0, &statcache))
  1857.     RETPUSHYES;
  1858.     RETPUSHNO;
  1859. }
  1860.  
  1861. PP(pp_ftrwrite)
  1862. {
  1863.     I32 result = my_stat(ARGS);
  1864.     dSP;
  1865.     if (result < 0)
  1866.     RETPUSHUNDEF;
  1867.     if (cando(S_IWUSR, 0, &statcache))
  1868.     RETPUSHYES;
  1869.     RETPUSHNO;
  1870. }
  1871.  
  1872. PP(pp_ftrexec)
  1873. {
  1874.     I32 result = my_stat(ARGS);
  1875.     dSP;
  1876.     if (result < 0)
  1877.     RETPUSHUNDEF;
  1878.     if (cando(S_IXUSR, 0, &statcache))
  1879.     RETPUSHYES;
  1880.     RETPUSHNO;
  1881. }
  1882.  
  1883. PP(pp_fteread)
  1884. {
  1885.     I32 result = my_stat(ARGS);
  1886.     dSP;
  1887.     if (result < 0)
  1888.     RETPUSHUNDEF;
  1889.     if (cando(S_IRUSR, 1, &statcache))
  1890.     RETPUSHYES;
  1891.     RETPUSHNO;
  1892. }
  1893.  
  1894. PP(pp_ftewrite)
  1895. {
  1896.     I32 result = my_stat(ARGS);
  1897.     dSP;
  1898.     if (result < 0)
  1899.     RETPUSHUNDEF;
  1900.     if (cando(S_IWUSR, 1, &statcache))
  1901.     RETPUSHYES;
  1902.     RETPUSHNO;
  1903. }
  1904.  
  1905. PP(pp_fteexec)
  1906. {
  1907.     I32 result = my_stat(ARGS);
  1908.     dSP;
  1909.     if (result < 0)
  1910.     RETPUSHUNDEF;
  1911.     if (cando(S_IXUSR, 1, &statcache))
  1912.     RETPUSHYES;
  1913.     RETPUSHNO;
  1914. }
  1915.  
  1916. PP(pp_ftis)
  1917. {
  1918.     I32 result = my_stat(ARGS);
  1919.     dSP;
  1920.     if (result < 0)
  1921.     RETPUSHUNDEF;
  1922.     RETPUSHYES;
  1923. }
  1924.  
  1925. PP(pp_fteowned)
  1926. {
  1927.     return pp_ftrowned(ARGS);
  1928. }
  1929.  
  1930. PP(pp_ftrowned)
  1931. {
  1932.     I32 result = my_stat(ARGS);
  1933.     dSP;
  1934.     if (result < 0)
  1935.     RETPUSHUNDEF;
  1936.     if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
  1937.     RETPUSHYES;
  1938.     RETPUSHNO;
  1939. }
  1940.  
  1941. PP(pp_ftzero)
  1942. {
  1943.     I32 result = my_stat(ARGS);
  1944.     dSP;
  1945.     if (result < 0)
  1946.     RETPUSHUNDEF;
  1947.     if (!statcache.st_size)
  1948.     RETPUSHYES;
  1949.     RETPUSHNO;
  1950. }
  1951.  
  1952. PP(pp_ftsize)
  1953. {
  1954.     I32 result = my_stat(ARGS);
  1955.     dSP; dTARGET;
  1956.     if (result < 0)
  1957.     RETPUSHUNDEF;
  1958.     PUSHi(statcache.st_size);
  1959.     RETURN;
  1960. }
  1961.  
  1962. PP(pp_ftmtime)
  1963. {
  1964.     I32 result = my_stat(ARGS);
  1965.     dSP; dTARGET;
  1966.     if (result < 0)
  1967.     RETPUSHUNDEF;
  1968.     PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
  1969.     RETURN;
  1970. }
  1971.  
  1972. PP(pp_ftatime)
  1973. {
  1974.     I32 result = my_stat(ARGS);
  1975.     dSP; dTARGET;
  1976.     if (result < 0)
  1977.     RETPUSHUNDEF;
  1978.     PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
  1979.     RETURN;
  1980. }
  1981.  
  1982. PP(pp_ftctime)
  1983. {
  1984.     I32 result = my_stat(ARGS);
  1985.     dSP; dTARGET;
  1986.     if (result < 0)
  1987.     RETPUSHUNDEF;
  1988.     PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
  1989.     RETURN;
  1990. }
  1991.  
  1992. PP(pp_ftsock)
  1993. {
  1994.     I32 result = my_stat(ARGS);
  1995.     dSP;
  1996.     if (result < 0)
  1997.     RETPUSHUNDEF;
  1998.     if (S_ISSOCK(statcache.st_mode))
  1999.     RETPUSHYES;
  2000.     RETPUSHNO;
  2001. }
  2002.  
  2003. PP(pp_ftchr)
  2004. {
  2005.     I32 result = my_stat(ARGS);
  2006.     dSP;
  2007.     if (result < 0)
  2008.     RETPUSHUNDEF;
  2009.     if (S_ISCHR(statcache.st_mode))
  2010.     RETPUSHYES;
  2011.     RETPUSHNO;
  2012. }
  2013.  
  2014. PP(pp_ftblk)
  2015. {
  2016.     I32 result = my_stat(ARGS);
  2017.     dSP;
  2018.     if (result < 0)
  2019.     RETPUSHUNDEF;
  2020.     if (S_ISBLK(statcache.st_mode))
  2021.     RETPUSHYES;
  2022.     RETPUSHNO;
  2023. }
  2024.  
  2025. PP(pp_ftfile)
  2026. {
  2027.     I32 result = my_stat(ARGS);
  2028.     dSP;
  2029.     if (result < 0)
  2030.     RETPUSHUNDEF;
  2031.     if (S_ISREG(statcache.st_mode))
  2032.     RETPUSHYES;
  2033.     RETPUSHNO;
  2034. }
  2035.  
  2036. PP(pp_ftdir)
  2037. {
  2038.     I32 result = my_stat(ARGS);
  2039.     dSP;
  2040.     if (result < 0)
  2041.     RETPUSHUNDEF;
  2042.     if (S_ISDIR(statcache.st_mode))
  2043.     RETPUSHYES;
  2044.     RETPUSHNO;
  2045. }
  2046.  
  2047. PP(pp_ftpipe)
  2048. {
  2049.     I32 result = my_stat(ARGS);
  2050.     dSP;
  2051.     if (result < 0)
  2052.     RETPUSHUNDEF;
  2053.     if (S_ISFIFO(statcache.st_mode))
  2054.     RETPUSHYES;
  2055.     RETPUSHNO;
  2056. }
  2057.  
  2058. PP(pp_ftlink)
  2059. {
  2060.     I32 result = my_lstat(ARGS);
  2061.     dSP;
  2062.     if (result < 0)
  2063.     RETPUSHUNDEF;
  2064.     if (S_ISLNK(statcache.st_mode))
  2065.     RETPUSHYES;
  2066.     RETPUSHNO;
  2067. }
  2068.  
  2069. PP(pp_ftsuid)
  2070. {
  2071.     dSP;
  2072. #ifdef S_ISUID
  2073.     I32 result = my_stat(ARGS);
  2074.     SPAGAIN;
  2075.     if (result < 0)
  2076.     RETPUSHUNDEF;
  2077.     if (statcache.st_mode & S_ISUID)
  2078.     RETPUSHYES;
  2079. #endif
  2080.     RETPUSHNO;
  2081. }
  2082.  
  2083. PP(pp_ftsgid)
  2084. {
  2085.     dSP;
  2086. #ifdef S_ISGID
  2087.     I32 result = my_stat(ARGS);
  2088.     SPAGAIN;
  2089.     if (result < 0)
  2090.     RETPUSHUNDEF;
  2091.     if (statcache.st_mode & S_ISGID)
  2092.     RETPUSHYES;
  2093. #endif
  2094.     RETPUSHNO;
  2095. }
  2096.  
  2097. PP(pp_ftsvtx)
  2098. {
  2099.     dSP;
  2100. #ifdef S_ISVTX
  2101.     I32 result = my_stat(ARGS);
  2102.     SPAGAIN;
  2103.     if (result < 0)
  2104.     RETPUSHUNDEF;
  2105.     if (statcache.st_mode & S_ISVTX)
  2106.     RETPUSHYES;
  2107. #endif
  2108.     RETPUSHNO;
  2109. }
  2110.  
  2111. PP(pp_fttty)
  2112. {
  2113.     dSP;
  2114.     int fd;
  2115.     GV *gv;
  2116.     char *tmps;
  2117.     if (op->op_flags & OPf_REF) {
  2118.     gv = cGVOP->op_gv;
  2119.     tmps = "";
  2120.     }
  2121.     else
  2122.     gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
  2123.     if (GvIO(gv) && IoIFP(GvIOp(gv)))
  2124.     fd = fileno(IoIFP(GvIOp(gv)));
  2125.     else if (isDIGIT(*tmps))
  2126.     fd = atoi(tmps);
  2127.     else
  2128.     RETPUSHUNDEF;
  2129.     if (isatty(fd))
  2130.     RETPUSHYES;
  2131.     RETPUSHNO;
  2132. }
  2133.  
  2134. #if defined(atarist) /* this will work with atariST. Configure will
  2135.             make guesses for other systems. */
  2136. # define FILE_base(f) ((f)->_base)
  2137. # define FILE_ptr(f) ((f)->_ptr)
  2138. # define FILE_cnt(f) ((f)->_cnt)
  2139. # define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
  2140. #endif
  2141.  
  2142. PP(pp_fttext)
  2143. {
  2144.     dSP;
  2145.     I32 i;
  2146.     I32 len;
  2147.     I32 odd = 0;
  2148.     STDCHAR tbuf[512];
  2149.     register STDCHAR *s;
  2150.     register IO *io;
  2151.     SV *sv;
  2152.  
  2153.     if (op->op_flags & OPf_REF) {
  2154.     EXTEND(SP, 1);
  2155.     if (cGVOP->op_gv == defgv) {
  2156.         if (statgv)
  2157.         io = GvIO(statgv);
  2158.         else {
  2159.         sv = statname;
  2160.         goto really_filename;
  2161.         }
  2162.     }
  2163.     else {
  2164.         statgv = cGVOP->op_gv;
  2165.         sv_setpv(statname, "");
  2166.         io = GvIO(statgv);
  2167.     }
  2168.     if (io && IoIFP(io)) {
  2169. #ifdef FILE_base
  2170.         Fstat(fileno(IoIFP(io)), &statcache);
  2171.         if (S_ISDIR(statcache.st_mode))    /* handle NFS glitch */
  2172.         if (op->op_type == OP_FTTEXT)
  2173.             RETPUSHNO;
  2174.         else
  2175.             RETPUSHYES;
  2176.         if (FILE_cnt(IoIFP(io)) <= 0) {
  2177.         i = getc(IoIFP(io));
  2178.         if (i != EOF)
  2179.             (void)ungetc(i, IoIFP(io));
  2180.         }
  2181.         if (FILE_cnt(IoIFP(io)) <= 0)    /* null file is anything */
  2182.         RETPUSHYES;
  2183.         len = FILE_bufsiz(IoIFP(io));
  2184.         s = FILE_base(IoIFP(io));
  2185. #else
  2186.         DIE("-T and -B not implemented on filehandles");
  2187. #endif
  2188.     }
  2189.     else {
  2190.         if (dowarn)
  2191.         warn("Test on unopened file <%s>",
  2192.           GvENAME(cGVOP->op_gv));
  2193.         SETERRNO(EBADF,RMS$_IFI);
  2194.         RETPUSHUNDEF;
  2195.     }
  2196.     }
  2197.     else {
  2198.     sv = POPs;
  2199.     statgv = Nullgv;
  2200.     sv_setpv(statname, SvPV(sv, na));
  2201.       really_filename:
  2202. #ifdef HAS_OPEN3
  2203.     i = open(SvPV(sv, na), O_RDONLY, 0);
  2204. #else
  2205.     i = open(SvPV(sv, na), 0);
  2206. #endif
  2207.     if (i < 0) {
  2208.         if (dowarn && strchr(SvPV(sv, na), '\n'))
  2209.         warn(warn_nl, "open");
  2210.         RETPUSHUNDEF;
  2211.     }
  2212.     Fstat(i, &statcache);
  2213.     len = read(i, tbuf, 512);
  2214.     (void)close(i);
  2215.     if (len <= 0) {
  2216.         if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
  2217.         RETPUSHNO;        /* special case NFS directories */
  2218.         RETPUSHYES;        /* null file is anything */
  2219.     }
  2220.     s = tbuf;
  2221.     }
  2222.  
  2223.     /* now scan s to look for textiness */
  2224.     /*   XXX ASCII dependent code */
  2225.  
  2226.     for (i = 0; i < len; i++, s++) {
  2227.     if (!*s) {            /* null never allowed in text */
  2228.         odd += len;
  2229.         break;
  2230.     }
  2231.     else if (*s & 128)
  2232.         odd++;
  2233.     else if (*s < 32 &&
  2234.       *s != '\n' && *s != '\r' && *s != '\b' &&
  2235.       *s != '\t' && *s != '\f' && *s != 27)
  2236.         odd++;
  2237.     }
  2238.  
  2239.     if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
  2240.     RETPUSHNO;
  2241.     else
  2242.     RETPUSHYES;
  2243. }
  2244.  
  2245. PP(pp_ftbinary)
  2246. {
  2247.     return pp_fttext(ARGS);
  2248. }
  2249.  
  2250. /* File calls. */
  2251.  
  2252. PP(pp_chdir)
  2253. {
  2254.     dSP; dTARGET;
  2255.     char *tmps;
  2256.     SV **svp;
  2257.  
  2258.     if (MAXARG < 1)
  2259.     tmps = Nullch;
  2260.     else
  2261.     tmps = POPp;
  2262.     if (!tmps || !*tmps) {
  2263.     svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
  2264.     if (svp)
  2265.         tmps = SvPV(*svp, na);
  2266.     }
  2267.     if (!tmps || !*tmps) {
  2268.     svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
  2269.     if (svp)
  2270.         tmps = SvPV(*svp, na);
  2271.     }
  2272.     TAINT_PROPER("chdir");
  2273.     PUSHi( chdir(tmps) >= 0 );
  2274. #ifdef VMS
  2275.     /* Clear the DEFAULT element of ENV so we'll get the new value
  2276.      * in the future. */
  2277.     hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
  2278. #endif
  2279.     RETURN;
  2280. }
  2281.  
  2282. PP(pp_chown)
  2283. {
  2284.     dSP; dMARK; dTARGET;
  2285.     I32 value;
  2286. #ifdef HAS_CHOWN
  2287.     value = (I32)apply(op->op_type, MARK, SP);
  2288.     SP = MARK;
  2289.     PUSHi(value);
  2290.     RETURN;
  2291. #else
  2292.     DIE(no_func, "Unsupported function chown");
  2293. #endif
  2294. }
  2295.  
  2296. PP(pp_chroot)
  2297. {
  2298.     dSP; dTARGET;
  2299.     char *tmps;
  2300. #ifdef HAS_CHROOT
  2301.     tmps = POPp;
  2302.     TAINT_PROPER("chroot");
  2303.     PUSHi( chroot(tmps) >= 0 );
  2304.     RETURN;
  2305. #else
  2306.     DIE(no_func, "chroot");
  2307. #endif
  2308. }
  2309.  
  2310. PP(pp_unlink)
  2311. {
  2312.     dSP; dMARK; dTARGET;
  2313.     I32 value;
  2314.     value = (I32)apply(op->op_type, MARK, SP);
  2315.     SP = MARK;
  2316.     PUSHi(value);
  2317.     RETURN;
  2318. }
  2319.  
  2320. PP(pp_chmod)
  2321. {
  2322.     dSP; dMARK; dTARGET;
  2323.     I32 value;
  2324.     value = (I32)apply(op->op_type, MARK, SP);
  2325.     SP = MARK;
  2326.     PUSHi(value);
  2327.     RETURN;
  2328. }
  2329.  
  2330. PP(pp_utime)
  2331. {
  2332.     dSP; dMARK; dTARGET;
  2333.     I32 value;
  2334.     value = (I32)apply(op->op_type, MARK, SP);
  2335.     SP = MARK;
  2336.     PUSHi(value);
  2337.     RETURN;
  2338. }
  2339.  
  2340. PP(pp_rename)
  2341. {
  2342.     dSP; dTARGET;
  2343.     int anum;
  2344.  
  2345.     char *tmps2 = POPp;
  2346.     char *tmps = SvPV(TOPs, na);
  2347.     TAINT_PROPER("rename");
  2348. #ifdef HAS_RENAME
  2349.     anum = rename(tmps, tmps2);
  2350. #else
  2351.     if (same_dirent(tmps2, tmps))    /* can always rename to same name */
  2352.     anum = 1;
  2353.     else {
  2354.     if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
  2355.         (void)UNLINK(tmps2);
  2356.     if (!(anum = link(tmps, tmps2)))
  2357.         anum = UNLINK(tmps);
  2358.     }
  2359. #endif
  2360.     SETi( anum >= 0 );
  2361.     RETURN;
  2362. }
  2363.  
  2364. PP(pp_link)
  2365. {
  2366.     dSP; dTARGET;
  2367. #ifdef HAS_LINK
  2368.     char *tmps2 = POPp;
  2369.     char *tmps = SvPV(TOPs, na);
  2370.     TAINT_PROPER("link");
  2371.     SETi( link(tmps, tmps2) >= 0 );
  2372. #else
  2373.     DIE(no_func, "Unsupported function link");
  2374. #endif
  2375.     RETURN;
  2376. }
  2377.  
  2378. PP(pp_symlink)
  2379. {
  2380.     dSP; dTARGET;
  2381. #ifdef HAS_SYMLINK
  2382.     char *tmps2 = POPp;
  2383.     char *tmps = SvPV(TOPs, na);
  2384.     TAINT_PROPER("symlink");
  2385.     SETi( symlink(tmps, tmps2) >= 0 );
  2386.     RETURN;
  2387. #else
  2388.     DIE(no_func, "symlink");
  2389. #endif
  2390. }
  2391.  
  2392. PP(pp_readlink)
  2393. {
  2394.     dSP; dTARGET;
  2395. #ifdef HAS_SYMLINK
  2396.     char *tmps;
  2397.     int len;
  2398.     tmps = POPp;
  2399.     len = readlink(tmps, buf, sizeof buf);
  2400.     EXTEND(SP, 1);
  2401.     if (len < 0)
  2402.     RETPUSHUNDEF;
  2403.     PUSHp(buf, len);
  2404.     RETURN;
  2405. #else
  2406.     EXTEND(SP, 1);
  2407.     RETSETUNDEF;        /* just pretend it's a normal file */
  2408. #endif
  2409. }
  2410.  
  2411. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  2412. static int
  2413. dooneliner(cmd, filename)
  2414. char *cmd;
  2415. char *filename;
  2416. {
  2417.     char mybuf[8192];
  2418.     char *s,
  2419.      *save_filename = filename;
  2420.     int anum = 1;
  2421.     FILE *myfp;
  2422.  
  2423.     strcpy(mybuf, cmd);
  2424.     strcat(mybuf, " ");
  2425.     for (s = mybuf+strlen(mybuf); *filename; ) {
  2426.     *s++ = '\\';
  2427.     *s++ = *filename++;
  2428.     }
  2429.     strcpy(s, " 2>&1");
  2430.     myfp = my_popen(mybuf, "r");
  2431.     if (myfp) {
  2432.     *mybuf = '\0';
  2433.     s = fgets(mybuf, sizeof mybuf, myfp);
  2434.     (void)my_pclose(myfp);
  2435.     if (s != Nullch) {
  2436.         for (errno = 1; errno < sys_nerr; errno++) {
  2437. #ifdef HAS_SYS_ERRLIST
  2438.         if (instr(mybuf, sys_errlist[errno]))    /* you don't see this */
  2439.             return 0;
  2440. #else
  2441.         char *errmsg;                /* especially if it isn't there */
  2442.  
  2443.         if (instr(mybuf,
  2444.                   (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
  2445.             return 0;
  2446. #endif
  2447.         }
  2448.         SETERRNO(0,0);
  2449. #ifndef EACCES
  2450. #define EACCES EPERM
  2451. #endif
  2452.         if (instr(mybuf, "cannot make"))
  2453.         SETERRNO(EEXIST,RMS$_FEX);
  2454.         else if (instr(mybuf, "existing file"))
  2455.         SETERRNO(EEXIST,RMS$_FEX);
  2456.         else if (instr(mybuf, "ile exists"))
  2457.         SETERRNO(EEXIST,RMS$_FEX);
  2458.         else if (instr(mybuf, "non-exist"))
  2459.         SETERRNO(ENOENT,RMS$_FNF);
  2460.         else if (instr(mybuf, "does not exist"))
  2461.         SETERRNO(ENOENT,RMS$_FNF);
  2462.         else if (instr(mybuf, "not empty"))
  2463.         SETERRNO(EBUSY,SS$_DEVOFFLINE);
  2464.         else if (instr(mybuf, "cannot access"))
  2465.         SETERRNO(EACCES,RMS$_PRV);
  2466.         else
  2467.         SETERRNO(EPERM,RMS$_PRV);
  2468.         return 0;
  2469.     }
  2470.     else {    /* some mkdirs return no failure indication */
  2471.         anum = (Stat(save_filename, &statbuf) >= 0);
  2472.         if (op->op_type == OP_RMDIR)
  2473.         anum = !anum;
  2474.         if (anum)
  2475.         SETERRNO(0,0);
  2476.         else
  2477.         SETERRNO(EACCES,RMS$_PRV);    /* a guess */
  2478.     }
  2479.     return anum;
  2480.     }
  2481.     else
  2482.     return 0;
  2483. }
  2484. #endif
  2485.  
  2486. PP(pp_mkdir)
  2487. {
  2488.     dSP; dTARGET;
  2489.     int mode = POPi;
  2490. #ifndef HAS_MKDIR
  2491.     int oldumask;
  2492. #endif
  2493.     char *tmps = SvPV(TOPs, na);
  2494.  
  2495.     TAINT_PROPER("mkdir");
  2496. #ifdef HAS_MKDIR
  2497.     SETi( mkdir(tmps, mode) >= 0 );
  2498. #else
  2499.     SETi( dooneliner("mkdir", tmps) );
  2500.     oldumask = umask(0);
  2501.     umask(oldumask);
  2502.     chmod(tmps, (mode & ~oldumask) & 0777);
  2503. #endif
  2504.     RETURN;
  2505. }
  2506.  
  2507. PP(pp_rmdir)
  2508. {
  2509.     dSP; dTARGET;
  2510.     char *tmps;
  2511.  
  2512.     tmps = POPp;
  2513.     TAINT_PROPER("rmdir");
  2514. #ifdef HAS_RMDIR
  2515.     XPUSHi( rmdir(tmps) >= 0 );
  2516. #else
  2517.     XPUSHi( dooneliner("rmdir", tmps) );
  2518. #endif
  2519.     RETURN;
  2520. }
  2521.  
  2522. /* Directory calls. */
  2523.  
  2524. PP(pp_open_dir)
  2525. {
  2526.     dSP;
  2527. #if defined(Direntry_t) && defined(HAS_READDIR)
  2528.     char *dirname = POPp;
  2529.     GV *gv = (GV*)POPs;
  2530.     register IO *io = GvIOn(gv);
  2531.  
  2532.     if (!io)
  2533.     goto nope;
  2534.  
  2535.     if (IoDIRP(io))
  2536.     closedir(IoDIRP(io));
  2537.     if (!(IoDIRP(io) = opendir(dirname)))
  2538.     goto nope;
  2539.  
  2540.     RETPUSHYES;
  2541. nope:
  2542.     if (!errno)
  2543.     SETERRNO(EBADF,RMS$_DIR);
  2544.     RETPUSHUNDEF;
  2545. #else
  2546.     DIE(no_dir_func, "opendir");
  2547. #endif
  2548. }
  2549.  
  2550. PP(pp_readdir)
  2551. {
  2552.     dSP;
  2553. #if defined(Direntry_t) && defined(HAS_READDIR)
  2554. #ifndef I_DIRENT
  2555.     Direntry_t *readdir _((DIR *));
  2556. #endif
  2557.     register Direntry_t *dp;
  2558.     GV *gv = (GV*)POPs;
  2559.     register IO *io = GvIOn(gv);
  2560.  
  2561.     if (!io || !IoDIRP(io))
  2562.     goto nope;
  2563.  
  2564.     if (GIMME == G_ARRAY) {
  2565.     /*SUPPRESS 560*/
  2566.     while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
  2567. #ifdef DIRNAMLEN
  2568.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2569. #else
  2570.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2571. #endif
  2572.     }
  2573.     }
  2574.     else {
  2575.     if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
  2576.         goto nope;
  2577. #ifdef DIRNAMLEN
  2578.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2579. #else
  2580.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2581. #endif
  2582.     }
  2583.     RETURN;
  2584.  
  2585. nope:
  2586.     if (!errno)
  2587.     SETERRNO(EBADF,RMS$_ISI);
  2588.     if (GIMME == G_ARRAY)
  2589.     RETURN;
  2590.     else
  2591.     RETPUSHUNDEF;
  2592. #else
  2593.     DIE(no_dir_func, "readdir");
  2594. #endif
  2595. }
  2596.  
  2597. PP(pp_telldir)
  2598. {
  2599.     dSP; dTARGET;
  2600. #if defined(HAS_TELLDIR) || defined(telldir)
  2601. #if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
  2602.     long telldir _((DIR *));
  2603. #endif
  2604.     GV *gv = (GV*)POPs;
  2605.     register IO *io = GvIOn(gv);
  2606.  
  2607.     if (!io || !IoDIRP(io))
  2608.     goto nope;
  2609.  
  2610.     PUSHi( telldir(IoDIRP(io)) );
  2611.     RETURN;
  2612. nope:
  2613.     if (!errno)
  2614.     SETERRNO(EBADF,RMS$_ISI);
  2615.     RETPUSHUNDEF;
  2616. #else
  2617.     DIE(no_dir_func, "telldir");
  2618. #endif
  2619. }
  2620.  
  2621. PP(pp_seekdir)
  2622. {
  2623.     dSP;
  2624. #if defined(HAS_SEEKDIR) || defined(seekdir)
  2625.     long along = POPl;
  2626.     GV *gv = (GV*)POPs;
  2627.     register IO *io = GvIOn(gv);
  2628.  
  2629.     if (!io || !IoDIRP(io))
  2630.     goto nope;
  2631.  
  2632.     (void)seekdir(IoDIRP(io), along);
  2633.  
  2634.     RETPUSHYES;
  2635. nope:
  2636.     if (!errno)
  2637.     SETERRNO(EBADF,RMS$_ISI);
  2638.     RETPUSHUNDEF;
  2639. #else
  2640.     DIE(no_dir_func, "seekdir");
  2641. #endif
  2642. }
  2643.  
  2644. PP(pp_rewinddir)
  2645. {
  2646.     dSP;
  2647. #if defined(HAS_REWINDDIR) || defined(rewinddir)
  2648.     GV *gv = (GV*)POPs;
  2649.     register IO *io = GvIOn(gv);
  2650.  
  2651.     if (!io || !IoDIRP(io))
  2652.     goto nope;
  2653.  
  2654.     (void)rewinddir(IoDIRP(io));
  2655.     RETPUSHYES;
  2656. nope:
  2657.     if (!errno)
  2658.     SETERRNO(EBADF,RMS$_ISI);
  2659.     RETPUSHUNDEF;
  2660. #else
  2661.     DIE(no_dir_func, "rewinddir");
  2662. #endif
  2663. }
  2664.  
  2665. PP(pp_closedir)
  2666. {
  2667.     dSP;
  2668. #if defined(Direntry_t) && defined(HAS_READDIR)
  2669.     GV *gv = (GV*)POPs;
  2670.     register IO *io = GvIOn(gv);
  2671.  
  2672.     if (!io || !IoDIRP(io))
  2673.     goto nope;
  2674.  
  2675. #ifdef VOID_CLOSEDIR
  2676.     closedir(IoDIRP(io));
  2677. #else
  2678.     if (closedir(IoDIRP(io)) < 0) {
  2679.     IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
  2680.     goto nope;
  2681.     }
  2682. #endif
  2683.     IoDIRP(io) = 0;
  2684.  
  2685.     RETPUSHYES;
  2686. nope:
  2687.     if (!errno)
  2688.     SETERRNO(EBADF,RMS$_IFI);
  2689.     RETPUSHUNDEF;
  2690. #else
  2691.     DIE(no_dir_func, "closedir");
  2692. #endif
  2693. }
  2694.  
  2695. /* Process control. */
  2696.  
  2697. PP(pp_fork)
  2698. {
  2699.     dSP; dTARGET;
  2700.     int childpid;
  2701.     GV *tmpgv;
  2702.  
  2703.     EXTEND(SP, 1);
  2704. #ifdef HAS_FORK
  2705.     childpid = fork();
  2706.     if (childpid < 0)
  2707.     RETSETUNDEF;
  2708.     if (!childpid) {
  2709.     /*SUPPRESS 560*/
  2710.     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
  2711.         sv_setiv(GvSV(tmpgv), (I32)getpid());
  2712.     hv_clear(pidstatus);    /* no kids, so don't wait for 'em */
  2713.     }
  2714.     PUSHi(childpid);
  2715.     RETURN;
  2716. #else
  2717.     DIE(no_func, "Unsupported function fork");
  2718. #endif
  2719. }
  2720.  
  2721. PP(pp_wait)
  2722. {
  2723.     dSP; dTARGET;
  2724.     int childpid;
  2725.     int argflags;
  2726.     I32 value;
  2727.  
  2728.     EXTEND(SP, 1);
  2729. #ifdef HAS_WAIT
  2730.     childpid = wait(&argflags);
  2731.     if (childpid > 0)
  2732.     pidgone(childpid, argflags);
  2733.     value = (I32)childpid;
  2734.     statusvalue = FIXSTATUS(argflags);
  2735.     PUSHi(value);
  2736.     RETURN;
  2737. #else
  2738.     DIE(no_func, "Unsupported function wait");
  2739. #endif
  2740. }
  2741.  
  2742. PP(pp_waitpid)
  2743. {
  2744.     dSP; dTARGET;
  2745.     int childpid;
  2746.     int optype;
  2747.     int argflags;
  2748.     I32 value;
  2749.  
  2750. #ifdef HAS_WAIT
  2751.     optype = POPi;
  2752.     childpid = TOPi;
  2753.     childpid = wait4pid(childpid, &argflags, optype);
  2754.     value = (I32)childpid;
  2755.     statusvalue = FIXSTATUS(argflags);
  2756.     SETi(value);
  2757.     RETURN;
  2758. #else
  2759.     DIE(no_func, "Unsupported function wait");
  2760. #endif
  2761. }
  2762.  
  2763. PP(pp_system)
  2764. {
  2765.     dSP; dMARK; dORIGMARK; dTARGET;
  2766.     I32 value;
  2767.     int childpid;
  2768.     int result;
  2769.     int status;
  2770.     Signal_t (*ihand)();     /* place to save signal during system() */
  2771.     Signal_t (*qhand)();     /* place to save signal during system() */
  2772.  
  2773. #if defined(HAS_FORK) && !defined(VMS) && !defined(OS2)
  2774.     if (SP - MARK == 1) {
  2775.     if (tainting) {
  2776.         char *junk = SvPV(TOPs, na);
  2777.         TAINT_ENV();
  2778.         TAINT_PROPER("system");
  2779.     }
  2780.     }
  2781.     while ((childpid = vfork()) == -1) {
  2782.     if (errno != EAGAIN) {
  2783.         value = -1;
  2784.         SP = ORIGMARK;
  2785.         PUSHi(value);
  2786.         RETURN;
  2787.     }
  2788.     sleep(5);
  2789.     }
  2790.     if (childpid > 0) {
  2791.     ihand = signal(SIGINT, SIG_IGN);
  2792.     qhand = signal(SIGQUIT, SIG_IGN);
  2793.     do {
  2794.         result = wait4pid(childpid, &status, 0);
  2795.     } while (result == -1 && errno == EINTR);
  2796.     (void)signal(SIGINT, ihand);
  2797.     (void)signal(SIGQUIT, qhand);
  2798.     statusvalue = FIXSTATUS(status);
  2799.     if (result < 0)
  2800.         value = -1;
  2801.     else {
  2802.         value = (I32)((unsigned int)status & 0xffff);
  2803.     }
  2804.     do_execfree();    /* free any memory child malloced on vfork */
  2805.     SP = ORIGMARK;
  2806.     PUSHi(value);
  2807.     RETURN;
  2808.     }
  2809.     if (op->op_flags & OPf_STACKED) {
  2810.     SV *really = *++MARK;
  2811.     value = (I32)do_aexec(really, MARK, SP);
  2812.     }
  2813.     else if (SP - MARK != 1)
  2814.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2815.     else {
  2816.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2817.     }
  2818.     _exit(-1);
  2819. #else /* ! FORK or VMS or OS/2 */
  2820.     if (op->op_flags & OPf_STACKED) {
  2821.     SV *really = *++MARK;
  2822.     value = (I32)do_aspawn(really, MARK, SP);
  2823.     }
  2824.     else if (SP - MARK != 1)
  2825.     value = (I32)do_aspawn(Nullsv, MARK, SP);
  2826.     else {
  2827.     value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
  2828.     }
  2829.     statusvalue = FIXSTATUS(value);
  2830.     do_execfree();
  2831.     SP = ORIGMARK;
  2832.     PUSHi(value);
  2833. #endif /* !FORK or VMS */
  2834.     RETURN;
  2835. }
  2836.  
  2837. PP(pp_exec)
  2838. {
  2839.     dSP; dMARK; dORIGMARK; dTARGET;
  2840.     I32 value;
  2841.  
  2842.     if (op->op_flags & OPf_STACKED) {
  2843.     SV *really = *++MARK;
  2844.     value = (I32)do_aexec(really, MARK, SP);
  2845.     }
  2846.     else if (SP - MARK != 1)
  2847. #ifdef VMS
  2848.     value = (I32)vms_do_aexec(Nullsv, MARK, SP);
  2849. #else
  2850.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2851. #endif
  2852.     else {
  2853.     if (tainting) {
  2854.         char *junk = SvPV(*SP, na);
  2855.         TAINT_ENV();
  2856.         TAINT_PROPER("exec");
  2857.     }
  2858. #ifdef VMS
  2859.     value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2860. #else
  2861.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2862. #endif
  2863.     }
  2864.     SP = ORIGMARK;
  2865.     PUSHi(value);
  2866.     RETURN;
  2867. }
  2868.  
  2869. PP(pp_kill)
  2870. {
  2871.     dSP; dMARK; dTARGET;
  2872.     I32 value;
  2873. #ifdef HAS_KILL
  2874.     value = (I32)apply(op->op_type, MARK, SP);
  2875.     SP = MARK;
  2876.     PUSHi(value);
  2877.     RETURN;
  2878. #else
  2879.     DIE(no_func, "Unsupported function kill");
  2880. #endif
  2881. }
  2882.  
  2883. PP(pp_getppid)
  2884. {
  2885. #ifdef HAS_GETPPID
  2886.     dSP; dTARGET;
  2887.     XPUSHi( getppid() );
  2888.     RETURN;
  2889. #else
  2890.     DIE(no_func, "getppid");
  2891. #endif
  2892. }
  2893.  
  2894. PP(pp_getpgrp)
  2895. {
  2896. #ifdef HAS_GETPGRP
  2897.     dSP; dTARGET;
  2898.     int pid;
  2899.     I32 value;
  2900.  
  2901.     if (MAXARG < 1)
  2902.     pid = 0;
  2903.     else
  2904.     pid = SvIVx(POPs);
  2905. #ifdef BSD_GETPGRP
  2906.     value = (I32)BSD_GETPGRP(pid);
  2907. #else
  2908.     if (pid != 0)
  2909.     DIE("POSIX getpgrp can't take an argument");
  2910.     value = (I32)getpgrp();
  2911. #endif
  2912.     XPUSHi(value);
  2913.     RETURN;
  2914. #else
  2915.     DIE(no_func, "getpgrp()");
  2916. #endif
  2917. }
  2918.  
  2919. PP(pp_setpgrp)
  2920. {
  2921. #ifdef HAS_SETPGRP
  2922.     dSP; dTARGET;
  2923.     int pgrp;
  2924.     int pid;
  2925.     if (MAXARG < 2) {
  2926.     pgrp = 0;
  2927.     pid = 0;
  2928.     }
  2929.     else {
  2930.     pgrp = POPi;
  2931.     pid = TOPi;
  2932.     }
  2933.  
  2934.     TAINT_PROPER("setpgrp");
  2935. #ifdef BSD_SETPGRP
  2936.     SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
  2937. #else
  2938.     if ((pgrp != 0) || (pid != 0)) {
  2939.     DIE("POSIX setpgrp can't take an argument");
  2940.     }
  2941.     SETi( setpgrp() >= 0 );
  2942. #endif /* USE_BSDPGRP */
  2943.     RETURN;
  2944. #else
  2945.     DIE(no_func, "setpgrp()");
  2946. #endif
  2947. }
  2948.  
  2949. PP(pp_getpriority)
  2950. {
  2951.     dSP; dTARGET;
  2952.     int which;
  2953.     int who;
  2954. #ifdef HAS_GETPRIORITY
  2955.     who = POPi;
  2956.     which = TOPi;
  2957.     SETi( getpriority(which, who) );
  2958.     RETURN;
  2959. #else
  2960.     DIE(no_func, "getpriority()");
  2961. #endif
  2962. }
  2963.  
  2964. PP(pp_setpriority)
  2965. {
  2966.     dSP; dTARGET;
  2967.     int which;
  2968.     int who;
  2969.     int niceval;
  2970. #ifdef HAS_SETPRIORITY
  2971.     niceval = POPi;
  2972.     who = POPi;
  2973.     which = TOPi;
  2974.     TAINT_PROPER("setpriority");
  2975.     SETi( setpriority(which, who, niceval) >= 0 );
  2976.     RETURN;
  2977. #else
  2978.     DIE(no_func, "setpriority()");
  2979. #endif
  2980. }
  2981.  
  2982. /* Time calls. */
  2983.  
  2984. PP(pp_time)
  2985. {
  2986.     dSP; dTARGET;
  2987.     XPUSHi( time(Null(Time_t*)) );
  2988.     RETURN;
  2989. }
  2990.  
  2991. #ifndef HZ
  2992. #define HZ 60
  2993. #endif
  2994.  
  2995. PP(pp_tms)
  2996. {
  2997.     dSP;
  2998.  
  2999. #if defined(MSDOS) || !defined(HAS_TIMES)
  3000.     DIE("times not implemented");
  3001. #else
  3002.     EXTEND(SP, 4);
  3003.  
  3004. #ifndef VMS
  3005.     (void)times(×buf);
  3006. #else
  3007.     (void)times((tbuffer_t *)×buf);  /* time.h uses different name for */
  3008.                                           /* struct tms, though same data   */
  3009.                                           /* is returned.                   */
  3010. #undef HZ
  3011. #define HZ CLK_TCK
  3012. #endif
  3013.  
  3014.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
  3015.     if (GIMME == G_ARRAY) {
  3016.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
  3017.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
  3018.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
  3019.     }
  3020.     RETURN;
  3021. #endif /* MSDOS */
  3022. }
  3023.  
  3024. PP(pp_localtime)
  3025. {
  3026.     return pp_gmtime(ARGS);
  3027. }
  3028.  
  3029. PP(pp_gmtime)
  3030. {
  3031.     dSP;
  3032.     Time_t when;
  3033.     struct tm *tmbuf;
  3034.     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
  3035.     static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
  3036.                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
  3037.  
  3038.     if (MAXARG < 1)
  3039.     (void)time(&when);
  3040.     else
  3041.     when = (Time_t)SvIVx(POPs);
  3042.  
  3043.     if (op->op_type == OP_LOCALTIME)
  3044.     tmbuf = localtime(&when);
  3045.     else
  3046.     tmbuf = gmtime(&when);
  3047.  
  3048.     EXTEND(SP, 9);
  3049.     if (GIMME != G_ARRAY) {
  3050.     dTARGET;
  3051.     char mybuf[30];
  3052.     if (!tmbuf)
  3053.         RETPUSHUNDEF;
  3054.     sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
  3055.         dayname[tmbuf->tm_wday],
  3056.         monname[tmbuf->tm_mon],
  3057.         tmbuf->tm_mday,
  3058.         tmbuf->tm_hour,
  3059.         tmbuf->tm_min,
  3060.         tmbuf->tm_sec,
  3061.         tmbuf->tm_year + 1900);
  3062.     PUSHp(mybuf, strlen(mybuf));
  3063.     }
  3064.     else if (tmbuf) {
  3065.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
  3066.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
  3067.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
  3068.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
  3069.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
  3070.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
  3071.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
  3072.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
  3073.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
  3074.     }
  3075.     RETURN;
  3076. }
  3077.  
  3078. PP(pp_alarm)
  3079. {
  3080.     dSP; dTARGET;
  3081.     int anum;
  3082. #ifdef HAS_ALARM
  3083.     anum = POPi;
  3084.     anum = alarm((unsigned int)anum);
  3085.     EXTEND(SP, 1);
  3086.     if (anum < 0)
  3087.     RETPUSHUNDEF;
  3088.     PUSHi((I32)anum);
  3089.     RETURN;
  3090. #else
  3091.     DIE(no_func, "Unsupported function alarm");
  3092. #endif
  3093. }
  3094.  
  3095. PP(pp_sleep)
  3096. {
  3097.     dSP; dTARGET;
  3098.     I32 duration;
  3099.     Time_t lasttime;
  3100.     Time_t when;
  3101.  
  3102.     (void)time(&lasttime);
  3103.     if (MAXARG < 1)
  3104.     pause();
  3105.     else {
  3106.     duration = POPi;
  3107.     sleep((unsigned int)duration);
  3108.     }
  3109.     (void)time(&when);
  3110.     XPUSHi(when - lasttime);
  3111.     RETURN;
  3112. }
  3113.  
  3114. /* Shared memory. */
  3115.  
  3116. PP(pp_shmget)
  3117. {
  3118.     return pp_semget(ARGS);
  3119. }
  3120.  
  3121. PP(pp_shmctl)
  3122. {
  3123.     return pp_semctl(ARGS);
  3124. }
  3125.  
  3126. PP(pp_shmread)
  3127. {
  3128.     return pp_shmwrite(ARGS);
  3129. }
  3130.  
  3131. PP(pp_shmwrite)
  3132. {
  3133. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3134.     dSP; dMARK; dTARGET;
  3135.     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
  3136.     SP = MARK;
  3137.     PUSHi(value);
  3138.     RETURN;
  3139. #else
  3140.     return pp_semget(ARGS);
  3141. #endif
  3142. }
  3143.  
  3144. /* Message passing. */
  3145.  
  3146. PP(pp_msgget)
  3147. {
  3148.     return pp_semget(ARGS);
  3149. }
  3150.  
  3151. PP(pp_msgctl)
  3152. {
  3153.     return pp_semctl(ARGS);
  3154. }
  3155.  
  3156. PP(pp_msgsnd)
  3157. {
  3158. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3159.     dSP; dMARK; dTARGET;
  3160.     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
  3161.     SP = MARK;
  3162.     PUSHi(value);
  3163.     RETURN;
  3164. #else
  3165.     return pp_semget(ARGS);
  3166. #endif
  3167. }
  3168.  
  3169. PP(pp_msgrcv)
  3170. {
  3171. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3172.     dSP; dMARK; dTARGET;
  3173.     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
  3174.     SP = MARK;
  3175.     PUSHi(value);
  3176.     RETURN;
  3177. #else
  3178.     return pp_semget(ARGS);
  3179. #endif
  3180. }
  3181.  
  3182. /* Semaphores. */
  3183.  
  3184. PP(pp_semget)
  3185. {
  3186. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3187.     dSP; dMARK; dTARGET;
  3188.     int anum = do_ipcget(op->op_type, MARK, SP);
  3189.     SP = MARK;
  3190.     if (anum == -1)
  3191.     RETPUSHUNDEF;
  3192.     PUSHi(anum);
  3193.     RETURN;
  3194. #else
  3195.     DIE("System V IPC is not implemented on this machine");
  3196. #endif
  3197. }
  3198.  
  3199. PP(pp_semctl)
  3200. {
  3201. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3202.     dSP; dMARK; dTARGET;
  3203.     int anum = do_ipcctl(op->op_type, MARK, SP);
  3204.     SP = MARK;
  3205.     if (anum == -1)
  3206.     RETSETUNDEF;
  3207.     if (anum != 0) {
  3208.     PUSHi(anum);
  3209.     }
  3210.     else {
  3211.     PUSHp("0 but true",10);
  3212.     }
  3213.     RETURN;
  3214. #else
  3215.     return pp_semget(ARGS);
  3216. #endif
  3217. }
  3218.  
  3219. PP(pp_semop)
  3220. {
  3221. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3222.     dSP; dMARK; dTARGET;
  3223.     I32 value = (I32)(do_semop(MARK, SP) >= 0);
  3224.     SP = MARK;
  3225.     PUSHi(value);
  3226.     RETURN;
  3227. #else
  3228.     return pp_semget(ARGS);
  3229. #endif
  3230. }
  3231.  
  3232. /* Get system info. */
  3233.  
  3234. PP(pp_ghbyname)
  3235. {
  3236. #ifdef HAS_SOCKET
  3237.     return pp_ghostent(ARGS);
  3238. #else
  3239.     DIE(no_sock_func, "gethostbyname");
  3240. #endif
  3241. }
  3242.  
  3243. PP(pp_ghbyaddr)
  3244. {
  3245. #ifdef HAS_SOCKET
  3246.     return pp_ghostent(ARGS);
  3247. #else
  3248.     DIE(no_sock_func, "gethostbyaddr");
  3249. #endif
  3250. }
  3251.  
  3252. PP(pp_ghostent)
  3253. {
  3254.     dSP;
  3255. #ifdef HAS_SOCKET
  3256.     I32 which = op->op_type;
  3257.     register char **elem;
  3258.     register SV *sv;
  3259.     struct hostent *gethostbyname();
  3260.     struct hostent *gethostbyaddr();
  3261. #ifdef HAS_GETHOSTENT
  3262.     struct hostent *gethostent();
  3263. #endif
  3264.     struct hostent *hent;
  3265.     unsigned long len;
  3266.  
  3267.     EXTEND(SP, 10);
  3268.     if (which == OP_GHBYNAME) {
  3269.     hent = gethostbyname(POPp);
  3270.     }
  3271.     else if (which == OP_GHBYADDR) {
  3272.     int addrtype = POPi;
  3273.     SV *addrsv = POPs;
  3274.     STRLEN addrlen;
  3275.     char *addr = SvPV(addrsv, addrlen);
  3276.  
  3277.     hent = gethostbyaddr(addr, addrlen, addrtype);
  3278.     }
  3279.     else
  3280. #ifdef HAS_GETHOSTENT
  3281.     hent = gethostent();
  3282. #else
  3283.     DIE("gethostent not implemented");
  3284. #endif
  3285.  
  3286. #ifdef HOST_NOT_FOUND
  3287.     if (!hent)
  3288.     statusvalue = FIXSTATUS(h_errno);
  3289. #endif
  3290.  
  3291.     if (GIMME != G_ARRAY) {
  3292.     PUSHs(sv = sv_newmortal());
  3293.     if (hent) {
  3294.         if (which == OP_GHBYNAME) {
  3295.         if (hent->h_addr)
  3296.             sv_setpvn(sv, hent->h_addr, hent->h_length);
  3297.         }
  3298.         else
  3299.         sv_setpv(sv, (char*)hent->h_name);
  3300.     }
  3301.     RETURN;
  3302.     }
  3303.  
  3304.     if (hent) {
  3305.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3306.     sv_setpv(sv, (char*)hent->h_name);
  3307.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3308.     for (elem = hent->h_aliases; elem && *elem; elem++) {
  3309.         sv_catpv(sv, *elem);
  3310.         if (elem[1])
  3311.         sv_catpvn(sv, " ", 1);
  3312.     }
  3313.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3314.     sv_setiv(sv, (I32)hent->h_addrtype);
  3315.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3316.     len = hent->h_length;
  3317.     sv_setiv(sv, (I32)len);
  3318. #ifdef h_addr
  3319.     for (elem = hent->h_addr_list; elem && *elem; elem++) {
  3320.         XPUSHs(sv = sv_mortalcopy(&sv_no));
  3321.         sv_setpvn(sv, *elem, len);
  3322.     }
  3323. #else
  3324.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3325.     if (hent->h_addr)
  3326.         sv_setpvn(sv, hent->h_addr, len);
  3327. #endif /* h_addr */
  3328.     }
  3329.     RETURN;
  3330. #else
  3331.     DIE(no_sock_func, "gethostent");
  3332. #endif
  3333. }
  3334.  
  3335. PP(pp_gnbyname)
  3336. {
  3337. #ifdef HAS_SOCKET
  3338.     return pp_gnetent(ARGS);
  3339. #else
  3340.     DIE(no_sock_func, "getnetbyname");
  3341. #endif
  3342. }
  3343.  
  3344. PP(pp_gnbyaddr)
  3345. {
  3346. #ifdef HAS_SOCKET
  3347.     return pp_gnetent(ARGS);
  3348. #else
  3349.     DIE(no_sock_func, "getnetbyaddr");
  3350. #endif
  3351. }
  3352.  
  3353. PP(pp_gnetent)
  3354. {
  3355.     dSP;
  3356. #ifdef HAS_SOCKET
  3357.     I32 which = op->op_type;
  3358.     register char **elem;
  3359.     register SV *sv;
  3360.     struct netent *getnetbyname();
  3361.     struct netent *getnetbyaddr();
  3362.     struct netent *getnetent();
  3363.     struct netent *nent;
  3364.  
  3365.     if (which == OP_GNBYNAME)
  3366.     nent = getnetbyname(POPp);
  3367.     else if (which == OP_GNBYADDR) {
  3368.     int addrtype = POPi;
  3369.     unsigned long addr = U_L(POPn);
  3370.     nent = getnetbyaddr((long)addr, addrtype);
  3371.     }
  3372.     else
  3373.     nent = getnetent();
  3374.  
  3375.     EXTEND(SP, 4);
  3376.     if (GIMME != G_ARRAY) {
  3377.     PUSHs(sv = sv_newmortal());
  3378.     if (nent) {
  3379.         if (which == OP_GNBYNAME)
  3380.         sv_setiv(sv, (I32)nent->n_net);
  3381.         else
  3382.         sv_setpv(sv, nent->n_name);
  3383.     }
  3384.     RETURN;
  3385.     }
  3386.  
  3387.     if (nent) {
  3388.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3389.     sv_setpv(sv, nent->n_name);
  3390.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3391.     for (elem = nent->n_aliases; *elem; elem++) {
  3392.         sv_catpv(sv, *elem);
  3393.         if (elem[1])
  3394.         sv_catpvn(sv, " ", 1);
  3395.     }
  3396.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3397.     sv_setiv(sv, (I32)nent->n_addrtype);
  3398.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3399.     sv_setiv(sv, (I32)nent->n_net);
  3400.     }
  3401.  
  3402.     RETURN;
  3403. #else
  3404.     DIE(no_sock_func, "getnetent");
  3405. #endif
  3406. }
  3407.  
  3408. PP(pp_gpbyname)
  3409. {
  3410. #ifdef HAS_SOCKET
  3411.     return pp_gprotoent(ARGS);
  3412. #else
  3413.     DIE(no_sock_func, "getprotobyname");
  3414. #endif
  3415. }
  3416.  
  3417. PP(pp_gpbynumber)
  3418. {
  3419. #ifdef HAS_SOCKET
  3420.     return pp_gprotoent(ARGS);
  3421. #else
  3422.     DIE(no_sock_func, "getprotobynumber");
  3423. #endif
  3424. }
  3425.  
  3426. PP(pp_gprotoent)
  3427. {
  3428.     dSP;
  3429. #ifdef HAS_SOCKET
  3430.     I32 which = op->op_type;
  3431.     register char **elem;
  3432.     register SV *sv;
  3433.     struct protoent *getprotobyname();
  3434.     struct protoent *getprotobynumber();
  3435.     struct protoent *getprotoent();
  3436.     struct protoent *pent;
  3437.  
  3438.     if (which == OP_GPBYNAME)
  3439.     pent = getprotobyname(POPp);
  3440.     else if (which == OP_GPBYNUMBER)
  3441.     pent = getprotobynumber(POPi);
  3442.     else
  3443.     pent = getprotoent();
  3444.  
  3445.     EXTEND(SP, 3);
  3446.     if (GIMME != G_ARRAY) {
  3447.     PUSHs(sv = sv_newmortal());
  3448.     if (pent) {
  3449.         if (which == OP_GPBYNAME)
  3450.         sv_setiv(sv, (I32)pent->p_proto);
  3451.         else
  3452.         sv_setpv(sv, pent->p_name);
  3453.     }
  3454.     RETURN;
  3455.     }
  3456.  
  3457.     if (pent) {
  3458.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3459.     sv_setpv(sv, pent->p_name);
  3460.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3461.     for (elem = pent->p_aliases; *elem; elem++) {
  3462.         sv_catpv(sv, *elem);
  3463.         if (elem[1])
  3464.         sv_catpvn(sv, " ", 1);
  3465.     }
  3466.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3467.     sv_setiv(sv, (I32)pent->p_proto);
  3468.     }
  3469.  
  3470.     RETURN;
  3471. #else
  3472.     DIE(no_sock_func, "getprotoent");
  3473. #endif
  3474. }
  3475.  
  3476. PP(pp_gsbyname)
  3477. {
  3478. #ifdef HAS_SOCKET
  3479.     return pp_gservent(ARGS);
  3480. #else
  3481.     DIE(no_sock_func, "getservbyname");
  3482. #endif
  3483. }
  3484.  
  3485. PP(pp_gsbyport)
  3486. {
  3487. #ifdef HAS_SOCKET
  3488.     return pp_gservent(ARGS);
  3489. #else
  3490.     DIE(no_sock_func, "getservbyport");
  3491. #endif
  3492. }
  3493.  
  3494. PP(pp_gservent)
  3495. {
  3496.     dSP;
  3497. #ifdef HAS_SOCKET
  3498.     I32 which = op->op_type;
  3499.     register char **elem;
  3500.     register SV *sv;
  3501.     struct servent *getservbyname();
  3502.     struct servent *getservbynumber();
  3503.     struct servent *getservent();
  3504.     struct servent *sent;
  3505.  
  3506.     if (which == OP_GSBYNAME) {
  3507.     char *proto = POPp;
  3508.     char *name = POPp;
  3509.  
  3510.     if (proto && !*proto)
  3511.         proto = Nullch;
  3512.  
  3513.     sent = getservbyname(name, proto);
  3514.     }
  3515.     else if (which == OP_GSBYPORT) {
  3516.     char *proto = POPp;
  3517.     int port = POPi;
  3518.  
  3519.     sent = getservbyport(port, proto);
  3520.     }
  3521.     else
  3522.     sent = getservent();
  3523.  
  3524.     EXTEND(SP, 4);
  3525.     if (GIMME != G_ARRAY) {
  3526.     PUSHs(sv = sv_newmortal());
  3527.     if (sent) {
  3528.         if (which == OP_GSBYNAME) {
  3529. #ifdef HAS_NTOHS
  3530.         sv_setiv(sv, (I32)ntohs(sent->s_port));
  3531. #else
  3532.         sv_setiv(sv, (I32)(sent->s_port));
  3533. #endif
  3534.         }
  3535.         else
  3536.         sv_setpv(sv, sent->s_name);
  3537.     }
  3538.     RETURN;
  3539.     }
  3540.  
  3541.     if (sent) {
  3542.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3543.     sv_setpv(sv, sent->s_name);
  3544.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3545.     for (elem = sent->s_aliases; *elem; elem++) {
  3546.         sv_catpv(sv, *elem);
  3547.         if (elem[1])
  3548.         sv_catpvn(sv, " ", 1);
  3549.     }
  3550.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3551. #ifdef HAS_NTOHS
  3552.     sv_setiv(sv, (I32)ntohs(sent->s_port));
  3553. #else
  3554.     sv_setiv(sv, (I32)(sent->s_port));
  3555. #endif
  3556.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3557.     sv_setpv(sv, sent->s_proto);
  3558.     }
  3559.  
  3560.     RETURN;
  3561. #else
  3562.     DIE(no_sock_func, "getservent");
  3563. #endif
  3564. }
  3565.  
  3566. PP(pp_shostent)
  3567. {
  3568.     dSP;
  3569. #ifdef HAS_SOCKET
  3570.     sethostent(TOPi);
  3571.     RETSETYES;
  3572. #else
  3573.     DIE(no_sock_func, "sethostent");
  3574. #endif
  3575. }
  3576.  
  3577. PP(pp_snetent)
  3578. {
  3579.     dSP;
  3580. #ifdef HAS_SOCKET
  3581.     setnetent(TOPi);
  3582.     RETSETYES;
  3583. #else
  3584.     DIE(no_sock_func, "setnetent");
  3585. #endif
  3586. }
  3587.  
  3588. PP(pp_sprotoent)
  3589. {
  3590.     dSP;
  3591. #ifdef HAS_SOCKET
  3592.     setprotoent(TOPi);
  3593.     RETSETYES;
  3594. #else
  3595.     DIE(no_sock_func, "setprotoent");
  3596. #endif
  3597. }
  3598.  
  3599. PP(pp_sservent)
  3600. {
  3601.     dSP;
  3602. #ifdef HAS_SOCKET
  3603.     setservent(TOPi);
  3604.     RETSETYES;
  3605. #else
  3606.     DIE(no_sock_func, "setservent");
  3607. #endif
  3608. }
  3609.  
  3610. PP(pp_ehostent)
  3611. {
  3612.     dSP;
  3613. #ifdef HAS_SOCKET
  3614.     endhostent();
  3615.     EXTEND(sp,1);
  3616.     RETPUSHYES;
  3617. #else
  3618.     DIE(no_sock_func, "endhostent");
  3619. #endif
  3620. }
  3621.  
  3622. PP(pp_enetent)
  3623. {
  3624.     dSP;
  3625. #ifdef HAS_SOCKET
  3626.     endnetent();
  3627.     EXTEND(sp,1);
  3628.     RETPUSHYES;
  3629. #else
  3630.     DIE(no_sock_func, "endnetent");
  3631. #endif
  3632. }
  3633.  
  3634. PP(pp_eprotoent)
  3635. {
  3636.     dSP;
  3637. #ifdef HAS_SOCKET
  3638.     endprotoent();
  3639.     EXTEND(sp,1);
  3640.     RETPUSHYES;
  3641. #else
  3642.     DIE(no_sock_func, "endprotoent");
  3643. #endif
  3644. }
  3645.  
  3646. PP(pp_eservent)
  3647. {
  3648.     dSP;
  3649. #ifdef HAS_SOCKET
  3650.     endservent();
  3651.     EXTEND(sp,1);
  3652.     RETPUSHYES;
  3653. #else
  3654.     DIE(no_sock_func, "endservent");
  3655. #endif
  3656. }
  3657.  
  3658. PP(pp_gpwnam)
  3659. {
  3660. #ifdef HAS_PASSWD
  3661.     return pp_gpwent(ARGS);
  3662. #else
  3663.     DIE(no_func, "getpwnam");
  3664. #endif
  3665. }
  3666.  
  3667. PP(pp_gpwuid)
  3668. {
  3669. #ifdef HAS_PASSWD
  3670.     return pp_gpwent(ARGS);
  3671. #else
  3672.     DIE(no_func, "getpwuid");
  3673. #endif
  3674. }
  3675.  
  3676. PP(pp_gpwent)
  3677. {
  3678.     dSP;
  3679. #ifdef HAS_PASSWD
  3680.     I32 which = op->op_type;
  3681.     register SV *sv;
  3682.     struct passwd *pwent;
  3683.  
  3684.     if (which == OP_GPWNAM)
  3685.     pwent = getpwnam(POPp);
  3686.     else if (which == OP_GPWUID)
  3687.     pwent = getpwuid(POPi);
  3688.     else
  3689.     pwent = (struct passwd *)getpwent();
  3690.  
  3691.     EXTEND(SP, 10);
  3692.     if (GIMME != G_ARRAY) {
  3693.     PUSHs(sv = sv_newmortal());
  3694.     if (pwent) {
  3695.         if (which == OP_GPWNAM)
  3696.         sv_setiv(sv, (I32)pwent->pw_uid);
  3697.         else
  3698.         sv_setpv(sv, pwent->pw_name);
  3699.     }
  3700.     RETURN;
  3701.     }
  3702.  
  3703.     if (pwent) {
  3704.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3705.     sv_setpv(sv, pwent->pw_name);
  3706.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3707.     sv_setpv(sv, pwent->pw_passwd);
  3708.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3709.     sv_setiv(sv, (I32)pwent->pw_uid);
  3710.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3711.     sv_setiv(sv, (I32)pwent->pw_gid);
  3712.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3713. #ifdef PWCHANGE
  3714.     sv_setiv(sv, (I32)pwent->pw_change);
  3715. #else
  3716. #ifdef PWQUOTA
  3717.     sv_setiv(sv, (I32)pwent->pw_quota);
  3718. #else
  3719. #ifdef PWAGE
  3720.     sv_setpv(sv, pwent->pw_age);
  3721. #endif
  3722. #endif
  3723. #endif
  3724.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3725. #ifdef PWCLASS
  3726.     sv_setpv(sv, pwent->pw_class);
  3727. #else
  3728. #ifdef PWCOMMENT
  3729.     sv_setpv(sv, pwent->pw_comment);
  3730. #endif
  3731. #endif
  3732.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3733.     sv_setpv(sv, pwent->pw_gecos);
  3734.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3735.     sv_setpv(sv, pwent->pw_dir);
  3736.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3737.     sv_setpv(sv, pwent->pw_shell);
  3738. #ifdef PWEXPIRE
  3739.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3740.     sv_setiv(sv, (I32)pwent->pw_expire);
  3741. #endif
  3742.     }
  3743.     RETURN;
  3744. #else
  3745.     DIE(no_func, "getpwent");
  3746. #endif
  3747. }
  3748.  
  3749. PP(pp_spwent)
  3750. {
  3751.     dSP;
  3752. #ifdef HAS_PASSWD
  3753.     setpwent();
  3754.     RETPUSHYES;
  3755. #else
  3756.     DIE(no_func, "setpwent");
  3757. #endif
  3758. }
  3759.  
  3760. PP(pp_epwent)
  3761. {
  3762.     dSP;
  3763. #ifdef HAS_PASSWD
  3764.     endpwent();
  3765.     RETPUSHYES;
  3766. #else
  3767.     DIE(no_func, "endpwent");
  3768. #endif
  3769. }
  3770.  
  3771. PP(pp_ggrnam)
  3772. {
  3773. #ifdef HAS_GROUP
  3774.     return pp_ggrent(ARGS);
  3775. #else
  3776.     DIE(no_func, "getgrnam");
  3777. #endif
  3778. }
  3779.  
  3780. PP(pp_ggrgid)
  3781. {
  3782. #ifdef HAS_GROUP
  3783.     return pp_ggrent(ARGS);
  3784. #else
  3785.     DIE(no_func, "getgrgid");
  3786. #endif
  3787. }
  3788.  
  3789. PP(pp_ggrent)
  3790. {
  3791.     dSP;
  3792. #ifdef HAS_GROUP
  3793.     I32 which = op->op_type;
  3794.     register char **elem;
  3795.     register SV *sv;
  3796.     struct group *grent;
  3797.  
  3798.     if (which == OP_GGRNAM)
  3799.     grent = (struct group *)getgrnam(POPp);
  3800.     else if (which == OP_GGRGID)
  3801.     grent = (struct group *)getgrgid(POPi);
  3802.     else
  3803.     grent = (struct group *)getgrent();
  3804.  
  3805.     EXTEND(SP, 4);
  3806.     if (GIMME != G_ARRAY) {
  3807.     PUSHs(sv = sv_newmortal());
  3808.     if (grent) {
  3809.         if (which == OP_GGRNAM)
  3810.         sv_setiv(sv, (I32)grent->gr_gid);
  3811.         else
  3812.         sv_setpv(sv, grent->gr_name);
  3813.     }
  3814.     RETURN;
  3815.     }
  3816.  
  3817.     if (grent) {
  3818.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3819.     sv_setpv(sv, grent->gr_name);
  3820.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3821.     sv_setpv(sv, grent->gr_passwd);
  3822.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3823.     sv_setiv(sv, (I32)grent->gr_gid);
  3824.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3825.     for (elem = grent->gr_mem; *elem; elem++) {
  3826.         sv_catpv(sv, *elem);
  3827.         if (elem[1])
  3828.         sv_catpvn(sv, " ", 1);
  3829.     }
  3830.     }
  3831.  
  3832.     RETURN;
  3833. #else
  3834.     DIE(no_func, "getgrent");
  3835. #endif
  3836. }
  3837.  
  3838. PP(pp_sgrent)
  3839. {
  3840.     dSP;
  3841. #ifdef HAS_GROUP
  3842.     setgrent();
  3843.     RETPUSHYES;
  3844. #else
  3845.     DIE(no_func, "setgrent");
  3846. #endif
  3847. }
  3848.  
  3849. PP(pp_egrent)
  3850. {
  3851.     dSP;
  3852. #ifdef HAS_GROUP
  3853.     endgrent();
  3854.     RETPUSHYES;
  3855. #else
  3856.     DIE(no_func, "endgrent");
  3857. #endif
  3858. }
  3859.  
  3860. PP(pp_getlogin)
  3861. {
  3862.     dSP; dTARGET;
  3863. #ifdef HAS_GETLOGIN
  3864.     char *tmps;
  3865.     EXTEND(SP, 1);
  3866.     if (!(tmps = getlogin()))
  3867.     RETPUSHUNDEF;
  3868.     PUSHp(tmps, strlen(tmps));
  3869.     RETURN;
  3870. #else
  3871.     DIE(no_func, "getlogin");
  3872. #endif
  3873. }
  3874.  
  3875. /* Miscellaneous. */
  3876.  
  3877. PP(pp_syscall)
  3878. {
  3879. #ifdef HAS_SYSCALL
  3880.     dSP; dMARK; dORIGMARK; dTARGET;
  3881.     register I32 items = SP - MARK;
  3882.     unsigned long a[20];
  3883.     register I32 i = 0;
  3884.     I32 retval = -1;
  3885.     MAGIC *mg;
  3886.  
  3887.     if (tainting) {
  3888.     while (++MARK <= SP) {
  3889.         if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
  3890.           (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
  3891.         tainted = TRUE;
  3892.     }
  3893.     MARK = ORIGMARK;
  3894.     TAINT_PROPER("syscall");
  3895.     }
  3896.  
  3897.     /* This probably won't work on machines where sizeof(long) != sizeof(int)
  3898.      * or where sizeof(long) != sizeof(char*).  But such machines will
  3899.      * not likely have syscall implemented either, so who cares?
  3900.      */
  3901.     while (++MARK <= SP) {
  3902.     if (SvNIOK(*MARK) || !i)
  3903.         a[i++] = SvIV(*MARK);
  3904.     else if (*MARK == &sv_undef)
  3905.         a[i++] = 0;
  3906.     else 
  3907.         a[i++] = (unsigned long)SvPV_force(*MARK, na);
  3908.     if (i > 15)
  3909.         break;
  3910.     }
  3911.     switch (items) {
  3912.     default:
  3913.     DIE("Too many args to syscall");
  3914.     case 0:
  3915.     DIE("Too few args to syscall");
  3916.     case 1:
  3917.     retval = syscall(a[0]);
  3918.     break;
  3919.     case 2:
  3920.     retval = syscall(a[0],a[1]);
  3921.     break;
  3922.     case 3:
  3923.     retval = syscall(a[0],a[1],a[2]);
  3924.     break;
  3925.     case 4:
  3926.     retval = syscall(a[0],a[1],a[2],a[3]);
  3927.     break;
  3928.     case 5:
  3929.     retval = syscall(a[0],a[1],a[2],a[3],a[4]);
  3930.     break;
  3931.     case 6:
  3932.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
  3933.     break;
  3934.     case 7:
  3935.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
  3936.     break;
  3937.     case 8:
  3938.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
  3939.     break;
  3940. #ifdef atarist
  3941.     case 9:
  3942.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
  3943.     break;
  3944.     case 10:
  3945.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
  3946.     break;
  3947.     case 11:
  3948.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3949.       a[10]);
  3950.     break;
  3951.     case 12:
  3952.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3953.       a[10],a[11]);
  3954.     break;
  3955.     case 13:
  3956.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3957.       a[10],a[11],a[12]);
  3958.     break;
  3959.     case 14:
  3960.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3961.       a[10],a[11],a[12],a[13]);
  3962.     break;
  3963. #endif /* atarist */
  3964.     }
  3965.     SP = ORIGMARK;
  3966.     PUSHi(retval);
  3967.     RETURN;
  3968. #else
  3969.     DIE(no_func, "syscall");
  3970. #endif
  3971. }
  3972.  
  3973. #if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
  3974.  
  3975. /*  XXX Emulate flock() with lockf().  This is just to increase
  3976.     portability of scripts.  The calls are not completely
  3977.     interchangeable.  What's really needed is a good file
  3978.     locking module.
  3979. */
  3980.  
  3981. /*  We might need <unistd.h> because it sometimes defines the lockf()
  3982.     constants.  Unfortunately, <unistd.h> causes troubles on some mixed
  3983.     (BSD/POSIX) systems, such as SunOS 4.1.3.  We could just try including
  3984.     <unistd.h> here in this part of the file, but that might
  3985.     conflict with various other #defines and includes above, such as
  3986.     #define vfork fork above.
  3987.  
  3988.    Further, the lockf() constants aren't POSIX, so they might not be
  3989.    visible if we're compiling with _POSIX_SOURCE defined.  Thus, we'll
  3990.    just stick in the SVID values and be done with it.  Sigh.
  3991. */
  3992.  
  3993. # ifndef F_ULOCK
  3994. #  define F_ULOCK    0    /* Unlock a previously locked region */
  3995. # endif
  3996. # ifndef F_LOCK
  3997. #  define F_LOCK    1    /* Lock a region for exclusive use */
  3998. # endif
  3999. # ifndef F_TLOCK
  4000. #  define F_TLOCK    2    /* Test and lock a region for exclusive use */
  4001. # endif
  4002. # ifndef F_TEST
  4003. #  define F_TEST    3    /* Test a region for other processes locks */
  4004. # endif
  4005.  
  4006. /* These are the flock() constants.  Since this sytems doesn't have
  4007.    flock(), the values of the constants are probably not available.
  4008. */
  4009. # ifndef LOCK_SH
  4010. #  define LOCK_SH 1
  4011. # endif
  4012. # ifndef LOCK_EX
  4013. #  define LOCK_EX 2
  4014. # endif
  4015. # ifndef LOCK_NB
  4016. #  define LOCK_NB 4
  4017. # endif
  4018. # ifndef LOCK_UN
  4019. #  define LOCK_UN 8
  4020. # endif
  4021.  
  4022. int
  4023. lockf_emulate_flock (fd, operation)
  4024. int fd;
  4025. int operation;
  4026. {
  4027.     int i;
  4028.     switch (operation) {
  4029.  
  4030.     /* LOCK_SH - get a shared lock */
  4031.     case LOCK_SH:
  4032.     /* LOCK_EX - get an exclusive lock */
  4033.     case LOCK_EX:
  4034.         i = lockf (fd, F_LOCK, 0);
  4035.         break;
  4036.  
  4037.     /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */
  4038.     case LOCK_SH|LOCK_NB:
  4039.     /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */
  4040.     case LOCK_EX|LOCK_NB:
  4041.         i = lockf (fd, F_TLOCK, 0);
  4042.         if (i == -1)
  4043.         if ((errno == EAGAIN) || (errno == EACCES))
  4044.             errno = EWOULDBLOCK;
  4045.         break;
  4046.  
  4047.     /* LOCK_UN - unlock */
  4048.     case LOCK_UN:
  4049.         i = lockf (fd, F_ULOCK, 0);
  4050.         break;
  4051.  
  4052.     /* Default - can't decipher operation */
  4053.     default:
  4054.         i = -1;
  4055.         errno = EINVAL;
  4056.         break;
  4057.     }
  4058.     return (i);
  4059. }
  4060. #endif
  4061.