/* * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the * contents of Cwd.xs. Do not edit this file, edit Cwd.xs instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "Cwd.xs" /* * ex: set ts=8 sts=4 sw=4 et: */ #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifndef NO_PPPORT_H # define NEED_croak_xs_usage # define NEED_sv_2pv_flags # define NEED_my_strlcpy # define NEED_my_strlcat # include "ppport.h" #endif #ifdef I_UNISTD # include #endif /* For special handling of os390 sysplexed systems */ #define SYSNAME "$SYSNAME" #define SYSNAME_LEN (sizeof(SYSNAME) - 1) /* The realpath() implementation from OpenBSD 3.9 to 4.2 (realpath.c 1.13) * Renamed here to bsd_realpath() to avoid library conflicts. */ /* 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) 2003 Constantin S. Svintsoff * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 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. The names of the authors may not be used to endorse or promote * products derived from this software without specific prior written * permission. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* OpenBSD system #includes removed since the Perl ones should do. --jhi */ #ifndef MAXSYMLINKS #define MAXSYMLINKS 8 #endif #ifndef VMS /* * char *realpath(const char *path, char resolved[MAXPATHLEN]); * * Find the real name of path, by removing all ".", ".." and symlink * components. Returns (resolved) on success, or (NULL) on failure, * in which case the path which caused trouble is left in (resolved). */ static char * bsd_realpath(const char *path, char resolved[MAXPATHLEN]) { char *p, *q, *s; size_t remaining_len, resolved_len; unsigned symlinks; int serrno; char remaining[MAXPATHLEN], next_token[MAXPATHLEN]; serrno = errno; symlinks = 0; if (path[0] == '/') { resolved[0] = '/'; resolved[1] = '\0'; if (path[1] == '\0') return (resolved); resolved_len = 1; remaining_len = my_strlcpy(remaining, path + 1, sizeof(remaining)); } else { if (getcwd(resolved, MAXPATHLEN) == NULL) { my_strlcpy(resolved, ".", MAXPATHLEN); return (NULL); } resolved_len = strlen(resolved); remaining_len = my_strlcpy(remaining, path, sizeof(remaining)); } if (remaining_len >= sizeof(remaining) || resolved_len >= MAXPATHLEN) { errno = ENAMETOOLONG; return (NULL); } /* * Iterate over path components in 'remaining'. */ while (remaining_len != 0) { /* * Extract the next path component and adjust 'remaining' * and its length. */ p = strchr(remaining, '/'); s = p ? p : remaining + remaining_len; if ((STRLEN)(s - remaining) >= (STRLEN)sizeof(next_token)) { errno = ENAMETOOLONG; return (NULL); } memcpy(next_token, remaining, s - remaining); next_token[s - remaining] = '\0'; remaining_len -= s - remaining; if (p != NULL) memmove(remaining, s + 1, remaining_len + 1); if (resolved[resolved_len - 1] != '/') { if (resolved_len + 1 >= MAXPATHLEN) { errno = ENAMETOOLONG; return (NULL); } resolved[resolved_len++] = '/'; resolved[resolved_len] = '\0'; } if (next_token[0] == '\0') continue; else if (strEQ(next_token, ".")) continue; else if (strEQ(next_token, "..")) { /* * Strip the last path component except when we have * single "/" */ if (resolved_len > 1) { resolved[resolved_len - 1] = '\0'; q = strrchr(resolved, '/') + 1; *q = '\0'; resolved_len = q - resolved; } continue; } /* * Append the next path component and lstat() it. If * lstat() fails we still can return successfully if * there are no more path components left. */ resolved_len = my_strlcat(resolved, next_token, MAXPATHLEN); if (resolved_len >= MAXPATHLEN) { errno = ENAMETOOLONG; return (NULL); } #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK) { struct stat sb; if (lstat(resolved, &sb) != 0) { if (errno == ENOENT && p == NULL) { errno = serrno; return (resolved); } return (NULL); } if (S_ISLNK(sb.st_mode)) { int slen; char symlink[MAXPATHLEN]; if (symlinks++ > MAXSYMLINKS) { errno = ELOOP; return (NULL); } slen = readlink(resolved, symlink, sizeof(symlink) - 1); if (slen < 0) return (NULL); symlink[slen] = '\0'; # ifdef EBCDIC /* XXX Probably this should be only os390 */ /* Replace all instances of $SYSNAME/foo simply by /foo */ if (slen > SYSNAME_LEN + strlen(next_token) && strnEQ(symlink, SYSNAME, SYSNAME_LEN) && *(symlink + SYSNAME_LEN) == '/' && strEQ(symlink + SYSNAME_LEN + 1, next_token)) { goto not_symlink; } # endif if (symlink[0] == '/') { resolved[1] = 0; resolved_len = 1; } else if (resolved_len > 1) { /* Strip the last path component. */ resolved[resolved_len - 1] = '\0'; q = strrchr(resolved, '/') + 1; *q = '\0'; resolved_len = q - resolved; } /* * If there are any path components left, then * append them to symlink. The result is placed * in 'remaining'. */ if (p != NULL) { if (symlink[slen - 1] != '/') { if ((STRLEN)(slen + 1) >= (STRLEN)sizeof(symlink)) { errno = ENAMETOOLONG; return (NULL); } symlink[slen] = '/'; symlink[slen + 1] = 0; } remaining_len = my_strlcat(symlink, remaining, sizeof(symlink)); if (remaining_len >= sizeof(remaining)) { errno = ENAMETOOLONG; return (NULL); } } remaining_len = my_strlcpy(remaining, symlink, sizeof(remaining)); } # ifdef EBCDIC not_symlink: ; # endif } #endif } /* * Remove trailing slash except when the resolved pathname * is a single "/". */ if (resolved_len > 1 && resolved[resolved_len - 1] == '/') resolved[resolved_len - 1] = '\0'; return (resolved); } #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) int Perl_getcwd_sv(pTHX_ SV *sv) { #ifndef PERL_MICRO SvTAINTED_on(sv); #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 { Stat_t statbuf; int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino; int namelen, pathlen=0; DIR *dir; Direntry_t *dp; (void)SvUPGRADE(sv, SVt_PV); if (PerlLIO_lstat(".", &statbuf) < 0) { SV_CWD_RETURN_UNDEF; } orig_cdev = statbuf.st_dev; orig_cino = statbuf.st_ino; cdev = orig_cdev; cino = orig_cino; for (;;) { odev = cdev; oino = cino; if (PerlDir_chdir("..") < 0) { SV_CWD_RETURN_UNDEF; } if (PerlLIO_stat(".", &statbuf) < 0) { SV_CWD_RETURN_UNDEF; } cdev = statbuf.st_dev; cino = statbuf.st_ino; if (odev == cdev && oino == cino) { break; } if (!(dir = PerlDir_open("."))) { SV_CWD_RETURN_UNDEF; } while ((dp = PerlDir_read(dir)) != NULL) { #ifdef DIRNAMLEN namelen = dp->d_namlen; #else namelen = strlen(dp->d_name); #endif /* skip . and .. */ if (SV_CWD_ISDOT(dp)) { continue; } if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) { SV_CWD_RETURN_UNDEF; } tdev = statbuf.st_dev; tino = statbuf.st_ino; if (tino == oino && tdev == odev) { break; } } if (!dp) { SV_CWD_RETURN_UNDEF; } if (pathlen + namelen + 1 >= MAXPATHLEN) { SV_CWD_RETURN_UNDEF; } SvGROW(sv, pathlen + namelen + 1); if (pathlen) { /* shift down */ Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char); } /* prepend current directory to the front */ *SvPVX(sv) = '/'; Move(dp->d_name, SvPVX(sv)+1, namelen, char); pathlen += (namelen + 1); #ifdef VOID_CLOSEDIR PerlDir_close(dir); #else if (PerlDir_close(dir) < 0) { SV_CWD_RETURN_UNDEF; } #endif } if (pathlen) { SvCUR_set(sv, pathlen); *SvEND(sv) = '\0'; SvPOK_only(sv); if (PerlDir_chdir(SvPVX(sv)) < 0) { SV_CWD_RETURN_UNDEF; } } if (PerlLIO_stat(".", &statbuf) < 0) { SV_CWD_RETURN_UNDEF; } cdev = statbuf.st_dev; cino = statbuf.st_ino; if (cdev != orig_cdev || cino != orig_cino) { Perl_croak(aTHX_ "Unstable directory path, " "current directory changed unexpectedly"); } return TRUE; } #endif #else return FALSE; #endif } #endif #if defined(START_MY_CXT) && defined(MY_CXT_CLONE) # define USE_MY_CXT 1 #else # define USE_MY_CXT 0 #endif #if USE_MY_CXT # define MY_CXT_KEY "Cwd::_guts" XS_VERSION typedef struct { SV *empty_string_sv, *slash_string_sv; } my_cxt_t; START_MY_CXT # define dUSE_MY_CXT dMY_CXT # define EMPTY_STRING_SV MY_CXT.empty_string_sv # define SLASH_STRING_SV MY_CXT.slash_string_sv # define POPULATE_MY_CXT do { \ MY_CXT.empty_string_sv = newSVpvs(""); \ MY_CXT.slash_string_sv = newSVpvs("/"); \ } while(0) #else # define dUSE_MY_CXT dNOOP # define EMPTY_STRING_SV sv_2mortal(newSVpvs("")) # define SLASH_STRING_SV sv_2mortal(newSVpvs("/")) #endif #define invocant_is_unix(i) THX_invocant_is_unix(aTHX_ i) static bool THX_invocant_is_unix(pTHX_ SV *invocant) { /* * This is used to enable optimisations that avoid method calls * by knowing how they would resolve. False negatives, disabling * the optimisation where it would actually behave correctly, are * acceptable. */ return SvPOK(invocant) && SvCUR(invocant) == 16 && !memcmp(SvPVX(invocant), "File::Spec::Unix", 16); } #define unix_canonpath(p) THX_unix_canonpath(aTHX_ p) static SV * THX_unix_canonpath(pTHX_ SV *path) { SV *retval; char const *p, *pe, *q; STRLEN l; char *o; STRLEN plen; SvGETMAGIC(path); if(!SvOK(path)) return &PL_sv_undef; p = SvPV_nomg(path, plen); if(plen == 0) return newSVpvs(""); pe = p + plen; retval = newSV(plen); #ifdef SvUTF8 if(SvUTF8(path)) SvUTF8_on(retval); #endif o = SvPVX(retval); if(DOUBLE_SLASHES_SPECIAL && p[0] == '/' && p[1] == '/' && p[2] != '/') { q = (const char *) memchr(p+2, '/', pe-(p+2)); if(!q) q = pe; l = q - p; memcpy(o, p, l); p = q; o += l; } /* * The transformations performed here are: * . squeeze multiple slashes * . eliminate "." segments, except one if that's all there is * . eliminate leading ".." segments * . eliminate trailing slash, unless it's all there is */ if(p[0] == '/') { *o++ = '/'; while(1) { do { p++; } while(p[0] == '/'); if(p[0] == '.' && p[1] == '.' && (p+2 == pe || p[2] == '/')) { p++; /* advance past second "." next time round loop */ } else if(p[0] == '.' && (p+1 == pe || p[1] == '/')) { /* advance past "." next time round loop */ } else { break; } } } else if(p[0] == '.' && p[1] == '/') { do { p++; do { p++; } while(p[0] == '/'); } while(p[0] == '.' && p[1] == '/'); if(p == pe) *o++ = '.'; } if(p == pe) goto end; while(1) { q = (const char *) memchr(p, '/', pe-p); if(!q) q = pe; l = q - p; memcpy(o, p, l); p = q; o += l; if(p == pe) goto end; while(1) { do { p++; } while(p[0] == '/'); if(p == pe) goto end; if(p[0] != '.') break; if(p+1 == pe) goto end; if(p[1] != '/') break; p++; } *o++ = '/'; } end: ; *o = 0; SvPOK_on(retval); SvCUR_set(retval, o - SvPVX(retval)); SvTAINT(retval); return retval; } #line 556 "Cwd.c" #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif #ifndef dVAR # define dVAR dNOOP #endif /* This stuff is not part of the API! You have been warned. */ #ifndef PERL_VERSION_DECIMAL # define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s) #endif #ifndef PERL_DECIMAL_VERSION # define PERL_DECIMAL_VERSION \ PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION) #endif #ifndef PERL_VERSION_GE # define PERL_VERSION_GE(r,v,s) \ (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s)) #endif #ifndef PERL_VERSION_LE # define PERL_VERSION_LE(r,v,s) \ (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s)) #endif /* XS_INTERNAL is the explicit static-linkage variant of the default * XS macro. * * XS_EXTERNAL is the same as XS_INTERNAL except it does not include * "STATIC", ie. it exports XSUB symbols. You probably don't want that * for anything but the BOOT XSUB. * * See XSUB.h in core! */ /* TODO: This might be compatible further back than 5.10.0. */ #if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1) # undef XS_EXTERNAL # undef XS_INTERNAL # if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING) # define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name) # define XS_INTERNAL(name) STATIC XSPROTO(name) # endif # if defined(__SYMBIAN32__) # define XS_EXTERNAL(name) EXPORT_C XSPROTO(name) # define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name) # endif # ifndef XS_EXTERNAL # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) # define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__) # define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__) # else # ifdef __cplusplus # define XS_EXTERNAL(name) extern "C" XSPROTO(name) # define XS_INTERNAL(name) static XSPROTO(name) # else # define XS_EXTERNAL(name) XSPROTO(name) # define XS_INTERNAL(name) STATIC XSPROTO(name) # endif # endif # endif #endif /* perl >= 5.10.0 && perl <= 5.15.1 */ /* The XS_EXTERNAL macro is used for functions that must not be static * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL * macro defined, the best we can do is assume XS is the same. * Dito for XS_INTERNAL. */ #ifndef XS_EXTERNAL # define XS_EXTERNAL(name) XS(name) #endif #ifndef XS_INTERNAL # define XS_INTERNAL(name) XS(name) #endif /* Now, finally, after all this mess, we want an ExtUtils::ParseXS * internal macro that we're free to redefine for varying linkage due * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to! */ #undef XS_EUPXS #if defined(PERL_EUPXS_ALWAYS_EXPORT) # define XS_EUPXS(name) XS_EXTERNAL(name) #else /* default to internal */ # define XS_EUPXS(name) XS_INTERNAL(name) #endif #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) /* prototype to pass -Wmissing-prototypes */ STATIC void S_croak_xs_usage(const CV *const cv, const char *const params); STATIC void S_croak_xs_usage(const CV *const cv, const char *const params) { const GV *const gv = CvGV(cv); PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) { const char *const gvname = GvNAME(gv); const HV *const stash = GvSTASH(gv); const char *const hvname = stash ? HvNAME(stash) : NULL; if (hvname) Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params); else Perl_croak_nocontext("Usage: %s(%s)", gvname, params); } else { /* Pants. I don't think that it should be possible to get here. */ Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params); } } #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define croak_xs_usage S_croak_xs_usage #endif /* NOTE: the prototype of newXSproto() is different in versions of perls, * so we define a portable version of newXSproto() */ #ifdef newXS_flags #define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0) #else #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv) #endif /* !defined(newXS_flags) */ #if PERL_VERSION_LE(5, 21, 5) # define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file) #else # define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b) #endif #line 700 "Cwd.c" #if USE_MY_CXT #define XSubPPtmpAAAA 1 XS_EUPXS(XS_Cwd_CLONE); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Cwd_CLONE) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 563 "Cwd.xs" PERL_UNUSED_VAR(items); { MY_CXT_CLONE; POPULATE_MY_CXT; } #line 715 "Cwd.c" } XSRETURN_EMPTY; } #endif XS_EUPXS(XS_Cwd_getcwd); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Cwd_getcwd) { dVAR; dXSARGS; dXSI32; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { #line 573 "Cwd.xs" { dXSTARG; /* fastcwd takes zero parameters: */ if (ix == 1 && items != 0) croak_xs_usage(cv, ""); getcwd_sv(TARG); XSprePUSH; PUSHTARG; SvTAINTED_on(TARG); } #line 742 "Cwd.c" PUTBACK; return; } } XS_EUPXS(XS_Cwd_abs_path); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Cwd_abs_path) { dVAR; dXSARGS; if (items < 0 || items > 1) croak_xs_usage(cv, "pathsv=Nullsv"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * pathsv; if (items < 1) pathsv = Nullsv; else { pathsv = ST(0) ; } #line 587 "Cwd.xs" { dXSTARG; char *const path = pathsv ? SvPV_nolen(pathsv) : (char *)"."; char buf[MAXPATHLEN]; if ( #ifdef VMS Perl_rmsexpand(aTHX_ path, buf, NULL, 0) #else bsd_realpath(path, buf) #endif ) { sv_setpv_mg(TARG, buf); SvPOK_only(TARG); SvTAINTED_on(TARG); } else sv_setsv(TARG, &PL_sv_undef); XSprePUSH; PUSHs(TARG); SvTAINTED_on(TARG); } #line 789 "Cwd.c" PUTBACK; return; } } #if defined(WIN32) && !defined(UNDER_CE) #define XSubPPtmpAAAB 1 XS_EUPXS(XS_Cwd_getdcwd); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Cwd_getdcwd) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { #line 616 "Cwd.xs" { 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_setpv_mg(TARG, dir); SvPOK_only(TARG); } else sv_setsv(TARG, &PL_sv_undef); Safefree(dir); XSprePUSH; PUSHs(TARG); SvTAINTED_on(TARG); } #line 837 "Cwd.c" PUTBACK; return; } } #endif XS_EUPXS(XS_File__Spec__Unix_canonpath); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_File__Spec__Unix_canonpath) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, path= &PL_sv_undef, ..."); { SV * RETVAL; SV * self = ST(0) ; SV * path; if (items < 2) path = &PL_sv_undef; else { path = ST(1) ; } #line 652 "Cwd.xs" PERL_UNUSED_VAR(self); RETVAL = unix_canonpath(path); #line 866 "Cwd.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_File__Spec__Unix__fn_canonpath); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_File__Spec__Unix__fn_canonpath) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { SV * RETVAL; SV * path; if (items < 1) path = &PL_sv_undef; else { path = ST(0) ; } #line 660 "Cwd.xs" RETVAL = unix_canonpath(path); #line 892 "Cwd.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_File__Spec__Unix_catdir); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_File__Spec__Unix_catdir) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); { #line 667 "Cwd.xs" dUSE_MY_CXT; SV *joined; #line 910 "Cwd.c" SV * RETVAL; SV * self = ST(0) ; #line 670 "Cwd.xs" EXTEND(SP, items+1); ST(items) = EMPTY_STRING_SV; joined = sv_newmortal(); do_join(joined, SLASH_STRING_SV, &ST(0), &ST(items)); if(invocant_is_unix(self)) { RETVAL = unix_canonpath(joined); } else { ENTER; PUSHMARK(SP); EXTEND(SP, 2); PUSHs(self); PUSHs(joined); PUTBACK; call_method("canonpath", G_SCALAR); SPAGAIN; RETVAL = POPs; LEAVE; SvREFCNT_inc(RETVAL); } #line 934 "Cwd.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_File__Spec__Unix__fn_catdir); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_File__Spec__Unix__fn_catdir) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 695 "Cwd.xs" dUSE_MY_CXT; SV *joined; #line 952 "Cwd.c" SV * RETVAL; #line 698 "Cwd.xs" EXTEND(SP, items+1); ST(items) = EMPTY_STRING_SV; joined = sv_newmortal(); do_join(joined, SLASH_STRING_SV, &ST(-1), &ST(items)); RETVAL = unix_canonpath(joined); #line 960 "Cwd.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_File__Spec__Unix_catfile); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_File__Spec__Unix_catfile) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); { #line 709 "Cwd.xs" dUSE_MY_CXT; #line 977 "Cwd.c" SV * RETVAL; SV * self = ST(0) ; #line 711 "Cwd.xs" if(invocant_is_unix(self)) { if(items == 1) { RETVAL = &PL_sv_undef; } else { SV *file = unix_canonpath(ST(items-1)); if(items == 2) { RETVAL = file; } else { SV *dir = sv_newmortal(); sv_2mortal(file); ST(items-1) = EMPTY_STRING_SV; do_join(dir, SLASH_STRING_SV, &ST(0), &ST(items-1)); RETVAL = unix_canonpath(dir); if(SvCUR(RETVAL) == 0 || SvPVX(RETVAL)[SvCUR(RETVAL)-1] != '/') sv_catsv(RETVAL, SLASH_STRING_SV); sv_catsv(RETVAL, file); } } } else { SV *file, *dir; ENTER; PUSHMARK(SP); EXTEND(SP, 2); PUSHs(self); PUSHs(items == 1 ? &PL_sv_undef : ST(items-1)); PUTBACK; call_method("canonpath", G_SCALAR); SPAGAIN; file = POPs; LEAVE; if(items <= 2) { RETVAL = SvREFCNT_inc(file); } else { char const *pv; STRLEN len; bool need_slash; SP--; ENTER; PUSHMARK(&ST(-1)); PUTBACK; call_method("catdir", G_SCALAR); SPAGAIN; dir = POPs; LEAVE; pv = SvPV(dir, len); need_slash = len == 0 || pv[len-1] != '/'; RETVAL = newSVsv(dir); if(need_slash) sv_catsv(RETVAL, SLASH_STRING_SV); sv_catsv(RETVAL, file); } } #line 1033 "Cwd.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_File__Spec__Unix__fn_catfile); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_File__Spec__Unix__fn_catfile) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 768 "Cwd.xs" dUSE_MY_CXT; #line 1050 "Cwd.c" SV * RETVAL; #line 770 "Cwd.xs" if(items == 0) { RETVAL = &PL_sv_undef; } else { SV *file = unix_canonpath(ST(items-1)); if(items == 1) { RETVAL = file; } else { SV *dir = sv_newmortal(); sv_2mortal(file); ST(items-1) = EMPTY_STRING_SV; do_join(dir, SLASH_STRING_SV, &ST(-1), &ST(items-1)); RETVAL = unix_canonpath(dir); if(SvCUR(RETVAL) == 0 || SvPVX(RETVAL)[SvCUR(RETVAL)-1] != '/') sv_catsv(RETVAL, SLASH_STRING_SV); sv_catsv(RETVAL, file); } } #line 1070 "Cwd.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } #ifdef __cplusplus extern "C" #endif XS_EXTERNAL(boot_Cwd); /* prototype to pass -Wmissing-prototypes */ XS_EXTERNAL(boot_Cwd) { #if PERL_VERSION_LE(5, 21, 5) dVAR; dXSARGS; #else dVAR; dXSBOOTARGSXSAPIVERCHK; #endif #if (PERL_REVISION == 5 && PERL_VERSION < 9) char* file = __FILE__; #else const char* file = __FILE__; #endif PERL_UNUSED_VAR(file); PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ #if PERL_VERSION_LE(5, 21, 5) XS_VERSION_BOOTCHECK; # ifdef XS_APIVERSION_BOOTCHECK XS_APIVERSION_BOOTCHECK; # endif #endif #if XSubPPtmpAAAA newXS_deffile("Cwd::CLONE", XS_Cwd_CLONE); #endif cv = newXS_deffile("Cwd::fastcwd", XS_Cwd_getcwd); XSANY.any_i32 = 1; cv = newXS_deffile("Cwd::getcwd", XS_Cwd_getcwd); XSANY.any_i32 = 0; newXS_deffile("Cwd::abs_path", XS_Cwd_abs_path); #if XSubPPtmpAAAB (void)newXSproto_portable("Cwd::getdcwd", XS_Cwd_getdcwd, file, ";@"); #endif newXS_deffile("File::Spec::Unix::canonpath", XS_File__Spec__Unix_canonpath); newXS_deffile("File::Spec::Unix::_fn_canonpath", XS_File__Spec__Unix__fn_canonpath); newXS_deffile("File::Spec::Unix::catdir", XS_File__Spec__Unix_catdir); newXS_deffile("File::Spec::Unix::_fn_catdir", XS_File__Spec__Unix__fn_catdir); newXS_deffile("File::Spec::Unix::catfile", XS_File__Spec__Unix_catfile); newXS_deffile("File::Spec::Unix::_fn_catfile", XS_File__Spec__Unix__fn_catfile); /* Initialisation Section */ #line 551 "Cwd.xs" #if USE_MY_CXT { MY_CXT_INIT; POPULATE_MY_CXT; } #endif #if XSubPPtmpAAAA #endif #if XSubPPtmpAAAB #endif #line 1137 "Cwd.c" /* End of Initialisation Section */ #if PERL_VERSION_LE(5, 21, 5) # if PERL_VERSION_GE(5, 9, 0) if (PL_unitcheckav) call_list(PL_scopestack_ix, PL_unitcheckav); # endif XSRETURN_YES; #else Perl_xs_boot_epilog(aTHX_ ax); #endif }