ruODK
ruODK copied to clipboard
Add a function that allows user to edit data in ODK Central and leave a comment about it
Feature
The latest ODK Central allows users to edit and comment data (https://docs.getodk.org/central-submissions/#submission-editing)
In a recent app (https://github.com/mtyszler/checkR-ODK) I wrote a function that uses ODK's API to programmatically push a data edit and comment.
The function could be further polished and incorporated in ruODK.
Let me know if yo are interested.
@yanokwa
edit_submission <-function(iid, comment, field, new_value, form_sch,
pid = get_default_pid(),
fid = get_default_fid(),
url = get_default_url(),
un = get_default_un(),
pw = get_default_pw(),
retries = get_retries()){
# written similar to ruODK::get_one_submission
success<-FALSE
# check type:
if (!check_type(field, new_value, form_sch)){
original_type<-form_sch %>%
filter(path == field) %>%
select(type)
print(paste0("Type mismatch, ", original_type, " expected: [", field, "]: ", new_value))
print(iid)
return(success)
}
# get submission XML
subm_xml<-httr::RETRY(
"GET",
glue::glue(
"{url}/v1/projects/{pid}/forms/",
"{URLencode(fid, reserved = TRUE)}/submissions/{iid}.xml"
),
config = httr::authenticate(un, pw),
times = retries
) %>%
httr::content(.)
# modify submission
target_node <- xml_find_first(subm_xml, paste0(".",field))
# check for type compliance
xml_text(target_node)<-toString(new_value)
# update instanceID
instanceID_node <- xml_find_first(subm_xml, "meta/instanceID")
deprecatedID_node<-xml_find_first(subm_xml, "meta/deprecatedID")
if (is.na(deprecatedID_node)) {
# if no deprecatedID, create one
xml_add_sibling(instanceID_node,instanceID_node)
xml_name(instanceID_node)<-"deprecatedID"
instanceID_node <- xml_find_first(subm_xml, "meta/instanceID")
} else {
# if exists, update value with current instance ID
xml_text(deprecatedID_node)<-xml_text(instanceID_node)
}
# generate new UUID
xml_text(instanceID_node)<-paste0("uuid:", UUIDgenerate(FALSE))
# save as temporary file
write_xml(subm_xml,"subm_xml.xml")
# update submission
header <-httr::authenticate(un, pw)
ctype <- httr::content_type_xml()
header$headers<-ctype$headers
updated<-httr::RETRY(
"PUT",
glue::glue(
"{url}/v1/projects/{pid}/forms/",
"{URLencode(fid, reserved = TRUE)}/submissions/{iid}"
),
config = header,
body = httr::upload_file("subm_xml.xml") ,
times = retries
)
file.remove("subm_xml.xml")
if (updated$status!=200) {
return (success)
}
### add comment
updated_comment<-httr::RETRY(
"POST",
glue::glue(
"{url}/v1/projects/{pid}/forms/",
"{URLencode(fid, reserved = TRUE)}/submissions/{iid}/comments"
),
config = httr::authenticate(un, pw),
body = list("body"= comment),
encode = "json",
times = retries
)
if (updated_comment$status!=200) {
return (success)
}
# return
success<-TRUE
return(success)
}
Thank you so much for this, it is super helpful. I wanted to know if there is an updated version for this using htttr2
(https://httr2.r-lib.org/). Might I suggest pull()
here. And same in check_type()
function here - https://github.com/mtyszler/checkR-ODK/blob/main/R_supporting_functions.R.
original_type<-form_sch %>%
filter(path == field) %>%
pull(type)
-Adithi