cleanup and reorg

This commit is contained in:
Patrick Schratz 2024-07-27 13:33:50 +02:00
commit 2e5939ace8
Signed by: pat-s
GPG key ID: 3C6318841EF78925
8 changed files with 103 additions and 68 deletions

View file

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

View file

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

View file

@ -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()
# error <- paste("Call:", deparse(conditionCall(e)), "\nMessage:", conditionMessage(e), sep = " ")
# only stderr contains the important information why the build failed
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

View file

@ -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,
error_occurred, force = FALSE, error = NULL) {
package_name, tag, platform, error_occurred,
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,
@ -98,32 +97,4 @@ 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)
}
}

View file

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

View file

@ -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) {
cli::cli_alert_warning("DEBUG: PACKAGES UPLOAD local dir: {pkgs_upload_local}")
cli::cli_alert_warning("DEBUG: PACKAGES UPLOAD remote dir: {pkgs_upload_remote}")
}
# if (debug) {
# cli::cli_alert_warning("DEBUG: PACKAGES UPLOAD local dir: {pkgs_upload_local}")
# 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")

View file

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

View file

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