Restore source downloader in R
This commit is contained in:
Armin
@@ -0,0 +1,203 @@
|
||||
#!/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)
|
||||
Reference in New Issue
Block a user