Nothing
#' Register a new dataseries
#'
#' This function registers a new dataseries of both, geometries or areal data
#' into the geospatial database. This contains the name and relevant meta-data
#' of a dataseries to enable provenance tracking and reproducability.
#' @param name [\code{character(1)}]\cr the dataseries abbreviation or name.
#' @param description [\code{character(1)}]\cr the "long name" or "brief
#' description" of the dataseries.
#' @param homepage [\code{character(1)}]\cr the homepage of the data provider
#' where the dataseries or additional information can be found.
#' @param licence_link [\code{character(1)}]\cr link to the licence or the
#' webpage from which the licence was copied.
#' @param licence_path [\code{character(1)}]\cr path to the local file in which
#' the licence text is stored.
#' @param notes [\code{character(1)}]\cr optional notes.
#' @param update [\code{logical(1)}]\cr whether or not the file
#' 'inv_dataseries.csv' should be updated (obligatory to continue registering
#' geometries or tables associated to this dataseries).
#' @param overwrite [\code{logical(1)}]\cr whether or not the dataseries to
#' register shall overwrite a potentially already existing older version.
#' @return Returns a tibble of the new entry that is appended to
#' 'inv_dataseries.csv' in case \code{update = TRUE}.
#' @family register functions
#' @examples
#' if(dev.interactive()){
#' # start the example database
#' makeExampleDB(until = "match_gazetteer", path = tempdir())
#'
#' regDataseries(name = "gadm",
#' description = "Database of Global Administrative Areas",
#' homepage = "https://gadm.org/index.html",
#' licence_link = "https://gadm.org/license.html",
#' update = TRUE)
#' }
#' @importFrom readr read_csv
#' @importFrom checkmate assertDataFrame assertNames assertCharacter
#' assertLogical
#' @importFrom tibble tibble
#' @export
regDataseries <- function(name = NULL, description = NULL, homepage = NULL,
licence_link = NULL, licence_path = NULL, notes = NULL,
update = FALSE, overwrite = FALSE){
# get tables
inv_dataseries <- read_csv(paste0(getOption(x = "adb_path"), "/inv_dataseries.csv"), col_types = "icccccc")
# in testing mode?
testing <- getOption(x = "adb_testing")
# check validity of arguments
assertNames(x = colnames(inv_dataseries),
permutation.of = c("datID", "name", "description", "homepage",
"licence_link", "licence_path", "notes"))
assertCharacter(x = name, ignore.case = TRUE, any.missing = FALSE, len = 1, null.ok = TRUE)
assertCharacter(x = description, ignore.case = TRUE, any.missing = FALSE, len = 1, null.ok = TRUE)
assertCharacter(x = homepage, ignore.case = TRUE, any.missing = FALSE, len = 1, null.ok = TRUE)
assertCharacter(x = licence_link, ignore.case = TRUE, any.missing = FALSE, len = 1, null.ok = TRUE)
assertCharacter(x = licence_path, ignore.case = TRUE, any.missing = FALSE, len = 1, null.ok = TRUE)
assertCharacter(x = notes, ignore.case = TRUE, any.missing = FALSE, len = 1, null.ok = TRUE)
assertLogical(x = update, len = 1)
assertLogical(x = overwrite, len = 1)
# ask for missing and required arguments
if(is.null(name)){
message("please type in the dataseries abbreviation: ")
if(!testing){
theName <- readline()
} else {
theName <- NA
}
if(is.na(theName)){
theName = NA_character_
}
} else{
if(name %in% inv_dataseries$name & !overwrite){
message("! the dataseries '", name, "' has already been registered !")
temp <- inv_dataseries[which(inv_dataseries$name %in% name), ]
return(temp)
}
theName <- name
}
if(is.null(description)){
message("please type in the long name or description of the series: ")
if(!testing){
theDescription <- readline()
} else {
theDescription <- NA
}
if(is.na(theDescription)){
theDescription = NA_character_
}
} else{
theDescription <- description
}
if(is.null(homepage)){
message("please type in the dataseries homepage: ")
if(!testing){
theHomepage <- readline()
} else {
theHomepage <- NA
}
if(is.na(theHomepage)){
theHomepage = NA_character_
}
} else{
theHomepage <- homepage
}
if(is.null(licence_link)){
message("please type in the weblink to the dataseries licence: ")
if(!testing){
theLicence_link <- readline()
} else {
theLicence_link <- NA
}
if(is.na(theLicence_link)){
theLicence_link = NA_character_
}
} else{
theLicence_link <- licence_link
}
if(is.null(licence_path)){
message("please type in the path to the local folder where the licence is stored: ")
if(!testing){
theLicence_path <- readline()
} else {
theLicence_path <- NA
}
if(is.na(theLicence_path)){
theLicence_path = NA_character_
}
} else{
theLicence_path <- licence_path
}
if(is.null(notes)){
notes = NA_character_
}
# construct new documentation
newDID <- ifelse(length(inv_dataseries$datID)==0, 1, as.integer(max(inv_dataseries$datID)+1))
if(overwrite){
if(theName %in% inv_dataseries$name){
newDID <- inv_dataseries$datID[which(inv_dataseries$name %in% theName)]
}
}
temp <- tibble(datID = as.integer(newDID),
name = theName,
description = theDescription,
homepage = theHomepage,
licence_link = theLicence_link,
licence_path = theLicence_path,
notes = notes)
if(update){
# in case the user wants to update, attach the new information to the table inv_dataseries.csv
updateTable(index = temp, name = "inv_dataseries", matchCols = c("name"))
}
return(temp)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.