The R Project SVN R-packages

Rev

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

Rev 3509 Rev 3684
Line 185... Line 185...
185
 
185
 
186
    /*
186
    /*
187
     * check for workspace.db, workspace1.db, ..., workspace9999.db if they
187
     * check for workspace.db, workspace1.db, ..., workspace9999.db if they
188
     * are valid workspace file. if one is found, use that as the workspace.
188
     * are valid workspace file. if one is found, use that as the workspace.
189
     */
189
     */
190
    filename = R_alloc(18, sizeof(char)); /* workspace10000.db\0 */
190
    filename = R_alloc(28, sizeof(char)); /* .SQLiteDF/workspace10000.db\0 */
191
    sprintf(filename, "%s.db", basename);
191
    sprintf(filename, ".SQLiteDF/%s.db", basename);
192
    while(_file_exists(filename) && file_idx < 10000) {
192
    while(_file_exists(filename) && file_idx < 10000) {
193
        if ((g_workspace = _is_workspace(filename)) != NULL) break;
193
        if ((g_workspace = _is_workspace(filename)) != NULL) break;
194
        warning("%s is not a SQLiteDF workspace\n", filename);
194
        warning("%s is not a SQLiteDF workspace\n", filename);
195
        sprintf(filename, "%s%d.db", basename, ++file_idx);
195
        sprintf(filename, ".SQLiteDF/%s%d.db", basename, ++file_idx);
196
    }
196
    }
197
 
197
 
198
    if ((g_workspace == NULL) && (file_idx < 10000)) {
198
    if ((g_workspace == NULL) && (file_idx < 10000)) {
199
        /* no workspace found but there are still "available" file name */
199
        /* no workspace found but there are still "available" file name */
200
        /* if (file_idx) warn("workspace will be stored at #{filename}") */
200
        /* if (file_idx) warn("workspace will be stored at #{filename}") */
Line 233... Line 233...
233
            }
233
            }
234
        }
234
        }
235
        sqlite3_free_table(result_set);
235
        sqlite3_free_table(result_set);
236
 
236
 
237
        /* notify if a previous workspace is reloaded */
237
        /* notify if a previous workspace is reloaded */
238
        Rprintf("[Previouse SQLiteDF workspace restored (%s)]\n", filename);
238
        Rprintf("[Previous SQLiteDF workspace restored (%s)]\n", filename);
239
 
239
 
240
        ret = ScalarLogical(TRUE);
240
        ret = ScalarLogical(TRUE);
241
    } else { /* can't find nor create workspace */
241
    } else { /* can't find nor create workspace */
242
        ret = ScalarLogical(FALSE);
242
        ret = ScalarLogical(FALSE);
243
    }
243
    }
Line 255... Line 255...
255
    /* determine if iname is loaded */
255
    /* determine if iname is loaded */
256
    sprintf(g_sql_buf[2], "select loaded, rel_filename from workspace where internal_name='%s'", iname);
256
    sprintf(g_sql_buf[2], "select loaded, rel_filename from workspace where internal_name='%s'", iname);
257
    sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, NULL);
257
    sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, NULL);
258
    res = sqlite3_step(stmt);
258
    res = sqlite3_step(stmt);
259
    if (exists && res != SQLITE_ROW) { 
259
    if (exists && res != SQLITE_ROW) { 
260
        error("No SDF with name '%s' found in the workspace.\n", iname);
-
 
261
        sqlite3_finalize(stmt); 
260
        sqlite3_finalize(stmt); 
262
        return 0; 
261
        error("No SDF with name '%s' found in the workspace.\n", iname);
263
    }
262
    }
264
    loaded = (res == SQLITE_ROW) ? sqlite3_column_int(stmt, 0) : 0;
263
    loaded = (res == SQLITE_ROW) ? sqlite3_column_int(stmt, 0) : 0;
265
    strcpy(g_sql_buf[1], (char*)sqlite3_column_text(stmt, 1)); /* ref filename */
264
    strcpy(g_sql_buf[1], (char*)sqlite3_column_text(stmt, 1)); /* ref filename */
266
    sqlite3_finalize(stmt);
265
    sqlite3_finalize(stmt);
267
 
266
 
Line 283... Line 282...
283
 
282
 
284
        /* g_sql_buf[2] contains the internal name as stored in the sdf
283
        /* g_sql_buf[2] contains the internal name as stored in the sdf
285
         * attribute. sync workspace record to that if needed */
284
         * attribute. sync workspace record to that if needed */
286
        if (exists && strcmp(iname, g_sql_buf[2]) != 0) {
285
        if (exists && strcmp(iname, g_sql_buf[2]) != 0) {
287
            if (!_is_r_sym(g_sql_buf[2])) {
286
            if (!_is_r_sym(g_sql_buf[2])) {
288
                warning("name stored in SDF is not valid. Ignoring that name...");
287
                warning("name \"%s\" stored in SDF is not valid. Ignoring that name...", g_sql_buf[2]);
289
                goto __out_of_syncname;
288
                goto __out_of_syncname;
290
            }
289
            }
291
            iname_final = R_alloc(strlen(g_sql_buf[2]) + 1, sizeof(g_sql_buf[2]));
290
            iname_final = R_alloc(strlen(g_sql_buf[2]) + 1, sizeof(g_sql_buf[2]));
292
            strcpy(iname_final, g_sql_buf[2]);
291
            strcpy(iname_final, g_sql_buf[2]);
293
 
292
 
Line 367... Line 366...
367
SEXP sdf_get_sdf(SEXP name) {    
366
SEXP sdf_get_sdf(SEXP name) {    
368
    char *iname;
367
    char *iname;
369
    SEXP ret;
368
    SEXP ret;
370
 
369
 
371
    if (TYPEOF(name) != STRSXP) {
370
    if (TYPEOF(name) != STRSXP) {
372
        Rprintf("Error: Argument must be a string containing the SDF name.\n");
371
        error("Argument must be a string containing the SDF name.");
373
        return R_NilValue;
-
 
374
    }
372
    }
375
    iname = CHAR(STRING_ELT(name, 0));
373
    iname = CHAR(STRING_ELT(name, 0));
376
 
374
 
377
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
375
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
378
 
376
 
Line 389... Line 387...
389
 
387
 
390
    if (IS_CHARACTER(filename)) {
388
    if (IS_CHARACTER(filename)) {
391
        fname = CHAR_ELT(filename, 0);
389
        fname = CHAR_ELT(filename, 0);
392
        fnamelen = strlen(fname);
390
        fnamelen = strlen(fname);
393
    } else {
391
    } else {
394
        Rprintf("Error: filename argument must be a string.\n");
392
        error("filename argument must be a string.");
395
        return R_NilValue;
-
 
396
    }
393
    }
397
 
394
 
398
    if (strcmp(fname+(fnamelen-3),".db") != 0) {
395
    if (strcmp(fname+(fnamelen-3),".db") != 0) {
399
        Rprintf("Error: Cannot attach because extension is not .db, which may cause problems [%s].\n");
396
        error("will not attach because extension is not .db");
400
        return R_NilValue;
-
 
401
    }
397
    }
402
 
398
 
403
    /* check if it is a valid sdf file */
399
    /* check if it is a valid sdf file */
404
    if (_is_sdf2(fname) == NULL) {
400
    if (_is_sdf2(fname) == NULL) {
405
        Rprintf("Error: %s is not a valid SDF.\n", fname);
401
        error("%s is not a valid SDF.", fname);
406
        return R_NilValue;
-
 
407
    } else {
402
    } else {
408
        /* _is_sdf2 puts the orig iname in buf2. transfer data to buf0 since
403
        /* _is_sdf2 puts the orig iname in buf2. transfer data to buf0 since
409
         * functions called below will use buf2 */
404
         * functions called below will use buf2 */
410
        strcpy(g_sql_buf[0], g_sql_buf[2]);
405
        strcpy(g_sql_buf[0], g_sql_buf[2]);
411
        iname_orig = g_sql_buf[0];
406
        iname_orig = g_sql_buf[0];
Line 416... Line 411...
416
    res = sqlite3_prepare(g_workspace, "select internal_name from workspace where full_filename=?",
411
    res = sqlite3_prepare(g_workspace, "select internal_name from workspace where full_filename=?",
417
            -1, &stmt, NULL);
412
            -1, &stmt, NULL);
418
    sqlite3_bind_text(stmt, 1, g_sql_buf[2], -1, SQLITE_STATIC);
413
    sqlite3_bind_text(stmt, 1, g_sql_buf[2], -1, SQLITE_STATIC);
419
    res = sqlite3_step(stmt);
414
    res = sqlite3_step(stmt);
420
    if (res == SQLITE_ROW) {
415
    if (res == SQLITE_ROW) {
421
        Rprintf("Warning: That sdf is already attached as '%s'\n",
416
        warning("this sdf is already attached as '%s'\n",
422
                sqlite3_column_text(stmt, 0));
417
                sqlite3_column_text(stmt, 0));
423
        sqlite3_finalize(stmt);
418
        sqlite3_finalize(stmt);
424
        return R_NilValue;
419
        return R_NilValue;
425
    } else sqlite3_finalize(stmt);
420
    } else sqlite3_finalize(stmt);
426
 
421
 
Line 429... Line 424...
429
    if (IS_CHARACTER(internal_name)) {
424
    if (IS_CHARACTER(internal_name)) {
430
        /* if name is specified, rename the sdf. original internal name is the
425
        /* if name is specified, rename the sdf. original internal name is the
431
         * one stored at sdf_attribute */
426
         * one stored at sdf_attribute */
432
        iname = CHAR_ELT(internal_name, 0);
427
        iname = CHAR_ELT(internal_name, 0);
433
        if (!_is_r_sym(iname)) {
428
        if (!_is_r_sym(iname)) {
434
            Rprintf("Error: %s is not a valid R symbol.\n", iname);
429
            error("%s is not a valid R symbol.", iname);
435
            return R_NilValue;
-
 
436
        }
430
        }
437
    } else {
431
    } else {
438
        /* if no name is specified, use original internal name */
432
        /* if no name is specified, use original internal name */
439
        iname = (char *)iname_orig;  /* g_sql_buf[0]! */
433
        iname = (char *)iname_orig;  /* g_sql_buf[0]! */
440
    }
434
    }
Line 443... Line 437...
443
    res = sqlite3_prepare(g_workspace, "select full_filename from workspace "
437
    res = sqlite3_prepare(g_workspace, "select full_filename from workspace "
444
           " where internal_name=?", -1, &stmt, NULL);
438
           " where internal_name=?", -1, &stmt, NULL);
445
    sqlite3_bind_text(stmt, 1, iname, -1, SQLITE_STATIC);
439
    sqlite3_bind_text(stmt, 1, iname, -1, SQLITE_STATIC);
446
    res = sqlite3_step(stmt);
440
    res = sqlite3_step(stmt);
447
    if (res == SQLITE_ROW) {
441
    if (res == SQLITE_ROW) {
448
        Rprintf("Error: The sdf internal name '%s' is already used by file %s.\n",
-
 
449
                iname, sqlite3_column_text(stmt, 1));
442
        strcpy(g_sql_buf[0], (char *)sqlite3_column_text(stmt,1));
450
        sqlite3_finalize(stmt);
443
        sqlite3_finalize(stmt);
-
 
444
        error("the sdf internal name '%s' is already used by file %s.",
451
        return R_NilValue;
445
                iname, g_sql_buf[0]);
452
    } 
446
    } 
453
    sqlite3_finalize(stmt);
447
    sqlite3_finalize(stmt);
454
    
448
    
455
    /* add it to workspace */
449
    /* add it to workspace */
456
    res = _add_sdf1(fname, iname);
450
    res = _add_sdf1(fname, iname);
Line 485... Line 479...
485
SEXP sdf_detach_sdf(SEXP internal_name) {
479
SEXP sdf_detach_sdf(SEXP internal_name) {
486
    char *iname;
480
    char *iname;
487
    int res;
481
    int res;
488
 
482
 
489
    if (!IS_CHARACTER(internal_name)) {
483
    if (!IS_CHARACTER(internal_name)) {
490
        Rprintf("Error: iname argument is not a string.\n");
484
        error("iname argument is not a string.");
491
        return R_NilValue;
-
 
492
    }
485
    }
493
 
486
 
494
    iname = CHAR_ELT(internal_name, 0);
487
    iname = CHAR_ELT(internal_name, 0);
495
    sprintf(g_sql_buf[0], "detach [%s]", iname);
488
    sprintf(g_sql_buf[0], "detach [%s]", iname);
496
 
489
 
Line 511... Line 504...
511
    
504
    
512
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
505
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
513
 
506
 
514
    /* check if valid r name */
507
    /* check if valid r name */
515
    if (!_is_r_sym(newname)) {
508
    if (!_is_r_sym(newname)) {
516
        Rprintf("Error: %s is not a valid R symbol.", iname);
509
        error("%s is not a valid R symbol.", iname);
517
        return R_NilValue;
-
 
518
    }
510
    }
519
 
511
 
520
    /* check if sdf already exists */
512
    /* check if sdf already exists */
521
    if (_sdf_exists2(newname)) { /* name is already taken */
513
    if (_sdf_exists2(newname)) { /* name is already taken */
522
        Rprintf("Error: the name \"%s\" is already taken.\n", newname);
514
        error("Error: the name \"%s\" is already taken.", newname);
523
        return R_NilValue;
-
 
524
    }
515
    }
525
 
516
 
526
    /* get path of the sdf file, because we're going to detach it */
517
    /* get path of the sdf file, because we're going to detach it */
527
    path = _get_sdf_detail2(iname, SDF_DETAIL_FULLFILENAME);
518
    path = _get_sdf_detail2(iname, SDF_DETAIL_FULLFILENAME);
528
    if (path == NULL) {
519
    if (path == NULL) {
529
        Rprintf("Error: no sdf named \"%s\" exists.\n", iname);
520
        error("no sdf named \"%s\" exists.", iname);
530
        return R_NilValue;
-
 
531
    }
521
    }
532
 
522
 
533
    /* change name in sdf_attribute */
523
    /* change name in sdf_attribute */
534
    sprintf(g_sql_buf[0], "update [%s].sdf_attributes set value='%s' "
524
    sprintf(g_sql_buf[0], "update [%s].sdf_attributes set value='%s' "
535
            "where attr='name'", iname, newname);
525
            "where attr='name'", iname, newname);
536
    res = _sqlite_exec(g_sql_buf[0]);
526
    res = _sqlite_exec(g_sql_buf[0]);
537
    Rprintf("result: %d\n", res);
-
 
538
    /* if (_sqlite_error(res)) return R_NilValue; */
527
    /* if (_sqlite_error(res)) return R_NilValue; */
539
 
528
 
540
    /* detach and remove sdf from workspace */
529
    /* detach and remove sdf from workspace */
541
    sprintf(g_sql_buf[0], "detach '%s'", iname);
530
    sprintf(g_sql_buf[0], "detach '%s'", iname);
542
    res = _sqlite_exec(g_sql_buf[0]);
531
    res = _sqlite_exec(g_sql_buf[0]);