The R Project SVN R

Rev

Rev 52804 | Rev 52814 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 52804 Rev 52813
Line 169... Line 169...
169 
#define INTERN_BUFSIZE 8096
 169 
#define INTERN_BUFSIZE 8096
170 
SEXP do_system(SEXP call, SEXP op, SEXP args, SEXP rho)
 170 
SEXP do_system(SEXP call, SEXP op, SEXP args, SEXP rho)
171 
{
 171 
{
172 
    rpipe *fp;
 172 
    rpipe *fp;
173 
    char  buf[INTERN_BUFSIZE];
 173 
    char  buf[INTERN_BUFSIZE];
174 
    int   vis = 0, flag = 2, i = 0, j, ll, ignore_stderr = 0;
 174 
    int   vis = 0, flag = 2, i = 0, j, ll,
- 
 
 175 
	ignore_stdout = 0, ignore_stderr = 0;
175 
    SEXP  tlist = R_NilValue, tchar, rval;
 176 
    SEXP  tlist = R_NilValue, tchar, rval;
176 
    HANDLE hERR = NULL /* -Wall */;
 177 
    HANDLE hOUT = NULL, hERR = NULL /* -Wall */;
177 
 
 178 
 
178 
    checkArity(op, args);
 179 
    checkArity(op, args);
179 
    if (!isString(CAR(args)))
 180 
    if (!isString(CAR(args)))
180 
	errorcall(call, _("character string expected as first argument"));
 181 
	errorcall(call, _("character string expected as first argument"));
181 
    if (isInteger(CADR(args)))
 182 
    if (isInteger(CADR(args)))
182 
	flag = INTEGER(CADR(args))[0];
 183 
	flag = INTEGER(CADR(args))[0];
183 
    if (flag >= 100) {
 184 
    if (flag >= 100) {
184 
	ignore_stderr = 1;
 185 
	ignore_stderr = 1;
185 
	flag -= 100;
 186 
	flag -= 100;
186 
    }
 187 
    }
- 
 
 188 
    if (flag >= 40) {
- 
 
 189 
	ignore_stdout = 1;
- 
 
 190 
	flag -= 40;
- 
 
 191 
    }
187 
    if (flag >= 20) {
 192 
    if (flag >= 20) {
188 
	vis = -1;
 193 
	vis = -1;
189 
	flag -= 20;
 194 
	flag -= 20;
190 
    } else if (flag >= 10) {
 195 
    } else if (flag >= 10) {
191 
	vis = 0;
 196 
	vis = 0;
Line 198... Line 203...
198 
    if (CharacterMode == RGui) {
 203 
    if (CharacterMode == RGui) {
199 
	SetStdHandle(STD_INPUT_HANDLE, INVALID_HANDLE_VALUE);
 204 
	SetStdHandle(STD_INPUT_HANDLE, INVALID_HANDLE_VALUE);
200 
	SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
 205 
	SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
201 
	SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
 206 
	SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
202 
    }
 207 
    }
- 
 
 208 
    if ((CharacterMode != RGui) && ignore_stdout) {
- 
 
 209 
	hOUT = GetStdHandle(STD_OUTPUT_HANDLE) ;
- 
 
 210 
	SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
- 
 
 211 
    }
203 
    if ((CharacterMode != RGui) && ignore_stderr) {
 212 
    if ((CharacterMode != RGui) && ignore_stderr) {
204 
	hERR = GetStdHandle(STD_ERROR_HANDLE) ;
 213 
	hERR = GetStdHandle(STD_ERROR_HANDLE) ;
205 
	SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
 214 
	SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
206 
    }
 215 
    }
207 
    if (flag < 2) {
 216 
    if (flag < 2) { /* Neither intern = TRUE nor
- 
 
 217 
		       show.output.on.console for Rgui */
208 
	ll = runcmd(CHAR(STRING_ELT(CAR(args), 0)),
 218 
	ll = runcmd(CHAR(STRING_ELT(CAR(args), 0)),
209 
		    getCharCE(STRING_ELT(CAR(args), 0)),
 219 
		    getCharCE(STRING_ELT(CAR(args), 0)),
210 
		    flag, vis,
 220 
		    flag, vis,
211 
		    CHAR(STRING_ELT(CADDR(args), 0)));
 221 
		    CHAR(STRING_ELT(CADDR(args), 0)));
212 
	// if (ll == NOLAUNCH) warning(runerror());
 222 
	// if (ll == NOLAUNCH) warning(runerror());
213 
    } else {
 223 
    } else {
- 
 
 224 
	/* read stdout +/- stderr from pipe */
214 
	int m = 0;
 225 
	int m = 0;
215 
	if(flag == 2 /* show on console */ || CharacterMode == RGui) m = 2;
 226 
	if(flag == 2 /* show on console */ || CharacterMode == RGui) m = 2;
216 
	if(ignore_stderr) m = 0;
 227 
	if(ignore_stderr) m = 0;
217 
	fp = rpipeOpen(CHAR(STRING_ELT(CAR(args), 0)),
 228 
	fp = rpipeOpen(CHAR(STRING_ELT(CAR(args), 0)),
218 
		       getCharCE(STRING_ELT(CAR(args), 0)),
 229 
		       getCharCE(STRING_ELT(CAR(args), 0)),
219 
		       vis, CHAR(STRING_ELT(CADDR(args), 0)), m);
 230 
		       vis, CHAR(STRING_ELT(CADDR(args), 0)), m);
220 
	if (!fp) {
 231 
	if (!fp) {
221 
	    /* If we are capturing standard output generate an error */
 232 
	    /* If intern = TRUE generate an error */
222 
	    if (flag == 3) error(runerror());
 233 
	    if (flag == 3) error(runerror());
223 
	    // warning(runerror());
 234 
	    // warning(runerror());
224 
	    ll = NOLAUNCH;
 235 
	    ll = NOLAUNCH;
225 
	} else {
 236 
	} else {
226 
	    if (flag == 3)
 237 
	    /* FIXME: use REPROTECT */
227 
		PROTECT(tlist);
 238 
	    if (flag == 3) PROTECT(tlist);
228 
	    for (i = 0; rpipeGets(fp, buf, INTERN_BUFSIZE); i++) {
 239 
	    for (i = 0; rpipeGets(fp, buf, INTERN_BUFSIZE); i++) {
229 
		if (flag == 3) {
 240 
		if (flag == 3) { /* intern = TRUE */
230 
		    ll = strlen(buf) - 1;
 241 
		    ll = strlen(buf) - 1;
231 
		    if ((ll >= 0) && (buf[ll] == '\n'))
 242 
		    if ((ll >= 0) && (buf[ll] == '\n')) buf[ll] = '\0';
232 
			buf[ll] = '\0';
 - 
 
233 
		    tchar = mkChar(buf);
 243 
		    tchar = mkChar(buf);
234 
		    UNPROTECT(1);
 244 
		    UNPROTECT(1); /* tlist */
235 
		    PROTECT(tlist = CONS(tchar, tlist));
 245 
		    PROTECT(tlist = CONS(tchar, tlist));
236 
		} else
 246 
		} else
237 
		    R_WriteConsole(buf, strlen(buf));
 247 
		    R_WriteConsole(buf, strlen(buf));
238 
	    }
 248 
	    }
239 
	    ll = rpipeClose(fp);
 249 
	    ll = rpipeClose(fp);
240 
	}
 250 
	}
241 
    }
 251 
    }
242 
    if ((CharacterMode != RGui) && ignore_stderr)
 252 
    /* restore stdout/stderr if we changed it */
- 
 
 253 
    if (hOUT) SetStdHandle(STD_OUTPUT_HANDLE, hOUT);
243 
	SetStdHandle(STD_ERROR_HANDLE, hERR);
 254 
    if (hERR) SetStdHandle(STD_ERROR_HANDLE, hERR);
244 
    if (flag == 3) {
 255 
    if (flag == 3) { /* intern = TRUE: convert pairlist to list */
245 
	PROTECT(rval = allocVector(STRSXP, i));
 256 
	PROTECT(rval = allocVector(STRSXP, i));
246 
	for (j = (i - 1); j >= 0; j--) {
 257 
	for (j = (i - 1); j >= 0; j--) {
247 
	    SET_STRING_ELT(rval, j, CAR(tlist));
 258 
	    SET_STRING_ELT(rval, j, CAR(tlist));
248 
	    tlist = CDR(tlist);
 259 
	    tlist = CDR(tlist);
249 
	}
 260 
	}