Commit | Line | Data |
ae2d1787 |
1 | /* |
2 | * Copyright (c) 1999 Olaf Flebbe o.flebbe@gmx.de |
3 | * |
4 | * You may distribute under the terms of either the GNU General Public |
5 | * License or the Artistic License, as specified in the README file. |
6 | * |
7 | */ |
4d2c4e07 |
8 | |
9 | #include <stdlib.h> |
ae2d1787 |
10 | #include <string.h> |
11 | #include <stdio.h> |
12 | #include <sys/unistd.h> |
85ca448a |
13 | #include <process.h> |
2585f9a3 |
14 | #include <emx.h> |
ae2d1787 |
15 | |
ed79a026 |
16 | |
3a2f06e9 |
17 | #include "EXTERN.h" |
18 | #include "perl.h" |
19 | #include "XSUB.h" |
20 | |
21 | int |
d5ff79b3 |
22 | do_spawn( char *cmd) { |
acfe0abc |
23 | dTHX; |
85ca448a |
24 | return system( cmd); |
3a2f06e9 |
25 | } |
26 | |
27 | int |
d5ff79b3 |
28 | do_aspawn ( void *vreally, void **vmark, void **vsp) { |
29 | |
acfe0abc |
30 | dTHX; |
d5ff79b3 |
31 | |
32 | SV *really = (SV*)vreally; |
33 | SV **mark = (SV**)vmark; |
34 | SV **sp = (SV**)vsp; |
35 | |
36 | char **argv; |
37 | char *str; |
38 | char *p2, **ptr; |
85ca448a |
39 | char *cmd; |
d5ff79b3 |
40 | |
41 | |
3a2f06e9 |
42 | int rc; |
d5ff79b3 |
43 | int index = 0; |
3a2f06e9 |
44 | |
45 | if (sp<=mark) |
46 | return -1; |
47 | |
d5ff79b3 |
48 | ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*)); |
3a2f06e9 |
49 | |
50 | while (++mark <= sp) { |
d5ff79b3 |
51 | if (*mark && (str = SvPV_nolen(*mark))) |
52 | argv[index] = str; |
3a2f06e9 |
53 | else |
d5ff79b3 |
54 | argv[index] = ""; |
3a2f06e9 |
55 | } |
d5ff79b3 |
56 | argv[index++] = 0; |
3a2f06e9 |
57 | |
d5ff79b3 |
58 | cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0])); |
59 | |
2585f9a3 |
60 | rc = spawnvp( P_WAIT, cmd, argv); |
d5ff79b3 |
61 | free( argv); |
d5ff79b3 |
62 | free( cmd); |
63 | |
3a2f06e9 |
64 | return rc; |
65 | } |
66 | |
ed79a026 |
67 | static |
68 | XS(epoc_getcwd) /* more or less stolen from win32.c */ |
69 | { |
70 | dXSARGS; |
71 | /* Make the host for current directory */ |
72 | char *buffer; |
73 | int buflen = 256; |
74 | |
75 | char *ptr; |
76 | buffer = (char *) malloc( buflen); |
77 | if (buffer == NULL) { |
78 | XSRETURN_UNDEF; |
79 | } |
80 | while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) { |
81 | buflen *= 2; |
82 | if (NULL == realloc( buffer, buflen)) { |
83 | XSRETURN_UNDEF; |
84 | } |
85 | |
86 | } |
87 | |
88 | /* |
89 | * If ptr != Nullch |
90 | * then it worked, set PV valid, |
91 | * else return 'undef' |
92 | */ |
93 | |
94 | if (ptr) { |
95 | SV *sv = sv_newmortal(); |
96 | char *tptr; |
97 | |
98 | for (tptr = ptr; *tptr != '\0'; tptr++) { |
99 | if (*tptr == '\\') { |
100 | *tptr = '/'; |
101 | } |
102 | } |
103 | sv_setpv(sv, ptr); |
104 | free( buffer); |
105 | |
106 | EXTEND(SP,1); |
107 | SvPOK_on(sv); |
108 | ST(0) = sv; |
ebdd4fa0 |
109 | #ifndef INCOMPLETE_TAINTS |
110 | SvTAINTED_on(ST(0)); |
111 | #endif |
ed79a026 |
112 | XSRETURN(1); |
113 | } |
114 | free( buffer); |
115 | XSRETURN_UNDEF; |
116 | } |
117 | |
118 | |
119 | void |
120 | Perl_init_os_extras(void) |
121 | { |
acfe0abc |
122 | dTHX; |
ed79a026 |
123 | char *file = __FILE__; |
124 | newXS("EPOC::getcwd", epoc_getcwd, file); |
125 | } |
126 | |