SYN SYN

[p5sagit/p5-mst-13.2.git] / epoc / epoc.c

diff --git a/epoc/epoc.c b/epoc/epoc.c
index a7c7e10..a2691f3 100644 (file)
--- a/epoc/epoc.c
+++ b/epoc/epoc.c
@@ -1,34 +1,63 @@
-/* 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>
+
+void
+Perl_epoc_init(int *argcp, char ***argvp) {
+  int i;
+  int truecount=0;
+  char **lastcp = (*argvp);
+  char *ptr;
+  for (i=0; i< *argcp; i++) {
+    if ((*argvp)[i]) {
+      if (*((*argvp)[i]) == '<') {
+       if (strlen((*argvp)[i]) > 1) {
+         ptr =((*argvp)[i])+1;
+       } else {
+         i++;
+         ptr = ((*argvp)[i]);
+       }
+       freopen(  ptr, "r", stdin);
+      } else if (*((*argvp)[i]) == '>') {
+       if (strlen((*argvp)[i]) > 1) {
+         ptr =((*argvp)[i])+1;
+       } else {
+         i++;
+         ptr = ((*argvp)[i]);
+       }
+       freopen(  ptr, "w", stdout);
+      } else if ((*((*argvp)[i]) == '2') && (*(((*argvp)[i])+1) == '>')) {
+       if (strcmp( (*argvp)[i], "2>&1") == 0) {
+         dup2( fileno( stdout), fileno( stderr));
+       } else {
+          if (strlen((*argvp)[i]) > 2) {
+            ptr =((*argvp)[i])+2;
+         } else {
+           i++;
+           ptr = ((*argvp)[i]);
+         }
+         freopen(  ptr, "w", stderr);
+       }
+      } else {
+       *lastcp++ = (*argvp)[i];
+       truecount++;
+      }
+    } 
+  }
+  *argcp=truecount;
+      
 
-int getgid() {return 0;}
-int getegid() {return 0;}
-int geteuid() {return 0;}
-int getuid() {return 0;}
-int setgid() {return -1;}
-int setuid() {return -1;}
-
-
-char *environ;
-
-int Perl_my_popen( int a, int b) {
-        return 0;
 }
-int Perl_my_pclose( int a) {
-        return 0;
-}
-
-kill() {}
-signal() {}
 
-void execv() {}
-void execvp() {}
-
-
-void do_spawn() {}
-void do_aspawn() {}
-void Perl_do_exec() {}
 
 #ifdef __MARM__
 /* Symbian forgot to include __fixunsdfi into the MARM euser.lib */
@@ -59,3 +88,122 @@ __fixunsdfsi (a)
 }
 
 #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);
+}