party2d/data-setup/R/01_download_sources.R

#!/usr/bin/env Rscript

args <- commandArgs(trailingOnly = FALSE)
file_arg <- args[grepl("^--file=", args)][1]
if (!is.na(file_arg)) {
  script_path <- sub("^--file=", "", file_arg)
  repo_root <- normalizePath(file.path(dirname(script_path), "..", ".."), mustWork = FALSE)
} else {
  repo_root <- normalizePath(getwd(), mustWork = TRUE)
}
if (!dir.exists(file.path(repo_root, "data-setup"))) repo_root <- normalizePath(getwd(), mustWork = TRUE)

raw_dir <- normalizePath(Sys.getenv("PARTY2D_RAW_DATA_DIR", file.path(repo_root, "_local", "raw")), mustWork = FALSE)
report_dir <- normalizePath(Sys.getenv("PARTY2D_REPORT_DIR", file.path(repo_root, "_local", "reports")), mustWork = FALSE)
dir.create(raw_dir, recursive = TRUE, showWarnings = FALSE)
dir.create(report_dir, recursive = TRUE, showWarnings = FALSE)

ua <- "party2d-data-setup/1.0 (+https://git.seimel.app/armin/party2d)"

download_file <- function(url, dest, overwrite = FALSE, headers = character()) {
  dir.create(dirname(dest), recursive = TRUE, showWarnings = FALSE)
  if (file.exists(dest) && file.info(dest)$size > 0 && !overwrite) {
    message("OK existing: ", dest)
    return(TRUE)
  }
  tmp <- paste0(dest, ".tmp")
  if (file.exists(tmp)) unlink(tmp)
  message("Downloading ", url, " -> ", dest)
  ok <- tryCatch({
    utils::download.file(
      url,
      tmp,
      mode = "wb",
      quiet = TRUE,
      method = "libcurl",
      headers = c("User-Agent" = ua, headers)
    )
    file.rename(tmp, dest)
  }, error = function(e) {
    message("FAILED ", url, ": ", conditionMessage(e))
    FALSE
  })
  if (!ok && file.exists(tmp)) unlink(tmp)
  isTRUE(ok)
}

download_dataverse <- function(doi, filename, dest, directory = NA_character_) {
  if (!requireNamespace("jsonlite", quietly = TRUE)) {
    message("FAILED Dataverse lookup: install R package jsonlite")
    return(FALSE)
  }
  api <- paste0("https://dataverse.harvard.edu/api/datasets/:persistentId/?persistentId=", utils::URLencode(doi, reserved = TRUE))
  fid <- tryCatch({
    meta <- jsonlite::fromJSON(api, simplifyVector = FALSE)
    files <- meta$data$latestVersion$files
    matches <- Filter(function(x) {
      same_file <- identical(x$dataFile$filename, filename)
      same_dir <- is.na(directory) || identical(x$directoryLabel, directory)
      same_file && same_dir
    }, files)
    if (length(matches) == 0) NA_integer_ else as.integer(matches[[1]]$dataFile$id)
  }, error = function(e) {
    message("FAILED Dataverse lookup ", doi, " ", filename, ": ", conditionMessage(e))
    NA_integer_
  })
  if (is.na(fid)) {
    message("FAILED Dataverse lookup ", doi, ": file not found: ", filename)
    return(FALSE)
  }
  download_file(paste0("https://dataverse.harvard.edu/api/access/datafile/", fid), dest)
}

download_manifesto <- function(dest) {
  key <- Sys.getenv("MANIFESTO_API_KEY", Sys.getenv("PARTY2D_MANIFESTO_API_KEY", ""))
  if (!nzchar(key)) {
    message("SKIP Manifesto: set MANIFESTO_API_KEY or PARTY2D_MANIFESTO_API_KEY")
    return(FALSE)
  }
  url <- "https://manifesto-project.wzb.eu/api/v1/get_core?key=MPDS2025a&raw=true"
  download_file(
    url,
    dest,
    overwrite = TRUE,
    headers = c("Referer" = "https://manifesto-project.wzb.eu/datasets", "API_KEY" = key)
  )
}

download_vparty <- function(dest) {
  email <- Sys.getenv("PARTY2D_VDEM_EMAIL", "")
  if (!nzchar(email)) {
    message("SKIP V-Party: set PARTY2D_VDEM_EMAIL to use V-Dem's required download form")
    return(FALSE)
  }
  curl <- Sys.which("curl")
  if (!nzchar(curl)) {
    message("FAILED V-Party: curl is required for the provider form")
    return(FALSE)
  }
  page <- "https://www.v-dem.net/data/v-party-dataset/country-party-date-v2/"
  tmpdir <- tempfile("vparty")
  dir.create(tmpdir)
  on.exit(unlink(tmpdir, recursive = TRUE), add = TRUE)
  cookie <- file.path(tmpdir, "cookies.txt")
  html <- file.path(tmpdir, "page.html")
  payload <- file.path(tmpdir, "payload.bin")
  zip_path <- file.path(tmpdir, "vparty.zip")
  status <- system2(curl, c("-L", "-A", ua, "-c", cookie, "-b", cookie, "-o", html, page), stdout = TRUE, stderr = TRUE)
  if (!file.exists(html)) {
    message("FAILED V-Party form load")
    return(FALSE)
  }
  page_text <- paste(readLines(html, warn = FALSE), collapse = "\n")
  csrf <- sub('.*name="csrfmiddlewaretoken"[^>]*value="([^"]*)".*', '\\1', page_text)
  if (identical(csrf, page_text)) csrf <- ""
  gender <- Sys.getenv("PARTY2D_VDEM_GENDER", "")
  form <- c(
    "csrfmiddlewaretoken", csrf,
    "email", email,
    "gender", gender,
    "accept_terms", "on",
    "dataset_file", "17",
    "website", ""
  )
  args <- c(
    "-L", "-A", ua, "-c", cookie, "-b", cookie,
    "-H", paste0("Referer: ", page),
    "-H", paste0("X-CSRFToken: ", csrf),
    "-H", "X-Requested-With: XMLHttpRequest",
    "-o", payload,
    "--data-urlencode", paste0(form[1], "=", form[2]),
    "--data-urlencode", paste0(form[3], "=", form[4]),
    "--data-urlencode", paste0(form[5], "=", form[6]),
    "--data-urlencode", paste0(form[7], "=", form[8]),
    "--data-urlencode", paste0(form[9], "=", form[10]),
    "--data-urlencode", paste0(form[11], "=", form[12]),
    paste0(page, "#dataset-download")
  )
  system2(curl, args, stdout = TRUE, stderr = TRUE)
  if (!file.exists(payload) || file.info(payload)$size == 0) {
    message("FAILED V-Party form submit")
    return(FALSE)
  }
  bytes <- readBin(payload, "raw", n = min(file.info(payload)$size, 4))
  if (length(bytes) >= 2 && identical(as.integer(bytes[1:2]), c(0x50L, 0x4bL))) {
    file.copy(payload, zip_path, overwrite = TRUE)
  } else {
    text <- paste(readLines(payload, warn = FALSE), collapse = "\n")
    m <- regexpr('https?://[^" ]*CPD_V-Party_R_v2\\.zip|/[^" ]*CPD_V-Party_R_v2\\.zip', text)
    if (m[1] < 0) {
      message("FAILED V-Party form response did not include a recognizable ZIP download")
      return(FALSE)
    }
    url <- regmatches(text, m)[1]
    if (startsWith(url, "/")) url <- paste0("https://www.v-dem.net", url)
    if (!download_file(url, zip_path, overwrite = TRUE, headers = c("Referer" = page))) return(FALSE)
  }
  listing <- utils::unzip(zip_path, list = TRUE)
  member <- listing$Name[grepl("\\.(rds|rda|rdata)$", listing$Name, ignore.case = TRUE)][1]
  if (is.na(member)) {
    message("FAILED V-Party ZIP contains no R data file")
    return(FALSE)
  }
  dir.create(dirname(dest), recursive = TRUE, showWarnings = FALSE)
  utils::unzip(zip_path, files = member, exdir = tmpdir, overwrite = TRUE)
  file.copy(file.path(tmpdir, member), dest, overwrite = TRUE)
  message("Extracted V-Party R data: ", dest)
  TRUE
}

status <- c()
status["PolDem"] <- download_file("https://poldem.eui.eu/downloads/cosa/poldem-election_all.csv", file.path(raw_dir, "poldem", "poldem-election_all.csv"))
status["PartyFacts external parties"] <- download_file("https://partyfacts.herokuapp.com/download/external-parties-csv/", file.path(raw_dir, "partyfacts", "partyfacts-external-parties.csv"))
status["Manifesto MPDS 2025a"] <- download_manifesto(file.path(raw_dir, "manifesto", "MPDataset_MPDS2025a.csv"))

ches_base <- "https://www.chesdata.eu/s/"
ches_files <- c(
  "1999-2019_CHES_dataset_meansv3.csv" = "1999-2019_CHES_dataset_means(v3).csv",
  "1999-2024_CHES_dataset_meansV2-3k4l.csv" = "1999-2024_CHES_dataset_meansV2-3k4l.csv",
  "CHES_2024_final_v2.csv" = "CHES_2024_final_v2.csv",
  "CHES_2024_ALL_Stacked_Expert.csv" = "CHES_2024_expert_level.csv",
  "CHES_CA2023.csv" = "CHES_CA2023.csv",
  "CHES_CA2023_expert-level.csv" = "CHES_CA2023_expert_level.csv",
  "ches_la_2020_aggregate_level_v01.csv" = "ches_la_2020_aggregate_level_v01.csv",
  "ches_la_2020_expert_level_v01.csv" = "CHES_LA2020_expert_level.csv",
  "CHES_ISRAEL_means_2021_2022.csv" = "CHES_ISRAEL_means_2021_2022.csv",
  "CHES_ISRAEL_expert_level_2021_2022.csv" = "CHES_IL_expert_level.csv"
)
for (remote in names(ches_files)) {
  local <- ches_files[[remote]]
  status[paste("CHES", local)] <- download_file(paste0(ches_base, utils::URLencode(remote, reserved = TRUE)), file.path(raw_dir, "ches", local))
}

status["POPPA integrated v2"] <- download_dataverse("doi:10.7910/DVN/RMQREQ", "poppa_integrated_v2.rds", file.path(raw_dir, "poppa", "poppa_integrated_v2.rds"), "final_data_v2")
status["GPS 2019 party"] <- download_dataverse("doi:10.7910/DVN/WMGTNS", "Global Party Survey by Party SPSS V2_1_Apr_2020-2.tab", file.path(raw_dir, "gps", "Global Party Survey by Party SPSS V2_1_Apr_2020-2.tab"))
status["V-Party"] <- download_vparty(file.path(raw_dir, "vparty", "V-Dem-CPD-Party-V2.rds"))

report <- file.path(report_dir, "download_sources_report.md")
lines <- c("# Download sources report", "", "| source | status |", "| --- | --- |")
for (name in names(status)) lines <- c(lines, paste0("| ", name, " | ", if (isTRUE(status[[name]])) "ok" else "missing/failed", " |"))
writeLines(lines, report)
message("Wrote download report: ", report)

quit(status = if (all(status)) 0 else 2)