Initial commit

#migrate/migrate-runs.R

@@ -0,0 +1,275 @@
+#!/usr/bin/env Rscript
+# =============================================================================
+# migrate-runs.R
+#
+# Dupliziert alle Runs von Nutzer A auf Nutzer B über die formr-API v1.
+# Die in den Runs liegenden Surveys werden dabei serverseitig als eigene
+# Kopien unter Nutzer B neu angelegt (leere results_table). Surveys, die in
+# KEINEM Run hängen, werden bewusst nicht angefasst.
+#
+# Hintergrund und Gesamtplan: docs/zweiter-nutzer-einrichten.md (Teil A.2b, E)
+#
+# Ablauf:
+#   Phase 1 (als Nutzer A, Scope run:read [+ file:read]):
+#           GET /v1/runs/{name}/structure  -> JSON pro Run nach WORKDIR/structures/
+#   Phase 2 (als Nutzer B, Scope run:write [+ file:write]):
+#           POST /v1/runs/{name-}          -> leeren Run anlegen
+#           PUT  /v1/runs/{name-}/structure-> Struktur (inkl. Surveys) importieren
+#
+# Es kann immer nur EINE API-Session aktiv sein, daher die zwei Phasen.
+# Das Skript ist wiederholbar: bereits angelegte Ziel-Runs werden übersprungen.
+#
+# -----------------------------------------------------------------------------
+# EINMALIGE EINRICHTUNG (im R-Prompt, NICHT in dieser Datei):
+#
+#   install.packages("keyring")
+#   remotes::install_github("rubenarslan/formr")   # formr ist nicht auf CRAN
+#   library(formr)
+#
+#   # client_id / client_secret aus dem formr-Panel (admin/account -> API
+#   # credentials). Werte NUR hier interaktiv eingeben, nie in Dateien.
+#   formr_store_keys(host = "https://diagnostik.karneboge.de/api",
+#                    client_id = "<CLIENT-ID-NUTZER-A>",
+#                    client_secret = "<SECRET-NUTZER-A>",
+#                    account = "mig_read")
+#   formr_store_keys(host = "https://diagnostik.karneboge.de/api",
+#                    client_id = "<CLIENT-ID-NUTZER-B>",
+#                    client_secret = "<SECRET-NUTZER-B>",
+#                    account = "mig_write")
+#
+#   Client A braucht Scope:  run:read     (optional zusätzlich file:read)
+#   Client B braucht Scope:  run:write    (optional zusätzlich file:write)
+#   Beide OHNE Run-Einschränkung. Nach der Migration beide Clients löschen.
+#
+#   VPN muss verbunden sein (die /api ist auf die VPN-IP beschränkt).
+# =============================================================================
+
+
+# ==== 1. KONFIGURATION =======================================================
+
+HOST      <- "https://diagnostik.karneboge.de/api"
+ACC_READ  <- "mig_read"    # keyring-account Nutzer A (siehe Einrichtung oben)
+ACC_WRITE <- "mig_write"   # keyring-account Nutzer B
+
+SUFFIX    <- "-"           # Ziel-Run-Name = Quell-Name + SUFFIX  (z. B. phq9 -> phq9-)
+
+ONLY      <- NULL          # NULL = alle Runs. Für den Testlauf: c("phq9", "gad7")
+
+DRY_RUN   <- FALSE          # TRUE: nichts schreiben, nur anzeigen was passieren würde.
+                          # Erst nach erfolgreichem Testlauf auf FALSE setzen.
+
+DO_FILES  <- TRUE         # TRUE: in Runs hochgeladene Dateien (Bildmaterial in
+                          # Fragebögen) mitkopieren. Braucht file:read / file:write.
+
+# Arbeitsverzeichnis (Export-JSONs + Log + ggf. Dateien). Standard: Unterordner
+# neben diesem Skript.
+WORKDIR   <- NULL          # NULL = <skriptordner>/run-migration ; sonst fester Pfad
+
+
+# ==== 2. VORBEREITUNG ========================================================
+
+if (!requireNamespace("formr", quietly = TRUE)) {
+  stop("Paket 'formr' fehlt: remotes::install_github('rubenarslan/formr')", call. = FALSE)
+}
+for (p in c("keyring", "jsonlite")) {
+  if (!requireNamespace(p, quietly = TRUE)) {
+    stop("Paket '", p, "' fehlt: install.packages('", p, "')", call. = FALSE)
+  }
+}
+library(formr)
+
+.script_dir <- tryCatch({
+  cmd <- commandArgs(FALSE)
+  f <- sub("^--file=", "", grep("^--file=", cmd, value = TRUE))
+  if (length(f) == 1L) {
+    dirname(normalizePath(f))
+  } else if (requireNamespace("rstudioapi", quietly = TRUE) &&
+             rstudioapi::isAvailable() &&
+             nzchar(rstudioapi::getSourceEditorContext()$path)) {
+    dirname(normalizePath(rstudioapi::getSourceEditorContext()$path))
+  } else {
+    getwd()
+  }
+}, error = function(e) getwd())
+
+if (is.null(WORKDIR)) WORKDIR <- file.path(.script_dir, "run-migration")
+dir.create(file.path(WORKDIR, "structures"), recursive = TRUE, showWarnings = FALSE)
+
+message("Arbeitsverzeichnis: ", normalizePath(WORKDIR))
+message("Modus: ", if (DRY_RUN) "DRY-RUN (nichts wird geschrieben)" else ">>> SCHREIBEND <<<")
+if (!is.null(ONLY)) message("Nur diese Runs: ", paste(ONLY, collapse = ", "))
+message("")
+
+# gültiger formr-Run-Name: Buchstabe vorn, dann a-z A-Z 0-9 - , Länge 3..256
+valid_run_name <- function(x) grepl("^[a-zA-Z][a-zA-Z0-9-]{2,255}$", x)
+
+# Log-Sammler
+LOG <- new.env()
+LOG$rows <- list()
+log_add <- function(phase, src, dst = NA, status, units_src = NA, units_dst = NA, message = "") {
+  LOG$rows[[length(LOG$rows) + 1L]] <- data.frame(
+    ts = format(Sys.time(), "%Y-%m-%d %H:%M:%S"),
+    phase = phase, src = src, dst = dst, status = status,
+    units_src = units_src, units_dst = units_dst, message = message,
+    stringsAsFactors = FALSE
+  )
+}
+
+# leere JSON-Objekte {} -> null (der Server verträgt {} in manchen Feldern nicht;
+# gleiche Korrektur wie in formr_api_push_project)
+clean_structure_json <- function(path) {
+  txt  <- paste(readLines(path, warn = FALSE), collapse = "\n")
+  txt2 <- gsub('":[[:space:]]*\\{\\}', '": null', txt)
+  if (!identical(txt, txt2)) writeLines(txt2, path)
+}
+
+
+# ==== 3. PHASE 0 – Run-Liste von Nutzer A ====================================
+
+message("== Phase 0: Run-Liste abrufen (Nutzer A) ==")
+formr_api_authenticate(host = HOST, account = ACC_READ, verbose = FALSE)
+runs_a <- formr_api_runs()
+formr_api_logout(verbose = FALSE)
+
+if (!nrow(runs_a)) stop("Nutzer A hat keine Runs (oder Client-Scope fehlt).", call. = FALSE)
+
+src_names <- runs_a$name
+if (!is.null(ONLY)) {
+  missing <- setdiff(ONLY, src_names)
+  if (length(missing)) message("  Nicht bei Nutzer A gefunden: ", paste(missing, collapse = ", "))
+  src_names <- intersect(src_names, ONLY)
+}
+if (!length(src_names)) stop("Keine Runs zur Migration ausgewählt.", call. = FALSE)
+message("  ", length(src_names), " Run(s) vorgemerkt.\n")
+
+
+# ==== 4. PHASE 1 – Struktur exportieren (Nutzer A) ==========================
+
+message("== Phase 1: Struktur exportieren (Nutzer A) ==")
+formr_api_authenticate(host = HOST, account = ACC_READ, verbose = FALSE)
+
+for (src in src_names) {
+  jf <- file.path(WORKDIR, "structures", paste0(src, ".json"))
+  tryCatch({
+    st <- formr_api_run_structure(src)
+    jsonlite::write_json(st, jf, pretty = TRUE, auto_unbox = TRUE)
+    clean_structure_json(jf)
+    n <- length(st$units)
+    message(sprintf("  [export] %-42s %3d units", src, n))
+    log_add("export", src, status = "ok", units_src = n)
+
+    if (DO_FILES) {
+      fdf <- tryCatch(formr_api_files(src, verbose = FALSE),
+                      error = function(e) data.frame())
+      if (nrow(fdf)) {
+        fd <- file.path(WORKDIR, "files", src)
+        dir.create(fd, recursive = TRUE, showWarnings = FALSE)
+        for (i in seq_len(nrow(fdf))) {
+          dest <- file.path(fd, basename(fdf$name[i]))
+          tryCatch(
+            utils::download.file(fdf$url[i], dest, mode = "wb", quiet = TRUE),
+            error = function(e) message("    Datei-Download fehlgeschlagen: ", fdf$name[i])
+          )
+        }
+        message(sprintf("           %d Datei(en) gesichert", nrow(fdf)))
+      }
+    }
+  }, error = function(e) {
+    message(sprintf("  [export] %-42s FEHLER: %s", src, conditionMessage(e)))
+    log_add("export", src, status = "error", message = conditionMessage(e))
+  })
+}
+
+formr_api_logout(verbose = FALSE)
+message("")
+
+
+# ==== 5. PHASE 2 – Runs anlegen + Struktur importieren (Nutzer B) ===========
+
+message("== Phase 2: Runs anlegen + importieren (Nutzer B) ==")
+formr_api_authenticate(host = HOST, account = ACC_WRITE, verbose = FALSE)
+
+existing_b <- formr_api_runs()
+existing_b_names <- if (nrow(existing_b)) existing_b$name else character(0)
+
+for (src in src_names) {
+  jf  <- file.path(WORKDIR, "structures", paste0(src, ".json"))
+  dst <- paste0(src, SUFFIX)
+
+  if (!file.exists(jf)) {
+    message(sprintf("  [skip]   %-42s kein Export vorhanden", src))
+    log_add("import", src, dst, status = "skipped", message = "kein Export-JSON")
+    next
+  }
+  if (!valid_run_name(dst)) {
+    message(sprintf("  [skip]   %-42s Ziel-Name '%s' ungültig", src, dst))
+    log_add("import", src, dst, status = "skipped", message = "Ziel-Name ungültig")
+    next
+  }
+  if (dst %in% existing_b_names) {
+    message(sprintf("  [skip]   %-42s '%s' existiert schon", src, dst))
+    log_add("import", src, dst, status = "skipped", message = "Ziel-Run existiert")
+    next
+  }
+
+  st_src <- jsonlite::read_json(jf)
+  n_src  <- length(st_src$units)
+
+  if (DRY_RUN) {
+    message(sprintf("  [dry]    %-42s -> %-44s (%d units)", src, dst, n_src))
+    log_add("import", src, dst, status = "dry-run", units_src = n_src)
+    next
+  }
+
+  tryCatch({
+    formr_api_create_run(dst, verbose = FALSE)
+    formr_api_run_structure(dst, structure_json_path = jf, verbose = FALSE)
+
+    chk   <- formr_api_run_structure(dst)
+    n_dst <- length(chk$units)
+    ok    <- n_dst >= n_src
+    message(sprintf("  [import] %-42s -> %-44s %d/%d units %s",
+                    src, dst, n_dst, n_src, if (ok) "OK" else "!! UNVOLLSTÄNDIG"))
+    log_add("import", src, dst,
+            status = if (ok) "ok" else "incomplete",
+            units_src = n_src, units_dst = n_dst)
+
+    if (DO_FILES) {
+      fd <- file.path(WORKDIR, "files", src)
+      if (dir.exists(fd) && length(list.files(fd))) {
+        tryCatch({
+          formr_api_upload_file(dst, fd, verbose = FALSE)
+          message(sprintf("           %d Datei(en) hochgeladen",
+                          length(list.files(fd))))
+        }, error = function(e) message("           Datei-Upload: ", conditionMessage(e)))
+      }
+    }
+  }, error = function(e) {
+    message(sprintf("  [import] %-42s -> %-44s FEHLER: %s",
+                    src, dst, conditionMessage(e)))
+    log_add("import", src, dst, status = "error",
+            units_src = n_src, message = conditionMessage(e))
+  })
+}
+
+formr_api_logout(verbose = FALSE)
+message("")
+
+
+# ==== 6. LOG SCHREIBEN ======================================================
+
+log_df <- do.call(rbind, LOG$rows)
+logf <- file.path(WORKDIR, sprintf("migration-log-%s.csv",
+                                   format(Sys.time(), "%Y%m%d-%H%M%S")))
+utils::write.csv(log_df, logf, row.names = FALSE)
+
+message("== Zusammenfassung ==")
+print(table(log_df$phase, log_df$status))
+message("\nLog: ", logf)
+
+if (DRY_RUN) {
+  message("\nDRY-RUN beendet. Kontrolliere die Liste oben, dann DRY_RUN <- FALSE.")
+} else {
+  message("\nFertig. Nacharbeit (Footer, secrets, cron/public) siehe ",
+          "docs/zweiter-nutzer-einrichten.md Teil E.7.")
+}