#library(curl)
#library(httr)
#library(jsonlite)
#' List External Resources
#'
#' List external resources for a study
#'
#' @return List of external resources
#' @param dataset_idno Study IDNo
#' @export
external_resources_list <- function(dataset_idno, api_key=NULL, api_base_url=NULL){
if(is.null(api_key)){
api_key=get_api_key();
}
endpoint=paste0('datasets/',dataset_idno,'/resources')
url=get_api_url(endpoint)
httpResponse <- GET(url, add_headers("X-API-KEY" = api_key), accept_json(), verbose(get_verbose()))
output=NULL
if(httpResponse$status_code!=200){
warning(content(httpResponse, "text"))
}else{
output=fromJSON(content(httpResponse,"text"))
}
return (output)
}
#' import_rdf
#'
#' Import an RDF file
#'
#' @return NULL
#' @param dataset_idno Study IDNo
#' @param rdf_file RDF file path
#' @param skip_uploads TRUE/FALSE - If TRUE, won't upload files
#' @param overwrite yes/no - Overwrite existing resources
#' @export
external_resources_import <- function(
dataset_idno,
rdf_file,
skip_uploads=FALSE,
overwrite="no",
api_key=NULL,
api_base_url=NULL
){
if(is.null(api_key)){
api_key=get_api_key();
}
resources <- rdfToList(rdf_file)
base_folder=dirname(rdf_file)
for(i in 1:length(resources)) {
if(is_valid_url(resources[[i]]$filename)){
resource_file=resources[[i]]$filename
}else {
resource_file=paste0(base_folder,"/",resources[[i]]$filename)
# If file not found in location provided in rdf (incl. sub-folder), look in base_folder itself
if(skip_uploads==FALSE && resources[[i]]$is_url==FALSE && file.exists(resource_file) == FALSE) {
resource_file = paste0(base_folder, "/", basename(resource_file))
if (!file.exists(resource_file)){
warning(paste0("Resource file not found: ",resource_file))
}
}
}
print(paste0("PROCESSING file.....",resource_file))
res_response <- external_resources_add(
idno = dataset_idno,
dctype = resources[[i]]$dctype,
dcformat = resources[[i]]$dcformat,
title = resources[[i]]$title,
author = resources[[i]]$creator,
dcdate = resources[[i]]$date,
country = resources[[i]]$spatial,
language = resources[[i]]$language,
contributor = resources[[i]]$contributor,
publisher = resources[[i]]$publisher,
rights = resources[[i]]$rights,
description = resources[[i]]$label,
abstract = resources[[i]]$abstract,
toc = resources[[i]]$toc,
file_path = resource_file,
overwrite = overwrite)
}
}
#' Upload external resources
#'
#' Upload an external resource file
#'
#' @return NULL
#' @param dataset_idno Study IDNo
#' @param resource_id (Optional) External resource ID
#' @param file External resource file to be uploaded
#' @export
external_resources_upload <- function(
dataset_idno,
resource_id=NULL,
file,
api_key=NULL,
api_base_url=NULL){
endpoint=paste0('datasets/',dataset_idno,'/files')
if(is.null(api_key)){
api_key=get_api_key();
}
url=get_api_url(endpoint)
options=list(
"file"=upload_file(file)
)
httpResponse <- POST(url, add_headers("X-API-KEY" = api_key),body=options, accept_json(), verbose(get_verbose()))
output=NULL
if(httpResponse$status_code!=200){
warning(content(httpResponse, "text"))
}else{
output=fromJSON(content(httpResponse,"text"))
}
return (output)
}
#' Download resource file
#'
#' Download resource file
#'
#' @return file
#' @param dataset_idno Study IDNo
#' @param resource_id Resource ID
#' @export
external_resources_download <- function(dataset_idno, resource_id,api_key=NULL, api_base_url=NULL){
if(is.null(api_key)){
api_key=get_api_key();
}
endpoint=paste0('datasets/',dataset_idno,'/resources/download/',resource_id)
url=get_api_url(endpoint)
httpResponse <- GET(url, add_headers("X-API-KEY" = api_key), accept_json(), verbose(get_verbose()))
output=NULL
if(httpResponse$status_code!=200){
warning(content(httpResponse, "text"))
return (httpResponse)
}
#get downloaded file name
file_name=get_disposition_filename(httpResponse)
#save downloaded file
#writeBin(resource$content, resource$file_name)
return (
list(
"file_name"=file_name,
"content" = content(httpResponse,"raw")
)
)
}
#' Create new resource
#'
#' Create a new resource
#'
#' @return NULL
#' @param idno \strong{(required)} Study IDNO
#' @param dctype Resource document type
#' @param title Resource title
#' @param dcformat Resource file format
#' @param author Author name
#' @param dcdate Date using YYYY-MM-DD format
#' @param country Country name
#' @param language Language or Language code
#' @param contributor Contributor name
#' @param publisher Publisher name
#' @param rights Rights
#' @param description Resource detailed description
#' @param abstract Resource abstract
#' @param toc Table of contents
#' @param file_path File path for uploading
#' @param overwrite Overwrite if resource already exists? Accepted values "yes", "no"
#'
#'
#'
#'
#' @export
external_resources_add <- function(
idno,
dctype,
title,
dcformat=NULL,
author=NULL,
dcdate=NULL,
country=NULL,
language=NULL,
contributor=NULL,
publisher=NULL,
rights=NULL,
description=NULL,
abstract=NULL,
toc=NULL,
file_path=NULL,
overwrite="no",
api_key=NULL,
api_base_url=NULL){
if(is.null(api_key)){
api_key=get_api_key();
}
options=list(
idno=idno,
dctype=dctype,
dcformat=dcformat,
title=title,
author=author,
dcdate=dcdate,
country=country,
language=language,
contributor=contributor,
publisher=publisher,
rights=rights,
description=description,
abstract=abstract,
toc=toc,
overwrite=overwrite
)
if (file.exists(file_path)){
options$file=upload_file(file_path)
}
else if(is_valid_url(file_path)){
options[['filename']]=file_path
}
url=get_api_url(paste0('datasets/',idno,'/resources'))
print(url)
httpResponse <- POST(url,
add_headers("X-API-KEY" = api_key),
body=options,
accept_json(),
verbose(get_verbose()))
output=NULL
if(httpResponse$status_code!=200){
warning(content(httpResponse, "text"))
}
output=list(
"status_code"=httpResponse$status_code,
"response"=nada_http_response_json(httpResponse)
)
return (output)
}
#' Delete External Resources
#'
#' Delete external resources for a study
#'
#' @return
#' @param dataset_idno Study IDNo
#' @param resource_id Resource ID
#' @export
external_resources_delete <- function(dataset_idno, resource_id, api_key=NULL, api_base_url=NULL){
if(is.null(api_key)){
api_key=get_api_key();
}
endpoint=paste0('datasets/',dataset_idno,'/resources/',resource_id)
url=get_api_url(endpoint)
httpResponse <- DELETE(url, add_headers("X-API-KEY" = api_key), accept_json(), verbose(get_verbose()))
output=NULL
if(httpResponse$status_code!=200){
warning(content(httpResponse, "text"))
}
output=list(
"status_code"=httpResponse$status_code,
"response"= nada_http_response_json(httpResponse)
)
return (output)
return (output)
}
#' Delete all external resources for a study
#'
#' Delete all external resources for a study
#'
#' @return
#' @param dataset_idno Study IDNo
#' @export
external_resources_delete_all <- function(dataset_idno, api_key=NULL, api_base_url=NULL){
if(is.null(api_key)){
api_key=get_api_key();
}
endpoint=paste0('datasets/',dataset_idno,'/resources/delete_all')
url=get_api_url(endpoint)
httpResponse <- DELETE(url, add_headers("X-API-KEY" = api_key), accept_json(), verbose(get_verbose()))
output=NULL
if(httpResponse$status_code!=200){
warning(content(httpResponse, "text"))
}else{
output=fromJSON(content(httpResponse,"text"))
}
return (output)
}
#' Convert RDF/XML to List
#'
#' Convert RDF/XML to list
#'
#' @return
#' @param rdf_file Path to RDF xml file
#' @export
rdfToList <- function(rdf_file) {
rdf <- xmlParse(rdf_file)
rdf_l <- xmlToList(rdf)
output=list()
for(i in 1:length(rdf_l)) {
for(j in 1:length(rdf_l[[i]])) {
rdf_l[[i]][j] = trimws(rdf_l[[i]][j], which = c("both", "left", "right"), whitespace = "[ \t\r\n]")
}
filepath = gsub("\\\\", "/", rdf_l[[i]]$.attrs)
resource<-list(
dctype = rdf_l[[i]]$type,
dcformat = rdf_l[[i]]$format,
title = rdf_l[[i]]$title,
author = rdf_l[[i]]$creator,
dcdate = rdf_l[[i]]$date,
country = rdf_l[[i]]$spatial,
language = rdf_l[[i]]$language,
contributor = rdf_l[[i]]$contributor,
publisher = rdf_l[[i]]$publisher,
rights = rdf_l[[i]]$rights,
description = rdf_l[[i]]$label,
abstract = rdf_l[[i]]$abstract,
toc = rdf_l[[i]]$toc,
filename = filepath
)
if (is_valid_url(filepath)){
resource[['is_url']]=TRUE
}else{
resource[['is_url']]=FALSE
}
output[[length(output) + 1]] <- resource
}
return (output)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.