Mercurial > vba-clojure

     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
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 25 Jun 2012 14:55:55 -0500
parents	27763b933818
children