move to R package

This commit is contained in:
Patrick Schratz 2024-06-02 13:05:39 +02:00
commit 5e32452d09
Signed by: pat-s
GPG key ID: 3C6318841EF78925
9 changed files with 257 additions and 0 deletions

2
.Rbuildignore Normal file
View file

@ -0,0 +1,2 @@
^.*\.Rproj$
^\.Rproj\.user$

4
.gitignore vendored Normal file
View file

@ -0,0 +1,4 @@
.Rproj.user
.Rhistory
.RData
.Ruserdata

View file

22
DESCRIPTION Normal file
View file

@ -0,0 +1,22 @@
Package: rBinaries
Title: What the Package Does (One Line, Title Case)
Version: 0.0.0.9000
Authors@R:
person("First", "Last", , "first.last@example.com", role = c("aut", "cre"),
comment = c(ORCID = "YOUR-ORCID-ID"))
Description: What the package does (one paragraph).
License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a
license
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.1
Imports:
cli,
gert,
lubridate,
magrittr,
pak,
paws.storage,
pkgbuild,
purrr,
xml2

15
NAMESPACE Normal file
View file

@ -0,0 +1,15 @@
# Generated by roxygen2: do not edit by hand
importFrom(gert,git_config_set)
importFrom(lubridate,as_date)
importFrom(lubridate,dmy_hms)
importFrom(magrittr,"%>%")
importFrom(pak,local_install_dev_deps)
importFrom(paws.storage,s3)
importFrom(pkgbuild,build)
importFrom(purrr,list_rbind)
importFrom(purrr,map)
importFrom(xml2,read_xml)
importFrom(xml2,xml_find_all)
importFrom(xml2,xml_find_first)
importFrom(xml2,xml_text)

101
R/build_binaries.R Normal file
View file

@ -0,0 +1,101 @@
#' @importFrom gert git_config_set
#' @importFrom pak local_install_dev_deps
#' @importFrom pkgbuild build
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",
install_system_dependencies = TRUE) {
codename <- set_codename(codename)
if (is.null(r_version_minor)) {
r_version_minor <- sub("R version (\\d+\\.\\d+).*", "\\1", R.Version()$version.string)
}
# create directory structure
dir_out_bin <- set_bin_path(r_version_minor, build_for_minor, local_build_root, codename)
dir_out_src <- sprintf("%s/src/contrib/Archive", local_build_root)
cli::cli_alert_info("{.fun build_binary_package}: Creating dir {.path {dir_out_bin}}.")
cli::cli_alert_info("{.fun build_binary_package}: Creating dir {.path {dir_out_src}}.")
dir.create(sprintf("%s/Archive", dir_out_bin), sprintf("%s/Archive", dir_out_src),
recursive = TRUE
)
local_clone_dir_single <- sprintf("%s/%s_%s", local_clone_dir, package_name, tag)
### 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 tag = NULL, build all tags
if (is.null(tag)) {
# when building all tags, we do a full clone to checkout all subsequent tags
# Using system git here as {gert} does not provide this functionality
# FIXME:
# system2("git", args = c("config", "advice.detachedHead", "false"))
# system2("git", args = c(
# "clone", sprintf("https://github.com/cran/%s", package_name), sprintf("%s/%s", local_clone_dir, package_name)
# ))
} else {
cli::cli_alert_info("{.fun build_binary_package}: 1. Cloning package {.env {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_binary_package}: 2. Building package {.env {package_name}} with tag {.env {tag}}.")
pkgbuild::build(
path = sprintf("%s", local_clone_dir_single),
binary = TRUE, vignettes = FALSE,
dest_path = dir_out_bin
)
if (!file.exists(sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag))) {
cli::cli_alert_info('{.fun build_binary_package}: 3. Moving package from {.path {sprintf("%s/%s*.tar.gz", dir_out_bin, package_name)}} to {.path {sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag)}}')
# remove _aarch64-unknown-linux-gnu part in filename
system2("rsync", args = c(
sprintf("%s/%s_%s*.tar.gz", dir_out_bin, package_name, tag),
sprintf("%s/%s_%s.tar.gz", dir_out_bin, package_name, tag)
))
} else {
cli::cli_alert_warning('{.fun build_binary_package}: Binary {sprintf("%s_%s.tar.gz", package_name, tag)} already exists. Skipping copy.')
}
unlink(sprintf("%s/%s_%s_R*.tar.gz", dir_out_bin, package_name, tag))
cli::cli_alert_info("{.fun build_binary_package}: 4. Removing {.path {local_clone_dir_single}}.")
unlink(local_clone_dir_single, force = TRUE, recursive = 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}}.")
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
))
}
Sys.setenv(PKG_SYSREQS_PLATFORM = pak_pkg_syrsreqs_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)
}
}

50
R/get_updated_packages.R Normal file
View file

@ -0,0 +1,50 @@
#' @importFrom magrittr %>%
#' @importFrom purrr map list_rbind
get_updated_cran_packages <- function(date = lubridate::today()) {
feed <- get_cranberry_feed()
# Apply the function to each item and bind the results into a data frame
results <- map(feed, ~ process_cranberry_rss(.x, date)) %>%
list_rbind()
return(results)
}
#' @importFrom xml2 read_xml xml_find_all
get_cranberry_feed <- function(feed = "https://dirk.eddelbuettel.com/cranberries/cran/updated/index.rss") {
# Fetch and parse the RSS feed
rss_content <- read_xml(feed)
# Extract item nodes
items <- xml_find_all(rss_content, "//item")
return(items)
}
#' @importFrom lubridate dmy_hms as_date
#' @importFrom xml2 xml_text xml_find_first
process_cranberry_rss <- function(feed, date = lubridate::today()) {
title <- xml_text(xml_find_first(feed, "title"))
pub_date_text <- xml_text(xml_find_first(feed, "pubDate"))
pub_date <- dmy_hms(pub_date_text)
pub_date <- as_date(pub_date)
if (!is.na(pub_date) && pub_date == date) {
package_info <- strsplit(title, " ")[[1]]
package_name <- package_info[2]
package_version_new <- package_info[7]
package_version_old <- package_info[12]
previous_update_date <- package_info[14]
return(data.frame(
"name" = package_name,
"version_new" = package_version_new,
"date_updated" = pub_date,
"version_old" = package_version_old,
"previous_update_date" = previous_update_date
))
} else {
return(NULL)
}
}

42
R/helpers.R Normal file
View file

@ -0,0 +1,42 @@
set_codename <- function(codename) {
if (is.null(codename)) {
if (Sys.info()["sysname"] == "Linux") {
dist_fam <- system2("grep",
args = c("'^ID_LIKE=' /etc/os-release | cut -d'=' -f2 | tr -d '\"'"), stdout = TRUE
)
if (dist_fam == "debian") {
codename <- system2("grep",
args = c("'^VERSION_CODENAME=' /etc/os-release | cut -d'=' -f2 | tr -d '\"'"), stdout = TRUE
)
} else if (grepl("rhel", dist_fam)) {
platform_id <- system2("grep",
args = c("'^PLATFORM_ID=' /etc/os-release | cut -d'=' -f2 | tr -d '\"'"), stdout = TRUE
)
if (platform_id == "platform:el9") {
codename <- "rhel9"
} else if (platform_id == "platform:el8") {
codename <- "rhel8"
}
}
} else {
codename <- "unknown"
}
}
return(codename)
}
set_bin_path <- function(r_version_minor, build_for_minor, local_build_root, codename) {
if (is.null(r_version_minor) && !build_for_minor) {
path <- sprintf(
"%s/__linux__/%s/latest/src/contrib",
local_build_root, codename
)
} else {
path <- sprintf(
"%s/__linux__/%s/%s/latest/src/contrib",
local_build_root, codename, r_version_minor
)
}
return(path)
}

21
rBinaries.Rproj Normal file
View file

@ -0,0 +1,21 @@
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
AutoAppendNewline: Yes
StripTrailingWhitespace: Yes
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageRoxygenize: rd,collate,namespace