[p5sagit/p5-mst-13.2.git] / epoc / epoc.c

/*
 *    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 <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <sys/unistd.h>
#include <process.h>


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