src/DB1.c

   1 #define NEED_CONNECTION_PSTREAMS
   2
   3 #include <R.h>
   4 #include <Rinternals.h>
   5
   6 SEXP read_key_map(SEXP filename, SEXP map, SEXP filesize, SEXP pos)
   7 {
   8         SEXP key, datalen;
   9         FILE *fp;
  10         int status;
  11         struct R_inpstream_st in;
  12
  13         if(!isEnvironment(map))
  14                 error("'map' should be an environment");
  15         if(!isString(filename))
  16                 error("'filename' should be character");
  17
  18         PROTECT(filesize = coerceVector(filesize, INTSXP));
  19         PROTECT(pos = coerceVector(pos, INTSXP));
  20
  21         fp = fopen(CHAR(STRING_ELT(filename, 0)), "rb");
  22
  23         if(INTEGER(pos)[0] > 0) {
  24                 status = fseek(fp, INTEGER(pos)[0], SEEK_SET);
  25
  26                 if(status < 0)
  27                         error("problem with initial file pointer seek");
  28         }
  29
  30         /* Initialize the incoming R file stream */
  31         R_InitFileInPStream(&in, fp, R_pstream_any_format, NULL, NULL);
  32
  33         while(INTEGER(pos)[0] < INTEGER(filesize)[0]) {
  34                 PROTECT(key = R_Unserialize(&in));
  35                 PROTECT(datalen = R_Unserialize(&in));
  36
  37                 /* calculate the position of file pointer */
  38                 INTEGER(pos)[0] = ftell(fp);
  39
  40                 if(INTEGER(datalen)[0] > 0) {
  41                         /* create a new entry in the key map */
  42                         defineVar(install(CHAR(STRING_ELT(key, 0))),
  43                                   duplicate(pos), map);
  44
  45                         /* advance to the next key */
  46                         fseek(fp, INTEGER(datalen)[0], SEEK_CUR);
  47                         INTEGER(pos)[0] = INTEGER(pos)[0] + INTEGER(datalen)[0];
  48                 }
  49                 else {
  50                         /* key has been deleted; set pos to NULL */
  51                         defineVar(install(CHAR(STRING_ELT(key, 0))),
  52                                   R_NilValue, map);
  53                 }
  54                 UNPROTECT(2);
  55         }
  56         UNPROTECT(2);
  57         fclose(fp);
  58         return map;
  59 }