add force parameter

This commit is contained in:
Patrick Schratz 2024-07-24 18:20:45 +02:00
commit c42e2be4a6
Signed by: pat-s
GPG key ID: 3C6318841EF78925
3 changed files with 36 additions and 57 deletions

View file

@ -1,7 +1,7 @@
#' @importFrom DBI dbConnect dbDisconnect dbWriteTable dbGetQuery dbExecute
store_build_metadata <- function(
package_name, tag, platform,
error_occurred, error) {
error_occurred, error, force = FALSE) {
# s3 <- paws.storage::s3(config = list(
# endpoint = "https://s3.eu-central-003.backblazeb2.com",
# region = "eu-central-003"
@ -15,28 +15,6 @@ store_build_metadata <- function(
port = 15432, user = "arm_binaries", password = Sys.getenv("PGPASS")
)
# NB: helper fun which should only be commented in if a new column in the DB is needed!
# columns_to_add <- list(
# c("average_build_time_per_tag", "REAL")
# )
# for (column in columns_to_add) {
# add_column_if_not_exists("/tmp/metadata.sqlite", "metadata_summary", column[1], column[2])
# }
# dbExecute(con, "BEGIN TRANSACTION")
# Create the "metadata" table if it does not exist
# dbExecute(con, "CREATE TABLE IF NOT EXISTS single_builds (
# package_name TEXT,
# tag TEXT,
# platform TEXT,
# error_occurred BOOLEAN,
# build_timestamp TEXT,
# build_duration REAL
# )")
# columns added after initial DB creation
# Create an index on the package_name and tag columns
dbExecute(con, "CREATE INDEX IF NOT EXISTS idx_metadata_package_tag ON single_builds(package_name, platform)")
@ -46,8 +24,8 @@ store_build_metadata <- function(
package_name, "' AND tag = '", tag, "'"
))
if (nrow(existing_entries) >= 1) {
cli::cli_alert_info("{.fun store_build_metadata}: Build metadata for {.field {package_name}} {.field {tag}} already exists.")
if (nrow(existing_entries) >= 1 && !force) {
cli::cli_alert_info("{.fun store_build_metadata}: Build metadata for {.field {.pkg package_name}} {.field {tag}} already exists.")
} else {
cli::cli_alert_info("{.fun store_build_metadata}: Storing build metadata for {.field {package_name}} {.field {tag}}.")
# Create a data frame with the metadata
@ -63,19 +41,10 @@ store_build_metadata <- function(
dbWriteTable(con, "single_builds", metadata, append = TRUE)
}
# dbExecute(con, "COMMIT")
# Close the SQLite connection
dbDisconnect(con)
# s3 <- paws.storage::s3(config = list(
# endpoint = "https://s3.eu-central-003.backblazeb2.com",
# region = "eu-central-003"
# ))
# s3$put_object(
# Bucket = "devxy-arm64-r-binaries-db", Key = "metadata.sqlite",
# Body = "/tmp/metadata.sqlite"
# )
return(invisible(TRUE))
}
#' @importFrom DBI dbConnect dbGetQuery

View file

@ -10,10 +10,15 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
local_build_root = "/root",
local_clone_dir = "/tmp",
platform = "redhat-9",
install_system_dependencies = TRUE) {
cli::cli_h2("Preparations")
install_system_dependencies = TRUE,
debug = FALSE,
force = FALSE) {
cli::cli_h2("Preparations ({.pkg {package_name}})")
codename <- set_codename(codename)
cli::cli_alert_warning("DEBUG: codename {codename}.")
if (debug) {
cli::cli_alert_warning("DEBUG: codename {codename}.")
}
if (is.null(r_version_minor)) {
r_version_minor <- sub("R version (\\d+\\.\\d+).*", "\\1", R.Version()$version.string)
@ -21,16 +26,21 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
# create directory structure
dir_out_bin <- set_bin_path(r_version_minor, build_for_minor, local_build_root, codename)
cli::cli_alert_warning("DEBUG: dir_out_bin {dir_out_bin}.")
if (debug) {
cli::cli_alert_warning("DEBUG: dir_out_bin {dir_out_bin}.")
}
dir_out_src <- sprintf("%s/src/contrib/Archive", local_build_root)
cli::cli_alert_info("{.fun build_binary_package}: Creating bin dir {.path {dir_out_bin}}.")
cli::cli_alert_info("{.fun build_binary_package}: Creating src dir {.path {dir_out_src}}.")
if (debug) {
cli::cli_alert_info("{.fun build_binary_package}: Creating bin dir {.path {dir_out_bin}}.")
cli::cli_alert_info("{.fun build_binary_package}: Creating src dir {.path {dir_out_src}}.")
}
dir.create(sprintf("%s/Archive", dir_out_bin), sprintf("%s/Archive", dir_out_src),
recursive = TRUE
)
cli::cli_h2("Installing system dependencies")
cli::cli_h2("Installing system dependencies ({.pkg {package_name}})")
gert::git_config_global_set("advice.detachedHead", "false")
@ -42,6 +52,9 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
)
# Retrieve all tags
all_tags <- gert::git_tag_list(repo = sprintf("%s/%s", tempdir(), "tmp1"))
# filter out tags that start with R- (= non-valid ones)
all_tags <- all_tags[!grepl("R-", all_tags$name), ]
unlink(sprintf("%s/%s", tempdir(), "tmp1"), force = TRUE, recursive = TRUE)
tag <- all_tags$name
package_name <- rep(package_name, length(tag))
@ -61,9 +74,9 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
}
t1 <- Sys.time()
cli::cli_h2("Building")
cli::cli_h2("Building ({.pkg {package_name[1]}})")
cli::cli_alert_info("Building binaries for {.pkg {package_name[[1]]}} with tags {.strong {tag}}.")
cli::cli_alert_info("Building binaries for {.pkg {package_name[[1]]}} with tags {.field {tag}}.")
# Set up the progress handler
progressr::handlers(global = TRUE)
@ -93,17 +106,17 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
total_build_time <- round(Sys.time() - t1, 2)
cli::cli_alert_info("Execution time for {.pkg {package_name[[1]]}} ({length(tag)} tags): {.strong {total_build_time} {units(difftime(Sys.time(), t1))}}.")
cli::cli_h2("Uploading")
cli::cli_h2("Uploading ({.pkg {package_name[1]}})")
out <- progressr::with_progress({
p <- progressr::progressor(along = tag)
future_mapply(function(x, y) {
tryCatch(
{
p()
upload_single_binary_to_s3(package_name = x, tag = y, debug = F)
upload_single_binary_to_s3(package_name = x, tag = y, force = force, build_for_minor = build_for_minor, debug = debug)
},
error = function(e) {
message("Error in uploading package ", x, " with tag ", y, ": ")
message(sprintf("Error in uploading package %s with tag %s: %s", x, y, e))
}
)
}, package_name, tag, future.seed = TRUE)
@ -117,7 +130,7 @@ install_package_system_dependencies <- function(package_name,
tag,
platform = "redhat-9",
local_clone_dir) {
cli::cli_alert_info("{.fun install_package_system_dependencies}: Cloning package {.pkg {package_name[1]}} with tag {.strong {tag}}.")
cli::cli_alert_info("{.fun install_package_system_dependencies}: Cloning package {.pkg {package_name[1]}} with tag {.field {tag}}.")
local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name[1], tail(tag, 1))
@ -147,7 +160,7 @@ build_single_tag <- function(
platform,
dir_out_bin,
local_clone_dir) {
cli::cli_alert_info("{.fun build_single_tag}: 1. Cloning package {.pkg {package_name}} with tag {.strong {tag}}.")
cli::cli_alert_info("{.fun build_single_tag}: 1. Cloning package {.pkg {package_name}} with tag {.field {tag}}.")
local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name, tag)
@ -158,15 +171,15 @@ build_single_tag <- function(
))
if (file.exists(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) {
cli::cli_alert_info("{.fun build_single_tag}: 2. Tarball for package {.pkg {package_name}} with tag {.strong {tag}} already exists. Skipping build.")
cli::cli_alert_info("{.fun build_single_tag}: 2. Tarball for package {.pkg {package_name}} with tag {.field {tag}} already exists. Skipping build.")
} else {
cli::cli_alert_info("{.fun build_single_tag}: 2. Building package {.pkg {package_name}} with tag {.strong {tag}}.")
cli::cli_alert_info("{.fun build_single_tag}: 2. Building package {.pkg {package_name}} with tag {.field {tag}}.")
t1 <- Sys.time()
pkgbuild::build(
dump <- pkgbuild::build(
path = sprintf("%s", local_clone_dir_single),
binary = TRUE, vignettes = FALSE,
dest_path = dir_out_bin
dest_path = dir_out_bin, quiet = TRUE
)
if (!file.exists(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) {
@ -200,6 +213,5 @@ build_single_tag <- function(
}
}
return(invisible(TRUE))
}

View file

@ -9,7 +9,7 @@ set_codename <- function(codename) {
codename <- system2("grep",
args = c("'^VERSION_CODENAME=' /etc/os-release | cut -d'=' -f2 | tr -d '\"'"), stdout = TRUE
)
} else if (grepl("rhel", dist_fam)) {
} else if (grepl("rhel|fedora", dist_fam)) {
platform_id <- system2("grep",
args = c("'^PLATFORM_ID=' /etc/os-release | cut -d'=' -f2 | tr -d '\"'"), stdout = TRUE
)
@ -42,8 +42,6 @@ set_bin_path <- function(
local_build_root, codename, r_version_minor
)
}
cli::cli_alert_warning("DEBUG: path {path}.")
return(path)
}