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
  15
  16 #include "EXTERN.h"
  17 #include "perl.h"
  18 #include "XSUB.h"
  19
  20 int
  21 do_spawn( char *cmd) {
  22     dTHX;
  23     return system( cmd);
  24 }
  25
  26 int
  27 do_aspawn ( void *vreally, void **vmark, void **vsp) {
  28
  29     dTHX;
  30
  31     SV *really = (SV*)vreally;
  32     SV **mark = (SV**)vmark;
  33     SV **sp = (SV**)vsp;
  34
  35     char **argv;
  36     char *str;
  37     char *p2, **ptr;
  38     char *cmd;
  39
  40
  41     int  rc;
  42     int index = 0;
  43
  44     if (sp<=mark)
  45       return -1;
  46
  47     ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*));
  48
  49     while (++mark <= sp) {
  50       if (*mark && (str = SvPV_nolen(*mark)))
  51         argv[index] = str;
  52       else
  53         argv[index] = "";
  54     }
  55     argv[index++] = 0;
  56
  57     cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0]));
  58
  59     rc = spawnvp( P_WAIT, cmd, argv);
  60     free( argv);
  61     free( cmd);
  62
  63     return rc;
  64 }
  65
  66 static
  67 XS(epoc_getcwd)   /* more or less stolen from win32.c */
  68 {
  69     dXSARGS;
  70     /* Make the host for current directory */
  71     char *buffer;
  72     int buflen = 256;
  73
  74     char *ptr;
  75     buffer = (char *) malloc( buflen);
  76     if (buffer == NULL) {
  77       XSRETURN_UNDEF;
  78     }
  79     while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) {
  80       buflen *= 2;
  81       if (NULL == realloc( buffer, buflen)) {
  82          XSRETURN_UNDEF;
  83       }
  84
  85     }
  86
  87     /*
  88      * If ptr != Nullch
  89      *   then it worked, set PV valid,
  90      *   else return 'undef'
  91      */
  92
  93     if (ptr) {
  94         SV *sv = sv_newmortal();
  95         char *tptr;
  96
  97         for (tptr = ptr; *tptr != '\0'; tptr++) {
  98           if (*tptr == '\\') {
  99             *tptr = '/';
 100           }
 101         }
 102         sv_setpv(sv, ptr);
 103         free( buffer);
 104
 105         EXTEND(SP,1);
 106         SvPOK_on(sv);
 107         ST(0) = sv;
 108 #ifndef INCOMPLETE_TAINTS
 109         SvTAINTED_on(ST(0));
 110 #endif
 111         XSRETURN(1);
 112     }
 113     free( buffer);
 114     XSRETURN_UNDEF;
 115 }
 116
 117
 118 void
 119 Perl_init_os_extras(void)
 120 {
 121   dTHX;
 122   char *file = __FILE__;
 123   newXS("EPOC::getcwd", epoc_getcwd, file);
 124 }
 125