R->modb handling of objects coded roughly

This commit is contained in:
2020-11-09 12:40:20 +00:00
parent 952b7e3c9e
commit 5b6784c07a
3 changed files with 769 additions and 42 deletions

View File

@@ -1,13 +1,58 @@
metaobject_ids <- function(title, ...) { #' @export
checkmate::assert_string(title) metaobject_ids <- function(query = list(), withDeleted = FALSE, ...) {
checkmate::assert_list(query)
checkmate::assert_logical(withDeleted)
conn_ref <- modb_conn_ref(args = list(...)) conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(c_rmodb_metaobjectId, conn_ref, title) res <- .Call(c_rmodb_metaobjectIds, conn_ref, query, withDeleted)
return(res)
}
#' @export
metaobject_query <- function(query = list(), withDeleted = FALSE, restrict_owner = 0, ...) {
checkmate::assert_list(query)
checkmate::assert_logical(withDeleted)
checkmate::assert_int(restrict_owner)
conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(
c_rmodb_metaobjectQuery, conn_ref,
query, withDeleted, as.integer(restrict_owner)
)
return(res)
}
#' @export
metadata_query <- function(query = list(), withDeleted = FALSE, restrict_owner = 0, ...) {
checkmate::assert_list(query)
checkmate::assert_logical(withDeleted)
checkmate::assert_int(restrict_owner)
conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(
c_rmodb_metadataQuery, conn_ref,
query, withDeleted, as.integer(restrict_owner)
)
return(res)
}
#' @export
object_query <- function(query = list(), withDeleted = FALSE, restrict_owner = 0, ...) {
checkmate::assert_list(query)
checkmate::assert_logical(withDeleted)
checkmate::assert_int(restrict_owner)
conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(
c_rmodb_metadataQuery, conn_ref,
query, withDeleted, as.integer(restrict_owner)
)
return(res) return(res)
} }
#' @export
metaobject_create <- function(meta, obj, id = NULL, ...) { metaobject_create <- function(meta, obj, id = NULL, ...) {
if (!checkmate::test_null(id)) { if (!checkmate::test_null(id)) {
checkmate::assert_int(id) checkmate::assert_int(id)
@@ -61,17 +106,87 @@ metaobject_create <- function(meta, obj, id = NULL, ...) {
"created_on", "updated_on", "deleted_on" "created_on", "updated_on", "deleted_on"
) )
ext <- meta[!(names(meta) %in% meta_fields)] ext <- meta[!(names(meta) %in% meta_fields)]
meta <- meta[names(meta) %in% c("title", "owner_id", "group_ids")] meta <- meta[names(meta) %in% meta_fields]
# utils::str(meta)
# utils::str(ext)
# utils::str(obj)
res <- .Call(c_rmodb_createMetaobject, conn_ref, as.integer(id), meta, obj, ext)
return(res)
}
#' @export
metaobject_update <- function(id, meta, obj, ...) {
checkmate::assert_int(id)
# TODO: validate meta and obj
# checkmate::assert_list(meta)
# checkmate::assert_names(names(meta), must.include = c("title"))
# assert_namesInclude(names(meta), one.of = c("owner", "owner_id"))
# if (test_namesInclude(names(meta), all.of = c("owner"))) {
# checkmate::assert_class(meta$owner, "modb_user")
# meta$owner_id <- meta$owner$id
# } else {
# checkmate::assert_int(meta$owner_id)
# }
# meta$owner_id <- as.integer(meta$owner_id)
# assert_namesInclude(names(meta), one.of = c("groups", "group_ids"))
# if (checkmate::test_null(meta$group_ids)) {
# meta$group_ids <- list()
# } else if (test_namesInclude(names(meta), all.of = c("groups"))) {
# meta$group_ids <- list()
# for (g in meta$groups) {
# checkmate::assert_class(g, "modb_group")
# meta$group_ids <- c(meta$group_ids, g$id)
# }
# } else if (checkmate::test_list(meta$group_ids)) {
# if (length(meta$group_ids) > 0) {
# checkmate::assert_integerish(unlist(meta$group_ids))
# }
# } else {
# checkmate::assert_integerish(meta$group_ids)
# }
# meta$group_ids <- c(as.integer(meta$group_ids))
conn_ref <- modb_conn_ref(args = list(...))
if (!missing(meta)) {
meta_fields <- c(
"id", "title", "owner_id", "owner", "groups", "group_ids",
"created_on", "updated_on", "deleted_on"
)
ext <- meta[!(names(meta) %in% meta_fields)]
meta <- meta[names(meta) %in% meta_fields[-1]]
if (length(meta) == 0) {
meta <- list(NULL)
}
if (length(ext) == 0) {
ext <- list(NULL)
}
} else {
meta <- list(NULL)
ext <- list(NULL)
}
if (missing(obj)) {
obj <- list(NULL)
}
utils::str(meta) utils::str(meta)
utils::str(ext) utils::str(ext)
utils::str(obj) utils::str(obj)
res <- .Call(c_rmodb_createMetaobject, conn_ref, as.integer(id), meta, obj, ext) res <- .Call(c_rmodb_updateMetaobject, conn_ref, as.integer(id), meta, obj, ext)
return(res) return(res)
} }
#' @export
metaobject_delete <- function(id, ...) { metaobject_delete <- function(id, ...) {
checkmate::assert_int(id) checkmate::assert_int(id)
conn_ref <- modb_conn_ref(args = list(...)) conn_ref <- modb_conn_ref(args = list(...))
@@ -79,6 +194,8 @@ metaobject_delete <- function(id, ...) {
res <- .Call(c_rmodb_deleteMetaobject, conn_ref, as.integer(id)) res <- .Call(c_rmodb_deleteMetaobject, conn_ref, as.integer(id))
return(res) return(res)
} }
#' @export
metaobject <- function(id, ...) { metaobject <- function(id, ...) {
checkmate::assert_int(id) checkmate::assert_int(id)
conn_ref <- modb_conn_ref(args = list(...)) conn_ref <- modb_conn_ref(args = list(...))
@@ -87,7 +204,8 @@ metaobject <- function(id, ...) {
return(res) return(res)
} }
metaobjects <- function(withDeleted = FALSE, ...) #' @export
metaobjects <- function(id_list = NULL, withDeleted = FALSE, ...)
{ {
checkmate::assert_logical(withDeleted) checkmate::assert_logical(withDeleted)
conn_ref <- modb_conn_ref(args = list(...)) conn_ref <- modb_conn_ref(args = list(...))
@@ -98,3 +216,51 @@ metaobjects <- function(withDeleted = FALSE, ...)
return(res) return(res)
} }
#' @export
metadata <- function(id, ...) {
checkmate::assert_int(id)
conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(c_rmodb_metaobject, conn_ref, as.integer(id))
res[names(res) %in% c("object")] <- NULL
return(res)
}
#' @export
metadatas <- function(id_list = NULL, withDeleted = FALSE, ...) {
if (!checkmate::test_null(id_list)) {
return(lapply(
id_list, rmodb:::metadata, conn_ref = conn_id, withDeleted = withDeleted
))
}
conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(c_rmodb_metadatas, conn_ref, as.logical(withDeleted))
return(res)
}
#' @export
object <- function(id, ...) {
checkmate::assert_int(id)
conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(c_rmodb_metaobject, conn_ref, as.integer(id))
return(res$object)
}
#' @export
objects <- function(id_list = NULL, withDeleted = FALSE, ...) {
if (!checkmate::test_null(id_list)) {
return(lapply(
id_list, rmodb:::object, conn_ref = conn_id, withDeleted = withDeleted
))
}
conn_ref <- modb_conn_ref(args = list(...))
res <- .Call(c_rmodb_metaobjects, conn_ref, as.logical(withDeleted))
return(res$object)
}

View File

@@ -3,6 +3,7 @@
#include "modb_database.h" #include "modb_database.h"
#include "modb_ref.h" #include "modb_ref.h"
#include "modb_users.h"
#include "R_helpers_p.h" #include "R_helpers_p.h"
#include "R_list_item.h" #include "R_list_item.h"
#include "R_timestamp.h" #include "R_timestamp.h"
@@ -12,6 +13,8 @@
#include "R_memory-object.h" #include "R_memory-object.h"
#include "R_magic.h" #include "R_magic.h"
#include "modb_p.h" // ARGH!
SEXP metadataToR(struct metadata_t *metadata) SEXP metadataToR(struct metadata_t *metadata)
@@ -121,41 +124,68 @@ SEXP metadataExtToR(struct meta_ext_t *ext)
struct meta_ext_value_t *ext_value; struct meta_ext_value_t *ext_value;
r_ext = PROTECT(Rf_allocVector(VECSXP, 1 + (int)ext->n_values)); r_ext = PROTECT(Rf_allocVector(VECSXP, 0 + (int)ext->n_values));
n_protect++; n_protect++;
r_attrib_names = PROTECT(Rf_allocVector(STRSXP, 1 + (int)ext->n_values)); r_attrib_names = PROTECT(Rf_allocVector(STRSXP, 0 + (int)ext->n_values));
n_protect++; n_protect++;
//printf("MAKING EXT\n");
for (idx = 0; idx < ext->n_values; idx++) { for (idx = 0; idx < ext->n_values; idx++) {
ext_value = *(ext->values + idx); ext_value = *(ext->values + idx);
//printf("%d, %s, %d, %p\n", ext_value->is_null, ext_value->key_c, ext_value->type, ext_value->value.raw);
switch(ext_value->type) { switch(ext_value->type) {
case VTYPE_RAW: case VTYPE_RAW:
r_tmp = PROTECT(objectToR(ext_value->value.raw)); r_tmp = PROTECT(objectToR(ext_value->value.raw));
break; break;
case VTYPE_BOOL: case VTYPE_BOOL:
r_tmp = PROTECT(Rf_ScalarLogical(ext_value->value.bool)); if (ext_value->is_null) {
r_tmp = PROTECT(Rf_ScalarLogical(R_NaInt));
} else {
r_tmp = PROTECT(Rf_ScalarLogical(ext_value->value.boolVal));
}
break; break;
case VTYPE_INT32: case VTYPE_INT32:
if (ext_value->is_null) {
r_tmp = PROTECT(Rf_ScalarInteger(R_NaInt));
} else {
r_tmp = PROTECT(Rf_ScalarInteger(ext_value->value.int32)); r_tmp = PROTECT(Rf_ScalarInteger(ext_value->value.int32));
}
break; break;
case VTYPE_DOUBLE: case VTYPE_DOUBLE:
if (ext_value->is_null) {
r_tmp = PROTECT(Rf_ScalarReal(R_NaReal));
} else {
r_tmp = PROTECT(Rf_ScalarReal(ext_value->value.dbl)); r_tmp = PROTECT(Rf_ScalarReal(ext_value->value.dbl));
}
break; break;
case VTYPE_STRING: case VTYPE_STRING:
r_tmp = PROTECT(Rf_allocVector(STRSXP, 1)); r_tmp = PROTECT(Rf_allocVector(STRSXP, 1));
n_protect++; n_protect++;
if (ext_value->is_null) {
SET_STRING_ELT(r_tmp, 0, PROTECT(R_NaString));
} else {
SET_STRING_ELT(r_tmp, 0, PROTECT(Rf_mkChar(ext_value->value.str))); SET_STRING_ELT(r_tmp, 0, PROTECT(Rf_mkChar(ext_value->value.str)));
}
break; break;
case VTYPE_TIMESTAMP: case VTYPE_TIMESTAMP:
if (ext_value->is_null) {
r_tmp = PROTECT(Rf_ScalarReal(R_NaReal));
} else {
r_tmp = PROTECT(R_Timestamp(ext_value->value.ts)); r_tmp = PROTECT(R_Timestamp(ext_value->value.ts));
}
break; break;
case VTYPE_ID: case VTYPE_ID:
if (ext_value->is_null) {
r_tmp = PROTECT(Rf_ScalarInteger(R_NaInt));
} else {
r_tmp = PROTECT(Rf_ScalarInteger((int)ext_value->value.id)); r_tmp = PROTECT(Rf_ScalarInteger((int)ext_value->value.id));
}
break; break;
} }
SET_VECTOR_ELT(r_ext, 1 + (int)idx, r_tmp); SET_VECTOR_ELT(r_ext, 0 + (int)idx, r_tmp);
SET_STRING_ELT(r_attrib_names, 1 + (int)idx, PROTECT(Rf_mkChar(ext_value->key_c))); SET_STRING_ELT(r_attrib_names, 0 + (int)idx, PROTECT(Rf_mkChar(ext_value->key_c)));
n_protect += 2; n_protect += 2;
} }
@@ -165,10 +195,368 @@ SEXP metadataExtToR(struct meta_ext_t *ext)
return r_ext; return r_ext;
} }
SEXP rmodb_metaobjectId(SEXP r_conn_ref, SEXP r_query) SEXP rmodb_metaobjectQuery(SEXP r_conn_ref, SEXP r_query, SEXP r_with_deleted,
SEXP r_owner_restrict)
{ {
stored_conn *sconn;
modb_ref modb;
SEXP r_query_names;
SEXP r_tmp;
SEXP r_metadatas;
int i;
const char *col;
const char *tmp_str;
where_builder *wb = 0, *wb_in = 0;
struct user_t user;
struct metadata_t *metadata;
struct metadata_t **metadata_list;
size_t n_metadatas;
size_t idx, n_ids, m_idx;
unsigned int *ids;
char *table;
size_t table_len;
if ((sconn = getConnectionByRef(r_conn_ref)) == 0) {
Rf_error("invalid connection reference\n");
}
if (!modbFindUse(sconn, &modb)) {
Rf_error("invalid modb reference\n");
}
bzero(&user, sizeof(struct user_t));
user.id = (unsigned int)Rf_asInteger(r_owner_restrict);
if (user.id > 0) {
wb = where(0, "owner_id", EQ, TYPE_ID, 1, user.id);
if (!modbFetchUserGroupIds(sconn, &modb, &user)) {
Rf_error("invalid user id\n");
}
if (user.n_groups > 0) {
for (idx = 0; idx < user.n_groups; idx++) {
if (modbFetchGroupMetadataIds(sconn, &modb, *(user.group_ids + idx), &ids, &n_ids) < 0) {
free(user.groups);
return R_NilValue; return R_NilValue;
} }
for (m_idx = 0; m_idx < n_ids; m_idx++) {
if (wb_in == 0) {
modbTableName(&table, &table_len, &modb, METADATA_TABLE, STR_LEN(METADATA_TABLE));
wb_in = whereIn(0, table, "mdo_id", TYPE_ID, 0);
modbFreeTableName(&table);
}
setWhereValue(wb_in, TYPE_ID, 1, *(ids + m_idx));
}
free(ids);
}
free(user.groups);
if (wb_in != 0) {
wb = createWhereBuilder(wb);
wb = whereAnd(0, whereOr(wb, wb_in));
}
}
}
if (Rf_asLogical(r_with_deleted) == 0) {
wb = whereAnd(wb, where(0, "deleted", IS_NULL, TYPE_RAW, 0));
}
r_query_names = Rf_getAttrib(r_query, R_NamesSymbol);
for (i = 0; i < LENGTH(r_query); i++) {
col = Rf_translateCharUTF8(STRING_ELT(r_query_names, i));
r_tmp = VECTOR_ELT(r_query, i);
if (Rf_isNull(r_tmp)) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
switch(TYPEOF(r_tmp)) {
case LGLSXP:/* logical vectors */
wb = whereAnd(wb, where(0, col, EQ, TYPE_BOOL, 1, Rf_asLogical(r_tmp)));
break;
case INTSXP:/* integer vectors */
wb = whereAnd(wb, where(0, col, EQ, TYPE_INT32, 1, Rf_asInteger(r_tmp)));
break;
case REALSXP:/* real variables */
wb = whereAnd(wb, where(0, col, EQ, TYPE_DOUBLE, 1, Rf_asReal(r_tmp)));
break;
case STRSXP:/* string vectors */
r_tmp = STRING_ELT(r_tmp, 0);
if (r_tmp == R_NaString) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
tmp_str = Rf_translateCharUTF8(r_tmp);
wb = whereAnd(wb, where(0, col, EQ, TYPE_STRING, 2, tmp_str, strlen(tmp_str)));
}
break;
case VECSXP:/* generic vectors */
break;
default:
break;
// Screwed if I know how to handle this...
}
}
}
if (modbMetadataQuery(sconn, &modb, wb, &metadata_list, &n_metadatas) <= 0) {
freeWhereBuilder(&wb);
return R_NilValue;
}
freeWhereBuilder(&wb);
r_metadatas = PROTECT(Rf_allocVector(VECSXP, (int)n_metadatas));
for (idx = 0; idx < n_metadatas; idx++) {
metadata = *(metadata_list + idx);
if (modbFetchMetadataOwner(sconn, &modb, metadata) < 0) {
freeMetadata(&metadata);
UNPROTECT(1 + (int)idx);
return R_NilValue;
}
if (modbFetchMetadataGroups(sconn, &modb, metadata, 0) < 0) {
freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT(1 + (int)idx);
return R_NilValue;
}
// if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) {
// freeMetadataList(&metadata_list, n_metadatas);
// UNPROTECT(1 + (int)idx);
// return R_NilValue;
// }
if (modbFetchMetadataObject(sconn, &modb, metadata) < 0) {
freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT(1 + (int)idx);
return R_NilValue;
}
SET_VECTOR_ELT(r_metadatas, (int)idx, PROTECT(metadataToR(metadata)));
}
freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT((int)(1 + n_metadatas));
return r_metadatas;
}
SEXP rmodb_metadataQuery(SEXP r_conn_ref, SEXP r_query, SEXP r_with_deleted, SEXP r_owner_restrict)
{
stored_conn *sconn;
modb_ref modb;
SEXP r_query_names;
SEXP r_tmp;
SEXP r_metadatas;
int i;
const char *col;
const char *tmp_str;
where_builder *wb = 0, *wb_in = 0;
struct user_t user;
struct metadata_t *metadata;
struct metadata_t **metadata_list;
size_t n_metadatas;
size_t idx, n_ids, m_idx;
unsigned int *ids;
char *table;
size_t table_len;
if ((sconn = getConnectionByRef(r_conn_ref)) == 0) {
Rf_error("invalid connection reference\n");
}
if (!modbFindUse(sconn, &modb)) {
Rf_error("invalid modb reference\n");
}
bzero(&user, sizeof(struct user_t));
user.id = (unsigned int)Rf_asInteger(r_owner_restrict);
if (user.id > 0) {
wb = where(0, "owner_id", EQ, TYPE_ID, 1, user.id);
if (!modbFetchUserGroupIds(sconn, &modb, &user)) {
Rf_error("invalid user id\n");
}
if (user.n_groups > 0) {
for (idx = 0; idx < user.n_groups; idx++) {
if (modbFetchGroupMetadataIds(sconn, &modb, *(user.group_ids + idx), &ids, &n_ids) < 0) {
free(user.groups);
return R_NilValue;
}
for (m_idx = 0; m_idx < n_ids; m_idx++) {
if (wb_in == 0) {
modbTableName(&table, &table_len, &modb, METADATA_TABLE, STR_LEN(METADATA_TABLE));
wb_in = whereIn(0, table, "mdo_id", TYPE_ID, 0);
modbFreeTableName(&table);
}
setWhereValue(wb_in, TYPE_ID, 1, *(ids + m_idx));
}
free(ids);
}
free(user.groups);
if (wb_in != 0) {
wb = whereAnd(0, whereOr(wb, wb_in));
}
}
}
if (Rf_asLogical(r_with_deleted) == 0) {
wb = whereAnd(wb, where(0, "deleted", IS_NULL, TYPE_RAW, 0));
}
r_query_names = Rf_getAttrib(r_query, R_NamesSymbol);
for (i = 0; i < LENGTH(r_query); i++) {
col = Rf_translateCharUTF8(STRING_ELT(r_query_names, i));
r_tmp = VECTOR_ELT(r_query, i);
if (Rf_isNull(r_tmp)) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
switch(TYPEOF(r_tmp)) {
case LGLSXP:/* logical vectors */
wb = whereAnd(wb, where(0, col, EQ, TYPE_BOOL, 1, Rf_asLogical(r_tmp)));
break;
case INTSXP:/* integer vectors */
wb = whereAnd(wb, where(0, col, EQ, TYPE_INT32, 1, Rf_asInteger(r_tmp)));
break;
case REALSXP:/* real variables */
wb = whereAnd(wb, where(0, col, EQ, TYPE_DOUBLE, 1, Rf_asReal(r_tmp)));
break;
case STRSXP:/* string vectors */
r_tmp = STRING_ELT(r_tmp, 0);
if (r_tmp == R_NaString) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
tmp_str = Rf_translateCharUTF8(r_tmp);
wb = whereAnd(wb, where(0, col, EQ, TYPE_STRING, 2, tmp_str, strlen(tmp_str)));
}
break;
case VECSXP:/* generic vectors */
break;
default:
break;
// Screwed if I know how to handle this...
}
}
}
if (modbMetadataQuery(sconn, &modb, wb, &metadata_list, &n_metadatas) <= 0) {
freeWhereBuilder(&wb);
return R_NilValue;
}
freeWhereBuilder(&wb);
r_metadatas = PROTECT(Rf_allocVector(VECSXP, (int)n_metadatas));
for (idx = 0; idx < n_metadatas; idx++) {
metadata = *(metadata_list + idx);
if (modbFetchMetadataOwner(sconn, &modb, metadata) < 0) {
freeMetadata(&metadata);
UNPROTECT(1 + (int)idx);
return R_NilValue;
}
if (modbFetchMetadataGroups(sconn, &modb, metadata, 0) < 0) {
freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT(1 + (int)idx);
return R_NilValue;
}
// if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) {
// freeMetadataList(&metadata_list, n_metadatas);
// UNPROTECT(1 + (int)idx);
// return R_NilValue;
// }
SET_VECTOR_ELT(r_metadatas, (int)idx, PROTECT(metadataToR(metadata)));
}
freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT((int)(1 + n_metadatas));
return r_metadatas;
}
SEXP rmodb_metaobjectIds(SEXP r_conn_ref, SEXP r_query, SEXP r_with_deleted)
{
stored_conn *sconn;
modb_ref modb;
SEXP r_query_names;
SEXP r_tmp;
SEXP r_ids;
int i;
const char *col;
const char *tmp_str;
where_builder *wb = 0;
struct metadata_t *metadata;
struct metadata_t **metadata_list;
size_t n_metadatas;
size_t idx;
if ((sconn = getConnectionByRef(r_conn_ref)) == 0) {
Rf_error("invalid connection reference\n");
}
if (!modbFindUse(sconn, &modb)) {
Rf_error("invalid modb reference\n");
}
if (Rf_asLogical(r_with_deleted) == 0) {
wb = where(0, "deleted", IS_NULL, TYPE_RAW, 0);
}
r_query_names = Rf_getAttrib(r_query, R_NamesSymbol);
for (i = 0; i < LENGTH(r_query); i++) {
col = Rf_translateCharUTF8(STRING_ELT(r_query_names, i));
r_tmp = VECTOR_ELT(r_query, i);
if (Rf_isNull(r_tmp)) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
switch(TYPEOF(r_tmp)) {
case LGLSXP:/* logical vectors */
if (R_IsNA(Rf_asLogical(r_tmp))) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
wb = whereAnd(wb, where(0, col, EQ, TYPE_BOOL, 1, Rf_asLogical(r_tmp)));
}
break;
case INTSXP:/* integer vectors */
if (R_IsNA(Rf_asInteger(r_tmp))) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
wb = whereAnd(wb, where(0, col, EQ, TYPE_INT32, 1, Rf_asInteger(r_tmp)));
}
break;
case REALSXP:/* real variables */
if (R_IsNA(Rf_asReal(r_tmp))) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
wb = whereAnd(wb, where(0, col, EQ, TYPE_DOUBLE, 1, Rf_asReal(r_tmp)));
}
break;
case STRSXP:/* string vectors */
r_tmp = STRING_ELT(r_tmp, 0);
if (r_tmp == R_NaString) {
wb = whereAnd(wb, where(0, col, IS_NULL, TYPE_RAW, 0));
} else {
tmp_str = Rf_translateCharUTF8(r_tmp);
wb = whereAnd(wb, where(0, col, EQ, TYPE_STRING, 2, tmp_str, strlen(tmp_str)));
}
break;
case VECSXP:/* generic vectors */
break;
default:
break;
// Screwed if I know how to handle this...
}
}
}
if (modbMetadataQuery(sconn, &modb, wb, &metadata_list, &n_metadatas) <= 0) {
freeWhereBuilder(&wb);
return R_NilValue;
}
freeWhereBuilder(&wb);
r_ids = PROTECT(Rf_allocVector(INTSXP, (int)n_metadatas));
for (idx = 0; idx < n_metadatas; idx++) {
metadata = *(metadata_list + idx);
SET_INTEGER_ELT(r_ids, (int)idx, (int)metadata->id);
}
freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT(1);
return r_ids;
}
SEXP rmodb_metaobject(SEXP r_conn_ref, SEXP r_id) SEXP rmodb_metaobject(SEXP r_conn_ref, SEXP r_id)
{ {
@@ -195,15 +583,15 @@ SEXP rmodb_metaobject(SEXP r_conn_ref, SEXP r_id)
freeMetadata(&metadata); freeMetadata(&metadata);
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataGroups(sconn, &modb, metadata, 0) <= 0) { if (modbFetchMetadataGroups(sconn, &modb, metadata, 0) < 0) {
freeMetadata(&metadata); freeMetadata(&metadata);
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataExtended(sconn, &modb, metadata) <= 0) { if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) {
freeMetadata(&metadata); freeMetadata(&metadata);
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataObject(sconn, &modb, metadata) <= 0) { if (modbFetchMetadataObject(sconn, &modb, metadata) < 0) {
freeMetadata(&metadata); freeMetadata(&metadata);
return R_NilValue; return R_NilValue;
} }
@@ -234,15 +622,15 @@ SEXP rmodb_metadata(SEXP r_conn_ref, SEXP r_id)
if (modbMetadataById(sconn, &modb, mo_id, &metadata) <= 0) { if (modbMetadataById(sconn, &modb, mo_id, &metadata) <= 0) {
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataOwner(sconn, &modb, metadata) <= 0) { if (modbFetchMetadataOwner(sconn, &modb, metadata) < 0) {
freeMetadata(&metadata); freeMetadata(&metadata);
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataGroups(sconn, &modb, metadata, 0) <= 0) { if (modbFetchMetadataGroups(sconn, &modb, metadata, 0) < 0) {
freeMetadata(&metadata); freeMetadata(&metadata);
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataExtended(sconn, &modb, metadata) <= 0) { if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) {
freeMetadata(&metadata); freeMetadata(&metadata);
return R_NilValue; return R_NilValue;
} }
@@ -320,11 +708,11 @@ SEXP rmodb_metaobjects(SEXP r_conn_ref, SEXP r_with_deleted)
UNPROTECT(1 + (int)idx); UNPROTECT(1 + (int)idx);
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) { // if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) {
freeMetadataList(&metadata_list, n_metadatas); // freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT(1 + (int)idx); // UNPROTECT(1 + (int)idx);
return R_NilValue; // return R_NilValue;
} // }
if (modbFetchMetadataObject(sconn, &modb, metadata) < 0) { if (modbFetchMetadataObject(sconn, &modb, metadata) < 0) {
freeMetadataList(&metadata_list, n_metadatas); freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT(1 + (int)idx); UNPROTECT(1 + (int)idx);
@@ -375,11 +763,11 @@ SEXP rmodb_metadatas(SEXP r_conn_ref, SEXP r_with_deleted)
UNPROTECT(1 + (int)idx); UNPROTECT(1 + (int)idx);
return R_NilValue; return R_NilValue;
} }
if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) { // if (modbFetchMetadataExtended(sconn, &modb, metadata) < 0) {
freeMetadataList(&metadata_list, n_metadatas); // freeMetadataList(&metadata_list, n_metadatas);
UNPROTECT(1 + (int)idx); // UNPROTECT(1 + (int)idx);
return R_NilValue; // return R_NilValue;
} // }
SET_VECTOR_ELT(r_metadatas, (int)idx, PROTECT(metadataToR(metadata))); SET_VECTOR_ELT(r_metadatas, (int)idx, PROTECT(metadataToR(metadata)));
} }
@@ -485,20 +873,34 @@ SEXP rmodb_createMetaobject(SEXP r_conn_ref, SEXP r_id,
switch(TYPEOF(r_tmp)) { switch(TYPEOF(r_tmp)) {
case LGLSXP:/* logical vectors */ case LGLSXP:/* logical vectors */
ext_value->type = VTYPE_BOOL; ext_value->type = VTYPE_BOOL;
ext_value->value.bool = Rf_asLogical(r_tmp); ext_value->value.boolVal = Rf_asLogical(r_tmp);
if (R_IsNA(Rf_asReal(r_tmp))) {
ext_value->is_null = 1;
}
break; break;
case INTSXP:/* integer vectors */ case INTSXP:/* integer vectors */
ext_value->type = VTYPE_INT32; ext_value->type = VTYPE_INT32;
ext_value->value.int32 = Rf_asInteger(r_tmp); ext_value->value.int32 = Rf_asInteger(r_tmp);
if (R_IsNA(Rf_asReal(r_tmp))) {
ext_value->is_null = 1;
}
break; break;
case REALSXP:/* real variables */ case REALSXP:/* real variables */
ext_value->type = VTYPE_DOUBLE; ext_value->type = VTYPE_DOUBLE;
ext_value->value.dbl = Rf_asReal(r_tmp); ext_value->value.dbl = Rf_asReal(r_tmp);
if (R_IsNA(Rf_asReal(r_tmp))) {
ext_value->is_null = 1;
}
break; break;
case STRSXP:/* string vectors */ case STRSXP:/* string vectors */
ext_value->type = VTYPE_STRING; ext_value->type = VTYPE_STRING;
ext_value->value.str_c = Rf_translateCharUTF8(STRING_ELT(r_tmp, 0)); r_tmp = STRING_ELT(r_tmp, 0);
if (r_tmp == R_NaString) {
ext_value->is_null = 1;
} else {
ext_value->value.str_c = Rf_translateCharUTF8(r_tmp);
ext_value->is_const = 1; ext_value->is_const = 1;
}
break; break;
case VECSXP:/* generic vectors */ case VECSXP:/* generic vectors */
break; break;
@@ -519,9 +921,164 @@ SEXP rmodb_createMetaobject(SEXP r_conn_ref, SEXP r_id,
return Rf_ScalarReal((double)metadata.id); return Rf_ScalarReal((double)metadata.id);
} }
SEXP rmodb_updateMetaobject(SEXP r_conn_ref, SEXP r_id, SEXP r_metaobject) SEXP rmodb_updateMetaobject(SEXP r_conn_ref, SEXP r_id,
SEXP r_metadata, SEXP r_object, SEXP r_extendedMeta)
{ {
return R_NilValue; stored_conn *sconn;
modb_ref modb;
struct metadata_t metadata;
struct object_t object;
struct meta_ext_t *metadata_ext;
struct meta_ext_value_t *ext_value;
struct r_memoryobject_t *memObj;
SEXP r_tmp, r_names;
int i;
if ((sconn = getConnectionByRef(r_conn_ref)) == 0) {
Rf_error("invalid connection reference\n");
}
if (!modbFindUse(sconn, &modb)) {
Rf_error("invalid modb reference\n");
}
memset(&metadata, 0, sizeof(struct metadata_t));
metadata.id = (unsigned int)Rf_asInteger(r_id);
if (!Rf_isNull(r_metadata) && TYPEOF(r_metadata) == VECSXP && LENGTH(r_metadata) == 1 && Rf_isNull(VECTOR_ELT(r_metadata, 0))) {
// Nothing to do here
} else {
r_tmp = R_listItem(r_metadata, "title");
if (r_tmp != R_NilValue) {
metadata.title_c = Rf_translateCharUTF8(STRING_ELT(r_tmp, 0));
}
r_tmp = R_listItem(r_metadata, "owner_id");
if (r_tmp != R_NilValue) {
metadata.owner_id = (unsigned int)Rf_asInteger(r_tmp);
}
r_tmp = R_listItem(r_metadata, "created_on");
if (r_tmp != R_NilValue) {
metadata.created_on = R_TimestampUnix(r_tmp);
}
r_tmp = R_listItem(r_metadata, "updated_on");
if (r_tmp != R_NilValue) {
metadata.updated_on = R_TimestampUnix(r_tmp);
}
r_tmp = R_listItem(r_metadata, "deleted_on");
if (r_tmp != R_NilValue) {
metadata.deleted_on = R_TimestampUnix(r_tmp);
}
if (!modbMetadataReplace(sconn, &modb, metadata.id, &metadata)) {
return Rf_ScalarLogical(FALSE);
}
r_tmp = R_listItem(r_metadata, "group_ids");
if (r_tmp != R_NilValue) {
if (LENGTH(r_tmp) == 1 && TYPEOF(r_tmp) != VECSXP) {
if (modbLink_Metadata_Group(
sconn, &modb, metadata.id,
(unsigned int)Rf_asInteger(r_tmp)) <= 0) {
return Rf_ScalarLogical(FALSE);
}
} else {
for (i = 0; i < LENGTH(r_tmp); i++) {
if (modbLink_Metadata_Group(
sconn, &modb, metadata.id,
(unsigned int)Rf_asInteger(VECTOR_ELT(r_tmp, i))) <= 0) {
return Rf_ScalarLogical(FALSE);
}
}
}
}
}
if (!Rf_isNull(r_object) && TYPEOF(r_object) == VECSXP && LENGTH(r_object) == 1 && Rf_isNull(VECTOR_ELT(r_object, 0))) {
} else {
memObj = robjectToMemory(r_object, R_MAGIC_XDR_V3);
object.id = metadata.id;
object.data_c = memObj->buf;
object.data_len = memObj->buf_size;
if (modbObjectUpdate(sconn, &modb, metadata.id, &object) <= 0) {
free(memObj->buf);
free(memObj);
return Rf_ScalarLogical(FALSE);
}
free(memObj->buf);
free(memObj);
}
if (!Rf_isNull(r_extendedMeta) && TYPEOF(r_extendedMeta) == VECSXP && LENGTH(r_extendedMeta) == 1 && Rf_isNull(VECTOR_ELT(r_extendedMeta, 0))) {
} else {
if ((metadata_ext = allocMetaExt()) == 0) {
return Rf_ScalarLogical(FALSE);
}
metadata_ext->id = metadata.id;
metadata_ext->n_values = (size_t)LENGTH(r_extendedMeta);
metadata_ext->values = allocMetaExtValues(metadata_ext->n_values, 1);
if (metadata_ext->values == 0) {
freeMetaExt(&metadata_ext);
return Rf_ScalarLogical(FALSE);
}
r_names = Rf_getAttrib(r_extendedMeta, R_NamesSymbol);
for (i = 0; i < LENGTH(r_extendedMeta); i++) {
ext_value = *(metadata_ext->values + i);
ext_value->key_c = Rf_translateCharUTF8(STRING_ELT(r_names, i));
r_tmp = VECTOR_ELT(r_extendedMeta, i);
if (Rf_isNull(r_tmp)) {
ext_value->type = VTYPE_RAW;
ext_value->is_null = 1;
} else {
switch(TYPEOF(r_tmp)) {
case LGLSXP:/* logical vectors */
ext_value->type = VTYPE_BOOL;
ext_value->value.boolVal = Rf_asLogical(r_tmp);
if (R_IsNA(Rf_asReal(r_tmp))) {
ext_value->is_null = 1;
}
break;
case INTSXP:/* integer vectors */
ext_value->type = VTYPE_INT32;
ext_value->value.int32 = Rf_asInteger(r_tmp);
if (R_IsNA(Rf_asReal(r_tmp))) {
ext_value->is_null = 1;
}
break;
case REALSXP:/* real variables */
ext_value->type = VTYPE_DOUBLE;
ext_value->value.dbl = Rf_asReal(r_tmp);
if (R_IsNA(Rf_asReal(r_tmp))) {
ext_value->is_null = 1;
}
break;
case STRSXP:/* string vectors */
ext_value->type = VTYPE_STRING;
r_tmp = STRING_ELT(r_tmp, 0);
if (r_tmp == R_NaString) {
ext_value->is_null = 1;
} else {
ext_value->value.str_c = Rf_translateCharUTF8(r_tmp);
ext_value->is_const = 1;
}
break;
case VECSXP:/* generic vectors */
break;
default:
break;
// Screwed if I know how to handle this...
}
}
}
if (modbMetaExtReplace(sconn, &modb, metadata.id, metadata_ext) <= 0) {
freeMetaExt(&metadata_ext);
return Rf_ScalarLogical(FALSE);
}
}
return Rf_ScalarLogical(TRUE);
} }
SEXP rmodb_deleteMetaobject(SEXP r_conn_ref, SEXP r_id) SEXP rmodb_deleteMetaobject(SEXP r_conn_ref, SEXP r_id)
{ {

View File

@@ -10,7 +10,10 @@ SEXP metadataToR(struct metadata_t *metadata);
SEXP objectToR(struct object_t *object); SEXP objectToR(struct object_t *object);
SEXP metadataExtToR(struct meta_ext_t *ext); SEXP metadataExtToR(struct meta_ext_t *ext);
SEXP rmodb_metaobjectId(SEXP r_conn_ref, SEXP r_query); SEXP rmodb_metaobjectIds(SEXP r_conn_ref, SEXP r_query, SEXP with_deleted);
SEXP rmodb_metaobjectQuery(SEXP r_conn_ref, SEXP r_query, SEXP r_with_deleted,
SEXP r_owner_restrict);
SEXP rmodb_metadataQuery(SEXP r_conn_ref, SEXP r_query, SEXP r_with_deleted, SEXP r_owner_restrict);
SEXP rmodb_metaobject(SEXP r_conn_ref, SEXP r_id); SEXP rmodb_metaobject(SEXP r_conn_ref, SEXP r_id);
SEXP rmodb_metadata(SEXP r_conn_ref, SEXP r_id); SEXP rmodb_metadata(SEXP r_conn_ref, SEXP r_id);
@@ -21,7 +24,8 @@ SEXP rmodb_metadatas(SEXP r_conn_ref, SEXP r_with_deleted);
SEXP rmodb_createMetaobject(SEXP r_conn_ref, SEXP r_id, SEXP rmodb_createMetaobject(SEXP r_conn_ref, SEXP r_id,
SEXP r_metadata, SEXP r_object, SEXP r_extendedMeta); SEXP r_metadata, SEXP r_object, SEXP r_extendedMeta);
SEXP rmodb_updateMetaobject(SEXP r_conn_ref, SEXP r_id, SEXP r_metaobject); SEXP rmodb_updateMetaobject(SEXP r_conn_ref, SEXP r_id,
SEXP r_metadata, SEXP r_object, SEXP r_extendedMeta);
SEXP rmodb_deleteMetaobject(SEXP r_conn_ref, SEXP r_id); SEXP rmodb_deleteMetaobject(SEXP r_conn_ref, SEXP r_id);