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 |