Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions extensions/most-used-content/.Rprofile
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
source("renv/activate.R")
2 changes: 2 additions & 0 deletions extensions/most-used-content/.gitignore
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
.posit/
app_cache/
108 changes: 108 additions & 0 deletions extensions/most-used-content/app.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,108 @@
library(shiny)
library(bslib)
library(DT)
library(connectapi)
library(dplyr)
library(purrr)
library(lubridate)

shinyOptions(
cache = cachem::cache_disk("./app_cache/cache/", max_age = 60 * 60 * 8)
)

source("get_usage.R")

ui <- page_fillable(
theme = bs_theme(version = 5),

card(
card_header("Most Used Content"),
layout_sidebar(
sidebar = sidebar(
title = "No Filters Yet",
open = FALSE,

actionButton("clear_cache", "Clear Cache", icon = icon("refresh"))
),
card(
DTOutput(
"content_usage_table"
)
)
)
)
)

server <- function(input, output, session) {
# Cache invalidation button ----
cache <- cachem::cache_disk("./app_cache/cache/")
observeEvent(input$clear_cache, {
print("Cache cleared!")
cache$reset() # Clears all cached data
session$reload() # Reload the app to ensure fresh data
})

# Loading and processing data ----
client <- connect()

# Default dates. "This week" is best "common sense" best represented by six
# days ago thru the end of today. Without these, content takes too long to
# display on some servers.
date_range <- reactive({
list(
from_date = today() - ddays(6),
to_date = today()
)
})

content <- reactive({
get_content(client)
}) |> bindCache("static_key")

usage_data <- reactive({
get_usage(
client,
from = date_range()$from_date,
to = date_range()$to_date + hours(23) + minutes(59) + seconds(59)
)
}) |> bindCache(date_range()$from_date, date_range()$to_date)

# Compute basic usage stats
content_usage_data <- reactive({
usage_summary <- usage_data() |>
group_by(content_guid) |>
summarize(
total_views = n(),
unique_viewers = n_distinct(user_guid, na.rm = TRUE),
last_viewed_at = max(timestamp, na.rm = TRUE)
)

content() |>
mutate(owner_username = map_chr(owner, "username")) |>
select(title, content_guid = guid, owner_username) |>
right_join(usage_summary, by = "content_guid") |>
arrange(desc(total_views))
}) |> bindCache(date_range()$from_date, date_range()$to_date)

output$content_usage_table <- renderDT({
datatable(
content_usage_data(),
options = list(
order = list(list(4, "desc")),
paging = FALSE
),
colnames = c(
"Content Title" = "title",
"Content GUID" = "content_guid",
"Owner Username" = "owner_username",
"Total Views" = "total_views",
"Unique Logged-in Viewers" = "unique_viewers",
"Last Viewed At" = "last_viewed_at"
)
) |>
formatDate(columns = "Last Viewed At", method = "toLocaleString")

})
}

shinyApp(ui, server)
58 changes: 58 additions & 0 deletions extensions/most-used-content/get_usage.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,58 @@
library(connectapi)

# This file contains functions that ultimately will more likely be part of
# connectapi. As such, I'm not using dplyr or pipes here.

NA_datetime_ <- vctrs::new_datetime(NA_real_, tzone = "UTC")
NA_list_ <- list(list())

usage_dtype <- tibble::tibble(
"id" = NA_integer_,
"user_guid" = NA_character_,
"content_guid" = NA_character_,
"timestamp" = NA_datetime_,
"data" = NA_list_
)

# A rough implementation of how a new firehose usage function would work in
# `connectapi`.
get_usage_firehose <- function(client, from = NULL, to = NULL) {
usage_raw <- client$GET(
connectapi:::unversioned_url("instrumentation", "content", "hits"),
query = list(
from = from,
to = to
)
)

# FIXME for connectapi: This is slow, it's where most of the slowness is with
# the new endpoint.
usage_parsed <- connectapi:::parse_connectapi_typed(usage_raw, usage_dtype)

usage_parsed[c("user_guid", "content_guid", "timestamp")]
}

get_usage_legacy <- function(client, from = NULL, to = NULL) {
shiny_usage <- get_usage_shiny(client, limit = Inf, from = from, to = to)
shiny_usage_cols <- shiny_usage[c("user_guid", "content_guid")]
shiny_usage_cols$timestamp <- shiny_usage$started

static_usage <- get_usage_static(client, limit = Inf, from = from, to = to)
static_usage_cols <- static_usage[c("user_guid", "content_guid")]
static_usage_cols$timestamp <- static_usage$time

bind_rows(shiny_usage_cols, static_usage_cols)
}

get_usage <- function(client, from = NULL, to = NULL) {
tryCatch(
{
print("Trying firehose usage endpoint.")
get_usage_firehose(client, from, to)
},
error = function(e) {
print("Could not use firehose endpoint; trying legacy usage endpoints.")
get_usage_legacy(client, from, to)
}
)
}
Loading