From 23fe15f71c09d0b9c6229924ea78751362be1bce Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Fri, 25 Sep 2026 21:42:06 +0200 Subject: [PATCH 1/9] Handle databases without an individual owner Databases are no longer required to have an owner, so the server may return a null ownerId/owner/ownerRef. getDatabases() and getBillingAccountDatabases() now return NA for missing owner fields rather than failing to build the data frame. Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- R/billingInfo.R | 6 +++--- R/databases.R | 10 ++++++++-- tests/testthat/setup.R | 4 +++- tests/testthat/test-databases.R | 4 +++- 4 files changed, 17 insertions(+), 7 deletions(-) diff --git a/R/billingInfo.R b/R/billingInfo.R index d546d74..943dacd 100644 --- a/R/billingInfo.R +++ b/R/billingInfo.R @@ -55,9 +55,9 @@ getBillingAccountDatabases <- function(billingAccountId, asDataFrame = TRUE) { databaseId = unlist(lapply(billingDatabases, function(x) {x$databaseId})), label = unlist(lapply(billingDatabases, function(x) {x$label})), description = unlist(lapply(billingDatabases, function(x) { if(nzchar(x$description)) x$description else NA_character_ })), - ownerId = unlist(lapply(billingDatabases, function(x) {x$owner[["id"]]})), - ownerName = unlist(lapply(billingDatabases, function(x) {x$owner[["name"]]})), - ownerEmail = unlist(lapply(billingDatabases, function(x) {x$owner[["email"]]})), + ownerId = vapply(billingDatabases, function(x) {charOrNA(x$owner[["id"]])}, character(1)), + ownerName = vapply(billingDatabases, function(x) {charOrNA(x$owner[["name"]])}, character(1)), + ownerEmail = vapply(billingDatabases, function(x) {charOrNA(x$owner[["email"]])}, character(1)), formCount = unlist(lapply(billingDatabases, function(x) {x$formCount})), userCount = unlist(lapply(billingDatabases, function(x) {x$userCount})), basicUserCount = unlist(lapply(billingDatabases, function(x) {x$basicUserCount})), diff --git a/R/databases.R b/R/databases.R index 9a19022..dae4f52 100644 --- a/R/databases.R +++ b/R/databases.R @@ -13,7 +13,7 @@ getDatabases <- function(asDataFrame = TRUE) { return(databasesListToTibble(databases)) } else if (asDataFrame == FALSE) { return(lapply(databases, function(x) { - x$ownerId <- as.character(x$ownerId) + x$ownerId <- charOrNA(x$ownerId) x$billingAccountId <- as.character(x$billingAccountId) x })) @@ -25,13 +25,19 @@ databasesListToTibble <- function(databases) { databaseId = unlist(lapply(databases, function(x) {x$databaseId})), label = unlist(lapply(databases, function(x) {x$label})), description = unlist(lapply(databases, function(x) { if(nzchar(x$description)) x$description else NA_character_ })), - ownerId = as.character(unlist(lapply(databases, function(x) {x$ownerId}))), + ownerId = vapply(databases, function(x) {charOrNA(x$ownerId)}, character(1)), billingAccountId = as.character(unlist(lapply(databases, function(x) {x$billingAccountId}))), suspended = unlist(lapply(databases, function(x) {x$suspended})) ) return(dbDF) } +# Databases are no longer required to have an individual owner, so +# owner fields may be null +charOrNA <- function(x) { + if (is.null(x)) NA_character_ else as.character(x) +} + databaseUpdates <- function() { list( resourceUpdates = list(), diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index e851003..88fc940 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -141,16 +141,18 @@ identicalForm <- function(a,b, b_allowed_new_fields = TRUE) { } } -expectActivityInfoSnapshotCompare <- function(x, snapshotName, replaceId = TRUE, replaceDate = TRUE, replaceResource = TRUE, allowed_new_fields = TRUE) { +expectActivityInfoSnapshotCompare <- function(x, snapshotName, replaceId = TRUE, replaceDate = TRUE, replaceResource = TRUE, allowed_new_fields = TRUE, ignoreFields = character()) { if (missing(snapshotName)) stop("You must give the snapshot a name") stopifnot("The snapshotName must be a character string" = is.character(snapshotName)&&length(snapshotName)==1) x <- canonicalizeActivityInfoObject(x, replaceId, replaceDate, replaceResource) + x <- x[!(names(x) %in% ignoreFields)] path <- testthat::test_path("_activityInfoSnaps", sprintf("%s.RDS", snapshotName)) if (file.exists(path)) { y <- readRDS(file = path) + y <- y[!(names(y) %in% ignoreFields)] } else { message("Adding activityInfo snapshot: ", snapshotName, ".RDS") saveRDS(x, file = path) diff --git a/tests/testthat/test-databases.R b/tests/testthat/test-databases.R index 2f49baf..a196322 100644 --- a/tests/testthat/test-databases.R +++ b/tests/testthat/test-databases.R @@ -36,7 +36,9 @@ testthat::test_that("getDatabaseTree() works", { tree <- getDatabaseTree(databaseId = database$databaseId) testthat::expect_s3_class(tree, "databaseTree") testthat::expect_identical(tree$databaseId, database$databaseId) - expectActivityInfoSnapshotCompare(tree, snapshotName = "databases-databaseTree", allowed_new_fields = TRUE) + # Databases may or may not have an individual owner, so ownerRef can be null + testthat::expect_true(is.null(tree$ownerRef) || is.list(tree$ownerRef)) + expectActivityInfoSnapshotCompare(tree, snapshotName = "databases-databaseTree", allowed_new_fields = TRUE, ignoreFields = "ownerRef") }) testthat::test_that("getDatabaseResources() works", { From 8633d3723ace070d017ee094740f2d5ce8599b42 Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Fri, 25 Sep 2026 21:42:06 +0200 Subject: [PATCH 2/9] Update release number and date for 5.0 Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- DESCRIPTION | 4 ++-- NEWS.md | 8 ++++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d312ca7..807ba0a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,8 +2,8 @@ Package: activityinfo Type: Package Title: R interface to ActivityInfo.org, an information management software for humanitarian and development operations -Version: 4.39 -Date: 2025-04-02 +Version: 5.0 +Date: 2026-09-25 Authors@R: c( person("Alex", "Bertram", email = "alex@bedatadriven.com", role = c("aut", "cre")), diff --git a/NEWS.md b/NEWS.md index 39a4692..b9fe7d6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +## [5.0] +- Databases are no longer required to have an individual owner. `getDatabases()` and `getBillingAccountDatabases()` now return `NA` for the owner columns (`ownerId`, `ownerName`, `ownerEmail`) of databases without an owner +- API tests now authenticate with an API token rather than basic password authentication + +## [4.39] +- `getDatabaseBillingAccount()` now includes `parentBillingAccountId` and handles billing accounts without a parent (#150) +- Fixed `getDatabaseBillingAccount()` for billing accounts with no addons (#151, #152) + ## [4.38] - New vignettes on grant-based roles, advanced user management (bulk actions), and advanced role use-cases (#122, #133) - Improved metadata on getRecords() to include last time modified (#26, #39) From ac0a78ad97bccec7a0a569478c9a1818d0b42ca5 Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Fri, 25 Sep 2026 21:59:36 +0200 Subject: [PATCH 3/9] Add note and multiple reference fields, required rules and validation messages - Add noteFieldSchema() and multipleReferenceFieldSchema(), with schema classes for both types when reading form schemas - Add requiredRule and validationMessage arguments to field schemas and columns to as.data.frame() of form schemas - Exclude notes from getRecords() columns - Support multiple reference fields in importRecords() - Fix hideFromEntry, hideInTable and reviewerOnly, which were not applied correctly to the field schema - Fix user fields being classed as reference fields Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- NAMESPACE | 2 + NEWS.md | 5 ++ R/formField.R | 124 ++++++++++++++++++++++------ R/forms.R | 2 + R/import.R | 21 +++++ R/records.R | 9 ++ man/attachmentFieldSchema.Rd | 15 +++- man/barcodeFieldSchema.Rd | 15 +++- man/calculatedFieldSchema.Rd | 2 + man/dateFieldSchema.Rd | 15 +++- man/formFieldSchema.Rd | 15 +++- man/geopointFieldSchema.Rd | 15 +++- man/monthFieldSchema.Rd | 15 +++- man/multilineFieldSchema.Rd | 15 +++- man/multipleReferenceFieldSchema.Rd | 83 +++++++++++++++++++ man/multipleSelectFieldSchema.Rd | 15 +++- man/noteFieldSchema.Rd | 54 ++++++++++++ man/quantityFieldSchema.Rd | 15 +++- man/referenceFieldSchema.Rd | 15 +++- man/sectionFieldSchema.Rd | 2 + man/serialNumberFieldSchema.Rd | 2 + man/singleSelectFieldSchema.Rd | 15 +++- man/subformFieldSchema.Rd | 9 +- man/textFieldSchema.Rd | 13 ++- man/userFieldSchema.Rd | 15 +++- man/weekFieldSchema.Rd | 15 +++- tests/testthat/_snaps/formField.md | 90 +++++++++++--------- tests/testthat/test-formField.r | 53 ++++++++++++ tests/testthat/test-forms.R | 4 +- tests/testthat/test-import.R | 45 +++++++++- 30 files changed, 635 insertions(+), 80 deletions(-) create mode 100644 man/multipleReferenceFieldSchema.Rd create mode 100644 man/noteFieldSchema.Rd diff --git a/NAMESPACE b/NAMESPACE index 9f078e8..5d590cd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -167,8 +167,10 @@ export(migrateFieldData) export(minimalColumnStyle) export(monthFieldSchema) export(multilineFieldSchema) +export(multipleReferenceFieldSchema) export(multipleSelectFieldSchema) export(namedElementVarList) +export(noteFieldSchema) export(parameter) export(permissions) export(prettyColumnStyle) diff --git a/NEWS.md b/NEWS.md index b9fe7d6..a741c62 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,11 @@ ## [5.0] - Databases are no longer required to have an individual owner. `getDatabases()` and `getBillingAccountDatabases()` now return `NA` for the owner columns (`ownerId`, `ownerName`, `ownerEmail`) of databases without an owner - API tests now authenticate with an API token rather than basic password authentication +- New `noteFieldSchema()` for note fields, which display guidance during data entry but do not capture a value. Notes are not included as columns in `getRecords()` +- New `multipleReferenceFieldSchema()` for fields that reference one or more records in another form. `importRecords()` accepts comma-separated record ids for these fields +- New `requiredRule` and `validationMessage` arguments for form field schemas, to limit when a required field is required and to show a custom message when validation fails. `as.data.frame()` of a form schema now includes the `requiredCondition` and `validationMessage` columns +- Potential breaking change: `hideFromEntry` now hides the field from data entry (previously it hid the field from the table), `hideInTable` now hides the field from the table (previously it was ignored), and `reviewerOnly` now restricts the field to reviewers (previously it was ignored) +- Fixed user fields being identified as reference fields ## [4.39] - `getDatabaseBillingAccount()` now includes `parentBillingAccountId` and handles billing accounts without a parent (#150) diff --git a/R/formField.R b/R/formField.R index 080c557..f7ac8a9 100644 --- a/R/formField.R +++ b/R/formField.R @@ -17,18 +17,28 @@ #' @param validationRule Validation rules for the form field given as a single character string; default is "" #' @param reviewerOnly Whether the form field is for reviewers only; default is FALSE #' @param typeParameters The type parameters object specific to the type given. +#' @param requiredRule A formula given as a single character string that limits +#' the requirement to the records in which the formula is satisfied. Only +#' applies when `required` is TRUE; default is "", which means the field is +#' required for every record +#' @param validationMessage A custom message given as a single character string +#' that is shown when the validation rule fails; default is NULL, which uses +#' the automatically composed message #' #' @family field schemas #' @export -formFieldSchema <- function(type, label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, typeParameters = NULL) { +formFieldSchema <- function(type, label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, typeParameters = NULL, requiredRule = "", validationMessage = NULL) { stopifnot("The label is required to be a character string" = (is.character(label)&&length(label)==1&&nchar(label)>0)) stopifnot("The description must be a character string" = is.null(description)||(is.character(description)&&length(description)==1&&nchar(description)>0)) stopifnot("The code must be a character string" = is.null(code)||(is.character(code)&&length(code)==1&&nchar(code)>0)) stopifnot("The id is required and must be a character string" = !is.null(id)&&(is.character(id)&&length(id)==1&&nchar(id)>0)) stopifnot("`relevanceRule` must be given as a character string" = !is.null(relevanceRule)&&(is.character(relevanceRule)&&length(relevanceRule)==1)) stopifnot("`validationRule` must be given as a character string" = !is.null(validationRule)&&(is.character(validationRule)&&length(validationRule)==1)) + stopifnot("`requiredRule` must be given as a character string" = !is.null(requiredRule)&&(is.character(requiredRule)&&length(requiredRule)==1)) + stopifnot("`validationMessage` must be NULL or a character string" = is.null(validationMessage)||(is.character(validationMessage)&&length(validationMessage)==1&&nchar(validationMessage)>0)) stopifnot("The key must be a logical/boolean of length 1" = is.logical(key)&&length(key)==1) stopifnot("`required` must be a logical/boolean of length 1" = is.logical(required)&&length(required)==1) + stopifnot("`requiredRule` only applies to required fields; set `required = TRUE`" = required||!nzchar(requiredRule)) stopifnot("`hideFromEntry` must be a logical/boolean of length 1" = is.logical(hideFromEntry)&&length(hideFromEntry)==1) stopifnot("`hideInTable` must be a logical/boolean of length 1" = is.logical(hideInTable)&&length(hideInTable)==1) stopifnot("`reviewerOnly` must be a logical/boolean of length 1" = is.logical(reviewerOnly)&&length(reviewerOnly)==1) @@ -46,10 +56,21 @@ formFieldSchema <- function(type, label, description = NULL, code = NULL, id = c schema$label <- label schema$relevanceCondition <- relevanceRule + schema$requiredCondition <- requiredRule schema$validationCondition <- validationRule - schema$tableVisible <- !hideFromEntry + + if (!is.null(validationMessage)) { + schema$validationMessage <- validationMessage + } + + schema$dataEntryVisible <- !hideFromEntry + schema$tableVisible <- !hideInTable schema$required <- required + if (reviewerOnly) { + schema$securityCategoryId <- "reviewer" + } + if (!is.null(description)) { schema$description = description } @@ -68,6 +89,7 @@ formFieldSchema <- function(type, label, description = NULL, code = NULL, id = c asFormFieldSchema <- function(e) { e$key <- identical(e$key, TRUE) e$required <- identical(e$required, TRUE) + e$dataEntryVisible <- !identical(e$dataEntryVisible, FALSE) e$tableVisible <- !identical(e$tableVisible, FALSE) if(is.null(e$code)) { e["code"] <- list(NULL) @@ -83,7 +105,7 @@ asFormFieldSchema <- function(e) { addFormFieldSchemaCustomClass <- function(e) { if (e$type == "FREE_TEXT") { - if (e$typeParameters$barcode) { + if (isTRUE(e$typeParameters$barcode)) { class(e) <- c("activityInfoBarcodeFieldSchema", class(e)) } else { class(e) <- c("activityInfoTextFieldSchema", class(e)) @@ -114,20 +136,22 @@ addFormFieldSchemaCustomClass <- function(e) { class(e) <- c("activityInfoAttachmentFieldSchema", class(e)) } else if (e$type == "calculated") { class(e) <- c("activityInfoCalculatedFieldSchema", class(e)) - } else if (e$type == "attachment") { - class(e) <- c("activityInfoAttachmentFieldSchema", class(e)) } else if (e$type == "subform") { class(e) <- c("activityInfoSubformFieldSchema", class(e)) } else if (e$type == "geopoint") { class(e) <- c("activityInfoGeopointFieldSchema", class(e)) } else if (e$type == "reference") { - if (grepl("@user$", e$typeParameters$range[[1]]$formId)) { + if (grepl("@users$", e$typeParameters$range[[1]]$formId)) { class(e) <- c("activityInfoUserFieldSchema", class(e)) } else { class(e) <- c("activityInfoReferenceFieldSchema", class(e)) } + } else if (e$type == "multiselectreference") { + class(e) <- c("activityInfoMultipleReferenceFieldSchema", class(e)) } else if (e$type == "section") { class(e) <- c("activityInfoSectionFieldSchema", class(e)) + } else if (e$type == "note") { + class(e) <- c("activityInfoNoteFieldSchema", class(e)) } return(e) } @@ -187,7 +211,7 @@ formFieldArgs <- function(x) { #' @inheritParams formFieldSchema #' #' @export -textFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +textFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( formFieldSchema, args = c( @@ -208,7 +232,7 @@ textFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), #' #' @family field schemas #' @export -barcodeFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +barcodeFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( formFieldSchema, args = c( @@ -269,7 +293,7 @@ serialNumberFieldSchema <- function(label, description = NULL, digits = 5L, pref #' is default #' @family field schemas #' @export -quantityFieldSchema <- function(label, description = NULL, units = "", aggregation = "SUM", code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +quantityFieldSchema <- function(label, description = NULL, units = "", aggregation = "SUM", code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { stopifnot("Units must be a character string (empty or not)" = is.character(units)&&length(units)==1) stopifnot("Aggregation must be a character string" = is.character(aggregation)&&length(aggregation)==1) schema <- do.call( @@ -298,7 +322,7 @@ quantityFieldSchema <- function(label, description = NULL, units = "", aggregati #' @inheritParams formFieldSchema #' @family field schemas #' @export -multilineFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +multilineFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( formFieldSchema, args = c( @@ -318,7 +342,7 @@ multilineFieldSchema <- function(label, description = NULL, code = NULL, id = cu #' @inheritParams formFieldSchema #' @family field schemas #' @export -dateFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +dateFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( formFieldSchema, args = c( @@ -339,7 +363,7 @@ dateFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), #' @inheritParams formFieldSchema #' @family field schemas #' @export -weekFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +weekFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( formFieldSchema, args = c( @@ -358,7 +382,7 @@ weekFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), #' @inheritParams formFieldSchema #' @family field schemas #' @export -monthFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +monthFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( formFieldSchema, args = c( @@ -370,7 +394,7 @@ monthFieldSchema <- function(label, description = NULL, code = NULL, id = cuid() schema } -selectFieldSchema <- function(cardinality, label, description = NULL, options = list(), code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +selectFieldSchema <- function(cardinality, label, description = NULL, options = list(), code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { stopifnot("Cardinality must be a character string 'single' or 'multiple'" = is.character(cardinality)&&length(cardinality)==1&&(cardinality %in% c("single", "multiple"))) schema <- do.call( formFieldSchema, @@ -403,7 +427,7 @@ selectFieldSchema <- function(cardinality, label, description = NULL, options = #' @param options A list of the single select field options #' @family field schemas #' @export -singleSelectFieldSchema <- function(label, description = NULL, options = list(), code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +singleSelectFieldSchema <- function(label, description = NULL, options = list(), code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( selectFieldSchema, args = c( @@ -423,7 +447,7 @@ singleSelectFieldSchema <- function(label, description = NULL, options = list(), #' @param options A list of the multiple select field options #' @family field schemas #' @export -multipleSelectFieldSchema <- function(label, description = NULL, options = list(), code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +multipleSelectFieldSchema <- function(label, description = NULL, options = list(), code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( selectFieldSchema, args = c( @@ -520,7 +544,7 @@ print.activityInfoSelectOptions <- function(x, ...) { #' @inheritParams formFieldSchema #' @family field schemas #' @export -attachmentFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +attachmentFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { schema <- do.call( formFieldSchema, args = c( @@ -578,7 +602,7 @@ calculatedFieldSchema <- function(label, description = NULL, formula, code = NUL #' @param subformId The id of the sub-form #' @family field schemas #' @export -subformFieldSchema <- function(label, description = NULL, subformId, code = NULL, id = cuid(), hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +subformFieldSchema <- function(label, description = NULL, subformId, code = NULL, id = cuid(), hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, validationMessage = NULL) { stopifnot("The subform id must be a character string" = is.character(subformId)&&length(subformId)==1&&nchar(subformId)>0) schema <- do.call( formFieldSchema, @@ -604,7 +628,7 @@ subformFieldSchema <- function(label, description = NULL, subformId, code = NULL #' @param referencedFormId The id of the referenced form #' @family field schemas #' @export -referenceFieldSchema <- function(label, description = NULL, referencedFormId, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +referenceFieldSchema <- function(label, description = NULL, referencedFormId, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { stopifnot("The referenced form id must be a character string" = is.character(referencedFormId)&&length(referencedFormId)==1&&nchar(referencedFormId)>0) schema <- do.call( formFieldSchema, @@ -627,6 +651,39 @@ referenceFieldSchema <- function(label, description = NULL, referencedFormId, co schema } +#' Create a Multiple Reference field schema +#' +#' A multiple reference field can be used to make reference to one or more +#' records in another form. +#' +#' A multiple reference field cannot be a key field. +#' +#' @inheritParams formFieldSchema +#' @param referencedFormId The id of the referenced form +#' @family field schemas +#' @export +multipleReferenceFieldSchema <- function(label, description = NULL, referencedFormId, code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { + stopifnot("The referenced form id must be a character string" = is.character(referencedFormId)&&length(referencedFormId)==1&&nchar(referencedFormId)>0) + schema <- do.call( + formFieldSchema, + args = c( + list(type = "multiselectreference"), + formFieldArgs(as.list(environment())), + list( + typeParameters = list( + "range" = list( + list( + "formId" = referencedFormId + ) + ) + ) + ) + ) + ) + + schema +} + #' Create a Geographic Point form field schema #' #' A Geographic Point field allow users to enter a geo-location with a certain @@ -645,7 +702,7 @@ referenceFieldSchema <- function(label, description = NULL, referencedFormId, co #' is TRUE #' @family field schemas #' @export -geopointFieldSchema <- function(label, description = NULL, requiredAccuracy = NULL, manualEntryAllowed = TRUE, code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +geopointFieldSchema <- function(label, description = NULL, requiredAccuracy = NULL, manualEntryAllowed = TRUE, code = NULL, id = cuid(), required = FALSE, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { stopifnot("requiredAccuracy must be a single numeric value or NULL" = is.null(requiredAccuracy)||(is.numeric(requiredAccuracy)&&length(requiredAccuracy)==1)) stopifnot("manualEntryAllowed must be single logical" = is.logical(manualEntryAllowed)&&length(manualEntryAllowed)==1) @@ -683,7 +740,7 @@ geopointFieldSchema <- function(label, description = NULL, requiredAccuracy = NU #' @param databaseId The database id of the form and users #' @family field schemas #' @export -userFieldSchema <- function(label, description = NULL, databaseId, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { +userFieldSchema <- function(label, description = NULL, databaseId, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE, requiredRule = "", validationMessage = NULL) { stopifnot("`databaseId` must be a character string" = is.character(databaseId)&&length(databaseId)==1&&nchar(databaseId)>0) schema <- do.call( formFieldSchema, @@ -729,6 +786,27 @@ sectionFieldSchema <- function(label, description = NULL, indentationLevel = 1L) schema } +#' Create a note form field schema +#' +#' A note displays its label and description to users during data entry. It +#' does not capture a value and is not included in the records table. +#' +#' @inheritParams formFieldSchema +#' @param description The text of the note +#' @family field schemas +#' @export +noteFieldSchema <- function(label, description = NULL, code = NULL, id = cuid(), hideFromEntry = FALSE, relevanceRule = "") { + schema <- do.call( + formFieldSchema, + args = c( + list(type = "note"), + formFieldArgs(as.list(environment())) + ) + ) + + schema +} + isFormFieldSchema <- function(schema) { "activityInfoFormFieldSchema" %in% class(schema) } @@ -917,7 +995,7 @@ addFormField <- function(...) { addFormField.character <- function(formId, schema, upload = FALSE, ...) { formSchema <- getFormSchema(formId = formId) sane <- checkFormField(formSchema, schema) - fromSchema <- sane$formSchema + formSchema <- sane$formSchema schema <- sane$schema formSchema$elements[[length(formSchema$elements)+1]] <- schema if (upload == TRUE) { @@ -932,7 +1010,7 @@ addFormField.character <- function(formId, schema, upload = FALSE, ...) { #' @rdname addFormField addFormField.formSchema <- function(formSchema, schema, upload = FALSE, ...) { sane <- checkFormField(formSchema, schema) - fromSchema <- sane$formSchema + formSchema <- sane$formSchema schema <- sane$schema formSchema$elements[[length(formSchema$elements)+1]] <- schema if (upload == TRUE) { diff --git a/R/forms.R b/R/forms.R index d3e8c50..39cb3aa 100644 --- a/R/forms.R +++ b/R/forms.R @@ -98,7 +98,9 @@ as.data.frame.formSchema <- function(x, row.names = NULL, optional = FALSE, ...) fieldLabel = sapply(x$elements, function(e) null2na(e$label)), fieldDescription = sapply(x$elements, function(e) null2na(e$description)), validationCondition = sapply(x$elements, function(e) null2na(e$validationCondition)), + validationMessage = sapply(x$elements, function(e) null2na(e$validationMessage)), relevanceCondition = sapply(x$elements, function(e) null2na(e$relevanceCondition)), + requiredCondition = sapply(x$elements, function(e) null2na(e$requiredCondition)), fieldRequired = sapply(x$elements, function(e) null2na(e$required)), key = sapply(x$elements, function(e) identical(e$key, TRUE)), referenceFormId = sapply(x$elements, function(e) null2na(e$typeParameters$range[[1]]$formId)), diff --git a/R/import.R b/R/import.R index df8c22a..444b233 100644 --- a/R/import.R +++ b/R/import.R @@ -151,6 +151,7 @@ prepareImport <- function(field, columnName, column) { quantity = as.double(column), enumerated = prepareEnumImport(field, columnName, column), reference = prepareReference(field, column), + multiselectreference = prepareMultipleReference(field, columnName, column), date = prepareDate(field, column), month = prepareMonth(field, columnName, column), serial = prepareSerial(field, columnName, column), @@ -250,6 +251,26 @@ prepareReference <- function(field, column) { column } +prepareMultipleReference <- function(field, columnName, column) { + column <- as.character(column) + column[!nzchar(column)] <- NA_character_ + rows <- strsplit(column, split = "\\s*,\\s*") + + lapply(rows, function(row) { + if(length(row) == 1 && is.na(row)) { + return(NA_character_) + } + invalid <- !grepl(row, pattern = "^[a-z][a-z0-9]{0,30}$") + if (any(invalid)) { + stop(sprintf("For multiple reference field '%s', the imported column `%s` contains invalid record ids: %s", + field$label, + columnName, + paste(collapse = ", ", sprintf("'%s'", head(unique(row[invalid]), n = 5))))) + } + I(row) + }) +} + prepareUserReference <- function(field, column) { column <- as.character(column) valid <- grepl(column, pattern = "^[0-9]{0,30}$") diff --git a/R/records.R b/R/records.R index 881b97f..4c4088d 100644 --- a/R/records.R +++ b/R/records.R @@ -988,6 +988,15 @@ elementVars <- function(element, formTree, style = defaultColumnStyle(), namedEl elementList <- list() + # Notes do not capture a value, so have no column + if (inherits(element, "activityInfoNoteFieldSchema")) { + if (namedElement) { + return(elementList) + } else { + return(character()) + } + } + useParentLabel <- (!missing(useParentLabel) && useParentLabel) if (useParentLabel) { stopifnot(!missing(parentLabel) && is.character(parentLabel) && length(parentLabel) == 1) diff --git a/man/attachmentFieldSchema.Rd b/man/attachmentFieldSchema.Rd index edc4df2..433a606 100644 --- a/man/attachmentFieldSchema.Rd +++ b/man/attachmentFieldSchema.Rd @@ -14,7 +14,9 @@ attachmentFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -37,6 +39,15 @@ attachmentFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ An attachments field allow users to add one or more attachments. @@ -53,7 +64,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/barcodeFieldSchema.Rd b/man/barcodeFieldSchema.Rd index 9142ea3..ac85e2d 100644 --- a/man/barcodeFieldSchema.Rd +++ b/man/barcodeFieldSchema.Rd @@ -15,7 +15,9 @@ barcodeFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -40,6 +42,15 @@ barcodeFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ Create a barcode form field schema @@ -53,7 +64,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/calculatedFieldSchema.Rd b/man/calculatedFieldSchema.Rd index 93dd850..f289539 100644 --- a/man/calculatedFieldSchema.Rd +++ b/man/calculatedFieldSchema.Rd @@ -51,7 +51,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/dateFieldSchema.Rd b/man/dateFieldSchema.Rd index 49705ae..e87f087 100644 --- a/man/dateFieldSchema.Rd +++ b/man/dateFieldSchema.Rd @@ -15,7 +15,9 @@ dateFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -40,6 +42,15 @@ dateFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ The Date format in ActivityInfo is YYYY-MM-DD so no matter the way the Date @@ -54,7 +65,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/formFieldSchema.Rd b/man/formFieldSchema.Rd index bd729f1..14a99da 100644 --- a/man/formFieldSchema.Rd +++ b/man/formFieldSchema.Rd @@ -17,7 +17,9 @@ formFieldSchema( relevanceRule = "", validationRule = "", reviewerOnly = FALSE, - typeParameters = NULL + typeParameters = NULL, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -46,6 +48,15 @@ formFieldSchema( \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} \item{typeParameters}{The type parameters object specific to the type given.} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ This is the function to create a basic form field schema object. It is @@ -61,7 +72,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/geopointFieldSchema.Rd b/man/geopointFieldSchema.Rd index 538a205..0227561 100644 --- a/man/geopointFieldSchema.Rd +++ b/man/geopointFieldSchema.Rd @@ -16,7 +16,9 @@ geopointFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -44,6 +46,15 @@ is TRUE} \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ A Geographic Point field allow users to enter a geo-location with a certain @@ -68,7 +79,9 @@ Other field schemas: \code{\link{formFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/monthFieldSchema.Rd b/man/monthFieldSchema.Rd index 66b5d4c..d85c7ac 100644 --- a/man/monthFieldSchema.Rd +++ b/man/monthFieldSchema.Rd @@ -15,7 +15,9 @@ monthFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -40,6 +42,15 @@ monthFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ The Month format in ActivityInfo is YYYY-MM. @@ -53,7 +64,9 @@ Other field schemas: \code{\link{formFieldSchema}()}, \code{\link{geopointFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/multilineFieldSchema.Rd b/man/multilineFieldSchema.Rd index 497faa3..a054be7 100644 --- a/man/multilineFieldSchema.Rd +++ b/man/multilineFieldSchema.Rd @@ -14,7 +14,9 @@ multilineFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -37,6 +39,15 @@ multilineFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ Multi-Line Text fields can be used to collect long answers to open-ended @@ -52,7 +63,9 @@ Other field schemas: \code{\link{formFieldSchema}()}, \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/multipleReferenceFieldSchema.Rd b/man/multipleReferenceFieldSchema.Rd new file mode 100644 index 0000000..1251e3e --- /dev/null +++ b/man/multipleReferenceFieldSchema.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formField.R +\name{multipleReferenceFieldSchema} +\alias{multipleReferenceFieldSchema} +\title{Create a Multiple Reference field schema} +\usage{ +multipleReferenceFieldSchema( + label, + description = NULL, + referencedFormId, + code = NULL, + id = cuid(), + required = FALSE, + hideFromEntry = FALSE, + hideInTable = FALSE, + relevanceRule = "", + validationRule = "", + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL +) +} +\arguments{ +\item{label}{The label of the form field} + +\item{description}{The description of the form field} + +\item{referencedFormId}{The id of the referenced form} + +\item{code}{The code name of the form field} + +\item{id}{The id of the form Field; default is to generate a new cuid} + +\item{required}{Whether the form field is required; default is FALSE} + +\item{hideFromEntry}{Whether the form field is hidden during data entry; default is FALSE} + +\item{hideInTable}{Whether the form field is hidden during data display; default is FALSE} + +\item{relevanceRule}{Relevance rules for the form field given as a single character string; default is ""} + +\item{validationRule}{Validation rules for the form field given as a single character string; default is ""} + +\item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} +} +\description{ +A multiple reference field can be used to make reference to one or more +records in another form. +} +\details{ +A multiple reference field cannot be a key field. +} +\seealso{ +Other field schemas: +\code{\link{attachmentFieldSchema}()}, +\code{\link{barcodeFieldSchema}()}, +\code{\link{calculatedFieldSchema}()}, +\code{\link{dateFieldSchema}()}, +\code{\link{formFieldSchema}()}, +\code{\link{geopointFieldSchema}()}, +\code{\link{monthFieldSchema}()}, +\code{\link{multilineFieldSchema}()}, +\code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, +\code{\link{quantityFieldSchema}()}, +\code{\link{referenceFieldSchema}()}, +\code{\link{sectionFieldSchema}()}, +\code{\link{serialNumberFieldSchema}()}, +\code{\link{singleSelectFieldSchema}()}, +\code{\link{subformFieldSchema}()}, +\code{\link{userFieldSchema}()}, +\code{\link{weekFieldSchema}()} +} +\concept{field schemas} diff --git a/man/multipleSelectFieldSchema.Rd b/man/multipleSelectFieldSchema.Rd index ee9d1e5..a7a6660 100644 --- a/man/multipleSelectFieldSchema.Rd +++ b/man/multipleSelectFieldSchema.Rd @@ -16,7 +16,9 @@ multipleSelectFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -43,6 +45,15 @@ multipleSelectFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ There is an options parameter for the list of multiple select items. Multiple @@ -59,6 +70,8 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/noteFieldSchema.Rd b/man/noteFieldSchema.Rd new file mode 100644 index 0000000..b86ad8c --- /dev/null +++ b/man/noteFieldSchema.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formField.R +\name{noteFieldSchema} +\alias{noteFieldSchema} +\title{Create a note form field schema} +\usage{ +noteFieldSchema( + label, + description = NULL, + code = NULL, + id = cuid(), + hideFromEntry = FALSE, + relevanceRule = "" +) +} +\arguments{ +\item{label}{The label of the form field} + +\item{description}{The text of the note} + +\item{code}{The code name of the form field} + +\item{id}{The id of the form Field; default is to generate a new cuid} + +\item{hideFromEntry}{Whether the form field is hidden during data entry; default is FALSE} + +\item{relevanceRule}{Relevance rules for the form field given as a single character string; default is ""} +} +\description{ +A note displays its label and description to users during data entry. It +does not capture a value and is not included in the records table. +} +\seealso{ +Other field schemas: +\code{\link{attachmentFieldSchema}()}, +\code{\link{barcodeFieldSchema}()}, +\code{\link{calculatedFieldSchema}()}, +\code{\link{dateFieldSchema}()}, +\code{\link{formFieldSchema}()}, +\code{\link{geopointFieldSchema}()}, +\code{\link{monthFieldSchema}()}, +\code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, +\code{\link{multipleSelectFieldSchema}()}, +\code{\link{quantityFieldSchema}()}, +\code{\link{referenceFieldSchema}()}, +\code{\link{sectionFieldSchema}()}, +\code{\link{serialNumberFieldSchema}()}, +\code{\link{singleSelectFieldSchema}()}, +\code{\link{subformFieldSchema}()}, +\code{\link{userFieldSchema}()}, +\code{\link{weekFieldSchema}()} +} +\concept{field schemas} diff --git a/man/quantityFieldSchema.Rd b/man/quantityFieldSchema.Rd index a39c00e..f479023 100644 --- a/man/quantityFieldSchema.Rd +++ b/man/quantityFieldSchema.Rd @@ -16,7 +16,9 @@ quantityFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -44,6 +46,15 @@ is default} \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ A Quantity field allow users to enter a numerical value. You can define the @@ -62,7 +73,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, diff --git a/man/referenceFieldSchema.Rd b/man/referenceFieldSchema.Rd index 3627f73..f5a3961 100644 --- a/man/referenceFieldSchema.Rd +++ b/man/referenceFieldSchema.Rd @@ -16,7 +16,9 @@ referenceFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -43,6 +45,15 @@ referenceFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ A reference field can be used to make reference to a record in another form. @@ -57,7 +68,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, diff --git a/man/sectionFieldSchema.Rd b/man/sectionFieldSchema.Rd index 9c32be0..cd68ef3 100644 --- a/man/sectionFieldSchema.Rd +++ b/man/sectionFieldSchema.Rd @@ -26,7 +26,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, diff --git a/man/serialNumberFieldSchema.Rd b/man/serialNumberFieldSchema.Rd index dad1b97..ebc0ed9 100644 --- a/man/serialNumberFieldSchema.Rd +++ b/man/serialNumberFieldSchema.Rd @@ -52,7 +52,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/singleSelectFieldSchema.Rd b/man/singleSelectFieldSchema.Rd index e24e966..4a5e705 100644 --- a/man/singleSelectFieldSchema.Rd +++ b/man/singleSelectFieldSchema.Rd @@ -16,7 +16,9 @@ singleSelectFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -43,6 +45,15 @@ singleSelectFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ There is an options parameter for the list of single select items. Single @@ -62,7 +73,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/subformFieldSchema.Rd b/man/subformFieldSchema.Rd index 2184aca..b696856 100644 --- a/man/subformFieldSchema.Rd +++ b/man/subformFieldSchema.Rd @@ -14,7 +14,8 @@ subformFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + validationMessage = NULL ) } \arguments{ @@ -37,6 +38,10 @@ subformFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ A subform field can be used to define a field that contains a subform. @@ -54,7 +59,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/textFieldSchema.Rd b/man/textFieldSchema.Rd index 5e0780c..90c11e0 100644 --- a/man/textFieldSchema.Rd +++ b/man/textFieldSchema.Rd @@ -15,7 +15,9 @@ textFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -40,6 +42,15 @@ textFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ You can define the format of the text that the users should type in a Text diff --git a/man/userFieldSchema.Rd b/man/userFieldSchema.Rd index f230d43..0d9f100 100644 --- a/man/userFieldSchema.Rd +++ b/man/userFieldSchema.Rd @@ -16,7 +16,9 @@ userFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -43,6 +45,15 @@ userFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ User fields allow you to select a specific user from a list. It is a field @@ -62,7 +73,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/man/weekFieldSchema.Rd b/man/weekFieldSchema.Rd index 4d7c4cd..9b13ad5 100644 --- a/man/weekFieldSchema.Rd +++ b/man/weekFieldSchema.Rd @@ -15,7 +15,9 @@ weekFieldSchema( hideInTable = FALSE, relevanceRule = "", validationRule = "", - reviewerOnly = FALSE + reviewerOnly = FALSE, + requiredRule = "", + validationMessage = NULL ) } \arguments{ @@ -40,6 +42,15 @@ weekFieldSchema( \item{validationRule}{Validation rules for the form field given as a single character string; default is ""} \item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} + +\item{requiredRule}{A formula given as a single character string that limits +the requirement to the records in which the formula is satisfied. Only +applies when \code{required} is TRUE; default is "", which means the field is +required for every record} + +\item{validationMessage}{A custom message given as a single character string +that is shown when the validation rule fails; default is NULL, which uses +the automatically composed message} } \description{ The Week format in ActivityInfo is YYYY-WW. Users can directly type using @@ -56,7 +67,9 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, +\code{\link{noteFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, diff --git a/tests/testthat/_snaps/formField.md b/tests/testthat/_snaps/formField.md index 8241d0a..66ff892 100644 --- a/tests/testthat/_snaps/formField.md +++ b/tests/testthat/_snaps/formField.md @@ -1,20 +1,23 @@ # Test deleteFormField() structure(list(databaseId = "", elements = list(structure(list( - code = "txt2", description = NULL, id = "", key = FALSE, - label = "Text field 2", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt2", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 2", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list")), structure(list( - code = "txt4", description = NULL, id = "", key = FALSE, - label = "Text field 4", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt4", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 4", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list")), structure(list( - code = "txt5", description = NULL, id = "", key = FALSE, - label = "Text field 5", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt5", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 5", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list"))), id = "", label = "R form with multiple fields to delete"), class = c("activityInfoFormSchema", "formSchema", "list")) @@ -22,25 +25,29 @@ --- structure(list(databaseId = "", elements = list(structure(list( - code = "txt1", description = NULL, id = "", key = FALSE, - label = "Text field 1", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt1", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 1", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list")), structure(list( - code = "txt2", description = NULL, id = "", key = FALSE, - label = "Text field 2", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt2", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 2", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list")), structure(list( - code = "txt3", description = NULL, id = "", key = FALSE, - label = "Text field 3", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt3", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 3", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list")), structure(list( - code = "txt5", description = NULL, id = "", key = FALSE, - label = "Text field 5", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt5", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 5", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list"))), id = "", label = "R form with multiple fields to delete"), class = c("activityInfoFormSchema", "formSchema", "list")) @@ -48,20 +55,23 @@ --- structure(list(databaseId = "", elements = list(structure(list( - code = "txt2", description = NULL, id = "", key = FALSE, - label = "Text field 2", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt2", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 2", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list")), structure(list( - code = "txt3", description = NULL, id = "", key = FALSE, - label = "Text field 3", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt3", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 3", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list")), structure(list( - code = "txt4", description = NULL, id = "", key = FALSE, - label = "Text field 4", relevanceCondition = "", required = FALSE, - tableVisible = TRUE, type = "FREE_TEXT", typeParameters = list( - barcode = FALSE), validationCondition = ""), class = c("activityInfoTextFieldSchema", + code = "txt4", dataEntryVisible = TRUE, description = NULL, + id = "", key = FALSE, label = "Text field 4", relevanceCondition = "", + required = FALSE, requiredCondition = "", tableVisible = TRUE, + type = "FREE_TEXT", typeParameters = list(barcode = FALSE), + validationCondition = ""), class = c("activityInfoTextFieldSchema", "activityInfoFormFieldSchema", "formField", "list"))), id = "", label = "R form with multiple fields to delete"), class = c("activityInfoFormSchema", "formSchema", "list")) diff --git a/tests/testthat/test-formField.r b/tests/testthat/test-formField.r index 07abbff..4d273a6 100644 --- a/tests/testthat/test-formField.r +++ b/tests/testthat/test-formField.r @@ -121,6 +121,18 @@ test_that("Test roundtrip of referenceFieldSchema()", { testField(referenceFieldSchema(label = "A referenceFieldSchema field", referencedFormId = "A dummy formId")) }) +test_that("Test roundtrip of multipleReferenceFieldSchema()", { + field <- multipleReferenceFieldSchema(label = "A multipleReferenceFieldSchema field", referencedFormId = "A dummy formId") + testthat::expect_s3_class(field, "activityInfoMultipleReferenceFieldSchema") + testField(field) +}) + +test_that("Test roundtrip of noteFieldSchema()", { + field <- noteFieldSchema(label = "A noteFieldSchema field", description = "Some guidance for the user") + testthat::expect_s3_class(field, "activityInfoNoteFieldSchema") + testField(field) +}) + test_that("Test roundtrip of sectionFieldSchema()", { testField(sectionFieldSchema(label = "A sectionFieldSchema field")) }) @@ -160,6 +172,47 @@ test_that("Test roundtrip of weekFieldSchema()", { testField(weekFieldSchema(label = "A weekFieldSchema field")) }) +test_that("Visibility and reviewer only options are set on the field schema", { + hiddenFromEntry <- textFieldSchema(label = "Hidden from entry", hideFromEntry = TRUE) + testthat::expect_false(hiddenFromEntry$dataEntryVisible) + testthat::expect_true(hiddenFromEntry$tableVisible) + + hiddenInTable <- textFieldSchema(label = "Hidden in table", hideInTable = TRUE) + testthat::expect_true(hiddenInTable$dataEntryVisible) + testthat::expect_false(hiddenInTable$tableVisible) + + testthat::expect_null(textFieldSchema(label = "Not reviewer only")$securityCategoryId) + testthat::expect_identical(textFieldSchema(label = "Reviewer only", reviewerOnly = TRUE)$securityCategoryId, "reviewer") +}) + +test_that("Test roundtrip of visibility and reviewer only options", { + testField(textFieldSchema(label = "A hidden text field", hideFromEntry = TRUE, hideInTable = TRUE, reviewerOnly = TRUE)) +}) + +test_that("A required rule can only be given for required fields", { + testthat::expect_error( + textFieldSchema(label = "Not required", requiredRule = "ISBLANK(other)"), + regexp = "requiredRule" + ) + field <- textFieldSchema(label = "Required", required = TRUE, requiredRule = "ISBLANK(other)") + testthat::expect_identical(field$requiredCondition, "ISBLANK(other)") +}) + +test_that("Test roundtrip of required rule and validation message", { + field <- quantityFieldSchema( + label = "A quantity field with rules", + required = TRUE, + requiredRule = "TRUE", + validationRule = "VALUE() > 0", + validationMessage = "Must be positive") + testthat::expect_identical(field$validationMessage, "Must be positive") + testField(field) +}) + +test_that("User fields have the user field schema class", { + testthat::expect_s3_class(userFieldSchema(label = "A user field", databaseId = "cdb123"), "activityInfoUserFieldSchema") +}) + test_that("Test toSelectOptions()", { }) diff --git a/tests/testthat/test-forms.R b/tests/testthat/test-forms.R index f2e618e..8ccb740 100644 --- a/tests/testthat/test-forms.R +++ b/tests/testthat/test-forms.R @@ -22,7 +22,7 @@ testthat::test_that("getFormSchema() and as.data.frame.formSchema() return a Sch output <- as.data.frame(output) - testthat::expect_true(inherits(output, "data.frame") & nrow(output) == 2 & ncol(output) == 17) + testthat::expect_true(inherits(output, "data.frame") & nrow(output) == 2 & ncol(output) == 19) testthat::expect_true(all(c( "databaseId", "formId", @@ -33,7 +33,9 @@ testthat::test_that("getFormSchema() and as.data.frame.formSchema() return a Sch "fieldLabel", "fieldDescription", "validationCondition", + "validationMessage", "relevanceCondition", + "requiredCondition", "fieldRequired", "key", "referenceFormId", diff --git a/tests/testthat/test-import.R b/tests/testthat/test-import.R index 39e0d2d..e5e5e24 100644 --- a/tests/testthat/test-import.R +++ b/tests/testthat/test-import.R @@ -44,4 +44,47 @@ test_that("importRecords() works with stageDirect = FALSE", { test_that("importRecords() works with stageDirect = TRUE", { -}) \ No newline at end of file +}) + +test_that("importRecords() works with multiple reference fields and getRecords() skips notes", { + target <- addForm(schema = formSchema( + databaseId = database$databaseId, + label = "Multiple reference target", + elements = list( + textFieldSchema(label = "Name", code = "NAME", key = TRUE)))) + + importRecords(target$id, data = data.frame(NAME = c("A", "B", "C"))) + targetRecords <- queryTable(target$id, id = "_id", name = "NAME") + ids <- targetRecords$id[order(targetRecords$name)] + + schema <- addForm(schema = formSchema( + databaseId = database$databaseId, + label = "Multiple reference source", + elements = list( + textFieldSchema(label = "Title", code = "TITLE", key = TRUE), + noteFieldSchema(label = "A note", description = "Some guidance"), + multipleReferenceFieldSchema(label = "Targets", code = "TARGETS", referencedFormId = target$id)))) + + df <- data.frame( + TITLE = c("None", "One", "Two"), + TARGETS = c(NA, ids[1], paste(ids[2], ids[3], sep = ","))) + + importRecords(schema$id, data = df) + + imported <- queryTable(schema$id, title = "TITLE", targets = "TARGETS") + imported <- imported[order(imported$title),] + + expect_identical(imported$title, c("None", "One", "Two")) + expect_true(is.na(imported$targets[1])) + expect_identical(imported$targets[2], ids[1]) + expect_setequal(strsplit(imported$targets[3], "\\s*,\\s*")[[1]], ids[2:3]) + + expect_error( + importRecords(schema$id, data = data.frame(TITLE = "Bad", TARGETS = "not a record id!")), + regexp = "invalid record ids" + ) + + records <- getRecords(schema$id, style = allColumnStyle()) %>% collect() + expect_false(any(grepl("note", names(records), ignore.case = TRUE))) + expect_true("TARGETS" %in% names(records)) +}) From ddad80b88a658f9fe38387a89bf6948432626926 Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Fri, 25 Sep 2026 22:24:17 +0200 Subject: [PATCH 4/9] Fix tests failing with testthat 3.3 and newer servers - compare_recursively() reports a missing field as a single failure, as expect_failure() now requires exactly one failure - Selecting after a filter no longer fails on the server, so check the filtered result instead of expecting an error - Ignore the database tree version in the snapshot comparison, as its value and format depend on the server - Snapshot only the text of the rendered Rmd body, as the rest of the html depends on the pandoc and rmarkdown versions Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- tests/testthat/_snaps/rmdOutput.md | 32 ++ .../_snaps/rmdOutput/TestMessages.html | 452 ------------------ tests/testthat/setup.R | 3 +- tests/testthat/test-databases.R | 4 +- tests/testthat/test-records.R | 31 +- tests/testthat/test-rmdOutput.R | 11 +- 6 files changed, 65 insertions(+), 468 deletions(-) create mode 100644 tests/testthat/_snaps/rmdOutput.md delete mode 100644 tests/testthat/_snaps/rmdOutput/TestMessages.html diff --git a/tests/testthat/_snaps/rmdOutput.md b/tests/testthat/_snaps/rmdOutput.md new file mode 100644 index 0000000..88db4d9 --- /dev/null +++ b/tests/testthat/_snaps/rmdOutput.md @@ -0,0 +1,32 @@ +# Rmd outputs as expected + + Code + writeLines(text) + Output + TestMessages + Nicolas Dickinson + 2022-12-11 + This is a test of issue #29 + try({ + if (grepl(pattern = "activityinfo-R$", rstudioapi::getActiveProject())) { + devtools::load_all(".") + withr::with_options(new = list(activityinfo.interactive = FALSE), { + source(file = testthat::test_path("setup.R")) + }) + } + }, silent = TRUE) + dt <- as.data.frame(getFormSchema(formId = personFormId)) + knitr::kable(dt[,c("fieldCode", "fieldType")]) + fieldCode + fieldType + NAME + FREE_TEXT + CHILDREN + subform + NA + reference + NA + reference + NA + reference + diff --git a/tests/testthat/_snaps/rmdOutput/TestMessages.html b/tests/testthat/_snaps/rmdOutput/TestMessages.html deleted file mode 100644 index cd6002d..0000000 --- a/tests/testthat/_snaps/rmdOutput/TestMessages.html +++ /dev/null @@ -1,452 +0,0 @@ - - - - - - - - - - - - - - - -TestMessages - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - -
-

This is a test of issue #29

-
try({
-  if (grepl(pattern = "activityinfo-R$", rstudioapi::getActiveProject())) {
-    devtools::load_all(".")
-    withr::with_options(new = list(activityinfo.interactive = FALSE), {
-      source(file = testthat::test_path("setup.R"))
-    })
-  }
-}, silent = TRUE)
-
-dt <- as.data.frame(getFormSchema(formId = personFormId))
-
-knitr::kable(dt[,c("fieldCode", "fieldType")])
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
fieldCodefieldType
NAMEFREE_TEXT
CHILDRENsubform
NAreference
NAreference
NAreference
-
- - - - -
- - - - - - - - - - - - - - - diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 88fc940..0917fd3 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -120,7 +120,8 @@ compare_recursively <- function(a, b, path = list()) { test <- name %in% names(b) if(!test) message(sprintf("Missing expected field name/key %s", paste(c(path, name), collapse="->"))) testthat::expect_true(test) - compare_recursively(a[[name]], b[[name]], c(path, name)) + # A missing field is a single failure; there is nothing to compare + if(test) compare_recursively(a[[name]], b[[name]], c(path, name)) } } else { message(sprintf("Incompatible structures under name/key '%s'", paste(path, collapse="'->'"))) diff --git a/tests/testthat/test-databases.R b/tests/testthat/test-databases.R index a196322..5731968 100644 --- a/tests/testthat/test-databases.R +++ b/tests/testthat/test-databases.R @@ -38,7 +38,9 @@ testthat::test_that("getDatabaseTree() works", { testthat::expect_identical(tree$databaseId, database$databaseId) # Databases may or may not have an individual owner, so ownerRef can be null testthat::expect_true(is.null(tree$ownerRef) || is.list(tree$ownerRef)) - expectActivityInfoSnapshotCompare(tree, snapshotName = "databases-databaseTree", allowed_new_fields = TRUE, ignoreFields = "ownerRef") + # The version depends on the server's state and version format + testthat::expect_true(is.character(tree$version) && length(tree$version) == 1) + expectActivityInfoSnapshotCompare(tree, snapshotName = "databases-databaseTree", allowed_new_fields = TRUE, ignoreFields = c("ownerRef", "version")) }) testthat::test_that("getDatabaseResources() works", { diff --git a/tests/testthat/test-records.R b/tests/testthat/test-records.R index a54052f..4e90cf2 100644 --- a/tests/testthat/test-records.R +++ b/tests/testthat/test-records.R @@ -304,19 +304,24 @@ testthat::test_that("getRecords() works", { }) }) - # removing columns required for a filter will result in an error - # expect warning using select after filter or sort - testthat::expect_error({ - testthat::expect_warning({ - recordIds <- rcrds %>% - addFilter('[A logical column] == "True"') %>% - addSort(list(list(dir = "DESC", field = "A date column"))) %>% - head(n = 10) %>% - select(`_id`) %>% - collect() %>% - pull("_id") - }) - }) + # expect warning using select after filter or sort, but the filter still + # applies even though its column is removed by select + testthat::expect_warning({ + recordIds <- rcrds %>% + addFilter('[A logical column] == "True"') %>% + addSort(list(list(dir = "DESC", field = "A date column"))) %>% + head(n = 10) %>% + select(`_id`) %>% + collect() %>% + pull("_id") + }, regexp = "select\\(\\) after a filter or sort") + + trueRecordIds <- rcrds %>% + filter(`A logical column` == "True") %>% + collect() %>% + pull("_id") + testthat::expect_length(recordIds, min(10L, length(trueRecordIds))) + testthat::expect_true(all(recordIds %in% trueRecordIds)) # filters will work even if the column is renamed in a lazy remote records object testthat::expect_no_warning({ diff --git a/tests/testthat/test-rmdOutput.R b/tests/testthat/test-rmdOutput.R index 29f62ae..54416f8 100644 --- a/tests/testthat/test-rmdOutput.R +++ b/tests/testthat/test-rmdOutput.R @@ -4,5 +4,14 @@ testthat::test_that("Rmd outputs as expected", { suppressMessages(capture_output(rmarkdown::render(testthat::test_path("ext/TestMessages.Rmd")))) ) ) - testthat::expect_snapshot_file(testthat::test_path("ext/TestMessages.html")) + + # Compare only the text of the rendered body: the rest of the html depends on + # the versions of pandoc and rmarkdown + html <- paste(readLines(testthat::test_path("ext/TestMessages.html"), warn = FALSE), collapse = "\n") + body <- sub(".*]*>(.*).*", "\\1", html) + body <- gsub("(?s)|", "", body, perl = TRUE) + text <- trimws(unlist(strsplit(gsub("<[^>]+>", "", body), "\n"))) + text <- text[nzchar(text)] + + testthat::expect_snapshot(writeLines(text)) }) From fc103ff390d679b986c9cd80dfcb6dea1794965e Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Fri, 25 Sep 2026 22:54:37 +0200 Subject: [PATCH 5/9] Update release notes for 5.0 Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- NEWS.md | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index a741c62..d84d5f2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,19 @@ ## [5.0] -- Databases are no longer required to have an individual owner. `getDatabases()` and `getBillingAccountDatabases()` now return `NA` for the owner columns (`ownerId`, `ownerName`, `ownerEmail`) of databases without an owner -- API tests now authenticate with an API token rather than basic password authentication +Potential breaking changes: +- `hideFromEntry` now hides a field from data entry (previously it hid the field from the table), `hideInTable` now hides a field from the table (previously it was ignored), and `reviewerOnly` now restricts a field to reviewers (previously it was ignored) +- Databases are no longer required to have an individual owner. `getDatabases()` and `getBillingAccountDatabases()` now return `NA` for the owner columns (`ownerId`, `ownerName`, `ownerEmail`) of databases without an owner, rather than failing +- User fields are now identified correctly when reading form schemas, so `getRecords()` includes them as columns with `minimalColumnStyle()` (previously they were left out) + +New features: - New `noteFieldSchema()` for note fields, which display guidance during data entry but do not capture a value. Notes are not included as columns in `getRecords()` - New `multipleReferenceFieldSchema()` for fields that reference one or more records in another form. `importRecords()` accepts comma-separated record ids for these fields -- New `requiredRule` and `validationMessage` arguments for form field schemas, to limit when a required field is required and to show a custom message when validation fails. `as.data.frame()` of a form schema now includes the `requiredCondition` and `validationMessage` columns -- Potential breaking change: `hideFromEntry` now hides the field from data entry (previously it hid the field from the table), `hideInTable` now hides the field from the table (previously it was ignored), and `reviewerOnly` now restricts the field to reviewers (previously it was ignored) -- Fixed user fields being identified as reference fields +- New `requiredRule` and `validationMessage` arguments for form field schemas, to limit when a required field is required and to show a custom message when validation fails +- `as.data.frame()` of a form schema now includes the `requiredCondition` and `validationMessage` columns +- Form field schemas from `getFormSchema()` now always include `dataEntryVisible`, like `tableVisible` + +Testing: +- API tests now authenticate with an API token rather than basic password authentication +- Tests updated for testthat 3.3 and to not depend on the versions of pandoc and rmarkdown ## [4.39] - `getDatabaseBillingAccount()` now includes `parentBillingAccountId` and handles billing accounts without a parent (#150) From 18d93d88b1e30184e75140796c59c0e539872b77 Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Fri, 25 Sep 2026 23:47:04 +0200 Subject: [PATCH 6/9] Test databases with and without an owner using fixed server responses The test servers only return databases with or without an owner depending on their version, so use fixed responses to always test both. Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- DESCRIPTION | 2 +- tests/testthat/test-databaseOwners.R | 48 ++++++++++++++++++++++++++++ 2 files changed, 49 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test-databaseOwners.R diff --git a/DESCRIPTION b/DESCRIPTION index 807ba0a..e1163a9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,7 +41,7 @@ Suggests: ggplot2, quanteda, scales, - testthat (>= 3.0.0), + testthat (>= 3.1.7), knitr, rmarkdown, markdown, diff --git a/tests/testthat/test-databaseOwners.R b/tests/testthat/test-databaseOwners.R new file mode 100644 index 0000000..6a31ca0 --- /dev/null +++ b/tests/testthat/test-databaseOwners.R @@ -0,0 +1,48 @@ +# Databases may or may not have an individual owner, depending on the server +# version and when the database was created. These tests use fixed server +# responses so that both cases are always tested, whatever the test server. + +databasesJson <- '[ + {"databaseId":"cowner1","label":"With owner","description":"","ownerId":"5148353961132032","billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false,"languages":[]}, + {"databaseId":"cowner2","label":"Without owner","description":"","ownerId":null,"billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false,"languages":[]} +]' + +billingDatabasesJson <- '[ + {"databaseId":"cowner1","label":"With owner","description":"","owner":{"id":"5148353961132032","name":"Bob","email":"bob@example.com"},"formCount":1,"userCount":2,"basicUserCount":0,"recordCount":3,"lastRecordUpdate":"2026-01-01","billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false}, + {"databaseId":"cowner2","label":"Without owner","description":"","owner":null,"formCount":0,"userCount":0,"basicUserCount":0,"recordCount":0,"lastRecordUpdate":"1970-01-01","billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false} +]' + +mockDatabases <- function(json, env = parent.frame()) { + databases <- activityinfo:::fromActivityInfoJson(json) + testthat::local_mocked_bindings(getResource = function(...) databases, .env = env) +} + +testthat::test_that("getDatabases() works with and without database owners", { + mockDatabases(databasesJson) + + df <- getDatabases() + testthat::expect_identical(df$databaseId, c("cowner1", "cowner2")) + testthat::expect_identical(df$ownerId, c("5148353961132032", NA_character_)) + + dbList <- getDatabases(asDataFrame = FALSE) + testthat::expect_identical(dbList[[1]]$ownerId, "5148353961132032") + testthat::expect_identical(dbList[[2]]$ownerId, NA_character_) +}) + +testthat::test_that("getDatabases() works when no database has an owner", { + mockDatabases(sub('"ownerId":"5148353961132032"', '"ownerId":null', databasesJson)) + + df <- getDatabases() + testthat::expect_identical(nrow(df), 2L) + testthat::expect_identical(df$ownerId, c(NA_character_, NA_character_)) +}) + +testthat::test_that("getBillingAccountDatabases() works with and without database owners", { + mockDatabases(billingDatabasesJson) + + df <- getBillingAccountDatabases("5308023665328128") + testthat::expect_identical(df$databaseId, c("cowner1", "cowner2")) + testthat::expect_identical(df$ownerId, c("5148353961132032", NA_character_)) + testthat::expect_identical(df$ownerName, c("Bob", NA_character_)) + testthat::expect_identical(df$ownerEmail, c("bob@example.com", NA_character_)) +}) From 8ab3190c7bec0b63aca213631afb7029186eaf58 Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Sat, 26 Sep 2026 01:00:49 +0200 Subject: [PATCH 7/9] Handle null descriptions, null record update times and multi-valued audit fields - getDatabases() and getBillingAccountDatabases() failed when the server returned a null description, as the self-managed server does - The lastRecordUpdate column of getBillingAccountDatabases() became logical when no database had records - queryAuditLog() failed on events with none or several resourceTypes; these are now combined into a single comma-separated value Also test these cases with fixed server responses. Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- R/audit.R | 5 +++ R/billingInfo.R | 8 +--- R/databases.R | 7 ++- ...atabaseOwners.R => test-serverResponses.R} | 43 +++++++++++++++++-- 4 files changed, 52 insertions(+), 11 deletions(-) rename tests/testthat/{test-databaseOwners.R => test-serverResponses.R} (50%) diff --git a/R/audit.R b/R/audit.R index 69fbe72..2abc79f 100644 --- a/R/audit.R +++ b/R/audit.R @@ -91,6 +91,11 @@ queryAuditLog <- function(databaseId, before = Sys.time(), after, resourceId = N event$user.email <- NA } event$user <- NULL + # Fields such as resourceTypes may have none or several values: combine + # them so that each event is a single row + event <- lapply(event, function(x) { + if (length(x) == 1) x else if (length(x) == 0) NA else paste(unlist(x), collapse = ",") + }) as.data.frame(event, stringsAsFactors = FALSE) })) diff --git a/R/billingInfo.R b/R/billingInfo.R index 943dacd..01b0eb3 100644 --- a/R/billingInfo.R +++ b/R/billingInfo.R @@ -54,7 +54,7 @@ getBillingAccountDatabases <- function(billingAccountId, asDataFrame = TRUE) { billingDatabases <- tibble::tibble( databaseId = unlist(lapply(billingDatabases, function(x) {x$databaseId})), label = unlist(lapply(billingDatabases, function(x) {x$label})), - description = unlist(lapply(billingDatabases, function(x) { if(nzchar(x$description)) x$description else NA_character_ })), + description = vapply(billingDatabases, function(x) {emptyToNA(x$description)}, character(1)), ownerId = vapply(billingDatabases, function(x) {charOrNA(x$owner[["id"]])}, character(1)), ownerName = vapply(billingDatabases, function(x) {charOrNA(x$owner[["name"]])}, character(1)), ownerEmail = vapply(billingDatabases, function(x) {charOrNA(x$owner[["email"]])}, character(1)), @@ -62,11 +62,7 @@ getBillingAccountDatabases <- function(billingAccountId, asDataFrame = TRUE) { userCount = unlist(lapply(billingDatabases, function(x) {x$userCount})), basicUserCount = unlist(lapply(billingDatabases, function(x) {x$basicUserCount})), recordCount = unlist(lapply(billingDatabases, function(x) {x$recordCount})), - lastRecordUpdate = unlist(lapply(billingDatabases, function(x) { - if(is.null(x$lastRecordUpdate)) - {NA} else - {x$lastRecordUpdate} - })), + lastRecordUpdate = vapply(billingDatabases, function(x) {charOrNA(x$lastRecordUpdate)}, character(1)), billingAccountId = unlist(lapply(billingDatabases, function(x) {x$billingAccountId})), suspended = unlist(lapply(billingDatabases, function(x) {x$suspended})), publishedTemplate = unlist(lapply(billingDatabases, function(x) {x$publishedTemplate})) diff --git a/R/databases.R b/R/databases.R index dae4f52..4b60d29 100644 --- a/R/databases.R +++ b/R/databases.R @@ -24,7 +24,7 @@ databasesListToTibble <- function(databases) { dbDF <- dplyr::tibble( databaseId = unlist(lapply(databases, function(x) {x$databaseId})), label = unlist(lapply(databases, function(x) {x$label})), - description = unlist(lapply(databases, function(x) { if(nzchar(x$description)) x$description else NA_character_ })), + description = vapply(databases, function(x) {emptyToNA(x$description)}, character(1)), ownerId = vapply(databases, function(x) {charOrNA(x$ownerId)}, character(1)), billingAccountId = as.character(unlist(lapply(databases, function(x) {x$billingAccountId}))), suspended = unlist(lapply(databases, function(x) {x$suspended})) @@ -38,6 +38,11 @@ charOrNA <- function(x) { if (is.null(x)) NA_character_ else as.character(x) } +# The server may return an empty or a null description +emptyToNA <- function(x) { + if (is.null(x) || !nzchar(x)) NA_character_ else as.character(x) +} + databaseUpdates <- function() { list( resourceUpdates = list(), diff --git a/tests/testthat/test-databaseOwners.R b/tests/testthat/test-serverResponses.R similarity index 50% rename from tests/testthat/test-databaseOwners.R rename to tests/testthat/test-serverResponses.R index 6a31ca0..1c5e635 100644 --- a/tests/testthat/test-databaseOwners.R +++ b/tests/testthat/test-serverResponses.R @@ -4,17 +4,23 @@ databasesJson <- '[ {"databaseId":"cowner1","label":"With owner","description":"","ownerId":"5148353961132032","billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false,"languages":[]}, - {"databaseId":"cowner2","label":"Without owner","description":"","ownerId":null,"billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false,"languages":[]} + {"databaseId":"cowner2","label":"Without owner","description":null,"ownerId":null,"billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false,"languages":[]} ]' billingDatabasesJson <- '[ {"databaseId":"cowner1","label":"With owner","description":"","owner":{"id":"5148353961132032","name":"Bob","email":"bob@example.com"},"formCount":1,"userCount":2,"basicUserCount":0,"recordCount":3,"lastRecordUpdate":"2026-01-01","billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false}, - {"databaseId":"cowner2","label":"Without owner","description":"","owner":null,"formCount":0,"userCount":0,"basicUserCount":0,"recordCount":0,"lastRecordUpdate":"1970-01-01","billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false} + {"databaseId":"cowner2","label":"Without owner","description":null,"owner":null,"formCount":0,"userCount":0,"basicUserCount":0,"recordCount":0,"lastRecordUpdate":null,"billingAccountId":5308023665328128,"suspended":false,"publishedTemplate":false} ]' +mockResponse <- function(fn, json, env = parent.frame()) { + response <- activityinfo:::fromActivityInfoJson(json) + mock <- list(function(...) response) + names(mock) <- fn + do.call(testthat::local_mocked_bindings, c(mock, list(.env = env))) +} + mockDatabases <- function(json, env = parent.frame()) { - databases <- activityinfo:::fromActivityInfoJson(json) - testthat::local_mocked_bindings(getResource = function(...) databases, .env = env) + mockResponse("getResource", json, env) } testthat::test_that("getDatabases() works with and without database owners", { @@ -45,4 +51,33 @@ testthat::test_that("getBillingAccountDatabases() works with and without databas testthat::expect_identical(df$ownerId, c("5148353961132032", NA_character_)) testthat::expect_identical(df$ownerName, c("Bob", NA_character_)) testthat::expect_identical(df$ownerEmail, c("bob@example.com", NA_character_)) + testthat::expect_identical(df$description, c(NA_character_, NA_character_)) + testthat::expect_identical(df$lastRecordUpdate, c("2026-01-01", NA_character_)) +}) + +testthat::test_that("getBillingAccountDatabases() columns keep their type when all values are null", { + mockDatabases(gsub('"lastRecordUpdate":"2026-01-01"', '"lastRecordUpdate":null', billingDatabasesJson)) + + df <- getBillingAccountDatabases("5308023665328128") + testthat::expect_identical(df$lastRecordUpdate, c(NA_character_, NA_character_)) +}) + +auditLogJson <- '{ + "events": [ + {"id":"e1","time":1790376900768,"formId":"cform1","description":"No resource types","type":"FORM","resourceTypes":[],"resourceId":"","user":{"id":"1","name":"Bob","email":"bob@example.com"}}, + {"id":"e2","time":1790376900769,"formId":"cform1","description":"One resource type","type":"FORM","resourceTypes":["FORM"],"resourceId":"cform1","user":{"id":"1","name":"Bob","email":"bob@example.com"}}, + {"id":"e3","time":1790376900770,"formId":"cform1","description":"Two resource types","type":"FORM","resourceTypes":["FORM","ROLE"],"resourceId":"cform1","user":null} + ], + "moreEvents": false, + "startTime": 1790376900000, + "endTime": 1790376901000 +}' + +testthat::test_that("queryAuditLog() works with events with none or several resource types", { + mockResponse("postResource", auditLogJson) + + events <- queryAuditLog("cdb1", after = as.POSIXct(1790376800, origin = "1970-01-01")) + testthat::expect_identical(nrow(events), 3L) + testthat::expect_identical(events$resourceTypes, c(NA, "FORM", "FORM,ROLE")) + testthat::expect_identical(events$user.name, c("Bob", "Bob", NA)) }) From b5f1cc621b3dca7ded0a8df12ee2cc30f851e130 Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Sat, 26 Sep 2026 01:00:56 +0200 Subject: [PATCH 8/9] Add fixes to the 5.0 release notes Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- NEWS.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/NEWS.md b/NEWS.md index d84d5f2..9c9eda7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,7 +11,13 @@ New features: - `as.data.frame()` of a form schema now includes the `requiredCondition` and `validationMessage` columns - Form field schemas from `getFormSchema()` now always include `dataEntryVisible`, like `tableVisible` +Fixes: +- `getDatabases()` and `getBillingAccountDatabases()` no longer fail when the server returns a null description, as self-managed servers do +- The `lastRecordUpdate` column of `getBillingAccountDatabases()` is now always character, including when no database has records +- `queryAuditLog()` no longer fails on events with none or several resource types; these are combined into a single comma-separated value in the `resourceTypes` column + Testing: +- Tests with fixed server responses for databases with and without an owner, and for the fixes above - API tests now authenticate with an API token rather than basic password authentication - Tests updated for testthat 3.3 and to not depend on the versions of pandoc and rmarkdown From bd794e858d85f6a08a720687bd84f102a7b4cd78 Mon Sep 17 00:00:00 2001 From: Alex Bertram Date: Sat, 26 Sep 2026 10:02:22 +0200 Subject: [PATCH 9/9] Make the tests pass against the self-managed server - Limit test ids to 21 characters, the maximum that the self-managed server accepts - Treat null and empty strings as equal in snapshot comparisons, as the self-managed server returns null for empty strings Co-Authored-By: Claude Opus 5.5 (1M context) Claude-Session: https://claude.ai/code/session_01MfjP16HSkanSsjZFVy8qPp --- NEWS.md | 1 + tests/testthat/_snaps/databases.md | 8 ++++---- tests/testthat/setup.R | 12 +++++++++--- tests/testthat/test-databases.R | 5 +++-- 4 files changed, 17 insertions(+), 9 deletions(-) diff --git a/NEWS.md b/NEWS.md index 9c9eda7..c39189d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -20,6 +20,7 @@ Testing: - Tests with fixed server responses for databases with and without an owner, and for the fixes above - API tests now authenticate with an API token rather than basic password authentication - Tests updated for testthat 3.3 and to not depend on the versions of pandoc and rmarkdown +- Tests can be run against the self-managed server ## [4.39] - `getDatabaseBillingAccount()` now includes `parentBillingAccountId` and handles billing accounts without a parent (#150) diff --git a/tests/testthat/_snaps/databases.md b/tests/testthat/_snaps/databases.md index 3f1f5a9..9bd010f 100644 --- a/tests/testthat/_snaps/databases.md +++ b/tests/testthat/_snaps/databases.md @@ -15,10 +15,10 @@ dbResources Output # A tibble: 2 x 5 - id label parentId type visibility - * - 1 c10000004 Person form c10000002 FORM PRIVATE - 2 c10000005 Children c10000004 SUB_FORM PRIVATE + id label parentId type visibility + * + 1 c10004 Person form c10002 FORM PRIVATE + 2 c10005 Children c10004 SUB_FORM PRIVATE # resourcePermissions() and synonym permissions() helper works diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 0917fd3..31d7423 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -14,13 +14,14 @@ suppressWarnings(grSoftVersion()) ##### Testing functions ##### -# creating a cuid that artificially enforces a sort order on IDs for snapshotting of API objects +# creating a cuid that artificially enforces a sort order on IDs for snapshotting of API objects. +# The ids are at most 21 characters long, the maximum that the self-managed server accepts. cuid <- local({ - i <- 10000000L + i <- 10000L function() { i <<- i + 1L - sprintf("c%d%s", i, activityinfo:::cuid()) + sprintf("c%d%s", i, substr(activityinfo:::cuid(), 2, 16)) } }) @@ -105,6 +106,11 @@ namesOrIndexes <- function(x) { } compare_recursively <- function(a, b, path = list()) { + # Some servers, such as the self-managed server, return null for an empty string + if ((identical(a, "") && is.null(b)) || (is.null(a) && identical(b, ""))) { + testthat::succeed() + return(invisible()) + } if (is.atomic(a) && is.atomic(b)) { if (!identical(a,b)) { message(sprintf("Field with name/key '%s' value has changed", paste(path, collapse="'->'"))) diff --git a/tests/testthat/test-databases.R b/tests/testthat/test-databases.R index 5731968..ff559f8 100644 --- a/tests/testthat/test-databases.R +++ b/tests/testthat/test-databases.R @@ -54,8 +54,9 @@ testthat::test_that("getDatabaseResources() works", { dbResources <- dbResources[order(dbResources$id, dbResources$parentId, dbResources$label, dbResources$visibility),] %>% select(id, label, parentId, type, visibility) - dbResources$id <- substr(dbResources$id,1,9) - dbResources$parentId <- substr(dbResources$parentId,1,9) + # Keep only the prefix that enforces the sort order of the test ids + dbResources$id <- substr(dbResources$id,1,6) + dbResources$parentId <- substr(dbResources$parentId,1,6) row.names(dbResources) <- NULL dbResources <- canonicalizeActivityInfoObject(dbResources, replaceId = FALSE)