This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove deprecated PERL_OBJECT cruft, it has long since stopped
[perl5.git] / ext / POSIX / POSIX.xs
index 80af6d3..60469a3 100644 (file)
@@ -2,13 +2,24 @@
 #define _POSIX_
 #endif
 
+#ifdef NETWARE
+       #define _POSIX_
+       /*
+        * Ideally this should be somewhere down in the includes
+        * but putting it in other places is giving compiler errors.
+        * Also here I am unable to check for HAS_UNAME since it wouldn't have
+        * yet come into the file at this stage - sgp 18th Oct 2000
+        */
+       #include <sys/utsname.h>
+#endif /* NETWARE */
+
 #define PERL_NO_GET_CONTEXT
 
 #include "EXTERN.h"
 #define PERLIO_NOT_STDIO 1
 #include "perl.h"
 #include "XSUB.h"
-#if defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_SYS)
+#if defined(PERL_IMPLICIT_SYS)
 #  undef signal
 #  undef open
 #  undef setmode
@@ -65,7 +76,7 @@
 #include <fcntl.h>
 
 #ifdef HAS_TZNAME
-#  if !defined(WIN32) && !defined(__CYGWIN__)
+#  if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE)
 extern char *tzname[];
 #  endif
 #else
@@ -126,7 +137,7 @@ char *tzname[] = { "" , "" };
 #if defined (__CYGWIN__)
 #    define tzname _tzname
 #endif
-#if defined (WIN32)
+#if defined (WIN32) || defined (NETWARE)
 #  undef mkfifo
 #  define mkfifo(a,b) not_here("mkfifo")
 #  define ttyname(a) (char*)not_here("ttyname")
@@ -156,6 +167,10 @@ char *tzname[] = { "" , "" };
 #  define sigdelset(a,b)       not_here("sigdelset")
 #  define sigfillset(a)                not_here("sigfillset")
 #  define sigismember(a,b)     not_here("sigismember")
+#ifndef NETWARE
+#  define setuid(a)            not_here("setuid")
+#  define setgid(a)            not_here("setgid")
+#endif /* NETWARE */
 #else
 
 #  ifndef HAS_MKFIFO
@@ -182,7 +197,7 @@ char *tzname[] = { "" , "" };
 #  ifdef I_UTIME
 #    include <utime.h>
 #  endif
-#endif /* WIN32 */
+#endif /* WIN32 || NETWARE */
 #endif /* __VMS */
 
 typedef int SysRet;
@@ -269,7 +284,9 @@ unsigned long strtoul (const char *, char **, int);
 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
 #endif
 #ifndef HAS_TIMES
+#ifndef NETWARE
 #define times(a) not_here("times")
+#endif /* NETWARE */
 #endif
 #ifndef HAS_UNAME
 #define uname(a) not_here("uname")
@@ -505,14 +522,15 @@ __END__
 }
 
 static void
-restore_sigmask(sigset_t *ossetp)
+restore_sigmask(pTHX_ SV *osset_sv)
 {
-           /* Fortunately, restoring the signal mask can't fail, because
-            * there's nothing we can do about it if it does -- we're not
-            * supposed to return -1 from sigaction unless the disposition
-            * was unaffected.
-            */
-           (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+     /* Fortunately, restoring the signal mask can't fail, because
+      * there's nothing we can do about it if it does -- we're not
+      * supposed to return -1 from sigaction unless the disposition
+      * was unaffected.
+      */
+     sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
+     (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
 }
 
 MODULE = SigSet                PACKAGE = POSIX::SigSet         PREFIX = sig
@@ -1156,7 +1174,7 @@ sigaction(sig, optaction, oldaction = 0)
        SV *                    optaction
        POSIX::SigAction        oldaction
     CODE:
-#ifdef WIN32
+#if defined(WIN32) || defined(NETWARE)
        RETVAL = not_here("sigaction");
 #else
 # This code is really grody because we're trying to make the signal
@@ -1168,6 +1186,7 @@ sigaction(sig, optaction, oldaction = 0)
            struct sigaction act;
            struct sigaction oact;
            sigset_t sset;
+           SV *osset_sv;
            sigset_t osset;
            POSIX__SigSet sigset;
            SV** svp;
@@ -1195,10 +1214,12 @@ sigaction(sig, optaction, oldaction = 0)
            sigfillset(&sset);
            RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
            if(RETVAL == -1)
-               XSRETURN(1);
+               XSRETURN_UNDEF;
            ENTER;
            /* Restore signal mask no matter how we exit this block. */
-           SAVEDESTRUCTOR(restore_sigmask, &osset);
+           osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
+           SAVEFREESV( osset_sv );
+           SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
 
            RETVAL=-1; /* In case both oldaction and action are 0. */
 
@@ -1215,7 +1236,7 @@ sigaction(sig, optaction, oldaction = 0)
                }
                RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
                if(RETVAL == -1)
-                   XSRETURN(1);
+                   XSRETURN_UNDEF;
                /* Get back the mask. */
                svp = hv_fetch(oldaction, "MASK", 4, TRUE);
                if (sv_isa(*svp, "POSIX::SigSet")) {
@@ -1277,6 +1298,8 @@ sigaction(sig, optaction, oldaction = 0)
                 * essentially meaningless anyway.
                 */
                RETVAL = sigaction(sig, & act, (struct sigaction *)0);
+               if(RETVAL == -1)
+                   XSRETURN_UNDEF;
            }
 
            LEAVE;
@@ -1727,40 +1750,12 @@ char *
 ttyname(fd)
        int             fd
 
-#XXX: use sv_getcwd()
 void
 getcwd()
-       PPCODE:
-#ifdef HAS_GETCWD
-       char *          buf;
-       int             buflen = 128;
-
-       New(0, buf, buflen, char);
-       /* Many getcwd()s know how to automatically allocate memory
-        * for the directory if the buffer argument is NULL but...
-        * (1) we cannot assume all getcwd()s do that
-        * (2) this may interfere with Perl's malloc
-         * So let's not.  --jhi */
-       while ((getcwd(buf, buflen) == NULL) && errno == ERANGE) {
-           buflen += 128;
-           if (buflen > MAXPATHLEN) {
-               Safefree(buf);
-               buf = NULL;
-               break;
-           }
-           Renew(buf, buflen, char);
-       }
-       if (buf) {
-           PUSHs(sv_2mortal(newSVpv(buf, 0)));
-           Safefree(buf);
-       }
-       else
-           PUSHs(&PL_sv_undef);
-#else
-       require_pv("Cwd.pm");
-        /* Module require may have grown the stack */
-       SPAGAIN;
-       PUSHMARK(sp);
-       PUTBACK;
-       XSRETURN(call_pv("Cwd::cwd", GIMME_V));
-#endif
+    PPCODE:
+      {
+       dXSTARG;
+       getcwd_sv(TARG);
+       XSprePUSH; PUSHTARG;
+      }
+