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
  14 void
  15 Perl_epoc_init(int *argcp, char ***argvp) {
  16   int i;
  17   int truecount=0;
  18   char **lastcp = (*argvp);
  19   char *ptr;
  20
  21 #if 0
  22   epoc_spawn_posix_server();
  23 #endif
  24   for (i=0; i< *argcp; i++) {
  25     if ((*argvp)[i]) {
  26       if (*((*argvp)[i]) == '<') {
  27         if (strlen((*argvp)[i]) > 1) {
  28           ptr =((*argvp)[i])+1;
  29         } else {
  30           i++;
  31           ptr = ((*argvp)[i]);
  32         }
  33         freopen(  ptr, "r", stdin);
  34       } else if (*((*argvp)[i]) == '>') {
  35         if (strlen((*argvp)[i]) > 1) {
  36           ptr =((*argvp)[i])+1;
  37         } else {
  38           i++;
  39           ptr = ((*argvp)[i]);
  40         }
  41         freopen(  ptr, "w", stdout);
  42       } else if ((*((*argvp)[i]) == '2') && (*(((*argvp)[i])+1) == '>')) {
  43         if (strcmp( (*argvp)[i], "2>&1") == 0) {
  44           dup2( fileno( stdout), fileno( stderr));
  45         } else {
  46           if (strlen((*argvp)[i]) > 2) {
  47             ptr =((*argvp)[i])+2;
  48           } else {
  49             i++;
  50             ptr = ((*argvp)[i]);
  51           }
  52           freopen(  ptr, "w", stderr);
  53         }
  54       } else {
  55         *lastcp++ = (*argvp)[i];
  56         truecount++;
  57       }
  58     }
  59   }
  60   *argcp=truecount;
  61
  62
  63 }
  64
  65
  66 #ifdef __MARM__
  67 /* Symbian forgot to include __fixunsdfi into the MARM euser.lib */
  68 /* This is from libgcc2.c , gcc-2.7.2.3                          */
  69
  70 typedef unsigned int UQItype    __attribute__ ((mode (QI)));
  71 typedef          int SItype     __attribute__ ((mode (SI)));
  72 typedef unsigned int USItype    __attribute__ ((mode (SI)));
  73 typedef          int DItype     __attribute__ ((mode (DI)));
  74 typedef unsigned int UDItype    __attribute__ ((mode (DI)));
  75
  76 typedef         float SFtype    __attribute__ ((mode (SF)));
  77 typedef         float DFtype    __attribute__ ((mode (DF)));
  78
  79
  80
  81 extern DItype __fixunssfdi (SFtype a);
  82 extern DItype __fixunsdfdi (DFtype a);
  83
  84
  85 USItype
  86 __fixunsdfsi (a)
  87      DFtype a;
  88 {
  89   if (a >= - (DFtype) (- 2147483647L  -1) )
  90     return (SItype) (a + (- 2147483647L  -1) ) - (- 2147483647L  -1) ;
  91   return (SItype) a;
  92 }
  93
  94 #endif
  95
  96 #include "EXTERN.h"
  97 #include "perl.h"
  98 #include "XSUB.h"
  99
 100 int
 101 do_spawn( char *cmd) {
 102     dTHX;
 103     char *argv0, *ptr;
 104     char *cmdptr = cmd;
 105     int ret;
 106
 107     argv0 = ptr = malloc( strlen(cmd) + 1);
 108
 109     while (*cmdptr && !isSPACE( *cmdptr)) {
 110       *ptr = *cmdptr;
 111       if (*ptr == '/') {
 112         *ptr = '\\';
 113       }
 114       ptr++; cmdptr++;
 115     }
 116     while (*cmdptr && isSPACE( *cmdptr)) {
 117       cmdptr++;
 118     }
 119     *ptr = '\0';
 120     ret = epoc_spawn( argv0, cmdptr);
 121     free( argv0);
 122     return ret;
 123 }
 124
 125 int
 126 do_aspawn ( void *vreally, void **vmark, void **vsp) {
 127
 128     dTHX;
 129
 130     SV *really = (SV*)vreally;
 131     SV **mark = (SV**)vmark;
 132     SV **sp = (SV**)vsp;
 133
 134     char **argv;
 135     char *str;
 136     char *p2, **ptr;
 137     char *cmd, *cmdline;
 138
 139
 140     int  rc;
 141     int index = 0;
 142     int len = 0;
 143
 144     if (sp<=mark)
 145       return -1;
 146
 147     ptr = argv =(char**) malloc ((sp-mark+3)*sizeof (char*));
 148
 149     while (++mark <= sp) {
 150       if (*mark && (str = SvPV_nolen(*mark)))
 151         argv[index] = str;
 152       else
 153         argv[index] = "";
 154
 155       len += strlen(argv[ index++]) + 1;
 156     }
 157     argv[index++] = 0;
 158
 159     cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0]));
 160
 161     for (p2=cmd; *p2 != '\0'; p2++) {
 162       /* Change / to \ */
 163       if ( *p2 == '/')
 164         *p2 = '\\';
 165     }
 166
 167     cmdline = (char * ) malloc( len + 1);
 168     cmdline[ 0] = '\0';
 169     while (*argv != NULL) {
 170       strcat( cmdline, *ptr++);
 171       strcat( cmdline, " ");
 172     }
 173
 174     free( argv);
 175
 176     rc = epoc_spawn( cmd, cmdline);
 177     free( cmdline);
 178     free( cmd);
 179
 180     return rc;
 181 }
 182
 183 static
 184 XS(epoc_getcwd)   /* more or less stolen from win32.c */
 185 {
 186     dXSARGS;
 187     /* Make the host for current directory */
 188     char *buffer;
 189     int buflen = 256;
 190
 191     char *ptr;
 192     buffer = (char *) malloc( buflen);
 193     if (buffer == NULL) {
 194       XSRETURN_UNDEF;
 195     }
 196     while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) {
 197       buflen *= 2;
 198       if (NULL == realloc( buffer, buflen)) {
 199          XSRETURN_UNDEF;
 200       }
 201
 202     }
 203
 204     /*
 205      * If ptr != Nullch
 206      *   then it worked, set PV valid,
 207      *   else return 'undef'
 208      */
 209
 210     if (ptr) {
 211         SV *sv = sv_newmortal();
 212         char *tptr;
 213
 214         for (tptr = ptr; *tptr != '\0'; tptr++) {
 215           if (*tptr == '\\') {
 216             *tptr = '/';
 217           }
 218         }
 219         sv_setpv(sv, ptr);
 220         free( buffer);
 221
 222         EXTEND(SP,1);
 223         SvPOK_on(sv);
 224         ST(0) = sv;
 225 #ifndef INCOMPLETE_TAINTS
 226         SvTAINTED_on(ST(0));
 227 #endif
 228         XSRETURN(1);
 229     }
 230     free( buffer);
 231     XSRETURN_UNDEF;
 232 }
 233
 234
 235 void
 236 Perl_init_os_extras(void)
 237 {
 238   dTHX;
 239   char *file = __FILE__;
 240   newXS("EPOC::getcwd", epoc_getcwd, file);
 241 }
 242
 243 void
 244 Perl_my_setenv(pTHX_ char *nam,char *val) {
 245   setenv( nam, val, 1);
 246 }