/* * 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 #include #include #include #include #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int do_spawn( char *cmd) { dTHX; return system( cmd); } int do_aspawn ( void *vreally, void **vmark, void **vsp) { dTHX; SV *really = (SV*)vreally; SV **mark = (SV**)vmark; SV **sp = (SV**)vsp; char **argv; char *str; char *p2, **ptr; char *cmd; 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; 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); }