dist/Cwd/Cwd.xs

   1 #define PERL_NO_GET_CONTEXT
   2
   3 #include "EXTERN.h"
   4 #include "perl.h"
   5 #include "XSUB.h"
   6 #define NEED_my_strlcpy
   7 #define NEED_my_strlcat
   8 #include "ppport.h"
   9
  10 #ifdef I_UNISTD
  11 #   include <unistd.h>
  12 #endif
  13
  14 /* The realpath() implementation from OpenBSD 3.9 to 4.2 (realpath.c 1.13)
  15  * Renamed here to bsd_realpath() to avoid library conflicts.
  16  */
  17
  18 /* See
  19  * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-11/msg00979.html
  20  * for the details of why the BSD license is compatible with the
  21  * AL/GPL standard perl license.
  22  */
  23
  24 /*
  25  * Copyright (c) 2003 Constantin S. Svintsoff <kostik@iclub.nsu.ru>
  26  *
  27  * Redistribution and use in source and binary forms, with or without
  28  * modification, are permitted provided that the following conditions
  29  * are met:
  30  * 1. Redistributions of source code must retain the above copyright
  31  *    notice, this list of conditions and the following disclaimer.
  32  * 2. Redistributions in binary form must reproduce the above copyright
  33  *    notice, this list of conditions and the following disclaimer in the
  34  *    documentation and/or other materials provided with the distribution.
  35  * 3. The names of the authors may not be used to endorse or promote
  36  *    products derived from this software without specific prior written
  37  *    permission.
  38  *
  39  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND
  40  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  41  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  42  * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  43  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  44  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  45  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  46  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  47  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  48  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  49  * SUCH DAMAGE.
  50  */
  51
  52 /* OpenBSD system #includes removed since the Perl ones should do. --jhi */
  53
  54 #ifndef MAXSYMLINKS
  55 #define MAXSYMLINKS 8
  56 #endif
  57
  58 #ifndef VMS
  59 /*
  60  * char *realpath(const char *path, char resolved[MAXPATHLEN]);
  61  *
  62  * Find the real name of path, by removing all ".", ".." and symlink
  63  * components.  Returns (resolved) on success, or (NULL) on failure,
  64  * in which case the path which caused trouble is left in (resolved).
  65  */
  66 static
  67 char *
  68 bsd_realpath(const char *path, char resolved[MAXPATHLEN])
  69 {
  70         char *p, *q, *s;
  71         size_t left_len, resolved_len;
  72         unsigned symlinks;
  73         int serrno;
  74         char left[MAXPATHLEN], next_token[MAXPATHLEN];
  75
  76         serrno = errno;
  77         symlinks = 0;
  78         if (path[0] == '/') {
  79                 resolved[0] = '/';
  80                 resolved[1] = '\0';
  81                 if (path[1] == '\0')
  82                         return (resolved);
  83                 resolved_len = 1;
  84                 left_len = my_strlcpy(left, path + 1, sizeof(left));
  85         } else {
  86                 if (getcwd(resolved, MAXPATHLEN) == NULL) {
  87                         my_strlcpy(resolved, ".", MAXPATHLEN);
  88                 return (NULL);
  89         }
  90                 resolved_len = strlen(resolved);
  91                 left_len = my_strlcpy(left, path, sizeof(left));
  92         }
  93         if (left_len >= sizeof(left) || resolved_len >= MAXPATHLEN) {
  94                 errno = ENAMETOOLONG;
  95                 return (NULL);
  96         }
  97
  98         /*
  99          * Iterate over path components in 'left'.
 100          */
 101         while (left_len != 0) {
 102                 /*
 103                  * Extract the next path component and adjust 'left'
 104                  * and its length.
 105                  */
 106                 p = strchr(left, '/');
 107                 s = p ? p : left + left_len;
 108                 if ((STRLEN)(s - left) >= (STRLEN)sizeof(next_token)) {
 109                         errno = ENAMETOOLONG;
 110                         return (NULL);
 111                         }
 112                 memcpy(next_token, left, s - left);
 113                 next_token[s - left] = '\0';
 114                 left_len -= s - left;
 115                 if (p != NULL)
 116                         memmove(left, s + 1, left_len + 1);
 117                 if (resolved[resolved_len - 1] != '/') {
 118                         if (resolved_len + 1 >= MAXPATHLEN) {
 119                                 errno = ENAMETOOLONG;
 120                                 return (NULL);
 121                 }
 122                         resolved[resolved_len++] = '/';
 123                         resolved[resolved_len] = '\0';
 124         }
 125                 if (next_token[0] == '\0')
 126                         continue;
 127                 else if (strcmp(next_token, ".") == 0)
 128                         continue;
 129                 else if (strcmp(next_token, "..") == 0) {
 130                         /*
 131                          * Strip the last path component except when we have
 132                          * single "/"
 133                          */
 134                         if (resolved_len > 1) {
 135                                 resolved[resolved_len - 1] = '\0';
 136                                 q = strrchr(resolved, '/') + 1;
 137                                 *q = '\0';
 138                                 resolved_len = q - resolved;
 139                         }
 140                         continue;
 141     }
 142
 143         /*
 144                  * Append the next path component and lstat() it. If
 145                  * lstat() fails we still can return successfully if
 146                  * there are no more path components left.
 147          */
 148                 resolved_len = my_strlcat(resolved, next_token, MAXPATHLEN);
 149                 if (resolved_len >= MAXPATHLEN) {
 150                         errno = ENAMETOOLONG;
 151                         return (NULL);
 152                 }
 153 #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK)
 154                 {
 155                         struct stat sb;
 156                         if (lstat(resolved, &sb) != 0) {
 157                                 if (errno == ENOENT && p == NULL) {
 158                                         errno = serrno;
 159                                         return (resolved);
 160                                 }
 161                                 return (NULL);
 162                         }
 163                         if (S_ISLNK(sb.st_mode)) {
 164                                 int slen;
 165                                 char symlink[MAXPATHLEN];
 166
 167                                 if (symlinks++ > MAXSYMLINKS) {
 168                                         errno = ELOOP;
 169                                         return (NULL);
 170                                 }
 171                                 slen = readlink(resolved, symlink, sizeof(symlink) - 1);
 172                                 if (slen < 0)
 173                                         return (NULL);
 174                                 symlink[slen] = '\0';
 175                                 if (symlink[0] == '/') {
 176                                         resolved[1] = 0;
 177                                         resolved_len = 1;
 178                                 } else if (resolved_len > 1) {
 179                                         /* Strip the last path component. */
 180                                         resolved[resolved_len - 1] = '\0';
 181                                         q = strrchr(resolved, '/') + 1;
 182                                         *q = '\0';
 183                                         resolved_len = q - resolved;
 184                                 }
 185
 186         /*
 187                                  * If there are any path components left, then
 188                                  * append them to symlink. The result is placed
 189                                  * in 'left'.
 190          */
 191                                 if (p != NULL) {
 192                                         if (symlink[slen - 1] != '/') {
 193                                                 if ((STRLEN)(slen + 1) >= (STRLEN)sizeof(symlink)) {
 194                                                         errno = ENAMETOOLONG;
 195                                                         return (NULL);
 196                                                 }
 197                                                 symlink[slen] = '/';
 198                                                 symlink[slen + 1] = 0;
 199                                         }
 200                                         left_len = my_strlcat(symlink, left, sizeof(left));
 201                                         if (left_len >= sizeof(left)) {
 202                                                 errno = ENAMETOOLONG;
 203                                                 return (NULL);
 204                                         }
 205                                 }
 206                                 left_len = my_strlcpy(left, symlink, sizeof(left));
 207                         }
 208                 }
 209 #endif
 210         }
 211
 212         /*
 213          * Remove trailing slash except when the resolved pathname
 214          * is a single "/".
 215          */
 216         if (resolved_len > 1 && resolved[resolved_len - 1] == '/')
 217                 resolved[resolved_len - 1] = '\0';
 218         return (resolved);
 219 }
 220 #endif
 221
 222 #ifndef SV_CWD_RETURN_UNDEF
 223 #define SV_CWD_RETURN_UNDEF \
 224 sv_setsv(sv, &PL_sv_undef); \
 225 return FALSE
 226 #endif
 227
 228 #ifndef OPpENTERSUB_HASTARG
 229 #define OPpENTERSUB_HASTARG     32      /* Called from OP tree. */
 230 #endif
 231
 232 #ifndef dXSTARG
 233 #define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
 234                              ? PAD_SV(PL_op->op_targ) : sv_newmortal())
 235 #endif
 236
 237 #ifndef XSprePUSH
 238 #define XSprePUSH (sp = PL_stack_base + ax - 1)
 239 #endif
 240
 241 #ifndef SV_CWD_ISDOT
 242 #define SV_CWD_ISDOT(dp) \
 243     (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \
 244         (dp->d_name[1] == '.' && dp->d_name[2] == '\0')))
 245 #endif
 246
 247 #ifndef getcwd_sv
 248 /* Taken from perl 5.8's util.c */
 249 #define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
 250 int Perl_getcwd_sv(pTHX_ SV *sv)
 251 {
 252 #ifndef PERL_MICRO
 253
 254 #ifndef INCOMPLETE_TAINTS
 255     SvTAINTED_on(sv);
 256 #endif
 257
 258 #ifdef HAS_GETCWD
 259     {
 260         char buf[MAXPATHLEN];
 261
 262         /* Some getcwd()s automatically allocate a buffer of the given
 263          * size from the heap if they are given a NULL buffer pointer.
 264          * The problem is that this behaviour is not portable. */
 265         if (getcwd(buf, sizeof(buf) - 1)) {
 266             STRLEN len = strlen(buf);
 267             sv_setpvn(sv, buf, len);
 268             return TRUE;
 269         }
 270         else {
 271             sv_setsv(sv, &PL_sv_undef);
 272             return FALSE;
 273         }
 274     }
 275
 276 #else
 277   {
 278     Stat_t statbuf;
 279     int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
 280     int namelen, pathlen=0;
 281     DIR *dir;
 282     Direntry_t *dp;
 283
 284     (void)SvUPGRADE(sv, SVt_PV);
 285
 286     if (PerlLIO_lstat(".", &statbuf) < 0) {
 287         SV_CWD_RETURN_UNDEF;
 288     }
 289
 290     orig_cdev = statbuf.st_dev;
 291     orig_cino = statbuf.st_ino;
 292     cdev = orig_cdev;
 293     cino = orig_cino;
 294
 295     for (;;) {
 296         odev = cdev;
 297         oino = cino;
 298
 299         if (PerlDir_chdir("..") < 0) {
 300             SV_CWD_RETURN_UNDEF;
 301         }
 302         if (PerlLIO_stat(".", &statbuf) < 0) {
 303             SV_CWD_RETURN_UNDEF;
 304         }
 305
 306         cdev = statbuf.st_dev;
 307         cino = statbuf.st_ino;
 308
 309         if (odev == cdev && oino == cino) {
 310             break;
 311         }
 312         if (!(dir = PerlDir_open("."))) {
 313             SV_CWD_RETURN_UNDEF;
 314         }
 315
 316         while ((dp = PerlDir_read(dir)) != NULL) {
 317 #ifdef DIRNAMLEN
 318             namelen = dp->d_namlen;
 319 #else
 320             namelen = strlen(dp->d_name);
 321 #endif
 322             /* skip . and .. */
 323             if (SV_CWD_ISDOT(dp)) {
 324                 continue;
 325             }
 326
 327             if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) {
 328                 SV_CWD_RETURN_UNDEF;
 329             }
 330
 331             tdev = statbuf.st_dev;
 332             tino = statbuf.st_ino;
 333             if (tino == oino && tdev == odev) {
 334                 break;
 335             }
 336         }
 337
 338         if (!dp) {
 339             SV_CWD_RETURN_UNDEF;
 340         }
 341
 342         if (pathlen + namelen + 1 >= MAXPATHLEN) {
 343             SV_CWD_RETURN_UNDEF;
 344         }
 345
 346         SvGROW(sv, pathlen + namelen + 1);
 347
 348         if (pathlen) {
 349             /* shift down */
 350             Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
 351         }
 352
 353         /* prepend current directory to the front */
 354         *SvPVX(sv) = '/';
 355         Move(dp->d_name, SvPVX(sv)+1, namelen, char);
 356         pathlen += (namelen + 1);
 357
 358 #ifdef VOID_CLOSEDIR
 359         PerlDir_close(dir);
 360 #else
 361         if (PerlDir_close(dir) < 0) {
 362             SV_CWD_RETURN_UNDEF;
 363         }
 364 #endif
 365     }
 366
 367     if (pathlen) {
 368         SvCUR_set(sv, pathlen);
 369         *SvEND(sv) = '\0';
 370         SvPOK_only(sv);
 371
 372         if (PerlDir_chdir(SvPVX(sv)) < 0) {
 373             SV_CWD_RETURN_UNDEF;
 374         }
 375     }
 376     if (PerlLIO_stat(".", &statbuf) < 0) {
 377         SV_CWD_RETURN_UNDEF;
 378     }
 379
 380     cdev = statbuf.st_dev;
 381     cino = statbuf.st_ino;
 382
 383     if (cdev != orig_cdev || cino != orig_cino) {
 384         Perl_croak(aTHX_ "Unstable directory path, "
 385                    "current directory changed unexpectedly");
 386     }
 387
 388     return TRUE;
 389   }
 390 #endif
 391
 392 #else
 393     return FALSE;
 394 #endif
 395 }
 396
 397 #endif
 398
 399 #if defined(START_MY_CXT) && defined(MY_CXT_CLONE)
 400 # define USE_MY_CXT 1
 401 #else
 402 # define USE_MY_CXT 0
 403 #endif
 404
 405 #if USE_MY_CXT
 406 # define MY_CXT_KEY "Cwd::_guts"XS_VERSION
 407 typedef struct {
 408     SV *empty_string_sv, *slash_string_sv;
 409 } my_cxt_t;
 410 START_MY_CXT
 411 # define dUSE_MY_CXT dMY_CXT
 412 # define EMPTY_STRING_SV MY_CXT.empty_string_sv
 413 # define SLASH_STRING_SV MY_CXT.slash_string_sv
 414 # define POPULATE_MY_CXT do { \
 415         MY_CXT.empty_string_sv = newSVpvs(""); \
 416         MY_CXT.slash_string_sv = newSVpvs("/"); \
 417     } while(0)
 418 #else
 419 # define dUSE_MY_CXT dNOOP
 420 # define EMPTY_STRING_SV sv_2mortal(newSVpvs(""))
 421 # define SLASH_STRING_SV sv_2mortal(newSVpvs("/"))
 422 #endif
 423
 424 #define invocant_is_unix(i) THX_invocant_is_unix(aTHX_ i)
 425 static
 426 bool
 427 THX_invocant_is_unix(pTHX_ SV *invocant)
 428 {
 429     /*
 430      * This is used to enable optimisations that avoid method calls
 431      * by knowing how they would resolve.  False negatives, disabling
 432      * the optimisation where it would actually behave correctly, are
 433      * acceptable.
 434      */
 435     return SvPOK(invocant) && SvCUR(invocant) == 16 &&
 436         !memcmp(SvPVX(invocant), "File::Spec::Unix", 16);
 437 }
 438
 439 #define unix_canonpath(p) THX_unix_canonpath(aTHX_ p)
 440 static
 441 SV *
 442 THX_unix_canonpath(pTHX_ SV *path)
 443 {
 444     SV *retval;
 445     char const *p, *pe, *q;
 446     STRLEN l;
 447     char *o;
 448     STRLEN plen;
 449     SvGETMAGIC(path);
 450     if(!SvOK(path)) return &PL_sv_undef;
 451     p = SvPV_nomg(path, plen);
 452     if(plen == 0) return newSVpvs("");
 453     pe = p + plen;
 454     retval = newSV(plen);
 455 #ifdef SvUTF8
 456     if(SvUTF8(path)) SvUTF8_on(retval);
 457 #endif
 458     o = SvPVX(retval);
 459     if(DOUBLE_SLASHES_SPECIAL && p[0] == '/' && p[1] == '/' && p[2] != '/') {
 460         q = (const char *) memchr(p+2, '/', pe-(p+2));
 461         if(!q) q = pe;
 462         l = q - p;
 463         memcpy(o, p, l);
 464         p = q;
 465         o += l;
 466     }
 467     /*
 468      * The transformations performed here are:
 469      *   . squeeze multiple slashes
 470      *   . eliminate "." segments, except one if that's all there is
 471      *   . eliminate leading ".." segments
 472      *   . eliminate trailing slash, unless it's all there is
 473      */
 474     if(p[0] == '/') {
 475         *o++ = '/';
 476         while(1) {
 477             do { p++; } while(p[0] == '/');
 478             if(p[0] == '.' && p[1] == '.' && (p+2 == pe || p[2] == '/')) {
 479                 p++;
 480                 /* advance past second "." next time round loop */
 481             } else if(p[0] == '.' && (p+1 == pe || p[1] == '/')) {
 482                 /* advance past "." next time round loop */
 483             } else {
 484                 break;
 485             }
 486         }
 487     } else if(p[0] == '.' && p[1] == '/') {
 488         do {
 489             p++;
 490             do { p++; } while(p[0] == '/');
 491         } while(p[0] == '.' && p[1] == '/');
 492         if(p == pe) *o++ = '.';
 493     }
 494     if(p == pe) goto end;
 495     while(1) {
 496         q = (const char *) memchr(p, '/', pe-p);
 497         if(!q) q = pe;
 498         l = q - p;
 499         memcpy(o, p, l);
 500         p = q;
 501         o += l;
 502         if(p == pe) goto end;
 503         while(1) {
 504             do { p++; } while(p[0] == '/');
 505             if(p == pe) goto end;
 506             if(p[0] != '.') break;
 507             if(p+1 == pe) goto end;
 508             if(p[1] != '/') break;
 509             p++;
 510         }
 511         *o++ = '/';
 512     }
 513     end: ;
 514     *o = 0;
 515     SvPOK_on(retval);
 516     SvCUR_set(retval, o - SvPVX(retval));
 517     return retval;
 518 }
 519
 520 MODULE = Cwd            PACKAGE = Cwd
 521
 522 PROTOTYPES: DISABLE
 523
 524 BOOT:
 525 #if USE_MY_CXT
 526 {
 527     MY_CXT_INIT;
 528     POPULATE_MY_CXT;
 529 }
 530 #endif
 531
 532 #if USE_MY_CXT
 533
 534 void
 535 CLONE(...)
 536 CODE:
 537         PERL_UNUSED_VAR(items);
 538         { MY_CXT_CLONE; POPULATE_MY_CXT; }
 539
 540 #endif
 541
 542 void
 543 getcwd(...)
 544 ALIAS:
 545     fastcwd=1
 546 PPCODE:
 547 {
 548     dXSTARG;
 549     /* fastcwd takes zero parameters:  */
 550     if (ix == 1 && items != 0)
 551         croak_xs_usage(cv,  "");
 552     getcwd_sv(TARG);
 553     XSprePUSH; PUSHTARG;
 554 #ifndef INCOMPLETE_TAINTS
 555     SvTAINTED_on(TARG);
 556 #endif
 557 }
 558
 559 void
 560 abs_path(pathsv=Nullsv)
 561     SV *pathsv
 562 PPCODE:
 563 {
 564     dXSTARG;
 565     char *const path = pathsv ? SvPV_nolen(pathsv) : (char *)".";
 566     char buf[MAXPATHLEN];
 567
 568     if (
 569 #ifdef VMS
 570         Perl_rmsexpand(aTHX_ path, buf, NULL, 0)
 571 #else
 572         bsd_realpath(path, buf)
 573 #endif
 574     ) {
 575         sv_setpv_mg(TARG, buf);
 576         SvPOK_only(TARG);
 577         SvTAINTED_on(TARG);
 578     }
 579     else
 580         sv_setsv(TARG, &PL_sv_undef);
 581
 582     XSprePUSH; PUSHs(TARG);
 583 #ifndef INCOMPLETE_TAINTS
 584     SvTAINTED_on(TARG);
 585 #endif
 586 }
 587
 588 #if defined(WIN32) && !defined(UNDER_CE)
 589
 590 void
 591 getdcwd(...)
 592 PROTOTYPE: ENABLE
 593 PPCODE:
 594 {
 595     dXSTARG;
 596     int drive;
 597     char *dir;
 598
 599     /* Drive 0 is the current drive, 1 is A:, 2 is B:, 3 is C: and so on. */
 600     if ( items == 0 ||
 601         (items == 1 && (!SvOK(ST(0)) || (SvPOK(ST(0)) && !SvCUR(ST(0))))))
 602         drive = 0;
 603     else if (items == 1 && SvPOK(ST(0)) && SvCUR(ST(0)) &&
 604              isALPHA(SvPVX(ST(0))[0]))
 605         drive = toUPPER(SvPVX(ST(0))[0]) - 'A' + 1;
 606     else
 607         croak("Usage: getdcwd(DRIVE)");
 608
 609     New(0,dir,MAXPATHLEN,char);
 610     if (_getdcwd(drive, dir, MAXPATHLEN)) {
 611         sv_setpv_mg(TARG, dir);
 612         SvPOK_only(TARG);
 613     }
 614     else
 615         sv_setsv(TARG, &PL_sv_undef);
 616
 617     Safefree(dir);
 618
 619     XSprePUSH; PUSHs(TARG);
 620 #ifndef INCOMPLETE_TAINTS
 621     SvTAINTED_on(TARG);
 622 #endif
 623 }
 624
 625 #endif
 626
 627 MODULE = Cwd            PACKAGE = File::Spec::Unix
 628
 629 SV *
 630 canonpath(SV *self, SV *path = &PL_sv_undef, ...)
 631 CODE:
 632     PERL_UNUSED_VAR(self);
 633     RETVAL = unix_canonpath(path);
 634 OUTPUT:
 635     RETVAL
 636
 637 SV *
 638 _fn_canonpath(SV *path = &PL_sv_undef, ...)
 639 CODE:
 640     RETVAL = unix_canonpath(path);
 641 OUTPUT:
 642     RETVAL
 643
 644 SV *
 645 catdir(SV *self, ...)
 646 PREINIT:
 647     dUSE_MY_CXT;
 648     SV *joined;
 649 CODE:
 650     EXTEND(SP, items+1);
 651     ST(items) = EMPTY_STRING_SV;
 652     joined = sv_newmortal();
 653     do_join(joined, SLASH_STRING_SV, &ST(0), &ST(items));
 654     if(invocant_is_unix(self)) {
 655         RETVAL = unix_canonpath(joined);
 656     } else {
 657         ENTER;
 658         PUSHMARK(SP);
 659         EXTEND(SP, 2);
 660         PUSHs(self);
 661         PUSHs(joined);
 662         PUTBACK;
 663         call_method("canonpath", G_SCALAR);
 664         SPAGAIN;
 665         RETVAL = POPs;
 666         LEAVE;
 667         SvREFCNT_inc(RETVAL);
 668     }
 669 OUTPUT:
 670     RETVAL
 671
 672 SV *
 673 _fn_catdir(...)
 674 PREINIT:
 675     dUSE_MY_CXT;
 676     SV *joined;
 677 CODE:
 678     EXTEND(SP, items+1);
 679     ST(items) = EMPTY_STRING_SV;
 680     joined = sv_newmortal();
 681     do_join(joined, SLASH_STRING_SV, &ST(-1), &ST(items));
 682     RETVAL = unix_canonpath(joined);
 683 OUTPUT:
 684     RETVAL
 685
 686 SV *
 687 catfile(SV *self, ...)
 688 PREINIT:
 689     dUSE_MY_CXT;
 690 CODE:
 691     if(invocant_is_unix(self)) {
 692         if(items == 1) {
 693             RETVAL = &PL_sv_undef;
 694         } else {
 695             SV *file = unix_canonpath(ST(items-1));
 696             if(items == 2) {
 697                 RETVAL = file;
 698             } else {
 699                 SV *dir = sv_newmortal();
 700                 sv_2mortal(file);
 701                 ST(items-1) = EMPTY_STRING_SV;
 702                 do_join(dir, SLASH_STRING_SV, &ST(0), &ST(items-1));
 703                 RETVAL = unix_canonpath(dir);
 704                 if(SvCUR(RETVAL) == 0 || SvPVX(RETVAL)[SvCUR(RETVAL)-1] != '/')
 705                     sv_catsv(RETVAL, SLASH_STRING_SV);
 706                 sv_catsv(RETVAL, file);
 707             }
 708         }
 709     } else {
 710         SV *file, *dir;
 711         ENTER;
 712         PUSHMARK(SP);
 713         EXTEND(SP, 2);
 714         PUSHs(self);
 715         PUSHs(items == 1 ? &PL_sv_undef : ST(items-1));
 716         PUTBACK;
 717         call_method("canonpath", G_SCALAR);
 718         SPAGAIN;
 719         file = POPs;
 720         LEAVE;
 721         if(items <= 2) {
 722             RETVAL = SvREFCNT_inc(file);
 723         } else {
 724             char const *pv;
 725             STRLEN len;
 726             bool need_slash;
 727             SP--;
 728             ENTER;
 729             PUSHMARK(&ST(-1));
 730             PUTBACK;
 731             call_method("catdir", G_SCALAR);
 732             SPAGAIN;
 733             dir = POPs;
 734             LEAVE;
 735             pv = SvPV(dir, len);
 736             need_slash = len == 0 || pv[len-1] != '/';
 737             RETVAL = newSVsv(dir);
 738             if(need_slash) sv_catsv(RETVAL, SLASH_STRING_SV);
 739             sv_catsv(RETVAL, file);
 740         }
 741     }
 742 OUTPUT:
 743     RETVAL
 744
 745 SV *
 746 _fn_catfile(...)
 747 PREINIT:
 748     dUSE_MY_CXT;
 749 CODE:
 750     if(items == 0) {
 751         RETVAL = &PL_sv_undef;
 752     } else {
 753         SV *file = unix_canonpath(ST(items-1));
 754         if(items == 1) {
 755             RETVAL = file;
 756         } else {
 757             SV *dir = sv_newmortal();
 758             sv_2mortal(file);
 759             ST(items-1) = EMPTY_STRING_SV;
 760             do_join(dir, SLASH_STRING_SV, &ST(-1), &ST(items-1));
 761             RETVAL = unix_canonpath(dir);
 762             if(SvCUR(RETVAL) == 0 || SvPVX(RETVAL)[SvCUR(RETVAL)-1] != '/')
 763                 sv_catsv(RETVAL, SLASH_STRING_SV);
 764             sv_catsv(RETVAL, file);
 765         }
 766     }
 767 OUTPUT:
 768     RETVAL