Mercurial > vba-clojure
comparison src/lua/liolib.c @ 11:27763b933818
raise lua sources up one level
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 03 Mar 2012 11:07:39 -0600 |
parents | src/lua/src/liolib.c@f9f4f1b99eed |
children |
comparison
equal
deleted
inserted
replaced
10:48b74a4e4692 | 11:27763b933818 |
---|---|
1 /* | |
2 ** $Id: liolib.c,v 2.73.1.3 2008/01/18 17:47:43 roberto Exp $ | |
3 ** Standard I/O (and system) library | |
4 ** See Copyright Notice in lua.h | |
5 */ | |
6 | |
7 | |
8 #include <errno.h> | |
9 #include <stdio.h> | |
10 #include <stdlib.h> | |
11 #include <string.h> | |
12 | |
13 #define liolib_c | |
14 #define LUA_LIB | |
15 | |
16 #include "lua.h" | |
17 | |
18 #include "lauxlib.h" | |
19 #include "lualib.h" | |
20 | |
21 | |
22 | |
23 #define IO_INPUT 1 | |
24 #define IO_OUTPUT 2 | |
25 | |
26 | |
27 static const char *const fnames[] = {"input", "output"}; | |
28 | |
29 | |
30 static int pushresult (lua_State *L, int i, const char *filename) { | |
31 int en = errno; /* calls to Lua API may change this value */ | |
32 if (i) { | |
33 lua_pushboolean(L, 1); | |
34 return 1; | |
35 } | |
36 else { | |
37 lua_pushnil(L); | |
38 if (filename) | |
39 lua_pushfstring(L, "%s: %s", filename, strerror(en)); | |
40 else | |
41 lua_pushfstring(L, "%s", strerror(en)); | |
42 lua_pushinteger(L, en); | |
43 return 3; | |
44 } | |
45 } | |
46 | |
47 | |
48 static void fileerror (lua_State *L, int arg, const char *filename) { | |
49 lua_pushfstring(L, "%s: %s", filename, strerror(errno)); | |
50 luaL_argerror(L, arg, lua_tostring(L, -1)); | |
51 } | |
52 | |
53 | |
54 #define tofilep(L) ((FILE **)luaL_checkudata(L, 1, LUA_FILEHANDLE)) | |
55 | |
56 | |
57 static int io_type (lua_State *L) { | |
58 void *ud; | |
59 luaL_checkany(L, 1); | |
60 ud = lua_touserdata(L, 1); | |
61 lua_getfield(L, LUA_REGISTRYINDEX, LUA_FILEHANDLE); | |
62 if (ud == NULL || !lua_getmetatable(L, 1) || !lua_rawequal(L, -2, -1)) | |
63 lua_pushnil(L); /* not a file */ | |
64 else if (*((FILE **)ud) == NULL) | |
65 lua_pushliteral(L, "closed file"); | |
66 else | |
67 lua_pushliteral(L, "file"); | |
68 return 1; | |
69 } | |
70 | |
71 | |
72 static FILE *tofile (lua_State *L) { | |
73 FILE **f = tofilep(L); | |
74 if (*f == NULL) | |
75 luaL_error(L, "attempt to use a closed file"); | |
76 return *f; | |
77 } | |
78 | |
79 | |
80 | |
81 /* | |
82 ** When creating file handles, always creates a `closed' file handle | |
83 ** before opening the actual file; so, if there is a memory error, the | |
84 ** file is not left opened. | |
85 */ | |
86 static FILE **newfile (lua_State *L) { | |
87 FILE **pf = (FILE **)lua_newuserdata(L, sizeof(FILE *)); | |
88 *pf = NULL; /* file handle is currently `closed' */ | |
89 luaL_getmetatable(L, LUA_FILEHANDLE); | |
90 lua_setmetatable(L, -2); | |
91 return pf; | |
92 } | |
93 | |
94 | |
95 /* | |
96 ** function to (not) close the standard files stdin, stdout, and stderr | |
97 */ | |
98 static int io_noclose (lua_State *L) { | |
99 lua_pushnil(L); | |
100 lua_pushliteral(L, "cannot close standard file"); | |
101 return 2; | |
102 } | |
103 | |
104 | |
105 /* | |
106 ** function to close 'popen' files | |
107 */ | |
108 static int io_pclose (lua_State *L) { | |
109 FILE **p = tofilep(L); | |
110 int ok = lua_pclose(L, *p); | |
111 *p = NULL; | |
112 return pushresult(L, ok, NULL); | |
113 } | |
114 | |
115 | |
116 /* | |
117 ** function to close regular files | |
118 */ | |
119 static int io_fclose (lua_State *L) { | |
120 FILE **p = tofilep(L); | |
121 int ok = (fclose(*p) == 0); | |
122 *p = NULL; | |
123 return pushresult(L, ok, NULL); | |
124 } | |
125 | |
126 | |
127 static int aux_close (lua_State *L) { | |
128 lua_getfenv(L, 1); | |
129 lua_getfield(L, -1, "__close"); | |
130 return (lua_tocfunction(L, -1))(L); | |
131 } | |
132 | |
133 | |
134 static int io_close (lua_State *L) { | |
135 if (lua_isnone(L, 1)) | |
136 lua_rawgeti(L, LUA_ENVIRONINDEX, IO_OUTPUT); | |
137 tofile(L); /* make sure argument is a file */ | |
138 return aux_close(L); | |
139 } | |
140 | |
141 | |
142 static int io_gc (lua_State *L) { | |
143 FILE *f = *tofilep(L); | |
144 /* ignore closed files */ | |
145 if (f != NULL) | |
146 aux_close(L); | |
147 return 0; | |
148 } | |
149 | |
150 | |
151 static int io_tostring (lua_State *L) { | |
152 FILE *f = *tofilep(L); | |
153 if (f == NULL) | |
154 lua_pushliteral(L, "file (closed)"); | |
155 else | |
156 lua_pushfstring(L, "file (%p)", f); | |
157 return 1; | |
158 } | |
159 | |
160 | |
161 static int io_open (lua_State *L) { | |
162 const char *filename = luaL_checkstring(L, 1); | |
163 const char *mode = luaL_optstring(L, 2, "r"); | |
164 FILE **pf = newfile(L); | |
165 *pf = fopen(filename, mode); | |
166 return (*pf == NULL) ? pushresult(L, 0, filename) : 1; | |
167 } | |
168 | |
169 | |
170 /* | |
171 ** this function has a separated environment, which defines the | |
172 ** correct __close for 'popen' files | |
173 */ | |
174 static int io_popen (lua_State *L) { | |
175 const char *filename = luaL_checkstring(L, 1); | |
176 const char *mode = luaL_optstring(L, 2, "r"); | |
177 FILE **pf = newfile(L); | |
178 *pf = lua_popen(L, filename, mode); | |
179 return (*pf == NULL) ? pushresult(L, 0, filename) : 1; | |
180 } | |
181 | |
182 | |
183 static int io_tmpfile (lua_State *L) { | |
184 FILE **pf = newfile(L); | |
185 *pf = tmpfile(); | |
186 return (*pf == NULL) ? pushresult(L, 0, NULL) : 1; | |
187 } | |
188 | |
189 | |
190 static FILE *getiofile (lua_State *L, int findex) { | |
191 FILE *f; | |
192 lua_rawgeti(L, LUA_ENVIRONINDEX, findex); | |
193 f = *(FILE **)lua_touserdata(L, -1); | |
194 if (f == NULL) | |
195 luaL_error(L, "standard %s file is closed", fnames[findex - 1]); | |
196 return f; | |
197 } | |
198 | |
199 | |
200 static int g_iofile (lua_State *L, int f, const char *mode) { | |
201 if (!lua_isnoneornil(L, 1)) { | |
202 const char *filename = lua_tostring(L, 1); | |
203 if (filename) { | |
204 FILE **pf = newfile(L); | |
205 *pf = fopen(filename, mode); | |
206 if (*pf == NULL) | |
207 fileerror(L, 1, filename); | |
208 } | |
209 else { | |
210 tofile(L); /* check that it's a valid file handle */ | |
211 lua_pushvalue(L, 1); | |
212 } | |
213 lua_rawseti(L, LUA_ENVIRONINDEX, f); | |
214 } | |
215 /* return current value */ | |
216 lua_rawgeti(L, LUA_ENVIRONINDEX, f); | |
217 return 1; | |
218 } | |
219 | |
220 | |
221 static int io_input (lua_State *L) { | |
222 return g_iofile(L, IO_INPUT, "r"); | |
223 } | |
224 | |
225 | |
226 static int io_output (lua_State *L) { | |
227 return g_iofile(L, IO_OUTPUT, "w"); | |
228 } | |
229 | |
230 | |
231 static int io_readline (lua_State *L); | |
232 | |
233 | |
234 static void aux_lines (lua_State *L, int idx, int toclose) { | |
235 lua_pushvalue(L, idx); | |
236 lua_pushboolean(L, toclose); /* close/not close file when finished */ | |
237 lua_pushcclosure(L, io_readline, 2); | |
238 } | |
239 | |
240 | |
241 static int f_lines (lua_State *L) { | |
242 tofile(L); /* check that it's a valid file handle */ | |
243 aux_lines(L, 1, 0); | |
244 return 1; | |
245 } | |
246 | |
247 | |
248 static int io_lines (lua_State *L) { | |
249 if (lua_isnoneornil(L, 1)) { /* no arguments? */ | |
250 /* will iterate over default input */ | |
251 lua_rawgeti(L, LUA_ENVIRONINDEX, IO_INPUT); | |
252 return f_lines(L); | |
253 } | |
254 else { | |
255 const char *filename = luaL_checkstring(L, 1); | |
256 FILE **pf = newfile(L); | |
257 *pf = fopen(filename, "r"); | |
258 if (*pf == NULL) | |
259 fileerror(L, 1, filename); | |
260 aux_lines(L, lua_gettop(L), 1); | |
261 return 1; | |
262 } | |
263 } | |
264 | |
265 | |
266 /* | |
267 ** {====================================================== | |
268 ** READ | |
269 ** ======================================================= | |
270 */ | |
271 | |
272 | |
273 static int read_number (lua_State *L, FILE *f) { | |
274 lua_Number d; | |
275 if (fscanf(f, LUA_NUMBER_SCAN, &d) == 1) { | |
276 lua_pushnumber(L, d); | |
277 return 1; | |
278 } | |
279 else return 0; /* read fails */ | |
280 } | |
281 | |
282 | |
283 static int test_eof (lua_State *L, FILE *f) { | |
284 int c = getc(f); | |
285 ungetc(c, f); | |
286 lua_pushlstring(L, NULL, 0); | |
287 return (c != EOF); | |
288 } | |
289 | |
290 | |
291 static int read_line (lua_State *L, FILE *f) { | |
292 luaL_Buffer b; | |
293 luaL_buffinit(L, &b); | |
294 for (;;) { | |
295 size_t l; | |
296 char *p = luaL_prepbuffer(&b); | |
297 if (fgets(p, LUAL_BUFFERSIZE, f) == NULL) { /* eof? */ | |
298 luaL_pushresult(&b); /* close buffer */ | |
299 return (lua_objlen(L, -1) > 0); /* check whether read something */ | |
300 } | |
301 l = strlen(p); | |
302 if (l == 0 || p[l-1] != '\n') | |
303 luaL_addsize(&b, l); | |
304 else { | |
305 luaL_addsize(&b, l - 1); /* do not include `eol' */ | |
306 luaL_pushresult(&b); /* close buffer */ | |
307 return 1; /* read at least an `eol' */ | |
308 } | |
309 } | |
310 } | |
311 | |
312 | |
313 static int read_chars (lua_State *L, FILE *f, size_t n) { | |
314 size_t rlen; /* how much to read */ | |
315 size_t nr; /* number of chars actually read */ | |
316 luaL_Buffer b; | |
317 luaL_buffinit(L, &b); | |
318 rlen = LUAL_BUFFERSIZE; /* try to read that much each time */ | |
319 do { | |
320 char *p = luaL_prepbuffer(&b); | |
321 if (rlen > n) rlen = n; /* cannot read more than asked */ | |
322 nr = fread(p, sizeof(char), rlen, f); | |
323 luaL_addsize(&b, nr); | |
324 n -= nr; /* still have to read `n' chars */ | |
325 } while (n > 0 && nr == rlen); /* until end of count or eof */ | |
326 luaL_pushresult(&b); /* close buffer */ | |
327 return (n == 0 || lua_objlen(L, -1) > 0); | |
328 } | |
329 | |
330 | |
331 static int g_read (lua_State *L, FILE *f, int first) { | |
332 int nargs = lua_gettop(L) - 1; | |
333 int success; | |
334 int n; | |
335 clearerr(f); | |
336 if (nargs == 0) { /* no arguments? */ | |
337 success = read_line(L, f); | |
338 n = first+1; /* to return 1 result */ | |
339 } | |
340 else { /* ensure stack space for all results and for auxlib's buffer */ | |
341 luaL_checkstack(L, nargs+LUA_MINSTACK, "too many arguments"); | |
342 success = 1; | |
343 for (n = first; nargs-- && success; n++) { | |
344 if (lua_type(L, n) == LUA_TNUMBER) { | |
345 size_t l = (size_t)lua_tointeger(L, n); | |
346 success = (l == 0) ? test_eof(L, f) : read_chars(L, f, l); | |
347 } | |
348 else { | |
349 const char *p = lua_tostring(L, n); | |
350 luaL_argcheck(L, p && p[0] == '*', n, "invalid option"); | |
351 switch (p[1]) { | |
352 case 'n': /* number */ | |
353 success = read_number(L, f); | |
354 break; | |
355 case 'l': /* line */ | |
356 success = read_line(L, f); | |
357 break; | |
358 case 'a': /* file */ | |
359 read_chars(L, f, ~((size_t)0)); /* read MAX_SIZE_T chars */ | |
360 success = 1; /* always success */ | |
361 break; | |
362 default: | |
363 return luaL_argerror(L, n, "invalid format"); | |
364 } | |
365 } | |
366 } | |
367 } | |
368 if (ferror(f)) | |
369 return pushresult(L, 0, NULL); | |
370 if (!success) { | |
371 lua_pop(L, 1); /* remove last result */ | |
372 lua_pushnil(L); /* push nil instead */ | |
373 } | |
374 return n - first; | |
375 } | |
376 | |
377 | |
378 static int io_read (lua_State *L) { | |
379 return g_read(L, getiofile(L, IO_INPUT), 1); | |
380 } | |
381 | |
382 | |
383 static int f_read (lua_State *L) { | |
384 return g_read(L, tofile(L), 2); | |
385 } | |
386 | |
387 | |
388 static int io_readline (lua_State *L) { | |
389 FILE *f = *(FILE **)lua_touserdata(L, lua_upvalueindex(1)); | |
390 int sucess; | |
391 if (f == NULL) /* file is already closed? */ | |
392 luaL_error(L, "file is already closed"); | |
393 sucess = read_line(L, f); | |
394 if (ferror(f)) | |
395 return luaL_error(L, "%s", strerror(errno)); | |
396 if (sucess) return 1; | |
397 else { /* EOF */ | |
398 if (lua_toboolean(L, lua_upvalueindex(2))) { /* generator created file? */ | |
399 lua_settop(L, 0); | |
400 lua_pushvalue(L, lua_upvalueindex(1)); | |
401 aux_close(L); /* close it */ | |
402 } | |
403 return 0; | |
404 } | |
405 } | |
406 | |
407 /* }====================================================== */ | |
408 | |
409 | |
410 static int g_write (lua_State *L, FILE *f, int arg) { | |
411 int nargs = lua_gettop(L) - 1; | |
412 int status = 1; | |
413 for (; nargs--; arg++) { | |
414 if (lua_type(L, arg) == LUA_TNUMBER) { | |
415 /* optimization: could be done exactly as for strings */ | |
416 status = status && | |
417 fprintf(f, LUA_NUMBER_FMT, lua_tonumber(L, arg)) > 0; | |
418 } | |
419 else { | |
420 size_t l; | |
421 const char *s = luaL_checklstring(L, arg, &l); | |
422 status = status && (fwrite(s, sizeof(char), l, f) == l); | |
423 } | |
424 } | |
425 return pushresult(L, status, NULL); | |
426 } | |
427 | |
428 | |
429 static int io_write (lua_State *L) { | |
430 return g_write(L, getiofile(L, IO_OUTPUT), 1); | |
431 } | |
432 | |
433 | |
434 static int f_write (lua_State *L) { | |
435 return g_write(L, tofile(L), 2); | |
436 } | |
437 | |
438 | |
439 static int f_seek (lua_State *L) { | |
440 static const int mode[] = {SEEK_SET, SEEK_CUR, SEEK_END}; | |
441 static const char *const modenames[] = {"set", "cur", "end", NULL}; | |
442 FILE *f = tofile(L); | |
443 int op = luaL_checkoption(L, 2, "cur", modenames); | |
444 long offset = luaL_optlong(L, 3, 0); | |
445 op = fseek(f, offset, mode[op]); | |
446 if (op) | |
447 return pushresult(L, 0, NULL); /* error */ | |
448 else { | |
449 lua_pushinteger(L, ftell(f)); | |
450 return 1; | |
451 } | |
452 } | |
453 | |
454 | |
455 static int f_setvbuf (lua_State *L) { | |
456 static const int mode[] = {_IONBF, _IOFBF, _IOLBF}; | |
457 static const char *const modenames[] = {"no", "full", "line", NULL}; | |
458 FILE *f = tofile(L); | |
459 int op = luaL_checkoption(L, 2, NULL, modenames); | |
460 lua_Integer sz = luaL_optinteger(L, 3, LUAL_BUFFERSIZE); | |
461 int res = setvbuf(f, NULL, mode[op], sz); | |
462 return pushresult(L, res == 0, NULL); | |
463 } | |
464 | |
465 | |
466 | |
467 static int io_flush (lua_State *L) { | |
468 return pushresult(L, fflush(getiofile(L, IO_OUTPUT)) == 0, NULL); | |
469 } | |
470 | |
471 | |
472 static int f_flush (lua_State *L) { | |
473 return pushresult(L, fflush(tofile(L)) == 0, NULL); | |
474 } | |
475 | |
476 | |
477 static const luaL_Reg iolib[] = { | |
478 {"close", io_close}, | |
479 {"flush", io_flush}, | |
480 {"input", io_input}, | |
481 {"lines", io_lines}, | |
482 {"open", io_open}, | |
483 {"output", io_output}, | |
484 {"popen", io_popen}, | |
485 {"read", io_read}, | |
486 {"tmpfile", io_tmpfile}, | |
487 {"type", io_type}, | |
488 {"write", io_write}, | |
489 {NULL, NULL} | |
490 }; | |
491 | |
492 | |
493 static const luaL_Reg flib[] = { | |
494 {"close", io_close}, | |
495 {"flush", f_flush}, | |
496 {"lines", f_lines}, | |
497 {"read", f_read}, | |
498 {"seek", f_seek}, | |
499 {"setvbuf", f_setvbuf}, | |
500 {"write", f_write}, | |
501 {"__gc", io_gc}, | |
502 {"__tostring", io_tostring}, | |
503 {NULL, NULL} | |
504 }; | |
505 | |
506 | |
507 static void createmeta (lua_State *L) { | |
508 luaL_newmetatable(L, LUA_FILEHANDLE); /* create metatable for file handles */ | |
509 lua_pushvalue(L, -1); /* push metatable */ | |
510 lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ | |
511 luaL_register(L, NULL, flib); /* file methods */ | |
512 } | |
513 | |
514 | |
515 static void createstdfile (lua_State *L, FILE *f, int k, const char *fname) { | |
516 *newfile(L) = f; | |
517 if (k > 0) { | |
518 lua_pushvalue(L, -1); | |
519 lua_rawseti(L, LUA_ENVIRONINDEX, k); | |
520 } | |
521 lua_pushvalue(L, -2); /* copy environment */ | |
522 lua_setfenv(L, -2); /* set it */ | |
523 lua_setfield(L, -3, fname); | |
524 } | |
525 | |
526 | |
527 static void newfenv (lua_State *L, lua_CFunction cls) { | |
528 lua_createtable(L, 0, 1); | |
529 lua_pushcfunction(L, cls); | |
530 lua_setfield(L, -2, "__close"); | |
531 } | |
532 | |
533 | |
534 LUALIB_API int luaopen_io (lua_State *L) { | |
535 createmeta(L); | |
536 /* create (private) environment (with fields IO_INPUT, IO_OUTPUT, __close) */ | |
537 newfenv(L, io_fclose); | |
538 lua_replace(L, LUA_ENVIRONINDEX); | |
539 /* open library */ | |
540 luaL_register(L, LUA_IOLIBNAME, iolib); | |
541 /* create (and set) default files */ | |
542 newfenv(L, io_noclose); /* close function for default files */ | |
543 createstdfile(L, stdin, IO_INPUT, "stdin"); | |
544 createstdfile(L, stdout, IO_OUTPUT, "stdout"); | |
545 createstdfile(L, stderr, 0, "stderr"); | |
546 lua_pop(L, 1); /* pop environment for default files */ | |
547 lua_getfield(L, -1, "popen"); | |
548 newfenv(L, io_pclose); /* create environment for 'popen' */ | |
549 lua_setfenv(L, -2); /* set fenv for 'popen' */ | |
550 lua_pop(L, 1); /* pop 'popen' */ | |
551 return 1; | |
552 } | |
553 |