dist/PathTools/Cwd.xs

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