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