#include <stdio.h>
#include <sys/unistd.h>
-char *environ = NULL;
void
Perl_epoc_init(int *argcp, char ***argvp) {
int i;
}
+
#ifdef __MARM__
/* Symbian forgot to include __fixunsdfi into the MARM euser.lib */
/* This is from libgcc2.c , gcc-2.7.2.3 */
}
#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int
+do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) {
+ return do_spawn( really, mark, sp);
+}
+
+int
+do_spawn (pTHX_ SV *really,SV **mark,SV **sp)
+{
+ dTHR;
+ int rc;
+ char **a,*cmd,**ptr, *cmdline, **argv, *p2;
+ STRLEN n_a;
+ size_t len = 0;
+
+ if (sp<=mark)
+ return -1;
+
+ a=argv=ptr=(char**) malloc ((sp-mark+3)*sizeof (char*));
+
+ while (++mark <= sp) {
+ if (*mark)
+ *a = SvPVx(*mark, n_a);
+ else
+ *a = "";
+ len += strlen( *a) + 1;
+ a++;
+ }
+ *a = Nullch;
+
+ if (!(really && *(cmd = SvPV(really, n_a)))) {
+ cmd = argv[0];
+ argv++;
+ }
+
+ cmdline = (char * ) malloc( len + 1);
+ cmdline[ 0] = '\0';
+ while (*argv != NULL) {
+ strcat( cmdline, *argv++);
+ strcat( cmdline, " ");
+ }
+
+ for (p2=cmd; *p2 != '\0'; p2++) {
+ /* Change / to \ */
+ if ( *p2 == '/')
+ *p2 = '\\';
+ }
+ rc = epoc_spawn( cmd, cmdline);
+ free( ptr);
+ free( cmdline);
+
+ return rc;
+}
+
+static
+XS(epoc_getcwd) /* more or less stolen from win32.c */
+{
+ dXSARGS;
+ /* Make the host for current directory */
+ char *buffer;
+ int buflen = 256;
+
+ char *ptr;
+ buffer = (char *) malloc( buflen);
+ if (buffer == NULL) {
+ XSRETURN_UNDEF;
+ }
+ while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) {
+ buflen *= 2;
+ if (NULL == realloc( buffer, buflen)) {
+ XSRETURN_UNDEF;
+ }
+
+ }
+
+ /*
+ * If ptr != Nullch
+ * then it worked, set PV valid,
+ * else return 'undef'
+ */
+
+ if (ptr) {
+ SV *sv = sv_newmortal();
+ char *tptr;
+
+ for (tptr = ptr; *tptr != '\0'; tptr++) {
+ if (*tptr == '\\') {
+ *tptr = '/';
+ }
+ }
+ sv_setpv(sv, ptr);
+ free( buffer);
+
+ EXTEND(SP,1);
+ SvPOK_on(sv);
+ ST(0) = sv;
+ XSRETURN(1);
+ }
+ free( buffer);
+ XSRETURN_UNDEF;
+}
+
+
+void
+Perl_init_os_extras(void)
+{
+ dTHXo;
+ char *file = __FILE__;
+ newXS("EPOC::getcwd", epoc_getcwd, file);
+}
+
+void
+Perl_my_setenv(pTHX_ char *nam,char *val) {
+ setenv( nam, val, 1);
+}