SEXP writetable(SEXP call, SEXP op, SEXP args, SEXP env) { SEXP x, sep, rnames, eol, na, dec, quote, xj; int nr, nc, i, j, qmethod; Rboolean wasopen, quote_rn = FALSE, *quote_col; Rconnection con; const char *csep, *ceol, *cna, *sdec, *tmp=NULL /* -Wall */; char cdec; SEXP *levels; R_StringBuffer strBuf = {NULL, 0, MAXELTSIZE}; wt_info wi; RCNTXT cntxt; args = CDR(args); x = CAR(args); args = CDR(args); /* this is going to be a connection open or openable for writing */ if(!inherits(CAR(args), "connection")) error(_("'file' is not a connection")); con = getConnection(asInteger(CAR(args))); args = CDR(args); if(!con->canwrite) error(_("cannot write to this connection")); wasopen = con->isopen; if(!wasopen) { strcpy(con->mode, "wt"); if(!con->open(con)) error(_("cannot open the connection")); } nr = asInteger(CAR(args)); args = CDR(args); nc = asInteger(CAR(args)); args = CDR(args); rnames = CAR(args); args = CDR(args); sep = CAR(args); args = CDR(args); eol = CAR(args); args = CDR(args); na = CAR(args); args = CDR(args); dec = CAR(args); args = CDR(args); quote = CAR(args); args = CDR(args); qmethod = asLogical(CAR(args)); if(nr == NA_INTEGER) error(_("invalid '%s' argument"), "nr"); if(nc == NA_INTEGER) error(_("invalid '%s' argument"), "nc"); if(!isNull(rnames) && !isString(rnames)) error(_("invalid '%s' argument"), "rnames"); if(!isString(sep)) error(_("invalid '%s' argument"), "sep"); if(!isString(eol)) error(_("invalid '%s' argument"), "eol"); if(!isString(na)) error(_("invalid '%s' argument"), "na"); if(!isString(dec)) error(_("invalid '%s' argument"), "dec"); if(qmethod == NA_LOGICAL) error(_("invalid '%s' argument"), "qmethod"); csep = translateChar(STRING_ELT(sep, 0)); ceol = translateChar(STRING_ELT(eol, 0)); cna = translateChar(STRING_ELT(na, 0)); sdec = translateChar(STRING_ELT(dec, 0)); if(strlen(sdec) != 1) error(_("'dec' must be a single character")); cdec = sdec[0]; quote_col = (Rboolean *) R_alloc(nc, sizeof(Rboolean)); for(j = 0; j < nc; j++) quote_col[j] = FALSE; for(i = 0; i < length(quote); i++) { /* NB, quote might be NULL */ int this = INTEGER(quote)[i]; if(this == 0) quote_rn = TRUE; if(this > 0) quote_col[this - 1] = TRUE; } R_AllocStringBuffer(0, &strBuf); PrintDefaults(); wi.savedigits = R_print.digits; R_print.digits = DBL_DIG;/* MAX precision */ wi.con = con; wi.wasopen = wasopen; wi.buf = &strBuf; begincontext(&cntxt, CTXT_CCODE, call, R_BaseEnv, R_BaseEnv, R_NilValue, R_NilValue); cntxt.cend = &wt_cleanup; cntxt.cenddata = &wi; if(isVectorList(x)) { /* A data frame */ /* handle factors internally, check integrity */ levels = (SEXP *) R_alloc(nc, sizeof(SEXP)); for(j = 0; j < nc; j++) { xj = VECTOR_ELT(x, j); if(LENGTH(xj) != nr) error(_("corrupt data frame -- length of column %d does not not match nrows"), j+1); if(inherits(xj, "factor")) { levels[j] = getAttrib(xj, R_LevelsSymbol); } else levels[j] = R_NilValue; } for(i = 0; i < nr; i++) { if(i % 1000 == 999) R_CheckUserInterrupt(); if(!isNull(rnames)) Rconn_printf(con, "%s%s", EncodeElement2(rnames, i, quote_rn, qmethod, &strBuf, cdec), csep); for(j = 0; j < nc; j++) { xj = VECTOR_ELT(x, j); if(j > 0) Rconn_printf(con, "%s", csep); if(isna(xj, i)) tmp = cna; else { if(!isNull(levels[j])) { /* We do not assume factors have integer levels, although they should. */ if(TYPEOF(xj) == INTSXP) tmp = EncodeElement2(levels[j], INTEGER(xj)[i] - 1, quote_col[j], qmethod, &strBuf, cdec); else if(TYPEOF(xj) == REALSXP) tmp = EncodeElement2(levels[j], (int) (REAL(xj)[i] - 1), quote_col[j], qmethod, &strBuf, cdec); else error("column %s claims to be a factor but does not have numeric codes", j+1); } else { tmp = EncodeElement2(xj, i, quote_col[j], qmethod, &strBuf, cdec); } /* if(cdec) change_dec(tmp, cdec, TYPEOF(xj)); */ } Rconn_printf(con, "%s", tmp); } Rconn_printf(con, "%s", ceol); } } else { /* A matrix */ if(!isVectorAtomic(x)) UNIMPLEMENTED_TYPE("write.table, matrix method", x); /* quick integrity check */ if(LENGTH(x) != nr * nc) error(_("corrupt matrix -- dims not not match length")); for(i = 0; i < nr; i++) { if(i % 1000 == 999) R_CheckUserInterrupt(); if(!isNull(rnames)) Rconn_printf(con, "%s%s", EncodeElement2(rnames, i, quote_rn, qmethod, &strBuf, cdec), csep); for(j = 0; j < nc; j++) { if(j > 0) Rconn_printf(con, "%s", csep); if(isna(x, i + j*nr)) tmp = cna; else { tmp = EncodeElement2(x, i + j*nr, quote_col[j], qmethod, &strBuf, cdec); /* if(cdec) change_dec(tmp, cdec, TYPEOF(x)); */ } Rconn_printf(con, "%s", tmp); } Rconn_printf(con, "%s", ceol); } } endcontext(&cntxt); wt_cleanup(&wi); return R_NilValue; }
int main(int argc, const char **argv) { wi_mutable_array_t *arguments; wi_pool_t *pool; wi_string_t *string, *root_path; int ch, facility; wi_boolean_t test_config, daemonize, change_directory, switch_user; /* init libwired */ wi_initialize(); wi_load(argc, argv); pool = wi_pool_init(wi_pool_alloc()); wi_log_syslog = true; wi_log_syslog_facility = LOG_DAEMON; /* init core systems */ wt_version_init(); wt_status_lock = wi_lock_init(wi_lock_alloc()); wt_start_date = wi_date_init(wi_date_alloc()); /* set defaults */ root_path = WI_STR(WT_ROOT); wi_settings_config_path = wi_string_init_with_cstring(wi_string_alloc(), WT_CONFIG_PATH); test_config = false; daemonize = true; change_directory = true; switch_user = true; /* init reexec argument list */ arguments = wi_array_init(wi_mutable_array_alloc()); /* parse command line switches */ while((ch = getopt(argc, (char * const *) argv, "46Dd:f:hi:L:ls:tuVvXx")) != -1) { switch(ch) { case '4': wt_address_family = WI_ADDRESS_IPV4; break; case '6': wt_address_family = WI_ADDRESS_IPV6; break; case 'D': daemonize = false; wi_log_stderr = true; break; case 'd': root_path = wi_string_with_cstring(optarg); break; case 'f': wi_release(wi_settings_config_path); wi_settings_config_path = wi_string_init_with_cstring(wi_string_alloc(), optarg); break; case 'i': wi_log_limit = wi_string_uint32(wi_string_with_cstring(optarg)); break; case 'L': wi_log_syslog = false; wi_log_file = true; wi_release(wi_log_path); wi_log_path = wi_string_init_with_cstring(wi_string_alloc(), optarg); break; case 'l': wi_log_level++; break; case 's': string = wi_string_with_cstring(optarg); facility = wi_log_syslog_facility_with_name(string); if(facility < 0) wi_log_fatal(WI_STR("Could not find syslog facility \"%@\": %m"), string); wi_log_syslog_facility = facility; break; case 't': test_config = true; break; case 'u': break; case 'V': case 'v': wt_version(); break; case 'X': daemonize = false; break; case 'x': daemonize = false; change_directory = false; switch_user = false; break; case '?': case 'h': default: wt_usage(); break; } wi_mutable_array_add_data(arguments, wi_string_with_format(WI_STR("-%c"), ch)); if(optarg) wi_mutable_array_add_data(arguments, wi_string_with_cstring(optarg)); } /* detach */ if(daemonize) { wi_mutable_array_add_data(arguments, WI_STR("-X")); switch(wi_fork()) { case -1: wi_log_fatal(WI_STR("Could not fork: %m")); break; case 0: if(!wi_execv(wi_string_with_cstring(argv[0]), arguments)) wi_log_fatal(WI_STR("Could not execute %s: %m"), argv[0]); break; default: _exit(0); break; } } wi_release(arguments); /* change directory */ if(change_directory) { if(!wi_fs_change_directory(root_path)) wi_log_error(WI_STR("Could not change directory to %@: %m"), root_path); } /* open log */ wi_log_open(); /* init subsystems */ wt_ssl_init(); wt_clients_init(); wt_servers_init(); /* read the config file */ wt_settings_init(); if(!wt_settings_read_config()) exit(1); /* apply settings */ wt_settings_apply_settings(); if(test_config) { printf("Config OK\n"); exit(0); } /* dump command line */ wi_log_info(WI_STR("Started as %@ %@"), wi_process_path(wi_process()), wi_array_components_joined_by_string(wi_process_arguments(wi_process()), WI_STR(" "))); /* init tracker */ wi_log_info(WI_STR("Starting Wired Tracker version %@"), wt_version_string); wt_tracker_init(); /* switch user/group */ if(switch_user) wi_switch_user(wt_settings.user, wt_settings.group); /* create tracker threads after privilege drop */ wt_signals_init(); wt_block_signals(); wt_servers_schedule(); wt_tracker_create_threads(); wt_write_pid(); wt_write_status(true); /* clean up pool after startup */ wi_pool_drain(pool); /* enter the signal handling thread in the main thread */ wt_signal_thread(NULL); /* dropped out */ wt_cleanup(); wi_log_close(); wi_release(pool); return 0; }
int main(int argc, const char **argv) { wi_pool_t *pool; wi_string_t *string; int ch, facility; wi_boolean_t no_chroot, test_config; /* init libwired */ wi_initialize(); wi_load(argc, argv); pool = wi_pool_init(wi_pool_alloc()); wi_log_startup = true; wi_log_syslog = true; wi_log_syslog_facility = LOG_DAEMON; /* init core systems */ wt_init_version(); wt_status_lock = wi_lock_init(wi_lock_alloc()); wt_start_date = wi_date_init(wi_date_alloc()); /* set defaults */ wi_root_path = wi_string_init_with_cstring(wi_string_alloc(), WT_ROOT); wi_settings_config_path = wi_string_init_with_cstring(wi_string_alloc(), WT_CONFIG_PATH); no_chroot = false; test_config = false; /* parse command line switches */ while((ch = getopt(argc, (char * const *) argv, "46Dd:f:hi:L:ls:tuVv")) != -1) { switch(ch) { case '4': wt_address_family = WI_ADDRESS_IPV4; break; case '6': wt_address_family = WI_ADDRESS_IPV6; break; case 'D': wt_daemonize = false; wi_log_stderr = true; break; case 'd': wi_release(wi_root_path); wi_root_path = wi_string_init_with_cstring(wi_string_alloc(), optarg); break; case 'f': wi_release(wi_settings_config_path); wi_settings_config_path = wi_string_init_with_cstring(wi_string_alloc(), optarg); break; case 'i': wi_log_limit = wi_string_uint32(wi_string_with_cstring(optarg)); break; case 'L': wi_log_syslog = false; wi_log_file = true; wi_release(wi_log_path); wi_log_path = wi_string_init_with_cstring(wi_string_alloc(), optarg); break; case 'l': wi_log_level++; break; case 's': string = wi_string_with_cstring(optarg); facility = wi_log_syslog_facility_with_name(string); if(facility < 0) { wi_log_err(WI_STR("Could not find syslog facility \"%@\": %m"), string); } wi_log_syslog_facility = facility; break; case 't': test_config = true; break; case 'u': no_chroot = true; break; case 'V': case 'v': wt_version(); break; case '?': case 'h': default: wt_usage(); break; } } /* open log */ wi_log_open(); /* init subsystems */ wt_init_ssl(); wt_init_clients(); wt_init_servers(); /* read the config file */ wt_settings_chroot = !no_chroot; wt_init_settings(); if(!wt_read_config()) exit(1); /* change root directory */ if(!no_chroot) { if(!wi_change_root()) wi_log_err(WI_STR("Could not change root to %@: %m"), wi_root_path); } /* apply config */ wt_apply_config(); if(test_config) { printf("Config OK\n"); exit(0); } /* dump command line */ if(wi_log_level >= WI_LOG_DEBUG) { wi_log_debug(WI_STR("Started as %@ %@"), wi_process_path(wi_process()), wi_array_components_joined_by_string(wi_process_arguments(wi_process()), WI_STR(" "))); } /* init tracker */ wi_log_info(WI_STR("Starting Wired Tracker version %@"), wt_version_string); wt_init_tracker(); /* detach (don't chdir, don't close i/o channels) */ if(wt_daemonize) { if(!wi_daemon()) wi_log_err(WI_STR("Could not become a daemon: %m")); } /* switch user/group */ wi_switch_user(wt_settings.user, wt_settings.group); /* create tracker threads after privilege drop */ wt_init_signals(); wt_block_signals(); wt_schedule_servers(); wt_fork_tracker(); wt_write_pid(); wt_write_status(true); wi_log_startup = false; wi_release(pool); pool = wi_pool_init(wi_pool_alloc()); /* enter the signal handling thread in the main thread */ wt_signal_thread(NULL); /* dropped out */ wt_cleanup(); wi_log_close(); wi_release(pool); return 0; }