ropensci / ruODK

ruODK: An R Client for the ODK Central API
https://docs.ropensci.org/ruODK/
GNU General Public License v3.0
41 stars 12 forks source link

Add a function that allows user to edit data in ODK Central and leave a comment about it #132

Open mtyszler opened 2 years ago

mtyszler commented 2 years ago

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)

}