| 2fec20fe |
|
| 4ad24353 |
.counter <- function(zero = 0) {
|
| 73652f4d |
i <- zero
function() {
i <<- i + 1
toString <- as.character(i)
}
|
| 193ae520 |
}
|
| 4ad24353 |
.add_metadata <- function(files) {
|
| 73652f4d |
x <- scan(files, what="", sep="\n")
y <- strsplit(x, "\t")
names(y) <- vapply(y, `[[`,character(1), 1)
listMeta <- lapply(y, `[`, -1)
|
| 193ae520 |
}
|
| 4ad24353 |
.schema_header <- function(datasetName) {
|
| 73652f4d |
schema_name <- list.files(
datasetName,
pattern = "*.schema$",
full.names = TRUE)
schema_name_xml <- list.files(
datasetName,
pattern = "*.xml$",
full.names = TRUE)
if(!length(schema_name) && !length(schema_name_xml))
stop("schema not present")
if(!length(schema_name))
xml_schema <- xml2::read_xml(schema_name_xml)
else
xml_schema <- xml2::read_xml(schema_name)
list_field <- xml2::as_list(xml_schema)
vector_field <- unlist(list_field)
|
| 193ae520 |
}
|
| 6ac6e0b7 |
|
| 4ad24353 |
.schema_type_coordinate <- function(datasetName) {
|
| 73652f4d |
schema_name <- list.files(
datasetName,
pattern = "*.schema$",
full.names = TRUE)
schema_name_xml <- list.files(
datasetName,
pattern = "*.xml$",
full.names = TRUE)
if(!length(schema_name) && !length(schema_name_xml))
stop("schema not present")
if(!length(schema_name))
xml_schema <- xml2::read_xml(schema_name_xml)
else
xml_schema <- xml2::read_xml(schema_name)
gmql_schema_tag <- xml2::xml_children(xml_schema)
all_attrs <- xml2::xml_attrs(gmql_schema_tag)
all_attrs_list <- as.list(all_attrs[[1]])
|
| a5e2122b |
}
|
| 43b72c07 |
# aggregates factory
|
| 4ad24353 |
.aggregates <- function(meta_data,class) {
|
| 73652f4d |
if(!is.list(meta_data))
stop("meta_data: invalid input")
if(!all(vapply(meta_data, function(x) is(x,class), logical(1))))
stop("All elements must be META_AGGREGATES object")
names <- names(meta_data)
if(is.null(names)) {
warning("You did not assign a names to a list.\nWe build it for you")
names <- vapply(meta_data, take_value.META_AGGREGATES,character(1))
} else {
if("" %in% names)
stop("No partial names assignment is allowed")
}
aggregate_matrix <- t(vapply(meta_data, function(x) {
new_value = as.character(x)
matrix <- matrix(new_value)
},character(2)))
m_names <- matrix(names)
metadata_matrix <- cbind(m_names,aggregate_matrix)
|
| 43b72c07 |
}
|
| 94a33e57 |
# meta join condition
|
| 4ad24353 |
.join_condition <- function(cond) {
|
| 73652f4d |
cond_matrix <- NULL
def <- cond$condition$def
if(!is.null(def))
cond_matrix <- rbind(cond_matrix, def)
exact <- cond$condition$exact
if(!is.null(exact))
cond_matrix <- rbind(cond_matrix, exact)
full <- cond$condition$full
if(!is.null(full))
cond_matrix <- rbind(cond_matrix, full)
cond_matrix
|
| bdfe862e |
}
|
| 2deed4ee |
|
| 4ad24353 |
.check_input <- function(value) {
|
| 73652f4d |
if(!is.character(value))
stop("no valid data")
if(length(value)>1)
stop("no multiple string")
|
| 8dc4d3af |
}
|
| 2deed4ee |
|
| 4ad24353 |
.check_logical <- function(value) {
|
| 73652f4d |
if(!is.logical(value))
stop("no valid data")
if(length(value)>1)
stop("no multiple string")
|
| 8dc4d3af |
}
|
| 18697071 |
|
| 4ad24353 |
.is_login_expired <- function(url) {
|
| 73652f4d |
if(exists("GMQL_credentials", envir = .GlobalEnv)) {
if(exists("authToken", where = GMQL_credentials)) {
authToken <- GMQL_credentials$authToken
url <- sub("/*[/]$","",url)
h <- c('Accept' = 'Application/json', 'X-Auth-Token' = authToken)
URL <- paste0(url,"/user")
req <- httr::GET(URL,httr::add_headers(h))
if(req$status_code != 200)
return(TRUE)
else
return(FALSE)
|
| 18697071 |
}
|
| 73652f4d |
}
return(TRUE)
|
| 18697071 |
}
|
