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