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 |