LXR perl/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
  20int 
  21do_spawn( char *cmd) {
  22    dTHX;
  23    return system( cmd);
  24}
  25
  26int
  27do_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
  66static
  67XS(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 != NULL 
  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
 118void
 119Perl_init_os_extras(void)
 120{ 
 121  dTHX;
 122  char *file = __FILE__;
 123  newXS("EPOC::getcwd", epoc_getcwd, file);
 124}
 125
 126