X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=epoc%2Fepoc.c;h=d580552ae99a4778a45033bb527eb2b76a324727;hb=c74ace89800a81a764294e9f6eacc04bbed5a568;hp=a7c7e1090b6140c196a3d15edcf10c64576dc04f;hpb=4d2c4e078e0d58f7b5fd54b2aedc642bb9296f6e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/epoc/epoc.c b/epoc/epoc.c
index a7c7e10..d580552 100644
--- a/epoc/epoc.c
+++ b/epoc/epoc.c
@@ -1,61 +1,125 @@
-/* Epoc helper Routines */
+/*
+ *    Copyright (c) 1999 Olaf Flebbe o.flebbe@gmx.de
+ *    
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
 
 #include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <sys/unistd.h>
+#include <process.h>
 
-int getgid() {return 0;}
-int getegid() {return 0;}
-int geteuid() {return 0;}
-int getuid() {return 0;}
-int setgid() {return -1;}
-int setuid() {return -1;}
 
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
 
-char *environ;
-
-int Perl_my_popen( int a, int b) {
-	 return 0;
-}
-int Perl_my_pclose( int a) {
-	 return 0;
+int 
+do_spawn( char *cmd) {
+    dTHX;
+    return system( cmd);
 }
 
-kill() {}
-signal() {}
+int
+do_aspawn ( void *vreally, void **vmark, void **vsp) {
 
-void execv() {}
-void execvp() {}
+    dTHX;
 
+    SV *really = (SV*)vreally;
+    SV **mark = (SV**)vmark;
+    SV **sp = (SV**)vsp;
 
-void do_spawn() {}
-void do_aspawn() {}
-void Perl_do_exec() {}
+    char **argv;
+    char *str;
+    char *p2, **ptr;
+    char *cmd;
 
-#ifdef __MARM__
-/* Symbian forgot to include __fixunsdfi into the MARM euser.lib */
-/* This is from libgcc2.c , gcc-2.7.2.3                          */
 
-typedef unsigned int UQItype	__attribute__ ((mode (QI)));
-typedef 	 int SItype	__attribute__ ((mode (SI)));
-typedef unsigned int USItype	__attribute__ ((mode (SI)));
-typedef		 int DItype	__attribute__ ((mode (DI)));
-typedef unsigned int UDItype	__attribute__ ((mode (DI)));
+    int  rc;
+    int index = 0;
 
-typedef 	float SFtype	__attribute__ ((mode (SF)));
-typedef		float DFtype	__attribute__ ((mode (DF)));
+    if (sp<=mark)
+      return -1;
+    
+    ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*));
+    
+    while (++mark <= sp) {
+      if (*mark && (str = SvPV_nolen(*mark)))
+	argv[index] = str;
+      else
+	argv[index] = "";
+    }
+    argv[index++] = 0;
 
+    cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0]));
 
+    rc = spawnvp( P_WAIT, cmd, argv);
+    free( argv);
+    free( cmd);
 
-extern DItype __fixunssfdi (SFtype a);
-extern DItype __fixunsdfdi (DFtype a);
-
+    return rc;
+}
 
-USItype
-__fixunsdfsi (a)
-     DFtype a;
+static
+XS(epoc_getcwd)   /* more or less stolen from win32.c */
 {
-  if (a >= - (DFtype) (- 2147483647L  -1) )
-    return (SItype) (a + (- 2147483647L  -1) ) - (- 2147483647L  -1) ;
-  return (SItype) a;
+    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;
+#ifndef INCOMPLETE_TAINTS
+	SvTAINTED_on(ST(0));
+#endif
+	XSRETURN(1);
+    }
+    free( buffer);
+    XSRETURN_UNDEF;
+}
+  
+
+void
+Perl_init_os_extras(void)
+{ 
+  dTHX;
+  char *file = __FILE__;
+  newXS("EPOC::getcwd", epoc_getcwd, file);
 }
 
-#endif