Dev/the env

DESCRIPTION

@@ -7,7 +7,7 @@ Description: Some functions useful when dealing with FCC data.
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Depends: 
     R (>= 2.10)
 LazyData: true

NAMESPACE

@@ -5,6 +5,8 @@ export(dl_nbm)
 export(fcc_to_parquet)
 export(get_nbm_available)
 export(get_nbm_release)
+export(set_user_agent)
+export(user_agent)
 import(DBI)
 import(duckdb)
 importFrom(stringi,stri_pad_left)

NEWS.md

@@ -1,3 +1,5 @@
 # cori.data.fcc (development version)
 
 * First functions released.
+
+* Improve functions with a user_agent defined in aaa.R #9

R/aaa.R

@@ -0,0 +1,33 @@
+the <- new.env(parent = emptyenv())
+the$user_agent <- paste0("Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7)",
+                         " AppleWebKit/537.36 (KHTML, like Gecko)",
+                         " Chrome/112.0.0.0 Safari/537.36")
+
+#' Seting user agent for function
+#' @export
+user_agent <- function() {
+  the$user_agent
+}
+
+#' Change User-Agent for a specific session
+#'
+#' Functions in this package use a specific User-Agent.
+#' You can change it for a specific R session.
+#'
+#' @param user_agent a string representing an User-Agent
+#'
+#' @export
+#'
+#'@examples
+#'\dontrun{
+#' set_user_agent(
+#' paste0("Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36",
+#' " (KHTML, like Gecko) Chrome/51.0.2704.103 Safari/537.36")
+#'}
+
+set_user_agent <- function(user_agent) {
+  stopifnot(is.character(user_agent))
+  old <- the$user_agent
+  the$user_agent <- user_agent
+  invisible(old)
+}

R/dl_nbm.R

@@ -7,6 +7,7 @@
 #' @param release_date a string can be "December 31, 2023" or "June 30, 2023"
 #' @param data_type a string "Fixed Broadband"
 #' @param data_category a string "Nationwide"
+#' @param user_agent a string set up by default
 #' @param ... additional parameters for download.file()
 #'
 #' @return A lot of zipped file
@@ -19,19 +20,18 @@
 #' }
 
 
-dl_nbm <- function(path_to_dl = "~/data_swamp", release_date = "June 30, 2023",
+dl_nbm <- function(path_to_dl = "~/data_swamp",
+                   release_date = "June 30, 2023",
                    data_type = "Fixed Broadband",
-                   data_category = "Nationwide", ...) {
+                   data_category = "Nationwide",
+                   user_agent = the$user_agent, ...) {
   # clean my mess
   prev_timeout <- getOption("timeout")
   on.exit(options(timeout = prev_timeout), add = TRUE)
   options(timeout = max(360, getOption("timeout")))
 
 
   base_url <- "https://broadbandmap.fcc.gov/nbm/map/api/getNBMDataDownloadFile/"
-  user_agent <- paste0("Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7)",
-                       " AppleWebKit/537.36 (KHTML, like Gecko)",
-                       " Chrome/112.0.0.0 Safari/537.36")
 
   all_data_to_dl <- get_nbm_available()
   one_release_to_dl <- all_data_to_dl[all_data_to_dl$release == release_date, ]

R/get_nbm_available.R

@@ -1,17 +1,29 @@
 #' Get release available in FCC NBM
 #'
-#' @param get_data_url a string providing NBM filing API. Default is "https://broadbandmap.fcc.gov/nbm/map/api/national_map_process/nbm_get_data_download/"
+#' NBM's API: 
+#' ```
+#' paste0("https://broadbandmap.fcc.gov/nbm/",
+#'        "map/api/national_map_process/nbm_get_data_download/")
+#' ```
+#' @param get_data_url a string providing NBM filing API.
+#' @param user_agent a string set up by default
+#' 
 #' @return A data frame.
 #' @export
 #'
 #' @examples
 #' nbm_data <- get_nbm_available()
 
-get_nbm_available <- function(get_data_url = "https://broadbandmap.fcc.gov/nbm/map/api/national_map_process/nbm_get_data_download/") {
+get_nbm_available <- function(
+  get_data_url = paste0("https://broadbandmap.fcc.gov/nbm/map/",
+                        "api/national_map_process/nbm_get_data_download/"),
+  user_agent = the$user_agent) {
 
   get_csv_to_dl <- function(release_file, release_nb) {
     get_data_url <- paste0(get_data_url,
                            release_file[release_nb, "process_uuid"])
+    h <- curl::new_handle()
+    curl::handle_setheaders(h, "User-Agent" = user_agent)
 
     raw_dat <- curl::curl_fetch_memory(get_data_url)
 

R/get_nbm_release.R

@@ -1,7 +1,7 @@
 #' Get release available in FCC NBM
 #'
 #' @param filing_url a string providing NBM filing API. Default is "https://broadbandmap.fcc.gov/nbm/map/api/published/filing"
-#' @param useragent set a default user agent "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:128.0) Gecko/20100101 Firefox/128.0"
+#' @param user_agent set a default user agent "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:128.0) Gecko/20100101 Firefox/128.0"
 #'
 #' @return A data frame.
 #' @export
@@ -10,10 +10,10 @@
 #' nbm <- get_nbm_release()
 
 get_nbm_release <- function(filing_url = "https://broadbandmap.fcc.gov/nbm/map/api/published/filing",
-                            useragent = "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:128.0) Gecko/20100101 Firefox/128.0") {
+                            user_agent = the$user_agent) {
   h <- curl::new_handle()
   curl::handle_setheaders(h,
-                          "User-Agent" = useragent)
+                          "User-Agent" = user_agent)
   req <- curl::curl_fetch_memory(filing_url, handle = h)
   release <- jsonlite::fromJSON(rawToChar(req$content))$data
   return(release)

tests/testthat/test-aaa.R

@@ -0,0 +1,13 @@
+test_that("the$user_agent should be string", {
+  expect_type(the$user_agent, "character")
+})
+
+test_that("error if set_user_agent", {
+  expect_error(set_user_agent(1))
+})
+
+test_that("seting user agent should change it", {
+  set_user_agent("Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/51.0.2704.103 Safari/537.36")
+  expect_equal(the$user_agent,
+  "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/51.0.2704.103 Safari/537.36")
+})