The R Project SVN R

Rev

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

Rev 52813 Rev 52814
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,
174 
    const char *fout = "", *ferr = "";
175 
	ignore_stdout = 0, ignore_stderr = 0;
 175 
    int   vis = 0, flag = 2, i = 0, j, ll;
176 
    SEXP  tlist = R_NilValue, tchar, rval;
 176 
    SEXP  cmd, fin, Stdout, Stderr, tlist = R_NilValue, tchar, rval;
177 
    HANDLE hOUT = NULL, hERR = NULL /* -Wall */;
 177 
    HANDLE hOUT = NULL, hERR = NULL /* -Wall */;
178 
 
 178 
 
179 
    checkArity(op, args);
 179 
    checkArity(op, args);
180 
    if (!isString(CAR(args)))
 180 
    cmd = CAR(args);
- 
 
 181 
    if (!isString(cmd) || LENGTH(cmd) != 1)
181 
	errorcall(call, _("character string expected as first argument"));
 182 
	errorcall(call, _("character string expected as first argument"));
182 
    if (isInteger(CADR(args)))
 183 
    args = CDR(args);
183 
	flag = INTEGER(CADR(args))[0];
 184 
    flag = asInteger(CAR(args)); args = CDR(args);
184 
    if (flag >= 100) {
 185 
    if (flag >= 20) {vis = -1; flag -= 20;}
185 
	ignore_stderr = 1;
 - 
 
186 
	flag -= 100;
 - 
 
187 
    }
 - 
 
188 
    if (flag >= 40) {
 186 
    else if (flag >= 10) {vis = 0; flag -= 10;}
189 
	ignore_stdout = 1;
 187 
    else vis = 1;
190 
	flag -= 40;
 - 
 
191 
    }
 188 
 
192 
    if (flag >= 20) {
 189 
    fin = CAR(args);
193 
	vis = -1;
 - 
 
194 
	flag -= 20;
 - 
 
195 
    } else if (flag >= 10) {
 - 
 
196 
	vis = 0;
 - 
 
197 
	flag -= 10;
 - 
 
198 
    } else
 - 
 
199 
	vis = 1;
 - 
 
200 
    if (!isString(CADDR(args)))
 190 
    if (!isString(fin))
201 
	errorcall(call, _("character string expected as third argument"));
 191 
	errorcall(call, _("character string expected as third argument"));
- 
 
 192 
    args = CDR(args);
- 
 
 193 
    Stdout = CAR(args);
- 
 
 194 
    args = CDR(args);
202 
    if ((CharacterMode != RGui) && (flag == 2)) flag = 1;
 195 
    Stderr = CAR(args);
- 
 
 196 
 
203 
    if (CharacterMode == RGui) {
 197 
    if (CharacterMode == RGui) {
204 
	SetStdHandle(STD_INPUT_HANDLE, INVALID_HANDLE_VALUE);
 198 
	SetStdHandle(STD_INPUT_HANDLE, INVALID_HANDLE_VALUE);
205 
	SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
 199 
	SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
206 
	SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
 200 
	SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
- 
 
 201 
    } else {
- 
 
 202 
	if (flag == 2) flag = 1; /* ignore std.output.on.console */
- 
 
 203 
	if (TYPEOF(Stdout) == STRSXP) {
- 
 
 204 
	    fout = CHAR(STRING_ELT(Stdout, 0));
- 
 
 205 
	} else if (asLogical(Stdout) == 0) {
- 
 
 206 
	    hOUT = GetStdHandle(STD_OUTPUT_HANDLE);
- 
 
 207 
	    SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
- 
 
 208 
	}
- 
 
 209 
	if (TYPEOF(Stderr) == STRSXP) {
- 
 
 210 
	    ferr = CHAR(STRING_ELT(Stderr, 0));
- 
 
 211 
	} else if (asLogical(Stderr) == 0) {
- 
 
 212 
	    hERR = GetStdHandle(STD_ERROR_HANDLE);
- 
 
 213 
	    SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
- 
 
 214 
	}
207 
    }
 215 
    }
208 
    if ((CharacterMode != RGui) && ignore_stdout) {
 - 
 
209 
	hOUT = GetStdHandle(STD_OUTPUT_HANDLE) ;
 - 
 
210 
	SetStdHandle(STD_OUTPUT_HANDLE, INVALID_HANDLE_VALUE);
 - 
 
211 
    }
 216 
 
212 
    if ((CharacterMode != RGui) && ignore_stderr) {
 - 
 
213 
	hERR = GetStdHandle(STD_ERROR_HANDLE) ;
 - 
 
214 
	SetStdHandle(STD_ERROR_HANDLE, INVALID_HANDLE_VALUE);
 - 
 
215 
    }
 - 
 
216 
    if (flag < 2) { /* Neither intern = TRUE nor
217 
    if (flag < 2) { /* Neither intern = TRUE nor
217 
		       show.output.on.console for Rgui */
 218 
		       show.output.on.console for Rgui */
218 
	ll = runcmd(CHAR(STRING_ELT(CAR(args), 0)),
 219 
	ll = runcmd(CHAR(STRING_ELT(cmd, 0)),
219 
		    getCharCE(STRING_ELT(CAR(args), 0)),
 220 
		    getCharCE(STRING_ELT(cmd, 0)),
220 
		    flag, vis,
 - 
 
221 
		    CHAR(STRING_ELT(CADDR(args), 0)));
 221 
		    flag, vis, CHAR(STRING_ELT(fin, 0)), fout, ferr);
222 
	// if (ll == NOLAUNCH) warning(runerror());
 222 
	// if (ll == NOLAUNCH) warning(runerror());
223 
    } else {
 223 
    } else {
224 
	/* read stdout +/- stderr from pipe */
 224 
	/* read stdout +/- stderr from pipe */
225 
	int m = 0;
 225 
	int m = 0;
226 
	if(flag == 2 /* show on console */ || CharacterMode == RGui) m = 2;
 226 
	if(flag == 2 /* show on console */ || CharacterMode == RGui) m = 3;
227 
	if(ignore_stderr) m = 0;
 227 
	if(TYPEOF(Stderr) == LGLSXP)
- 
 
 228 
	    m = asLogical(Stderr) ? 2 : 0;
- 
 
 229 
	if(m  && TYPEOF(Stdout) == LGLSXP && asLogical(Stdout)) m = 3;
228 
	fp = rpipeOpen(CHAR(STRING_ELT(CAR(args), 0)),
 230 
	fp = rpipeOpen(CHAR(STRING_ELT(cmd, 0)),
229 
		       getCharCE(STRING_ELT(CAR(args), 0)),
 231 
		       getCharCE(STRING_ELT(cmd, 0)),
230 
		       vis, CHAR(STRING_ELT(CADDR(args), 0)), m);
 232 
		       vis, CHAR(STRING_ELT(cmd, 0)), m);
231 
	if (!fp) {
 233 
	if (!fp) {
232 
	    /* If intern = TRUE generate an error */
 234 
	    /* If intern = TRUE generate an error */
233 
	    if (flag == 3) error(runerror());
 235 
	    if (flag == 3) error(runerror());
234 
	    // warning(runerror());
 236 
	    // warning(runerror());
235 
	    ll = NOLAUNCH;
 237 
	    ll = NOLAUNCH;
Line 259... Line 261...
259 
	    tlist = CDR(tlist);
 261 
	    tlist = CDR(tlist);
260 
	}
 262 
	}
261 
	UNPROTECT(2);
 263 
	UNPROTECT(2);
262 
	return rval;
 264 
	return rval;
263 
    } else {
 265 
    } else {
264 
	tlist = ScalarInteger(ll);
 266 
	rval = ScalarInteger(ll);
265 
	R_Visible = 0;
 267 
	R_Visible = 0;
266 
	return tlist;
 268 
	return rval;
267 
    }
 269 
    }
268 
}
 270 
}