add 'cran_downloads' for #11

DESCRIPTION

@@ -15,11 +15,13 @@ Imports:
     dplyr,
     fs,
     gert,
+    httr2,
     memoise,
     pbapply,
     pkgstats
 Suggests:
     brio,
+    httptest2,
     lubridate,
     quarto,
     testthat (>= 3.0.0),

R/chaoss-metrics-external.R

@@ -0,0 +1,27 @@
+#' Extract total CRAN downloads for nominated package over period defined by
+#' `options("githist_period")`.
+#'
+#' @param pkg_name Name of package. For packages not on CRAN, the 'cranlogs'
+#' API returns download counts of 0.
+#' @param end_date The date up to which download counts are to be aggregated.
+#' @return A single integer counting the number of downloads.
+#' @noRd
+cran_downloads <- function (pkg_name, end_date = Sys.Date ()) {
+
+    checkmate::assert_character (pkg_name, len = 1L)
+    checkmate::assert_date (end_date)
+    period <- get_githist_period ()
+    start_date <- as.Date (end_date - period)
+    interval <- paste (start_date, sep = ":", end_date)
+
+    base_url <- "http://cranlogs.r-pkg.org/"
+    daily_url <- paste0 (base_url, "downloads/total/")
+    req_url <- paste0 (daily_url, interval, "/", pkg_name)
+
+    req <- httr2::request (req_url)
+    resp <- httr2::req_perform (req)
+    httr2::resp_check_status (resp)
+
+    body <- httr2::resp_body_json (resp)
+    return (body [[1]]$downloads)
+}

R/utils.R

@@ -28,6 +28,13 @@ set_num_cores <- function (num_cores) {
     return (num_cores)
 }
 
+pkg_name_from_path <- function (path) {
+    desc <- fs::dir_ls (path, type = "file", regexp = "DESCRIPTION$")
+    checkmate::assert_file_exists (desc)
+
+    unname (read.dcf (desc) [, "Package"])
+}
+
 filter_git_hist <- function (h, n, step_days) {
     if (!is.null (n)) {
         h <- h [seq_len (n), ]

codemeta.json

@@ -46,6 +46,18 @@
       },
       "sameAs": "https://CRAN.R-project.org/package=brio"
     },
+    {
+      "@type": "SoftwareApplication",
+      "identifier": "httptest2",
+      "name": "httptest2",
+      "provider": {
+        "@id": "https://cran.r-project.org",
+        "@type": "Organization",
+        "name": "Comprehensive R Archive Network (CRAN)",
+        "url": "https://cran.r-project.org"
+      },
+      "sameAs": "https://CRAN.R-project.org/package=httptest2"
+    },
     {
       "@type": "SoftwareApplication",
       "identifier": "lubridate",
@@ -170,6 +182,18 @@
       "sameAs": "https://CRAN.R-project.org/package=gert"
     },
     "6": {
+      "@type": "SoftwareApplication",
+      "identifier": "httr2",
+      "name": "httr2",
+      "provider": {
+        "@id": "https://cran.r-project.org",
+        "@type": "Organization",
+        "name": "Comprehensive R Archive Network (CRAN)",
+        "url": "https://cran.r-project.org"
+      },
+      "sameAs": "https://CRAN.R-project.org/package=httr2"
+    },
+    "7": {
       "@type": "SoftwareApplication",
       "identifier": "memoise",
       "name": "memoise",
@@ -181,7 +205,7 @@
       },
       "sameAs": "https://CRAN.R-project.org/package=memoise"
     },
-    "7": {
+    "8": {
       "@type": "SoftwareApplication",
       "identifier": "pbapply",
       "name": "pbapply",
@@ -193,15 +217,15 @@
       },
       "sameAs": "https://CRAN.R-project.org/package=pbapply"
     },
-    "8": {
+    "9": {
       "@type": "SoftwareApplication",
       "identifier": "pkgstats",
       "name": "pkgstats",
       "sameAs": "https://github.com/ropensci-review-tools/pkgstats"
     },
     "SystemRequirements": null
   },
-  "fileSize": "88.964KB",
+  "fileSize": "90.739KB",
   "readme": "https://github.com/ropensci-review-tools/githist/blob/main/README.md",
   "contIntegration": ["https://github.com/ropensci-review-tools/githist/actions?query=workflow%3AR-CMD-check", "https://app.codecov.io/gh/ropensci-review-tools/githist"],
   "developmentStatus": "https://www.repostatus.org/#active"

inst/httptest2/redact.R

@@ -0,0 +1,20 @@
+function (resp) {
+
+    resp <- httptest2::gsub_response (
+        resp,
+        "http://cranlogs.r-pkg.org/downloads/total/",
+        "cranlogs/",
+        fixed = TRUE
+    )
+
+    # Timestamp pattern, where replacing with "" removes sub-dir:
+    ptn <- "[0-9]{4}\\-[0-9]{2}\\-[0-9]{2}"
+    resp <- httptest2::gsub_response (
+        resp,
+        paste0 (ptn, "\\:", ptn),
+        "",
+        fixed = FALSE
+    )
+
+    return (resp)
+}

tests/testthat.R

@@ -7,6 +7,7 @@
 # * https://testthat.r-lib.org/articles/special-files.html
 
 library (testthat)
+library (httptest2)
 library (githist)
 
 test_check ("githist")

tests/testthat/cran_dl/cranlogs/goodpractice.json

@@ -0,0 +1,8 @@
+[
+    {
+        "start": "2023-10-03",
+        "end": "2024-01-01",
+        "downloads": 2308,
+        "package": "goodpractice"
+    }
+]

tests/testthat/test-chaoss-metrics-external.R

@@ -0,0 +1,11 @@
+test_that ("chaoss external cran_downloads", {
+
+    pkg_name <- "goodpractice"
+    end_date <- as.Date ("2024-01-01")
+    dl <- with_mock_dir ("cran_dl", {
+        cran_downloads (pkg_name = pkg_name, end_date = end_date)
+    })
+    expect_type (dl, "integer")
+    expect_length (dl, 1L)
+    expect_equal (dl, 2308)
+})