epoc/epoc.c

   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  */
   8
   9 #include <stdlib.h>
  10 #include <string.h>
  11 #include <stdio.h>
  12 #include <sys/unistd.h>
  13 #include <process.h>
  14 #include <emx.h>
  15
  16
  17 #include "EXTERN.h"
  18 #include "perl.h"
  19 #include "XSUB.h"
  20
  21 int
  22 do_spawn( char *cmd) {
  23     dTHX;
  24     return system( cmd);
  25 }
  26
  27 int
  28 do_aspawn ( void *vreally, void **vmark, void **vsp) {
  29
  30     dTHX;
  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;
  39     char *cmd;
  40
  41
  42     int  rc;
  43     int index = 0;
  44
  45     if (sp<=mark)
  46       return -1;
  47
  48     ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*));
  49
  50     while (++mark <= sp) {
  51       if (*mark && (str = SvPV_nolen(*mark)))
  52         argv[index] = str;
  53       else
  54         argv[index] = "";
  55     }
  56     argv[index++] = 0;
  57
  58     cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0]));
  59
  60     rc = spawnvp( P_WAIT, cmd, argv);
  61     free( argv);
  62     free( cmd);
  63
  64     return rc;
  65 }
  66
  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;
 109 #ifndef INCOMPLETE_TAINTS
 110         SvTAINTED_on(ST(0));
 111 #endif
 112         XSRETURN(1);
 113     }
 114     free( buffer);
 115     XSRETURN_UNDEF;
 116 }
 117
 118
 119 void
 120 Perl_init_os_extras(void)
 121 {
 122   dTHX;
 123   char *file = __FILE__;
 124   newXS("EPOC::getcwd", epoc_getcwd, file);
 125 }
 126