Add graceful failing when website is not available

R/find_team_contests.R

@@ -28,7 +28,16 @@ find_team_contests <- function(team_id = NULL) {
   # get team info and request URL
   team_info <- get_team_info(team_id)
   url <- paste0("https://stats.ncaa.org/teams/", team_id)
-  resp <- request_url(url)
+
+  resp <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for team ID {team_id}.")
+    },
+    request_url(url)
+  )
+  if (length(resp) == 1) {
+    if (grepl(pattern = "No website available for team ID", resp)) return(invisible())
+  }
 
   html_table <- resp |> httr2::resp_body_html() |>
     rvest::html_element("table")

R/get_teams.R

@@ -45,7 +45,15 @@ get_teams <- function(year = NULL,
                 "&conf_id=-1",
                 "&division=", division,
                 "&sport_code=", sport)
-  resp <- request_url(url)
+  resp <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available.")
+    },
+    request_url(url)
+  )
+  if (length(resp) == 1) {
+    if (grepl(pattern = "No website available", resp)) return(invisible())
+  }
 
   # create HTML table
   data_read <- resp |>

R/match_pbp.R

@@ -23,10 +23,19 @@ match_pbp <- function(contest = NULL) {
   url <- paste0("https://stats.ncaa.org/contests/", contest, "/play_by_play")
 
   ## get pbp HTML table
-  pbp_all <- request_url(url) |>
-    httr2::resp_body_html() |>
-    rvest::html_elements("table") |>
-    rvest::html_table()
+  pbp_all <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for contest {contest}.")
+    },
+    request_url(url) |>
+      httr2::resp_body_html() |>
+      rvest::html_elements("table") |>
+      rvest::html_table()
+  )
+  if (length(pbp_all) == 1) {
+    if (grepl(pattern = "No website available for contest", pbp_all)) return(invisible())
+  }
+
   match_info <- pbp_all[[1]]
 
   # calculate number of sets

R/player_match_stats.R

@@ -37,10 +37,19 @@ player_match_stats <- function(contest = NULL,
 
   # get and request URL
   url <- paste0("https://stats.ncaa.org/contests/", contest, "/individual_stats")
-  match_all <- request_url(url) |>
+
+  match_all <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for contest {contest}.")
+    },
+  request_url(url) |>
     httr2::resp_body_html() |>
     rvest::html_elements("table") |>
     rvest::html_table()
+  )
+  if (length(match_all) == 1) {
+    if (grepl(pattern = "No website available for contest", match_all)) return(invisible())
+  }
   match_info <- match_all[[1]]
 
   # extract date

R/player_season_stats.R

@@ -36,14 +36,23 @@ player_season_stats <- function(team_id,
   check_logical("team_stats", team_stats)
 
   # get team info and request URL
-  # teams <- dplyr::bind_rows(ncaavolleyballr::wvb_teams, ncaavolleyballr::mvb_teams)
   team_info <- get_team_info(team_id)
   url <- paste0("https://stats.ncaa.org/teams/", team_id, "/season_to_date_stats")
 
-  table <- request_url(url) |>
-    httr2::resp_body_html() |>
-    rvest::html_element("table") |>
-    rvest::html_table()
+  table <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for team ID {team_id}.")
+    },
+    request_url(url) |>
+      httr2::resp_body_html() |>
+      rvest::html_element("table") |>
+      rvest::html_table()
+  )
+  if (length(table) == 1) {
+    if (grepl(pattern = "No website available for team ID", table)) return(invisible())
+  }
+
+
   if (nrow(table) == 0 | !"Player" %in% colnames(table)) {
     cli::cli_warn("No {team_info$yr[1]} season stats available for {team_info$team_name[1]} (team ID {team_id}).")
     return(invisible())

R/team_match_stats.R

@@ -33,7 +33,15 @@ team_match_stats <- function(team_id = NULL,
   # get team info and request URL
   team_info <- get_team_info(team_id) #|>
   team_url <- paste0("https://stats.ncaa.org/teams/", team_id)
-  resp <- request_url(team_url)
+  resp <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for team ID {team_id}.")
+    },
+    request_url(team_url)
+  )
+  if (length(resp) == 1) {
+    if (grepl(pattern = "No website available for team ID", resp)) return(invisible())
+  }
 
   # extract arena info
   gbg_page <- resp |> httr2::resp_body_html() |>
@@ -42,13 +50,20 @@ team_match_stats <- function(team_id = NULL,
     stringr::str_subset("/players/\\d+")
   gbg_url <- paste0("https://stats.ncaa.org/", gbg_page)
 
-  tables <- request_url(gbg_url) |>
-    httr2::resp_body_html() |>
-    rvest::html_elements("table") |>
-    rvest::html_table()
-  # team <- tables[[1]]$Team[1]
+  table <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for team ID {team_id}.")
+    },
+    request_url(gbg_url) |>
+      httr2::resp_body_html() |>
+      rvest::html_elements("table") |>
+      rvest::html_table()
+  )
+  if (length(table) == 1) {
+    if (grepl(pattern = "No website available for team ID", table)) return(invisible())
+  }
 
-  matches <- tables[[2]] |>
+  matches <- table[[2]] |>
     dplyr::mutate(Date = dplyr::na_if(.data$Date, ""),
                   team_opp = ifelse(.data$Opponent == "Defensive Totals", "Opponent", "Team"),
                   Opponent = dplyr::na_if(.data$Opponent, "Defensive Totals"),

R/team_season_info.R

@@ -32,7 +32,15 @@ team_season_info <- function(team_id = NULL) {
   team_info <- get_team_info(team_id)
 
   url <- paste0("https://stats.ncaa.org/teams/", team_id)
-  resp <- request_url(url)
+  resp <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for team ID {team_id}.")
+    },
+    request_url(url)
+  )
+  if (length(resp) == 1) {
+    if (grepl(pattern = "No website available for team ID", resp)) return(invisible())
+  }
 
   # extract arena info
   arena <- resp |> httr2::resp_body_html() |>

R/team_season_stats.R

@@ -41,7 +41,15 @@ team_season_stats <- function(team = NULL,
     dplyr::select(Year = "year", Team = "team_name", Conference = "conference")
   team_id <- team_ids[length(team_ids)]
   team_url <- paste0("https://stats.ncaa.org/teams/", team_id)
-  resp <- request_url(team_url)
+  resp <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for team ID {team_id}.")
+    },
+    request_url(team_url)
+  )
+  if (length(resp) == 1) {
+    if (grepl(pattern = "No website available for team ID", resp)) return(invisible())
+  }
 
   # extract season summary info
   gbg_page <- resp |> httr2::resp_body_html() |>
@@ -50,12 +58,20 @@ team_season_stats <- function(team = NULL,
     stringr::str_subset("/players/\\d+")
   gbg_url <- paste0("https://stats.ncaa.org/", gbg_page)
 
-  table <- request_url(gbg_url) |>
-    httr2::resp_body_html() |>
-    rvest::html_element("table") |>
-    rvest::html_table() |>
-    dplyr::mutate(Year = dplyr::na_if(.data$Year, "")) |>
-    tidyr::fill("Year")
+  table <- tryCatch(
+    error = function(cnd) {
+      cli::cli_warn("No website available for team ID {team_id}.")
+    },
+    request_url(gbg_url) |>
+      httr2::resp_body_html() |>
+      rvest::html_element("table") |>
+      rvest::html_table() |>
+      dplyr::mutate(Year = dplyr::na_if(.data$Year, "")) |>
+      tidyr::fill("Year")
+  )
+  if (length(table) == 1) {
+    if (grepl(pattern = "No website available for team ID", table)) return(invisible())
+  }
 
   # return team or opponent summary info
   if(!opponent) {

tests/testthat/test-match_pbp.R

@@ -16,3 +16,8 @@ test_that("match_pbp() errors trigger correctly", {
   expect_error(match_pbp(contest = 585290),
                "Enter valid contest ID as a character string")
 })
+
+test_that("match_pbp() warnings trigger correctly", {
+  expect_warning(match_pbp(contest = "5675914"),
+                 "No website available for contest")
+})

tests/testthat/test-player_match_stats.R

@@ -37,3 +37,8 @@ test_that("player_match_stats() errors trigger correctly", {
   expect_error(player_match_stats(contest = "6080706", sport = "VB"),
                "Enter valid sport")
 })
+
+test_that("player_match_stats() warnings trigger correctly", {
+  expect_warning(player_match_stats(contest = "5675914", team = "Franklin"),
+               "No website available for contest")
+})