X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FCwd%2FCwd.xs;h=7434dfa70000b64a1afcdab8031063d76198428a;hb=dfa4e5d386dd8c5329351699b02085856cdd140e;hp=fae3ef97e3ef040665dd614d544bff02ec0ee6c1;hpb=09122b95120d497042cb9df9ebb06ebcfca423aa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Cwd/Cwd.xs b/ext/Cwd/Cwd.xs index fae3ef9..7434dfa 100644 --- a/ext/Cwd/Cwd.xs +++ b/ext/Cwd/Cwd.xs @@ -1,6 +1,10 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#ifndef NO_PPPORT_H +# define NEED_sv_2pv_nolen +# include "ppport.h" +#endif #ifdef I_UNISTD # include @@ -8,7 +12,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 +36,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 +72,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,6 +215,31 @@ 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 */ #define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a) @@ -240,7 +270,7 @@ int Perl_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; @@ -352,6 +382,7 @@ int Perl_getcwd_sv(pTHX_ register SV *sv) } return TRUE; + } #endif #else @@ -380,15 +411,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)); @@ -404,7 +449,7 @@ PPCODE: #endif } -#ifdef WIN32 +#if defined(WIN32) && !defined(UNDER_CE) void getdcwd(...) @@ -424,15 +469,16 @@ PPCODE: else croak("Usage: getdcwd(DRIVE)"); - /* Pass a NULL pointer as the second argument to have space allocated. */ - if (dir = _getdcwd(drive, NULL, MAXPATHLEN)) { + New(0,dir,MAXPATHLEN,char); + if (_getdcwd(drive, dir, MAXPATHLEN)) { sv_setpvn(TARG, dir, strlen(dir)); - free(dir); SvPOK_only(TARG); } else sv_setsv(TARG, &PL_sv_undef); + Safefree(dir); + XSprePUSH; PUSHTARG; #ifndef INCOMPLETE_TAINTS SvTAINTED_on(TARG);