X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=ab8356eab72d3bf335fe39c04dade4e489b6788f;hb=531b886104fed3302a6d671985aba5e2f6420dd5;hp=1d69fe5602d20ccae22b0f6cc22f9986dcd6b6e9;hpb=cb5953d685cec7d1e5d677ac4d2ddbe33ef0a803;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index 1d69fe5..ab8356e 100644
--- a/util.c
+++ b/util.c
@@ -2051,7 +2051,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     return PerlIO_fdopen(p[This], mode);
 }
 #else
-#if defined(atarist) || defined(DJGPP)
+#if defined(atarist)
 FILE *popen();
 PerlIO *
 Perl_my_popen(pTHX_ char *cmd, char *mode)
@@ -2063,6 +2063,20 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     */
     return PerlIO_importFILE(popen(cmd, mode), 0);
 }
+#else
+#if defined(DJGPP)
+FILE *djgpp_popen();
+PerlIO *
+Perl_my_popen(pTHX_ char *cmd, char *mode)
+{
+    PERL_FLUSHALL_FOR_CHILD;
+    /* Call system's popen() to get a FILE *, then import it.
+       used 0 for 2nd parameter to PerlIO_importFILE;
+       apparently not used
+    */
+    return PerlIO_importFILE(djgpp_popen(cmd, mode), 0);
+}
+#endif
 #endif
 
 #endif /* !DOSISH */
@@ -2367,7 +2381,7 @@ Perl_pidgone(pTHX_ Pid_t pid, int status)
     return;
 }
 
-#if defined(atarist) || defined(OS2) || defined(DJGPP)
+#if defined(atarist) || defined(OS2)
 int pclose();
 #ifdef HAS_FORK
 int					/* Cannot prototype with I32
@@ -2381,9 +2395,20 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     /* Needs work for PerlIO ! */
     FILE *f = PerlIO_findFILE(ptr);
     I32 result = pclose(f);
+    PerlIO_releaseFILE(ptr,f);
+    return result;
+}
+#endif
+
 #if defined(DJGPP)
+int djgpp_pclose();
+I32
+Perl_my_pclose(pTHX_ PerlIO *ptr)
+{
+    /* Needs work for PerlIO ! */
+    FILE *f = PerlIO_findFILE(ptr);
+    I32 result = djgpp_pclose(f);
     result = (result << 8) & 0xff00;
-#endif
     PerlIO_releaseFILE(ptr,f);
     return result;
 }
@@ -3604,36 +3629,39 @@ Fill the sv with current working directory
  *     because you might chdir out of a directory that you can't chdir
  *     back into. */
 
-/* XXX: this needs more porting #ifndef HAS_GETCWD */
 int
 Perl_sv_getcwd(pTHX_ register SV *sv)
 {
 #ifndef PERL_MICRO
 
-#ifndef HAS_GETCWD
+#ifdef HAS_GETCWD
+    {
+	char buf[MAXPATHLEN];
+
+        /* Some getcwd()s automatically allocate a buffer of the given
+	 * size from the heap if they are given a NULL buffer pointer.
+	 * The problem is that this behaviour is not portable. */
+        if (getcwd(buf, sizeof(buf) - 1)) {
+            STRLEN len = strlen(buf);
+            sv_setpvn(sv, buf, len);
+            return TRUE;
+        }
+        else {
+            sv_setsv(sv, &PL_sv_undef);
+            return FALSE;
+        }
+    }
+
+#else
+
     struct stat statbuf;
     int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
     int namelen, pathlen=0;
     DIR *dir;
     Direntry_t *dp;
-#endif
 
     (void)SvUPGRADE(sv, SVt_PV);
 
-#ifdef HAS_GETCWD
-
-    SvGROW(sv, 128);
-    while ((getcwd(SvPVX(sv), SvLEN(sv)-1) == NULL) && errno == ERANGE) {
-        if (SvLEN(sv) + 128 >= MAXPATHLEN) {
-            SV_CWD_RETURN_UNDEF;
-	}
-        SvGROW(sv, SvLEN(sv) + 128);
-    }
-    SvCUR_set(sv, strlen(SvPVX(sv)));
-    SvPOK_only(sv);
-
-#else
-
     if (PerlLIO_lstat(".", &statbuf) < 0) {
         SV_CWD_RETURN_UNDEF;
     }
@@ -3715,12 +3743,14 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 #endif
     }
 
-    SvCUR_set(sv, pathlen);
-    *SvEND(sv) = '\0';
-    SvPOK_only(sv);
+    if (pathlen) {
+        SvCUR_set(sv, pathlen);
+        *SvEND(sv) = '\0';
+        SvPOK_only(sv);
 
-    if (PerlDir_chdir(SvPVX(sv)) < 0) {
-        SV_CWD_RETURN_UNDEF;
+	if (PerlDir_chdir(SvPVX(sv)) < 0) {
+            SV_CWD_RETURN_UNDEF;
+        }
     }
     if (PerlLIO_stat(".", &statbuf) < 0) {
         SV_CWD_RETURN_UNDEF;
@@ -3741,150 +3771,3 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 #endif
 }
 
-/*
-=for apidoc sv_realpath
-
-Emulate realpath(3).
-
-The real realpath() is not used because it's a known can of worms.
-We may have bugs but hey, they are our very own.
-
-=cut
- */
-int
-Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN maxlen)
-{
-#ifndef PERL_MICRO
-    char name[MAXPATHLEN]    = { 0 };
-    char dotdots[MAXPATHLEN] = { 0 };
-    char *s;
-    STRLEN pathlen, namelen;
-    DIR *parent;
-    Direntry_t *dp;
-    struct stat cst, pst, tst;
-
-    if (!sv || !path || !maxlen) {
-        Perl_warn(aTHX_ "sv_realpath: realpath(0x%x, 0x%x, "")",
-                  sv, path, maxlen);
-        SV_CWD_RETURN_UNDEF;
-    }
-
-    /* Is the source buffer too long?
-     * Don't use strlen() to avoid running off the end. */
-    if (maxlen >= MAXPATHLEN)
-        pathlen = maxlen;
-    else {
-        s = memchr(path, '\0', MAXPATHLEN);
-	pathlen = s ? s - path : MAXPATHLEN;
-    }
-    if (pathlen >= MAXPATHLEN) {
-        Perl_warn(aTHX_ "sv_realpath: source too large");
-        SV_CWD_RETURN_UNDEF;
-    }
-
-    if (PerlLIO_stat(path, &cst) < 0) {
-        Perl_warn(aTHX_ "sv_realpath: stat(\"%s\"): %s",
-                  path, Strerror(errno));
-        SV_CWD_RETURN_UNDEF;
-    }
-
-    (void)SvUPGRADE(sv, SVt_PV);
-
-    Copy(path, dotdots, maxlen, char);
-
-    pathlen = 0;
-
-    for (;;) {
-        strcat(dotdots, "/..");
-        StructCopy(&cst, &pst, struct stat);
-
-        if (PerlLIO_stat(dotdots, &cst) < 0) {
-            Perl_warn(aTHX_ "sv_realpath: stat(\"%s\"): %s",
-                      dotdots, Strerror(errno));
-            SV_CWD_RETURN_UNDEF;
-        }
-
-        if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) {
-            /* We've reached the root: previous is same as current */
-            break;
-        } else {
-            STRLEN dotdotslen = strlen(dotdots);
-
-            /* Scan through the dir looking for name of previous */
-            if (!(parent = PerlDir_open(dotdots))) {
-                Perl_warn(aTHX_ "sv_realpath: opendir(\"%s\"): %s",
-                          dotdots, Strerror(errno));
-                SV_CWD_RETURN_UNDEF;
-            }
-
-            SETERRNO(0,SS$_NORMAL); /* for readdir() */
-            while ((dp = PerlDir_read(parent)) != NULL) {
-                if (SV_CWD_ISDOT(dp)) {
-                    continue;
-                }
-
-                Copy(dotdots, name, dotdotslen, char);
-                name[dotdotslen] = '/';
-#ifdef DIRNAMLEN
-                namelen = dp->d_namlen;
-#else
-                namelen = strlen(dp->d_name);
-#endif
-                Copy(dp->d_name, name + dotdotslen + 1, namelen, char);
-                name[dotdotslen + 1 + namelen] = 0;
-
-                if (PerlLIO_lstat(name, &tst) < 0) {
-                    PerlDir_close(parent);
-                    Perl_warn(aTHX_ "sv_realpath: lstat(\"%s\"): %s",
-                              name, Strerror(errno));
-                    SV_CWD_RETURN_UNDEF;
-                }
-
-                if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino)
-                    break;
-
-                SETERRNO(0,SS$_NORMAL); /* for readdir() */
-            }
-
-            if (!dp && errno) {
-                Perl_warn(aTHX_ "sv_realpath: readdir(\"%s\"): %s",
-                          dotdots, Strerror(errno));
-                SV_CWD_RETURN_UNDEF;
-            }
-
-	    if (pathlen + namelen + 1 >= MAXPATHLEN) {
-	        Perl_warn(aTHX_ "sv_realpath: too long name");
-                SV_CWD_RETURN_UNDEF;
-	    }
-
-            SvGROW(sv, pathlen + namelen + 1);
-            if (pathlen) {
-                /* shift down */
-                Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
-            }
-
-            *SvPVX(sv) = '/';
-            Move(dp->d_name, SvPVX(sv)+1, namelen, char);
-            pathlen += (namelen + 1);
-
-#ifdef VOID_CLOSEDIR
-            PerlDir_close(parent);
-#else
-            if (PerlDir_close(parent) < 0) {
-                Perl_warn(aTHX_ "sv_realpath: closedir(\"%s\"): %s",
-                          dotdots, Strerror(errno));
-                SV_CWD_RETURN_UNDEF;
-            }
-#endif
-        }
-    }
-
-    SvCUR_set(sv, pathlen);
-    SvPOK_only(sv);
-
-    return TRUE;
-#else
-    return FALSE; /* MICROPERL */
-#endif
-}
-