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