dist/PathTools/Cwd.xs

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