X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=epoc%2Fepoc.c;h=d580552ae99a4778a45033bb527eb2b76a324727;hb=a11019f8bfc1b4438fdb32560361d443c701e293;hp=d0fae23f7ee600441428a37fb789750b073938f9;hpb=ae2d1787751a38d67ea377bb8eb603cbbf3a36bc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/epoc/epoc.c b/epoc/epoc.c index d0fae23..d580552 100644 --- a/epoc/epoc.c +++ b/epoc/epoc.c @@ -10,81 +10,116 @@ #include #include #include +#include -char *environ = NULL; -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; - +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +int +do_spawn( char *cmd) { + dTHX; + return system( cmd); } -#ifdef __MARM__ -/* Symbian forgot to include __fixunsdfi into the MARM euser.lib */ -/* This is from libgcc2.c , gcc-2.7.2.3 */ +int +do_aspawn ( void *vreally, void **vmark, void **vsp) { -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))); + dTHX; -typedef float SFtype __attribute__ ((mode (SF))); -typedef float DFtype __attribute__ ((mode (DF))); + SV *really = (SV*)vreally; + SV **mark = (SV**)vmark; + SV **sp = (SV**)vsp; + char **argv; + char *str; + char *p2, **ptr; + char *cmd; -extern DItype __fixunssfdi (SFtype a); -extern DItype __fixunsdfdi (DFtype a); + int rc; + int index = 0; + 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; -USItype -__fixunsdfsi (a) - DFtype a; -{ - if (a >= - (DFtype) (- 2147483647L -1) ) - return (SItype) (a + (- 2147483647L -1) ) - (- 2147483647L -1) ; - return (SItype) a; + cmd = strdup((const char*)(really ? SvPV_nolen(really) : argv[0])); + + rc = spawnvp( P_WAIT, cmd, argv); + free( argv); + free( cmd); + + 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; +#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); +} +