X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FCwd%2FCwd.xs;h=039adb93f6e9f9419213e6414cdff7512fbb7a8e;hb=2a5d9b1d41e4bafaa26126c5dea2f6ff0b72b6a7;hp=6f8dc9657bcbec177388eede68a987058ed7cb19;hpb=a9939470558f41efaae5bf23fe0c76fc3a2402ea;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs
index 6f8dc96..039adb9 100644
--- a/ext/Cwd/Cwd.xs
+++ b/ext/Cwd/Cwd.xs
@@ -1,6 +1,8 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#define NEED_sv_2pv_nolen
+#include "ppport.h"
 
 #ifdef I_UNISTD
 #   include <unistd.h>
@@ -8,7 +10,14 @@
 
 /* The realpath() implementation from OpenBSD 2.9 (realpath.c 1.4)
  * Renamed here to bsd_realpath() to avoid library conflicts.
- * --jhi 2000-06-20 */
+ * --jhi 2000-06-20 
+ */
+
+/* See
+ * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-11/msg00979.html
+ * for the details of why the BSD license is compatible with the
+ * AL/GPL standard perl license.
+ */
 
 /*
  * Copyright (c) 1994
@@ -25,11 +34,7 @@
  * 2. Redistributions in binary form must reproduce the above copyright
  *    notice, this list of conditions and the following disclaimer in the
  *    documentation and/or other materials provided with the distribution.
- * 3. All advertising materials mentioning features or use of this software
- *    must display the following acknowledgement:
- *	This product includes software developed by the University of
- *	California, Berkeley and its contributors.
- * 4. Neither the name of the University nor the names of its contributors
+ * 3. Neither the name of the University nor the names of its contributors
  *    may be used to endorse or promote products derived from this software
  *    without specific prior written permission.
  *
@@ -65,9 +70,7 @@ static char *rcsid = "$OpenBSD: realpath.c,v 1.4 1998/05/18 09:55:19 deraadt Exp
  */
 static
 char *
-bsd_realpath(path, resolved)
-	const char *path;
-	char *resolved;
+bsd_realpath(const char *path, char *resolved)
 {
 #ifdef VMS
        dTHX;
@@ -210,9 +213,35 @@ err2:
 #endif
 }
 
+#ifndef SV_CWD_RETURN_UNDEF
+#define SV_CWD_RETURN_UNDEF \
+sv_setsv(sv, &PL_sv_undef); \
+return FALSE
+#endif
+
+#ifndef OPpENTERSUB_HASTARG
+#define OPpENTERSUB_HASTARG     32      /* Called from OP tree. */
+#endif
+
+#ifndef dXSTARG
+#define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
+                             ? PAD_SV(PL_op->op_targ) : sv_newmortal())
+#endif
+
+#ifndef XSprePUSH
+#define XSprePUSH (sp = PL_stack_base + ax - 1)
+#endif
+
+#ifndef SV_CWD_ISDOT
+#define SV_CWD_ISDOT(dp) \
+    (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \
+        (dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
+#endif
+
 #ifndef getcwd_sv
-// Taken from perl 5.8's util.c
-int getcwd_sv(pTHX_ register SV *sv)
+/* Taken from perl 5.8's util.c */
+#define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
+int Perl_getcwd_sv(pTHX_ register SV *sv)
 {
 #ifndef PERL_MICRO
 
@@ -239,7 +268,7 @@ int getcwd_sv(pTHX_ register SV *sv)
     }
 
 #else
-
+  {
     Stat_t statbuf;
     int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
     int namelen, pathlen=0;
@@ -351,6 +380,7 @@ int getcwd_sv(pTHX_ register SV *sv)
     }
 
     return TRUE;
+  }
 #endif
 
 #else
@@ -379,15 +409,29 @@ PPCODE:
 }
 
 void
+getcwd(...)
+PROTOTYPE: DISABLE
+PPCODE:
+{
+    dXSTARG;
+    getcwd_sv(TARG);
+    XSprePUSH; PUSHTARG;
+#ifndef INCOMPLETE_TAINTS
+    SvTAINTED_on(TARG);
+#endif
+}
+
+void
 abs_path(pathsv=Nullsv)
     SV *pathsv
+PROTOTYPE: DISABLE
 PPCODE:
 {
     dXSTARG;
     char *path;
     char buf[MAXPATHLEN];
 
-    path = pathsv ? SvPV_nolen(pathsv) : ".";
+    path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
 
     if (bsd_realpath(path, buf)) {
         sv_setpvn(TARG, buf, strlen(buf));
@@ -402,3 +446,41 @@ PPCODE:
     SvTAINTED_on(TARG);
 #endif
 }
+
+#if defined(WIN32) && !defined(UNDER_CE)
+
+void
+getdcwd(...)
+PPCODE:
+{
+    dXSTARG;
+    int drive;
+    char *dir;
+
+    /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
+    if ( items == 0 ||
+        (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
+        drive = 0;
+    else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
+             isALPHA(SvPVX(ST(0))[0]))
+        drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
+    else
+        croak("Usage: getdcwd(DRIVE)");
+
+    New(0,dir,MAXPATHLEN,char);
+    if (_getdcwd(drive, dir, MAXPATHLEN)) {
+        sv_setpvn(TARG, dir, strlen(dir));
+        SvPOK_only(TARG);
+    }
+    else
+        sv_setsv(TARG, &PL_sv_undef);
+
+    Safefree(dir);
+
+    XSprePUSH; PUSHTARG;
+#ifndef INCOMPLETE_TAINTS
+    SvTAINTED_on(TARG);
+#endif
+}
+
+#endif