Add support for configurable analytics

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sandpaper
 Title: Create and Curate Carpentries Lessons
-Version: 0.16.4
+Version: 0.16.5.9000
 Authors@R: c(
     person(given = "Zhian N.",
            family = "Kamvar",

NEWS.md

@@ -4,6 +4,13 @@
 
 * Fix for empty divs when checking for headers
   (reported: @dmgatti, #581; fixed @froggleston)
+* Add support for including the Carpentries matomo
+  tracker, a custom user-supplied tracker script, or
+  no tracking 
+  (reported: @tbyhdgs, @fiveop https://github.com/carpentries/varnish/issues/37,
+   @zkamvar https://github.com/carpentries/sandpaper/issues/438,
+   implemented: @froggleston
+  )
 
 
 # sandpaper 0.16.4 (2024-04-10)

R/build_html.R

@@ -64,6 +64,10 @@ build_html <- function(template = "chapter", pkg, nodes, global_data, path_md, q
   global_data$instructor$set("json", fill_metadata_template(meta))
   global_data$instructor$set("translate", translated)
   global_data$instructor$set("citation", meta$get()$citation)
+
+  # add tracker script
+  global_data$instructor$set("analytics", processTracker(meta$get()$analytics))
+
   modified <- pkgdown::render_page(pkg,
     template,
     data = global_data$instructor$get(),
@@ -80,6 +84,10 @@ build_html <- function(template = "chapter", pkg, nodes, global_data, path_md, q
     meta$set("url", paste0(base_url, this_page))
     global_data$learner$set("json", fill_metadata_template(meta))
     global_data$learner$set("citation", meta$get()$citation)
+
+    # add tracker script
+    global_data$learner$set("analytics", processTracker(meta$get()$analytics))
+
     pkgdown::render_page(pkg,
       template,
       data = global_data$learner$get(),

R/utils-metadata.R

@@ -48,6 +48,8 @@ initialise_metadata <- function(path = ".") {
   this_metadata$set(c("date", "modified"), format(Sys.Date(), "%F"))
   this_metadata$set(c("date", "published"), format(Sys.Date(), "%F"))
   this_metadata$set("citation", path_citation(path))
+
+  this_metadata$set("analytics", cfg$analytics)
 }
 
 

R/utils-tracker.R

@@ -0,0 +1,34 @@
+processTracker <- function(string) {
+    string <- as.character(string)
+
+    # default to whatever the user supplies
+    analytics_str <- string
+
+    if (identical(string, "carpentries")) {
+        analytics_str <- '
+        <!-- Matomo -->
+        <script>
+          var _paq = window._paq = window._paq || [];
+          /* tracker methods like "setCustomDimension" should be called before "trackPageView" */
+          _paq.push(["setDocumentTitle", document.domain + "/" + document.title]);
+          _paq.push(["setDomains", ["*.lessons.carpentries.org","*.datacarpentry.github.io","*.datacarpentry.org","*.librarycarpentry.github.io","*.librarycarpentry.org","*.swcarpentry.github.io", "*.carpentries.github.io"]]);
+          _paq.push(["setDoNotTrack", true]);
+          _paq.push(["disableCookies"]);
+          _paq.push(["trackPageView"]);
+          _paq.push(["enableLinkTracking"]);
+          (function() {
+              var u="https://matomo.carpentries.org/";
+              _paq.push(["setTrackerUrl", u+"matomo.php"]);
+              _paq.push(["setSiteId", "1"]);
+              var d=document, g=d.createElement("script"), s=d.getElementsByTagName("script")[0];
+              g.async=true; g.src="https://matomo.carpentries.org/matomo.js"; s.parentNode.insertBefore(g,s);
+          })();
+        </script>
+        <!-- End Matomo Code -->
+        '
+    } else if (identical(string, "")) {
+        analytics_str <- ""
+    }
+
+    return(analytics_str)
+}

R/utils-xml.R

@@ -171,6 +171,7 @@ translate_overview <- function(nodes = NULL) {
 # @param translations a named vector of translated strings whose names are the
 #   strings in English
 xml_text_translate <- function(nodes, translations) {
+  # removes whitespace in order to translate, but need to add it back for nested tags
   txt <- xml2::xml_text(nodes, trim = TRUE)
   xml2::xml_set_text(nodes, apply_translations(txt, translations))
   return(invisible(nodes))
@@ -204,6 +205,7 @@ fix_callouts <- function(nodes = NULL) {
   # https://github.com/carpentries/sandpaper/issues/556
   h3_text <- xml2::xml_find_all(h3, ".//text()")
   xml_text_translate(h3_text, translations)
+
   xml2::xml_set_attr(h3, "class", "callout-title")
   inner_div <- xml2::xml_parent(h3)
   # remove the "section level3 callout-title" attrs

R/utils-yaml.R

@@ -193,6 +193,8 @@ create_pkgdown_yaml <- function(path) {
       beta       = usr$life_cycle == "beta",
       stable     = usr$life_cycle == "stable",
       doi        = doi,
+      # Enable tracking?
+      analytics  = if (is.null(usr$analytics)) NULL else (siQuote(usr$analytics)),
       NULL
     )
   )

tests/testthat/test-utils-tracker.R

@@ -0,0 +1,10 @@
+test_that("analytics carpentries tracker code generation works", {
+    tracker_yaml <- "analytics: carpentries"
+
+    YML <- yaml::yaml.load(tracker_yaml)
+
+    tracker_str <- processTracker(siQuote(YML$analytics))
+
+    expect_true(length(tracker_str) > 0)
+    expect_false(identical(tracker_str, "carpentries"))
+})