add update_packages() fix #5

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.")
+    })
+  }
+}