add force parameter

R/build-metadata.R

@@ -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) {
+  if (nrow(existing_entries) >= 1 && !force) {
-    cli::cli_alert_info("{.fun store_build_metadata}: Build metadata for {.field {package_name}} {.field {tag}} already exists.")
+    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(
+  return(invisible(TRUE))
-  #   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"
-  # )
 }
 
 #' @importFrom DBI dbConnect dbGetQuery

R/build_binaries.R

@@ -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) {
+                                 install_system_dependencies = TRUE,
-  cli::cli_h2("Preparations")
+                                 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}}.")
+  if (debug) {
-  cli::cli_alert_info("{.fun build_binary_package}: Creating src dir {.path {dir_out_src}}.")
+    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))
 }

R/helpers.R

@@ -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)
 }