File Coverage

Cwd.xs
Criterion Covered Total %
statement 196 226 86.7
branch 154 204 75.4
condition n/a
subroutine n/a
pod n/a
total 350 430 81.4


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