add update_packages() fix #5

.woodpecker/update_packages.yaml

@@ -0,0 +1,98 @@
+when:
+  event: [cron]
+  name: update-packages
+
+skip_clone: true
+
+matrix:
+  include:
+    - PLATFORM: redhat-9
+    # - PLATFORM: redhat-8
+    # - PLATFORM: ubuntu-2404
+    # - PLATFORM: ubuntu-2204
+steps:
+  - name: 'Processing Updates: (${PLATFORM})'
+    secrets: [red_hat_dev_pw, aws_access_key_id, aws_secret_access_key, pgpass, git_ro_token, GITHUB_PAT]
+    image: docker.io/pats22/arm-binaries-r-${PLATFORM}
+    pull: true
+    # to ensure the PACKAGES upload step is being executed
+    failure: ignore
+    environment:
+      GIT_USER: pat-s
+      # set the location of the 'pkgcache' cache dir which persists the R package dependencies needed to install the packages themselves
+      R_PKG_CACHE_DIR: /mnt/cache/pkgcache
+      R_LIBS_USER: /mnt/cache/R-pkgs
+      CCACHE_DIR: /mnt/cache/ccache
+    volumes:
+      - arm-binaries-r-dep-cache-${PLATFORM}:/mnt/cache
+    commands:
+      # download latest package version (avoid having to rebuild image every time)
+      # rscript_startup arg: required to pass down global option to future workers https://github.com/HenrikBengtsson/future/issues/134#issuecomment-2245666169
+      - git clone https://pat-s:$$git_ro_token@git.devxy.io/devxy/arm64-r-binaries.git .
+      - rm -rf /mnt/cache/R-pkgs/00LOCK-arm64-r-binaries /mnt/cache/R-pkgs/00LOCK-rBinaries
+      # for some reason this one is often corrupt on redhat-9
+      - rm -rf /mnt/cache/R-pkgs/RPostgres /mnt/cache/pkgcache/R/pkgcache
+      - R -q -e 'pak::pak("dyfanjones/s3fs")'
+      - R -q -e 'devtools::install(); packageVersion("rBinaries")'
+      - mkdir -p /root/.R && /bin/bash -c 'echo -e "CXX_STD = CXX14\nCC=ccache gcc\nCPP=ccache gcc\nCXX=ccache g++\nCXX11=ccache g++\nCXX14=ccache g++\nCXX17=ccache g++\nF77=ccache /usr/bin/gfortran\nFC=ccache /usr/bin/gfortran" > /root/.R/Makevars'
+      # manually install some packages into the cache so that some builds don't fail
+      # Hmisc -> ABCanalysis
+      # - R -q -e 'Sys.setenv(PKG_SYSREQS = TRUE, PKG_SYSREQS_VERBOSE = TRUE, PKG_SYSREQS_PLATFORM = "redhat-9"); pak::pak(c("Hmisc", "pls", "abd", "doRNG", "devtools"))'
+      # more complicated system dependencies which pak cannot resolve
+      - mkdir -p /mnt/cache/pkgcache /mnt/cache/R-pkgs /mnt/cache/ccache /mnt/cache/packages
+      # set additional repos: important as otherwise some packages cannot be resolved (e.g. INLA). Also: setting our own binary repos so we can make use of them for dep installation at some point
+      - R -q -e 'options(crayon.enabled = TRUE, Ncpus = 4, future.globals.onReference = "error", repos = structure(c(getOption("repos"),INLA="https://inla.r-inla-download.org/R/stable"))); pkgs = tools::CRAN_package_db()[[1]][${BLOCK}]; pkgs = setdiff(pkgs, c("biplotbootGUI", "cncaGUI", "dynBiplotGUI", "ade4TkGUI", "BlockmodelingGUI", "cncaGUI", "EventDetectGUI", "irtGUI", "KappaGUI", "magickGUI", "miniGUI", "multibiplotGUI", "TextMiningGUI", "later", "RclusTool", "Rcmdr", "RcmdrMisc", "RcmdrPlugin.aRnova", "RcmdrPlugin.BiclustGUI", "RcmdrPlugin.BWS1", "RcmdrPlugin.BWS2", "RcmdrPlugin.BWS3", "RcmdrPlugin.cpd", "RcmdrPlugin.DCCV", "RcmdrPlugin.DCE", "RcmdrPlugin.depthTools", "RcmdrPlugin.DoE", "RcmdrPlugin.EACSPIR", "RcmdrPlugin.EBM", "RcmdrPlugin.EcoVirtual", "RcmdrPlugin.Export", "RcmdrPlugin.EZR",  "RcmdrPlugin.FactoMineR", "RcmdrPlugin.GWRM", "RcmdrPlugin.HH", "RcmdrPlugin.KMggplot2", "RcmdrPlugin.MA", "RcmdrPlugin.MPAStats", "RcmdrPlugin.NMBU", "RcmdrPlugin.orloca", "RcmdrPlugin.PcaRobust", "RcmdrPlugin.RiskDemo", "RcmdrPlugin.RMTCJags", "RcmdrPlugin.ROC", "RcmdrPlugin.sos" , "RcmdrPlugin.survival", "RcmdrPlugin.TeachingDemos", "RcmdrPlugin.TeachStat", "RcmdrPlugin.temis", "RcmdrPlugin.UCA" , "RcmdrPlugin.WorldFlora", "sf", "StratigrapheR", "tcltk2")); library(rBinaries); future::plan("sequential" rscript_startup = quote(options(crayon.enabled = TRUE))); update_packages(platform = "${PLATFORM}"))'
+    backend_options:
+      kubernetes:
+        ### PROD
+        resources:
+          requests:
+            memory: 10Gi
+            cpu: 1000m
+          limits:
+            memory: 10Gi
+            cpu: 1000m
+        # DEBUG
+        # resources:
+        #   requests:
+        #     memory: 4Gi
+        #     cpu: 2000m
+        #   limits:
+        #     memory: 4Gi
+        #     cpu: 2000m
+        nodeSelector:
+          kubernetes.io/arch: 'arm64'
+        tolerations:
+          - key: "CI"
+            operator: "Equal"
+            value: "true"
+            effect: "NoSchedule"
+  # - name: Upload PACKAGES files
+  #   secrets: [red_hat_dev_pw, aws_access_key_id, aws_secret_access_key, pgpass, git_ro_token]
+  #   image: docker.io/pats22/arm-binaries-r-ubi9
+  #   pull: true
+  #   environment:
+  #     GIT_USER: pat-s
+  #     # set the location of the 'pkgcache' cache dir which persists the R package dependencies needed to install the packages themselves
+  #     R_PKG_CACHE_DIR: /mnt/cache/pkgcache
+  #     R_LIBS_USER: /mnt/cache/R-pkgs
+  #   volumes:
+  #     - arm-binaries-r-dep-cache-rhel9:/mnt/cache
+  #   commands:
+  #     # download latest package version (avoid having to rebuild image every time)
+  #     # rscript_startup arg: required to pass down global option to future workers https://github.com/HenrikBengtsson/future/issues/134#issuecomment-2245666169
+  #     - R -q -e 'pak::local_install(); packageVersion("rBinaries")'
+  #     - R -q -e 'pak::pak(c("dyfanjones/s3fs", "pat-s/desc@description-from-remote", "pat-s/cranlike@s3"))'
+  #     - cd /mnt/cache/packages
+  #     - R -q -e 'options(crayon.enabled = TRUE); library(rBinaries); upload_package_index()'
+  #   backend_options:
+  #     kubernetes:
+  #       resources:
+  #         requests:
+  #           memory: 1000Mi
+  #           cpu: 0m
+  #         limits:
+  #           memory: 1300Mi
+  #           cpu: 1000m
+  #       nodeSelector:
+  #         kubernetes.io/arch: 'arm64'

NAMESPACE

@@ -9,6 +9,7 @@ export(list_metadata_tables)
 export(query_metadata_table)
 export(set_bin_path)
 export(set_codename)
+export(update_packages)
 export(upload_package_index)
 export(upload_single_binary_to_s3)
 import(progressr)
@@ -22,6 +23,7 @@ importFrom(RPostgres,Postgres)
 importFrom(cli,cli_alert)
 importFrom(cranlike,add_PACKAGES)
 importFrom(cranlike,update_PACKAGES)
+importFrom(dplyr,bind_rows)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
 importFrom(dplyr,n)
@@ -33,8 +35,11 @@ importFrom(future,plan)
 importFrom(future.apply,future_mapply)
 importFrom(gert,git_clone)
 importFrom(gert,git_config_global_set)
+importFrom(lubridate,"%within%")
 importFrom(lubridate,as_date)
 importFrom(lubridate,dmy_hms)
+importFrom(lubridate,interval)
+importFrom(lubridate,today)
 importFrom(magrittr,"%>%")
 importFrom(pak,local_install_dev_deps)
 importFrom(pkgbuild,build)
@@ -42,6 +47,7 @@ importFrom(progressr,progressor)
 importFrom(progressr,with_progress)
 importFrom(purrr,list_rbind)
 importFrom(purrr,map)
+importFrom(purrr,walk2)
 importFrom(s3fs,s3_dir_ls)
 importFrom(s3fs,s3_file_exists)
 importFrom(s3fs,s3_file_system)

R/get_updated_packages.R

@@ -1,17 +1,62 @@
+#' Get updated CRAN packages
 #' @importFrom magrittr %>%
 #' @importFrom purrr map list_rbind
+#' @importFrom lubridate today
+#' @examples
+#' get_updated_cran_packages(lubridate::interval(today() - 7, today()))
+#'
 get_updated_cran_packages <- function(date = lubridate::today()) {
-  feed <- get_cranberry_feed()
+  feed <- get_cranberries_feed()
 
   # Apply the function to each item and bind the results into a data frame
-  results <- map(feed, ~ process_cranberry_rss(.x, date)) %>%
+  results <- map(feed, ~ process_cranberries_rss(.x, date)) %>%
     list_rbind()
 
   return(results)
 }
 
+#' Get new CRAN packages
+#' @importFrom magrittr %>%
+#' @importFrom purrr map list_rbind
+#' @importFrom lubridate today
+#' @examples
+#' # last week
+#' get_new_cran_packages(lubridate::interval(today() - 7, today()))
+#'
+get_new_cran_packages <- function(date = lubridate::today()) {
+  feed <- get_cranberries_feed(type = "new")
+
+  # Apply the function to each item and bind the results into a data frame
+  results <- map(feed, ~ process_cranberries_rss(.x, date)) %>%
+    list_rbind()
+
+  return(results)
+}
+
+#' Get removed CRAN packages
+#' @importFrom magrittr %>%
+#' @importFrom purrr map list_rbind
+#' @importFrom lubridate today
+#' @examples
+#' get_removed_cran_packages()
+#' get_removed_cran_packages(lubridate::interval(today() - 7, today()))
+#'
+get_removed_cran_packages <- function(date = lubridate::today()) {
+  feed <- get_cranberries_feed(type = "removed")
+
+  # Apply the function to each item and bind the results into a data frame
+  results <- map(feed, ~ process_cranberries_rss(.x, date)) %>%
+    list_rbind()
+
+  return(results)
+}
+
+#' Get Cranberries fieed
 #' @importFrom xml2 read_xml xml_find_all
-get_cranberry_feed <- function(feed = "https://dirk.eddelbuettel.com/cranberries/cran/updated/index.rss") {
+#' @param type Which type of packages to query. Allowed are `"updated"`, `"new"` and `"removed"`
+get_cranberries_feed <- function(type = "updated") {
+  feed <- sprintf("https://dirk.eddelbuettel.com/cranberries/cran/%s/index.rss", type)
+
   # Fetch and parse the RSS feed
   rss_content <- read_xml(feed)
 
@@ -21,29 +66,52 @@ get_cranberry_feed <- function(feed = "https://dirk.eddelbuettel.com/cranberries
   return(items)
 }
 
-#' @importFrom lubridate dmy_hms as_date
+#' @importFrom lubridate dmy_hms as_date interval %within%
 #' @importFrom xml2 xml_text xml_find_first
-process_cranberry_rss <- function(feed, date = lubridate::today()) {
+process_cranberries_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)
+  pub_date <- as_date(dmy_hms(pub_date_text))
+  # pub_date_interval <- interval(head(pub_date), tail(pub_date))
+  if (class(date) == "Date") {
+    date <- interval(date, 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]
+  # browser()
+  if (pub_date %within% date) {
+    if (grepl("updated", title)) {
+      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
+      return(data.frame(
+        "name" = package_name,
+        "version" = package_version_new,
+        "date" = pub_date,
+        "version_old" = package_version_old,
+        "previous_update_date" = previous_update_date
+      ))
+    } else if (grepl("New package", title)) {
+      package_info <- strsplit(title, " ")[[1]]
+      package_name <- package_info[3]
+      package_version_new <- package_info[7]
 
-    ))
+      return(data.frame(
+        "name" = package_name,
+        "version" = package_version_new,
+        "date" = pub_date
+      ))
+    } else if (grepl("was removed", title)) {
+      package_info <- strsplit(title, " ")[[1]]
+      package_name <- package_info[2]
+
+      return(data.frame(
+        "name" = package_name,
+        "date" = pub_date
+      ))
+    }
   } else {
     return(NULL)
   }

R/update-packages.R

@@ -0,0 +1,59 @@
+#' Process updated and new CRAN packages
+#' @description
+#' Packages which got removed from CRAN can be deleted by setting `prune = TRUE`.
+#' Argument `interval` allows to specify a range which should be processed.
+#'
+#' @export
+#' @importFrom dplyr bind_rows
+#' @importFrom purrr walk2
+update_packages <- function(
+    package_name,
+    tag,
+    platform = platform,
+    local_clone_dir,
+    interval = lubridate::today(),
+    prune = TRUE,
+    build_for_minor = FALSE,
+    codename = NULL,
+    r_minor_version = NULL,
+    local_build_root = ".",
+    endpoint = "https://s3.eu-central-003.backblazeb2.com",
+    region = "eu-central-003",
+    bucket = "devxy-arm64-r-binaries") {
+  # Get list of updated and new packages for a specific day
+  updated_pkgs <- get_updated_cran_packages()
+  new_pkgs <- get_new_cran_packages()
+
+  all_pkgs <- dplyr::bind_rows(updated_pkgs, new_pkgs)
+
+  purrr::walk2(all_pkgs$name, all_pkgs$version, ~ build_binary_package(.x, .y))
+
+  if (prune) {
+    removed_pkgs <- get_removed_cran_packages(interval)
+
+    s3fs::s3_file_system(
+      aws_access_key_id = Sys.getenv("AWS_ACCESS_KEY_ID"),
+      aws_secret_access_key = Sys.getenv("AWS_SECRET_ACCESS_KEY"),
+      endpoint = endpoint,
+      region_name = region,
+    )
+
+    if (!build_for_minor) {
+      local_bin_dir <- sprintf("%s/arm64/%s/latest/src/contrib", local_build_root, codename)
+      remote_bin_dir <- sprintf("%s/arm64/%s/latest/src/contrib", bucket, codename)
+    } else {
+      dir_out_bin <- sprintf("%s/arm64/%s/%s/latest/src/contrib", local_build_root, codename, r_minor_version)
+      remote_bin_dir <- sprintf("%s/arm64/%s/%s/latest/src/contrib", bucket, codename, r_minor_version)
+    }
+
+    files <- s3fs::s3_dir_ls(remote_bin_dir)
+
+    purrr::walk(removed_pkgs$name, ~ {
+      cli::cli_alert("{.fun update_packages}: Removing package {.pkg {.x}} from S3.")
+      files_filtered <- grep("bold_", files, value = TRUE)
+      s3fs::s3_file_delete_async(files_filtered)
+
+      cli::cli_alert_success("{.fun update_packages}: Successfully removed {.pkg {basename(files_filtered)}} from S3.")
+    })
+  }
+}

man/get_cranberries_feed.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_updated_packages.R
+\name{get_cranberries_feed}
+\alias{get_cranberries_feed}
+\title{Get Cranberries fieed}
+\usage{
+get_cranberries_feed(type = "updated")
+}
+\arguments{
+\item{type}{Which type of packages to query. Allowed are \code{"updated"}, \code{"new"} and \code{"removed"}}
+}
+\description{
+Get Cranberries fieed
+}

man/get_new_cran_packages.Rd

@@ -0,0 +1,16 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_updated_packages.R
+\name{get_new_cran_packages}
+\alias{get_new_cran_packages}
+\title{Get new CRAN packages}
+\usage{
+get_new_cran_packages(date = lubridate::today())
+}
+\description{
+Get new CRAN packages
+}
+\examples{
+# last week
+get_new_cran_packages(lubridate::interval(today() - 7, today()))
+
+}

man/get_removed_cran_packages.Rd

@@ -0,0 +1,16 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_updated_packages.R
+\name{get_removed_cran_packages}
+\alias{get_removed_cran_packages}
+\title{Get removed CRAN packages}
+\usage{
+get_removed_cran_packages(date = lubridate::today())
+}
+\description{
+Get removed CRAN packages
+}
+\examples{
+get_removed_cran_packages()
+get_removed_cran_packages(lubridate::interval(today() - 7, today()))
+
+}

man/get_updated_cran_packages.Rd

@@ -0,0 +1,15 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/get_updated_packages.R
+\name{get_updated_cran_packages}
+\alias{get_updated_cran_packages}
+\title{Get updated CRAN packages}
+\usage{
+get_updated_cran_packages(date = lubridate::today())
+}
+\description{
+Get updated CRAN packages
+}
+\examples{
+get_updated_cran_packages(lubridate::interval(today() - 7, today()))
+
+}

man/update_packages.Rd

@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/update-packages.R
+\name{update_packages}
+\alias{update_packages}
+\title{Process updated and new CRAN packages}
+\usage{
+update_packages(
+  package_name,
+  tag,
+  platform = platform,
+  local_clone_dir,
+  interval = lubridate::today(),
+  prune = TRUE
+)
+}
+\description{
+Packages which got removed from CRAN can be deleted by setting \code{prune = TRUE}.
+Argument \code{interval} allows to specify a range which should be processed.
+}