124 lines
3.7 KiB
R
124 lines
3.7 KiB
R
#' Get updated CRAN packages
|
|
#' @importFrom magrittr %>%
|
|
#' @importFrom purrr map list_rbind
|
|
#' @importFrom lubridate today
|
|
#' @examples
|
|
#' get_updated_cran_packages(lubridate::interval(today() - 7, today()))
|
|
#' @export
|
|
get_updated_cran_packages <- function(date = lubridate::today()) {
|
|
feed <- get_cranberries_feed()
|
|
|
|
# Apply the function to each item and bind the results into a data frame
|
|
results <- purrr::map(feed, ~ process_cranberries_rss(.x, date)) %>%
|
|
purrr::list_rbind()
|
|
|
|
return(results)
|
|
}
|
|
|
|
#' Get new CRAN packages
|
|
#' @importFrom magrittr %>%
|
|
#' @importFrom purrr map list_rbind
|
|
#' @importFrom lubridate today
|
|
#' @export
|
|
#' @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 <- purrr::map(feed, ~ process_cranberries_rss(.x, date)) %>%
|
|
purrr::list_rbind()
|
|
|
|
return(results)
|
|
}
|
|
|
|
#' Get removed CRAN packages
|
|
#' @importFrom magrittr %>%
|
|
#' @importFrom purrr map list_rbind
|
|
#' @importFrom lubridate today
|
|
#' @export
|
|
#' @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 <- purrr::map(feed, ~ process_cranberries_rss(.x, date)) %>%
|
|
purrr::list_rbind()
|
|
|
|
if (nrow(results == 0)) {
|
|
cli::cli_alert_info("{.fun archive_package}: No packages to archive for interval {.field {date}}.")
|
|
}
|
|
|
|
return(results)
|
|
}
|
|
|
|
#' Get Cranberries fieed
|
|
#' @importFrom xml2 read_xml xml_find_all
|
|
#' @export
|
|
#' @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 <- xml2::read_xml(feed)
|
|
|
|
# Extract item nodes
|
|
items <- xml2::xml_find_all(rss_content, "//item")
|
|
|
|
return(items)
|
|
}
|
|
|
|
#' @importFrom lubridate dmy_hms as_date interval %within%
|
|
#' @importFrom xml2 xml_text xml_find_first
|
|
#' @export
|
|
process_cranberries_rss <- function(feed, date = lubridate::today()) {
|
|
title <- xml2::xml_text(xml_find_first(feed, "title"))
|
|
pub_date_text <- xml2::xml_text(xml_find_first(feed, "pubDate"))
|
|
pub_date <- lubridate::as_date(dmy_hms(pub_date_text))
|
|
if (class(date) == "Date") {
|
|
date <- lubridate::interval(date, date)
|
|
}
|
|
|
|
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" = 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)
|
|
}
|
|
}
|