cleanup and reorg

DESCRIPTION

@@ -16,7 +16,6 @@ Imports:
     gert,
     lubridate,
     magrittr,
-    pak,
     pkgbuild,
     progressr,
     purrr,
@@ -28,3 +27,4 @@ Suggests:
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
+Remotes: pat-s/desc@description-from-remote, pat-s/cranlike@s3

NAMESPACE

@@ -26,15 +26,19 @@ importFrom(dplyr,group_by)
 importFrom(dplyr,n)
 importFrom(dplyr,summarise)
 importFrom(dplyr,tbl)
+importFrom(fs,file_move)
 importFrom(fs,file_size)
 importFrom(future,plan)
 importFrom(future.apply,future_mapply)
-importFrom(gert,git_config_set)
+importFrom(gert,git_clone)
+importFrom(gert,git_config_global_set)
 importFrom(lubridate,as_date)
 importFrom(lubridate,dmy_hms)
 importFrom(magrittr,"%>%")
 importFrom(pak,local_install_dev_deps)
 importFrom(pkgbuild,build)
+importFrom(progressr,progressor)
+importFrom(progressr,with_progress)
 importFrom(purrr,list_rbind)
 importFrom(purrr,map)
 importFrom(s3fs,s3_dir_ls)

R/build_binaries.R

@@ -1,7 +1,9 @@
+#' Build R binary packages
 #' @import progressr
 #' @importFrom future plan
 #' @importFrom future.apply future_mapply
-#' @importFrom gert git_config_set
+#' @importFrom progressr with_progress progressor
+#' @importFrom gert git_config_global_set git_clone
 #' @importFrom pak local_install_dev_deps
 #' @importFrom pkgbuild build
 #' @export
@@ -45,7 +47,6 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
   gert::git_config_global_set("advice.detachedHead", "false")
 
   if (is.null(tag)) {
-    # get all tags of package
     gert::git_clone(sprintf("https://github.com/cran/%s", package_name),
       path = sprintf("%s/%s", tempdir(), "tmp1"),
       verbose = FALSE
@@ -58,14 +59,6 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
     unlink(sprintf("%s/%s", tempdir(), "tmp1"), force = TRUE, recursive = TRUE)
     tag <- all_tags$name
     package_name <- rep(package_name, length(tag))
-
-    # if (reset_db_metadata) {
-    #   cli::cli_alert_warning("{.fun build_binary_package}: Resetting metadata for {.pkg {package_name}}.")
-
-    #   con <- dbConnect(RSQLite::SQLite(), dbname = "metadata_summary.db")
-    #   # Remove all entries from the metadata_summary table
-    #   dbExecute(con, "DELETE FROM metadata_summary")
-    # }
   }
 
   ### Install system dependencies
@@ -84,7 +77,7 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
 
   out <- progressr::with_progress({
     p <- progressr::progressor(along = tag)
-    future_mapply(function(x, y) {
+    future::future_mapply(function(x, y) {
       tryCatch(
         {
           p()
@@ -95,21 +88,13 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
             dbname = "build_metadata", host = "postgres-arm-binaries-r.devxy.io",
             port = 15432, user = "arm_binaries", password = Sys.getenv("PGPASS")
           )
-          # here we check if build_duration is empty and take this as an indicator that the build failed. I.e. we set error_occurred = TRUE
-          # val <- dbGetQuery(con, sprintf("SELECT build_duration FROM single_builds WHERE package_name = '%s' and tag = '%s'", x, y))
-          # if (is.na(val)) {
-          #   dbExecute(con, sprintf("UPDATE single_builds SET error_occurred = TRUE WHERE package_name = '%s' and tag = '%s'", x, y))
-          # }
           dbDisconnect(con)
         },
         error = function(e) {
           message(sprintf("Error in processing package %s with tag %s: %s", x, y, e))
-          # print(e)
-          # str(e)
           local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, x, y)
           unlink(local_clone_dir_single, force = TRUE, recursive = TRUE)
-          # NB: this does not always work, which is why we are using the lack of build_duration as a secondary factor in store_metadata()
+          # only stderr contains the important information why the build failed
-          # error <- paste("Call:", deparse(conditionCall(e)), "\nMessage:", conditionMessage(e), sep = " ")
           store_build_metadata(x, y, platform, error_occurred = TRUE, force = TRUE, error = e$stderr)
         }
       )
@@ -122,7 +107,7 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
   cli::cli_h2("Uploading ({.pkg {package_name[1]}})")
   out <- progressr::with_progress({
     p <- progressr::progressor(along = tag)
-    future_mapply(function(x, y) {
+    future::future_mapply(function(x, y) {
       tryCatch(
         {
           p()
@@ -137,14 +122,14 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
 
   cli::cli_h2("Updating package index for package ({.pkg {package_name[1]}})")
 
-  add_to_package_index(package_name[1], debug = debug)
+  # add_to_package_index(package_name[1], debug = debug)
 
   return(invisible(TRUE))
 }
 
 #' @importFrom cli cli_alert
 #' @importFrom pkgbuild build
-#' @importFrom fs file_size
+#' @importFrom fs file_size file_move
 #' @export
 build_single_tag <- function(
     package_name, tag = NULL,
@@ -156,7 +141,7 @@ build_single_tag <- function(
 
   local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name, tag)
 
-  # Using system git here as {gert} does not provide this functionality
+  # Using system git here as {gert} does not provide this functionality to checkout a branch by tag
   system2("git", args = c(
     "clone", "-q", sprintf("--branch=%s", tag),
     sprintf("https://github.com/cran/%s", package_name), local_clone_dir_single

R/metadata-build.R

@@ -1,7 +1,8 @@
+#' Stores build metadata of single binary builds in a Postgres DB
 #' @importFrom DBI dbConnect dbDisconnect dbWriteTable dbGetQuery dbExecute
 store_build_metadata <- function(
-    package_name, tag, platform,
+    package_name, tag, platform, error_occurred,
-    error_occurred, force = FALSE, error = NULL) {
+    force = FALSE, error = NA) {
   con <- DBI::dbConnect(RPostgres::Postgres(),
     dbname = "build_metadata", host = "postgres-arm-binaries-r.devxy.io",
     port = 15432, user = "arm_binaries", password = Sys.getenv("PGPASS")
@@ -13,19 +14,17 @@ store_build_metadata <- function(
     package_name, "' AND tag = '", tag, "'"
   ))
 
-  if (is.null(error)) {
-    error <- NA
-  }
-
   if (nrow(existing_entries) >= 1 && !force) {
     cli::cli_alert("{.fun store_build_metadata}: Build metadata for {.field {.pkg package_name}} {.field {tag}} already exists.")
   } else if (nrow(existing_entries) >= 1 && force) {
     cli::cli_alert_info("{.fun store_build_metadata}: Force overwriting build metadata for {.pkg {package_name}} {.field {tag}} because {.code force = TRUE} was set.")
 
-    DBI::dbExecute(con, "UPDATE single_builds SET build_timestamp = $1, error_occurred = $2, error = $3 WHERE package_name = $4 and tag = $5", params = list(format(Sys.time(), "%Y-%m-%d %H:%M:%S"), error_occurred, error, package_name, tag))
+    DBI::dbExecute(con, "UPDATE single_builds SET build_timestamp = $1, error_occurred = $2, error = $3 WHERE package_name = $4 and tag = $5",
+      params = list(format(Sys.time(), "%Y-%m-%d %H:%M:%S"), error_occurred, error, package_name, tag)
+    )
   } else if (nrow(existing_entries) == 0) {
     cli::cli_alert("{.fun store_build_metadata}: Storing build metadata for {.pkg {package_name}} {.field {tag}}.")
-    # Create a data frame with the metadata
+    # if no entry exists already, we can insert the info via dbWriteTable by passing a DF
     metadata <- data.frame(
       package_name = package_name,
       tag = tag,
@@ -99,31 +98,3 @@ build_metadata_summary <- function(package_name, platform) {
   # Close the SQLite connection
   dbDisconnect(con)
 }
-
-query_metadata_summary <- function(package_name = NULL, platform = NULL) {
-  # s3 <- paws.storage::s3(config = list(
-  #   endpoint = "https://s3.eu-central-003.backblazeb2.com",
-  #   region = "eu-central-003"
-  # ))
-  # db_local <- s3$get_object(Bucket = "devxy-arm64-r-binaries-db", Key = "metadata.sqlite")
-  # writeBin(db_local$Body, "/tmp/metadata.sqlite")
-
-  # Create a new SQLite connection
-  con <- dbcon_mem()
-
-  # If both package_name and platform are NULL, return the full table
-  if (is.null(package_name) && is.null(platform)) {
-    summary <- dbGetQuery(con, "SELECT * FROM metadata_summary")
-  } else {
-    # Query the metadata_summary table for the specified package and platform
-    summary <- dbGetQuery(con, paste0(
-      "SELECT * FROM metadata_summary WHERE package_name = '",
-      package_name, "' AND platform = '", platform, "'"
-    ))
-  }
-
-  # Close the SQLite connection
-  dbDisconnect(con)
-
-  return(summary)
-}

R/metadata-query.R

@@ -22,3 +22,31 @@ list_metadata_tables <- function() {
   )
   dbListTables(con)
 }
+
+query_metadata_summary <- function(package_name = NULL, platform = NULL) {
+  # s3 <- paws.storage::s3(config = list(
+  #   endpoint = "https://s3.eu-central-003.backblazeb2.com",
+  #   region = "eu-central-003"
+  # ))
+  # db_local <- s3$get_object(Bucket = "devxy-arm64-r-binaries-db", Key = "metadata.sqlite")
+  # writeBin(db_local$Body, "/tmp/metadata.sqlite")
+
+  # Create a new SQLite connection
+  con <- dbcon_mem()
+
+  # If both package_name and platform are NULL, return the full table
+  if (is.null(package_name) && is.null(platform)) {
+    summary <- dbGetQuery(con, "SELECT * FROM metadata_summary")
+  } else {
+    # Query the metadata_summary table for the specified package and platform
+    summary <- dbGetQuery(con, paste0(
+      "SELECT * FROM metadata_summary WHERE package_name = '",
+      package_name, "' AND platform = '", platform, "'"
+    ))
+  }
+
+  # Close the SQLite connection
+  dbDisconnect(con)
+
+  return(summary)
+}

R/packages_index.R

@@ -80,7 +80,13 @@ upload_package_index <- function(
     region_name = region,
   )
 
-  dummy <- purrr::walk2(
+  pkg_count = length(s3fs::s3_dir_ls(remote_bin_dir)) - 4
+  t1 <- Sys.time()
+  cranlike::update_PACKAGES(remote_bin_dir)
+  total_build_time <- round(Sys.time() - t1, 2)
+  cli::cli_alert("Time updating PACKAGES index for {.field {pkg_count}} packages: {.strong {total_build_time} {units(difftime(Sys.time(), t1))}}.")
+
+  purrr::walk2(
     sprintf("%s/%s", local_bin_dir, c("PACKAGES", "PACKAGES.db", "PACKAGES.rds", "PACKAGES.gz")),
     sprintf("%s/%s", remote_bin_dir, c("PACKAGES", "PACKAGES.db", "PACKAGES.rds", "PACKAGES.gz")),
     \(x, y) s3fs::s3_file_upload(x, y, overwrite = TRUE)
@@ -89,10 +95,10 @@ upload_package_index <- function(
   pkgs_upload_local <- sprintf("%sPACKAGES", local_bin_dir)
   pkgs_upload_remote <- sprintf("%sPACKAGES", remote_bin_dir)
 
-  if (debug) {
+  # if (debug) {
-    cli::cli_alert_warning("DEBUG: PACKAGES UPLOAD local dir: {pkgs_upload_local}")
+  #   cli::cli_alert_warning("DEBUG: PACKAGES UPLOAD local dir: {pkgs_upload_local}")
-    cli::cli_alert_warning("DEBUG: PACKAGES UPLOAD remote dir: {pkgs_upload_remote}")
+  #   cli::cli_alert_warning("DEBUG: PACKAGES UPLOAD remote dir: {pkgs_upload_remote}")
-  }
+  # }
 
   # s3 <- paws.storage::s3(endpoint = endpoint, region = region)
   # s3$put_object(Body = pkgs_upload_local, Bucket = bucket, Key = "__linux__/rhel9/latest/src/contrib/PACKAGES")

man/build_binary_package.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/build_binaries.R
+\name{build_binary_package}
+\alias{build_binary_package}
+\title{Build R binary packages}
+\usage{
+build_binary_package(
+  package_name,
+  tag = NULL,
+  codename = NULL,
+  r_minor_version = NULL,
+  build_for_minor = TRUE,
+  local_build_root = "/mnt/cache/binaries/",
+  local_clone_dir = "/tmp",
+  platform = "redhat-9",
+  install_system_dependencies = TRUE,
+  debug = FALSE,
+  force = FALSE
+)
+}
+\description{
+Build R binary packages
+}

man/store_build_metadata.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/metadata-build.R
+\name{store_build_metadata}
+\alias{store_build_metadata}
+\title{Stores build metadata of single binary builds in a Postgres DB}
+\usage{
+store_build_metadata(
+  package_name,
+  tag,
+  platform,
+  error_occurred,
+  force = FALSE,
+  error = NA
+)
+}
+\description{
+Stores build metadata of single binary builds in a Postgres DB
+}