devxy/build-cran-binaries
Watch
1
0
Fork
You've already forked build-cran-binaries
 0
Code Issues 11 Pull requests Releases Activity

add sqlite db for metadata build info

Browse source
This commit is contained in:
Patrick Schratz 2024-06-03 23:10:30 +02:00
commit fe99870a94
Signed by: pat-s
GPG key ID: 3C6318841EF78925
3 changed files with 307 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

155
R/build-metadata.R Normal file
View file

@ -0,0 +1,155 @@
#' @importFrom DBI dbConnect dbDisconnect dbWriteTable dbGetQuery dbExecute
#' @importFrom RSQLite SQLite
store_build_metadata <- function(
package_name, tag, platform,
error_occurred, error) {
# Create a new SQLite connection
con <- dbConnect(RSQLite::SQLite(), dbname = "metadata.db")
dbExecute(con, "BEGIN TRANSACTION")
# Create the "metadata" table if it does not exist
dbExecute(con, "CREATE TABLE IF NOT EXISTS metadata (
package_name TEXT,
tag TEXT,
platform TEXT,
error_occurred BOOLEAN,
build_timestamp TEXT
)")
# Create an index on the package_name and tag columns
dbExecute(con, "CREATE INDEX IF NOT EXISTS idx_metadata_package_tag ON metadata(package_name, platform)")
# Check if an entry with the same package_name and tag already exists
existing_entries <- dbGetQuery(con, paste0(
"SELECT * FROM metadata WHERE package_name = '",
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.")
} 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
metadata <- data.frame(
package_name = package_name,
tag = tag,
platform = platform,
error_occurred = error_occurred,
build_timestamp = format(Sys.time(), "%Y-%m-%d")
)
# Write the data frame to the SQLite database
dbWriteTable(con, "metadata", metadata, append = TRUE)
}
dbExecute(con, "COMMIT")
# Close the SQLite connection
dbDisconnect(con)
}
#' @importFrom DBI dbConnect dbGetQuery
#' @importFrom RSQLite SQLite
#' @importFrom dplyr filter_at vars all_vars
query_build_metadata <- function(package_name = NULL, tag = NULL, platform = NULL,
error_occurred = NULL, error = NULL, build_timestamp = NULL) {
# Create a new SQLite connection
con <- dbConnect(RSQLite::SQLite(), dbname = "metadata.db")
# Read the entire table
metadata <- dbGetQuery(con, "SELECT * FROM metadata")
# Close the SQLite connection
dbDisconnect(con)
# Filter the data frame based on the given parameters
filter_conditions <- list(
package_name = package_name, tag = tag, platform = platform,
error_occurred = error_occurred, error = error,
build_timestamp = build_timestamp
)
# Remove NULL elements from the list
filter_conditions <- filter_conditions[!sapply(filter_conditions, is.null)]
# Apply the filter conditions if any exist
if (length(filter_conditions) > 0) {
metadata <- dplyr::filter_at(
metadata, dplyr::vars(names(filter_conditions)),
dplyr::all_vars(. == filter_conditions[[.]])
)
}
return(metadata)
}
#' @importFrom DBI dbConnect dbDisconnect dbWriteTable dbGetQuery dbExecute dbListTables
#' @importFrom RSQLite SQLite
#' @importFrom dplyr group_by summarise filter n
build_metadata_summary <- function(package_name, platform) {
# Create a new SQLite connection
con <- dbConnect(RSQLite::SQLite(), dbname = "metadata.db")
metadata <- dbGetQuery(con, paste0(
"SELECT * FROM metadata WHERE package_name = '", package_name,
"' AND platform = '", platform, "'"
))
print(sprintf("Package: %s", package_name))
print(sprintf("Platform: %s", platform))
# Calculate the summary
summary <- metadata %>%
group_by(package_name, platform) %>%
summarise(
successful_builds = sum(!error_occurred),
unsuccessful_builds = sum(error_occurred),
total_builds = n(),
percentage_successful_builds = round(successful_builds / total_builds * 100, 2)
)
print("DEBUG")
print(summary)
# Check if the metadata_summary table exists
if ("metadata_summary" %in% dbListTables(con)) {
# Update the row for the specified package
dbExecute(con, paste0(
"UPDATE metadata_summary SET successful_builds = ", summary$successful_builds,
", unsuccessful_builds = ", summary$unsuccessful_builds,
", total_builds = ", summary$total_builds,
", percentage_successful_builds = ", summary$percentage_successful_builds,
" WHERE package_name = '", package_name,
"' AND platform = '", platform, "'"
))
} else {
# Write the summary to a new table in the SQLite database
dbWriteTable(con, "metadata_summary", summary)
}
# Close the SQLite connection
dbDisconnect(con)
}
#' @importFrom RSQLite SQLite
query_metadata_summary <- function(package_name = NULL, platform = NULL) {
# Create a new SQLite connection
con <- dbConnect(RSQLite::SQLite(), dbname = "metadata.db")
# 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)
}

103
R/build_binaries.R
View file

@ -8,8 +8,9 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
r_version_minor = NULL, build_for_minor = TRUE,
local_build_root = "/root",
local_clone_dir = "/tmp",
pak_pkg_syrsreqs_platform = "redhat-9",
platform = "redhat-9",
install_system_dependencies = TRUE) {
cli::cli_h2("Preparations")
codename <- set_codename(codename)
if (is.null(r_version_minor)) {
@ -27,11 +28,6 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
cli::cli_h2("Installing system dependencies")
### Install system dependencies
if (install_system_dependencies) {
install_package_system_dependencies(package_name, pak_pkg_syrsreqs_platform, tag, local_clone_dir_single)
}
gert::git_config_global_set("advice.detachedHead", "false")
if (is.null(tag)) {
@ -46,63 +42,103 @@ build_binary_package <- function(package_name, tag = NULL, codename = NULL,
tag <- all_tags$name
package_name <- rep(package_name, length(tag))
cli::cli_alert_info("Building binaries for {.pkg {package_name[[1]]}} with tags {.env {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
if (install_system_dependencies) {
install_package_system_dependencies(package_name, tag, platform, local_clone_dir)
}
t1 <- Sys.time()
cli::cli_h2("Building")
cli::cli_alert_info("Building binaries for {.pkg {package_name[[1]]}} with tags {.strong {tag}}.")
# devtools::install(quiet = TRUE)
# Set up the progress handler
progressr::handlers(global = TRUE)
progressr::handlers("cli")
# cli::cli_alert("{package_name}")
# cli::cli_alert("{tag}")
progressr::handlers("cli", "debug")
out <- progressr::with_progress({
p <- progressr::progressor(along = tag)
future_mapply(function(x, y) {
p()
build_single_tag(x, y, dir_out_bin, local_clone_dir)
tryCatch(
{
p()
build_single_tag(x, y, dir_out_bin, local_clone_dir)
store_build_metadata(x, y, platform, FALSE)
},
error = function(e) {
message("Error in processing package ", x, " with tag ", y, ": ")
unlink(local_clone_dir_single, force = TRUE, recursive = TRUE)
store_build_metadata(x, y, platform, TRUE)
}
)
}, package_name, tag, future.seed = TRUE)
})
# future.apply::future_mapply(build_single_tag,
# package_name = package_name, tag = tag,
# MoreArgs = list(
# dir_out_bin = dir_out_bin,
# local_clone_dir = local_clone_dir
# ),
# future.seed = TRUE
# )
# round(Sys.time() - t1, 2)}} {units(difftime(Sys.time(), t1))}
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))}}.")
# add average_build_time_per_tag to metadata summary table
average_build_time_per_tag <- round(total_build_time / length(tag), 2)
con <- dbConnect(RSQLite::SQLite(), dbname = "metadata.db")
# Check if the entry exists in the metadata_summary table
# Check if a valid entry exists in the metadata_summary table
entry <- dbGetQuery(con, paste0(
"SELECT average_build_time_per_tag FROM metadata_summary WHERE package_name = '", package_name[[1]],
"' AND platform = '", platform, "'"
))
# If the entry does not exist or is not valid, entry will be NULL or NA
entry_exists <- !is.null(entry$average_build_time_per_tag) && !is.na(entry$average_build_time_per_tag)
# If the entry does not exist, update the average_build_time_per_tag
if (!entry_exists) {
dbExecute(con, paste0(
"UPDATE metadata_summary SET average_build_time_per_tag = ", average_build_time_per_tag,
" WHERE package_name = '", package_name[[1]], "' AND platform = '", platform, "'"
))
}
cli::cli_alert_info("{.fun build_binary_package}: Building/updating metadata summary for {.pkg {package_name[[1]]}}.")
build_metadata_summary(package_name[[1]], platform)
return(invisible(TRUE))
}
install_package_system_dependencies <- function(package_name,
pak_pkg_syrsreqs_platform = "redhat-9",
tag,
local_clone_dir_single) {
cli::cli_alert_info("{.fun install_package_system_dependencies}: Cloning package {.env {package_name}} with tag {.env {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}}.")
local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name[1], tail(tag, 1))
if (!dir.exists(local_clone_dir_single)) {
system2("git", args = c(
"clone", "-q", sprintf("--branch=%s", tag),
sprintf("https://github.com/cran/%s", package_name), local_clone_dir_single
"clone", "-q", sprintf("--branch=%s", tail(tag, 1)),
sprintf("https://github.com/cran/%s", package_name[1]), local_clone_dir_single
))
}
Sys.setenv(PKG_SYSREQS_PLATFORM = pak_pkg_syrsreqs_platform)
Sys.setenv(PKG_SYSREQS_PLATFORM = platform)
Sys.setenv(PKG_SYSREQS = TRUE)
Sys.setenv(PKG_SYSREQS_VERBOSE = TRUE)
pak::local_install_dev_deps(sprintf("%s", local_clone_dir_single))
cli::cli_alert_info("{.fun install_package_system_dependencies}: 4. Removing {.path {local_clone_dir_single}}.")
# delete clone again as we need a full clone of the repo when not only building a single tag
if (!is.null(tag)) {
unlink(sprintf("%s", local_clone_dir_single), recursive = TRUE, force = TRUE)
}
unlink(sprintf("%s", local_clone_dir_single), recursive = TRUE, force = TRUE)
}
@ -111,18 +147,17 @@ install_package_system_dependencies <- function(package_name,
build_single_tag <- function(package_name, tag = NULL,
dir_out_bin,
local_clone_dir) {
cli::cli_alert_info("{.fun build_single_tag}: 1. Cloning package {.pkg {package_name}} with tag {.strong {tag}}.")
local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name, tag)
cli::cli_alert_info("{.fun build_single_tag}: 1. Cloning package {.pkg {package_name}} with tag {.env {tag}}.")
# Using system git here as {gert} does not provide this functionality
system2("git", args = c(
"clone", "-q", sprintf("--branch=%s", tag),
sprintf("https://github.com/cran/%s", package_name), local_clone_dir_single
))
cli::cli_alert_info("{.fun build_single_tag}: 2. Building package {.pkg {package_name}} with tag {.env {tag}}.")
cli::cli_alert_info("{.fun build_single_tag}: 2. Building package {.pkg {package_name}} with tag {.strong {tag}}.")
pkgbuild::build(
path = sprintf("%s", local_clone_dir_single),

2
R/helpers.R
View file

@ -26,7 +26,7 @@ set_codename <- function(codename) {
}
set_bin_path <- function(r_version_minor, build_for_minor, local_build_root, codename) {
if (is.null(r_version_minor) && !build_for_minor) {
if (!build_for_minor) {
path <- sprintf(
"%s/__linux__/%s/latest/src/contrib",
local_build_root, codename