diff --git a/.Rbuildignore b/.Rbuildignore index 2b30024..6192428 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,3 +9,4 @@ ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^inst/extdata/cached-secrets/* \ No newline at end of file diff --git a/.gitignore b/.gitignore index 9da072c..00dd8f5 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ .secrets/* .httr-oauth docs +inst/extdata/cached-secrets/* \ No newline at end of file diff --git a/NAMESPACE b/NAMESPACE index 54f8cf1..8ec9234 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,22 +4,28 @@ export(all_ga_metrics) export(auth_from_secret) export(authorize) export(calendly_get) +export(clean_repo_metrics) export(delete_creds) export(get_calendly_user) export(get_ga_metadata) export(get_ga_properties) export(get_ga_stats) export(get_ga_user) +export(get_github) export(get_github_metrics) -export(get_github_repo) export(get_github_user) export(get_google_files) +export(get_repo_list) +export(get_repos_metrics) export(get_youtube_stats) +export(gh_repo_wrapper) export(list_calendly_events) export(request_ga) importFrom(assertthat,assert_that) importFrom(assertthat,is.string) +importFrom(dplyr,"%>%") importFrom(dplyr,bind_rows) +importFrom(dplyr,distinct) importFrom(gh,gh) importFrom(httr,accept_json) importFrom(httr,config) @@ -29,6 +35,7 @@ importFrom(httr,oauth_app) importFrom(httr,oauth_endpoints) importFrom(jsonlite,fromJSON) importFrom(lubridate,today) +importFrom(purrr,map) importFrom(utils,browseURL) importFrom(utils,installed.packages) importFrom(utils,menu) diff --git a/R/auth.R b/R/auth.R index f850796..246eb1b 100644 --- a/R/auth.R +++ b/R/auth.R @@ -42,8 +42,13 @@ authorize <- function(app_name = NULL, # Store api key here token <- readline(prompt = "Paste token here and press enter: ") - # If they chose to cache it, we'll store it as a global option - if (cache_it == 1) options(calendly_api = token) + options(calendly_api = token) + + + # If they chose to cache it, we'll store it in rds file format + if (cache_it == 1) { + saveRDS(token, file.path(cache_secrets_folder(), "calendly.RDS")) + } } if (app_name == "github") { @@ -52,10 +57,13 @@ authorize <- function(app_name = NULL, message("On the opened page, scroll down and click 'Generate Token'.") # Store api key here - token <- readline(prompt = "Paste token here and press enter:") + token <- readline(prompt = "Paste token here and press enter: ") + + # Check that token + if (!grepl("ghp", token)) stop("This doesn't look like a GitHub Personal Access token. https://docs.github.com/en/authentication/keeping-your-account-and-data-secure/managing-your-personal-access-tokens") - # If they chose to cache it, we'll store it as a global option - if (cache_it == 1) options(github_api = token) + # If they chose to cache it, we'll store it in rds file format + if (cache_it == 1) saveRDS(token, file.path(cache_secrets_folder(), "github.RDS")) } if (app_name == "google") { @@ -87,23 +95,43 @@ delete_creds <- function(app_name = "all") { if (!(app_name %in% c("all", supported))) stop("That is not a supported app or endpoint") - if (app_name == "all" | app_name == "calendly") { - options(calendly_api = NULL) - remove_token("calendly") - message("Calendly creds deleted from .Rprofile") - } + ## Checking for the existence of cached creds + calendly_creds_exist <- !is.null(getOption("calendly_api")) + github_creds_exist <- !is.null(getOption("github_api")) + oauth_file <- list.files(pattern = ".httr-oauth", all.files = TRUE, recursive = TRUE, full.names = TRUE) + google_creds_exist <- length(oauth_file) != 0 - if (app_name == "all" | app_name == "github") { - options(github_api = NULL) - remove_token("github") - message("GitHub creds deleted from .Rprofile") - } + # Do any exist? + none_exist <- all(!calendly_creds_exist, !github_creds_exist, !google_creds_exist) + + if (none_exist) { + message("No cached creds to delete (from metricminer anyway). Done") + } else { + if (app_name == "all" | app_name == "calendly") { + if (calendly_creds_exist) { + options(calendly_api = NULL) + remove_token("calendly") + remove_cache("calendly") + message("Calendly creds deleted from cache and environment") + } + } - if (app_name == "all" | app_name == "google") { - oauth_file <- list.files(pattern = ".httr-oauth", all.files = TRUE, recursive = TRUE, full.names = TRUE) - file.remove(oauth_file) - remove_token("google") - message("Cached Google .httr-oauth file deleted") + if (app_name == "all" | app_name == "github") { + if (github_creds_exist) { + options(github_api = NULL) + remove_token("github") + remove_cache("github") + message("GitHub creds deleted from cache and environment") + } + } + + if (app_name == "all" | app_name == "google") { + if (google_creds_exist) { + file.remove(oauth_file) + remove_token("google") + message("Cached Google .httr-oauth file deleted and token removed from environment") + } + } } } diff --git a/R/cran.R b/R/cran.R index 3e4f4bc..3a262a9 100644 --- a/R/cran.R +++ b/R/cran.R @@ -1 +1,14 @@ # CRAN + +# library("ggplot2") +# library("dlstats") + +# download_stats <- cran_stats(c("ottrpal", "githubr", "rgoogleclassroom")) + +# if (!is.null(download_stats)) { +# print(head(download_stats)) +# ggplot(download_stats, aes(end, downloads, group=package, color=package)) + +# geom_line() + +# geom_point() + +# scale_y_log10() +# } diff --git a/R/github.R b/R/github.R index 54b9fdf..518eb9d 100644 --- a/R/github.R +++ b/R/github.R @@ -1,25 +1,20 @@ # Extracting data from GitHub -#' Get the GitHub User's info +#' Handler function for GET requests from GitHub #' @description This is a function to get the GitHub user's info #' @param token You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function +#' @param url What is the URL endpoint we are attempting to grab here? #' @return Information regarding a github account #' @importFrom utils menu installed.packages #' @importFrom httr oauth_app oauth_endpoints oauth2.0_token #' @export -#' @examples \dontrun{ -#' -#' authorize("github") -#' get_github_user() -#' } -get_github_user <- function(token) { - # Get auth token - token <- get_token(app_name = "github") - - # Declare URL - url <- "https://api.github.com/user" +get_github <- function(token = NULL, url) { + if (is.null(token)) { + # Get auth token + token <- get_token(app_name = "github") + } - # Github api get + # Github api get result <- httr::GET( url, httr::add_headers(Authorization = paste0("Bearer ", token)), @@ -40,119 +35,276 @@ get_github_user <- function(token) { #' @description This is a function to get the GitHub user's info #' @param token You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function #' @return Information regarding a github account -#' @importFrom utils menu installed.packages -#' @importFrom httr oauth_app oauth_endpoints oauth2.0_token #' @export #' @examples \dontrun{ #' #' authorize("github") #' get_github_user() #' } -get_github_user <- function(token) { - +get_github_user <- function(token = NULL) { if (is.null(token)) { # Get auth token token <- get_token(app_name = "github") - } else { - token <- token } get_github( url = "https://api.github.com/user", - token = token, + token = token ) } -#' Get the repository info -#' @description This is a function to get the GitHub user's info +#' Retrieve list of repositories for an owner +#' @description This is a function to get the information about a repository #' @param token You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function -#' @param owner The owner -#' @param repo The repository +#' @param owner The owner of the repository. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl` +#' @param count The number of responses that should be returned. Default is 20 or you can say "all" to retrieve all. #' @return Information regarding a github account -#' @importFrom utils menu installed.packages -#' @importFrom httr oauth_app oauth_endpoints oauth2.0_token +#' @importFrom gh gh #' @export #' @examples \dontrun{ #' #' authorize("github") -#' get_github_repo() +#' get_repo_list(owner = "fhdsl") #' } -get_github_repo <- function(token, owner, repo) { +#' +get_repo_list <- function(owner, count = "all", token = NULL) { + + if (count == "all") count <- "Inf" if (is.null(token)) { # Get auth token - token <- get_token(app_name = "github") - } else { - token <- token + token <- get_token(app_name = "github", try = TRUE) + if (is.null(token)) warning("No token found. Only public repositories will be retrieved.") } - repo_activity <- gh::gh("GET /repos/{owner}/{repo}/activity", - owner = owner, - repo = repo, - .token = token + + repo_list <- gh::gh("GET /orgs/{owner}/repos", + owner = owner, + .token = token, + .limit = count ) + return(repo_list) +} +#' Get the repository metrics +#' @description This is a function to get the information about a repository +#' @param token You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function +#' @param repo The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl/metricminer` +#' @param count How many items would you like to recieve? Put "all" to retrieve all records. +#' @param data_format Default is to return a curated data frame. However if you'd like to see the raw information returned from GitHub set format to "raw". +#' @return Information regarding a github account +#' @importFrom gh gh +#' @importFrom purrr map +#' @export +#' @examples \dontrun{ +#' +#' authorize("github") +#' metrics <- get_github_metrics(repo = "fhdsl/metricminer") +#' } +get_github_metrics <- function(repo, token = NULL, count = "all", data_format = "dataframe") { - stars <- gh::gh("GET /repos/{owner}/{repo}/stargazers", - owner = owner, - repo = repo, - .token = token - ) + if (count == "all") count <- Inf - forks <- gh::gh("GET /repos/{owner}/{repo}/forks", - owner = owner, - repo = repo, - .token = token - ) + # Split it up + split_it <- strsplit(repo, split = "\\/") + owner <- split_it[[1]][1] + repo <- split_it[[1]][2] - contributors <- gh::gh("GET /repos/{owner}/{repo}/contributors", - owner = owner, - repo = repo, - .token = token + api_calls <- list( + repo_activity = "GET /repos/{owner}/{repo}/activity", + stars = "GET /repos/{owner}/{repo}/stargazers", + forks = "GET /repos/{owner}/{repo}/forks", + contributors = "GET /repos/{owner}/{repo}/contributors", + community = "GET /repos/{owner}/{repo}/community/profile", + clones = "GET /repos/{owner}/{repo}/traffic/clones", + views = "GET /repos/{owner}/{repo}/traffic/views" ) + # Put gh_repo_wrapper inside function + gh_repo_wrapper_fn <- function(api_call) { + gh_repo_wrapper(api_call = api_call, + owner = owner, + repo = repo, + token = token, + count = count, + data_format = data_format + ) + } + # Run gh_repo_wrapper_fn() on api_calls + # when error occurs, set value to "Not Found" + results <- purrr::map(api_calls, purrr::possibly(gh_repo_wrapper_fn, "Not Found")) - return(list(repo_activity, stars, forks, contributors)) + names(results) <- names(api_calls) + + if (data_format == "dataframe") { + results <- clean_repo_metrics( + repo_name = paste0(c(owner, repo), collapse = "/"), + repo_metric_list = results + ) + } + return(results) } -#' Get the metrics from GitHub on a repo -#' @description This is a function to get the GitHub user's info +#' Retrieve metrics for a list of repos +#' @description This is a function to get metrics for a list of repos. You can provide an owner and attempt retrieve all repos from a +#' particular organization, or you can provide a character vector of repos like " #' @param token You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function -#' @param owner Who is the owner of this account? For example in the repository fhdsl/metricminer, fhdsl is the owner -#' @param repo What is the repository name? For example in the repository fhdsl/metricminer, "metricminer" is the repo name. +#' @param owner The owner of the repository. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl` +#' @param repo_names a character vector of repositories you'd like to collect metrics from. +#' @param data_format Default is to return a curated data frame. However if you'd like to see the raw information returned from GitHub set format to "raw". #' @return Information regarding a github account #' @importFrom gh gh +#' @importFrom purrr map +#' @importFrom dplyr bind_rows #' @export #' @examples \dontrun{ #' #' authorize("github") -#' get_github_user() +#' all_repos_metrics <- get_repos_metrics(owner = "fhdsl") +#' readr::write_tsv(all_repos_metrics, "fhdsl_github_metrics.tsv") +#' +#' repo_names <- c("fhdsl/metricminer", "jhudsl/OTTR_Template") +#' some_repos_metrics <- get_repos_metrics(repo_names = repo_names) +#' #' } -get_github_metrics <- function(token, owner, repo) { +#' +get_repos_metrics <- function(owner = NULL, repo_names = NULL, token = NULL, data_format = "dataframe") { if (is.null(token)) { # Get auth token - token <- get_token(app_name = "github") - } else { - token <- token + token <- get_token(app_name = "github", try = TRUE) } - community <- gh::gh("GET /repos/{owner}/{repo}/community/profile", - owner = owner, - repo = repo, - .token = token - ) + if (is.null(repo_names) && !is.null(owner)) { + repo_list <- get_repo_list( + token = token, + owner = owner, + count = "all" + ) - clones <- gh::gh("GET /repos/{owner}/{repo}/traffic/clones", - owner = owner, - repo = repo, - .token = token - ) + # Extra repo names from the repo list + repo_names <- unlist(purrr::map(repo_list, "full_name")) + } - views <- gh::gh("GET /repos/{owner}/{repo}/traffic/views", + # Now run get_github_metrics on all repos + repo_metrics <- lapply(repo_names, function(repo) { + get_github_metrics(token = token, + repo = repo, + data_format = data_format) + }) + + # Keep names + names(repo_metrics) <- repo_names + + if (data_format == "dataframe") { + repo_metrics <- dplyr::bind_rows(repo_metrics) + } + + return(repo_metrics) +} + +#' Wrapper function for gh repo calls +#' @description This is a function that wraps up gh calls for us +#' @param api_call an API call and endpoint like "GET /repos/{owner}/{repo}/activity". That has `owner` and `user`. +#' @param token You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function +#' @param owner The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl` +#' @param repo The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `metricminer` +#' @param count How many items would you like to receive? Put "all" to retrieve all records. +#' @param data_format What format should the data be returned in? Default is dataframe. But if you'd like the original raw results, saw "raw". +#' @return Metrics for a repo on GitHub +#' @importFrom gh gh +#' @export +#' +gh_repo_wrapper <- function(api_call, owner, repo, token = NULL, count = Inf, data_format = "dataframe") { + + message(paste("Trying", api_call, "for", repo)) + + if (is.null(token)) { + # Get auth token + token <- get_token(app_name = "github", try = TRUE) + if (is.null(token)) warning("No GitHub token found. Only certain metrics will be able to be retrieved.") + } + + # Not all repos have all stats so we have to try it. + result <- try(gh::gh(api_call, owner = owner, repo = repo, - .params = list("per" = "day"), - .token = token + .token = token, + .limit = count + ), silent = TRUE) + + # Some handlers because not all repos have all stats + if (length(result) == 0) result <- "No results" + if (grepl("404", result[1])) result <- "No results" + if (grepl("Error", result[1])) result <- "No results" + + return(result) +} + + +#' Cleaning metrics from GitHub +#' @description This is a function to get metrics for all the repos underneath an organization +#' @param repo_name The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `metricminer` +#' @param repo_metric_list a list containing the metrics c +#' @return Metrics for a repo on GitHub +#' @importFrom gh gh +#' @importFrom dplyr bind_rows distinct %>% +#' @importFrom purrr map +#' @export +#' +clean_repo_metrics <- function(repo_name, repo_metric_list) { + + if (repo_metric_list$contributors[1] != "No results") { + contributors <- + lapply(repo_metric_list$contributors, function(contributor) { + data.frame( + contributor = contributor$login, + num_contributors = contributor$contributions) + }) %>% + dplyr::bind_rows() %>% + dplyr::distinct() + + num_contributors <- length(unique(contributors$contributor)) + total_contributors <- sum(contributors$num_contributors) + } else { + num_contributors <- NA + total_contributors <- NA + } + + if (repo_metric_list$forks[1] != "No results") { + forks <- unlist(purrr::map(repo_metric_list$forks, "full_name")) + num_forks <- length(forks) + } else { + num_forks <- NA + } + metrics <- data.frame( + repo_name, + num_forks = num_forks, + num_contributors = num_contributors, + total_contributions = total_contributors, + num_stars = length(unlist(purrr::map(repo_metric_list$stars, "login"))), + health_percentage = ifelse(repo_metric_list$community[1] != "No results", as.numeric(repo_metric_list$community$health_percentage), NA), + num_clones = ifelse(repo_metric_list$clones[1] != "No results", as.numeric(repo_metric_list$clones$count), NA), + unique_views = ifelse(repo_metric_list$views[1] != "No results", as.numeric(repo_metric_list$views$count), NA) ) + + rownames(metrics) <- repo_name + return(metrics) +} + + +gh_pagination <- function(first_page_result) { + # Set up a while loop for us to store the multiple page requests in + cummulative_pages <- first_page_result + page <- 1 + + next_pg <- try(gh::gh_next(first_page_result), silent = TRUE) + + while (!grepl("Error", next_pg[1])) { + cummulative_pages <- c(cummulative_pages, next_pg) + next_pg <- try(gh::gh_next(next_pg), silent = TRUE) + page <- page + 1 + } + + return(cummulative_pages) } diff --git a/R/google-analytics.R b/R/google-analytics.R index 90bf8be..668762f 100644 --- a/R/google-analytics.R +++ b/R/google-analytics.R @@ -8,12 +8,12 @@ #' @param token credentials for access to Google using OAuth. `authorize("google")` #' @param body_params The body parameters for the request #' @param query A list to be passed to query -#' @param type Is this a GET or a POST? +#' @param request_type Is this a GET or a POST? #' @importFrom httr config accept_json content #' @importFrom jsonlite fromJSON #' @importFrom assertthat assert_that is.string #' @export -request_ga <- function(token, url, query = NULL, body_params = NULL, type) { +request_ga <- function(token, url, query = NULL, body_params = NULL, request_type) { if (is.null(token)) { # Get auth token @@ -21,10 +21,10 @@ request_ga <- function(token, url, query = NULL, body_params = NULL, type) { } config <- httr::config(token = token) - if (type == "GET") { + if (request_type == "GET") { result <- httr::GET( url = url, - body = body, + body = body_params, query = query, config = config, httr::accept_json(), @@ -32,7 +32,7 @@ request_ga <- function(token, url, query = NULL, body_params = NULL, type) { ) } - if (type == "POST") { + if (request_type == "POST") { result <- httr::POST( url = url, body = body_params, @@ -55,6 +55,7 @@ request_ga <- function(token, url, query = NULL, body_params = NULL, type) { #' Get Google Analytics Accounts #' @description This is a function to get the Google Analytics accounts that this user has access to +#' @param request_type Is this a GET or a POST? #' @importFrom httr config accept_json content #' @importFrom jsonlite fromJSON #' @importFrom assertthat assert_that is.string @@ -64,14 +65,14 @@ request_ga <- function(token, url, query = NULL, body_params = NULL, type) { #' authorize("google") #' get_ga_user() #' } -get_ga_user <- function() { +get_ga_user <- function(request_type = "GET") { # Get auth token token <- get_token(app_name = "google") results <- request_ga( token = token, url = "https://analytics.googleapis.com/analytics/v3/management/accountSummaries", - type = "GET" + request_type = "GET" ) return(results$items) @@ -99,7 +100,7 @@ get_ga_properties <- function(account_id) { token = token, url = "https://analyticsadmin.googleapis.com/v1alpha/properties", query = list(filter = paste0("parent:accounts/", account_id)), - type = "GET" + request_type = "GET" ) return(results) @@ -133,7 +134,7 @@ get_ga_metadata <- function(property_id) { results <- request_ga( token = token, url = url, - type = "GET" + request_type = "GET" ) return(results) @@ -144,7 +145,8 @@ get_ga_metadata <- function(property_id) { #' @param property_id a GA property. Looks like '123456789' Can be obtained from running `get_ga_properties()` #' @param start_date YYYY-MM-DD format of what metric you'd like to collect metrics from to start. Default is the earliest date Google Analytics were collected. #' @param end_date YYYY-MM-DD format of what metric you'd like to collect metrics from to end. Default is today. -#' +#' @param body_params The body parameters for the request +#' @param stats_type Do you want to retrieve metrics or dimensions? #' @importFrom httr config accept_json content #' @importFrom jsonlite fromJSON #' @importFrom assertthat assert_that is.string @@ -158,10 +160,10 @@ get_ga_metadata <- function(property_id) { #' properties_list <- get_ga_properties(account_id = accounts$id[1]) #' #' property_id <- gsub("properties/", "", properties_list$properties$name[1]) -#' metrics <- get_ga_stats(property_id, type = "metrics") -#' dimensions <- get_ga_stats(property_id, type = "dimensions") +#' metrics <- get_ga_stats(property_id, stats_type = "metrics") +#' dimensions <- get_ga_stats(property_id, stats_type = "dimensions") #' } -get_ga_stats <- function(property_id, start_date = "2015-08-14", end_date = NULL, type = "metrics") { +get_ga_stats <- function(property_id, start_date = "2015-08-14", body_params = NULL, end_date = NULL, stats_type = "metrics") { # If no end_date is set, use today end_date <- ifelse(is.null(end_date), as.character(lubridate::today()), end_date) @@ -172,7 +174,7 @@ get_ga_stats <- function(property_id, start_date = "2015-08-14", end_date = NULL # Get auth token token <- get_token(app_name = "google") - if (type == "metrics") { + if (stats_type == "metrics") { body_params <- list( dateRanges = list( "startDate" = start_date, @@ -180,7 +182,7 @@ get_ga_stats <- function(property_id, start_date = "2015-08-14", end_date = NULL metrics = metrics_list() ) } - if (type == "dimensions") { + if (stats_type == "dimensions") { body_params <- list( dateRanges = list( "startDate" = start_date, @@ -192,8 +194,8 @@ get_ga_stats <- function(property_id, start_date = "2015-08-14", end_date = NULL results <- request_ga( token = token, url = url, - body = body_params, - type = "POST" + body_params = body_params, + request_type = "POST" ) return(results) @@ -249,8 +251,8 @@ all_ga_metrics <- function(account_id) { # Now loop through all the properties all_google_analytics_data <- lapply(property_names, function(property_id) { - metrics <- get_ga_stats(property_id, type = "metrics") - dimensions <- get_ga_stats(property_id, type = "dimensions") + metrics <- get_ga_stats(property_id, stats_type = "metrics") + dimensions <- get_ga_stats(property_id, stats_type = "dimensions") return(list(metrics = metrics, dimensions = dimensions)) }) diff --git a/R/token-handlers.R b/R/token-handlers.R index 3d45ce9..f92d201 100644 --- a/R/token-handlers.R +++ b/R/token-handlers.R @@ -17,20 +17,56 @@ remove_token <- function(app_name) { .Env$metricminer_tokens[[app_name]] <- NULL } +remove_cache <- function(app_name) { + if (app_name == "calendly") file.remove(file.path(cache_secrets_folder(), "calendly.RDS")) + if (app_name == "github") file.remove(file.path(cache_secrets_folder(), "github.RDS")) +} + # Get token from environment -get_token <- function(app_name) { - # If there's none in the current environemnt, attempt to grab a cached credential +# Default is to try to retrieve credentials but if credentials are not necessary +# and you just want to attempt to grab credentials and see if you can then set try = TRUE +get_token <- function(app_name, try = FALSE) { + + # If there's none in the current environment, attempt to grab a stored credential + if (is.null(.Env$metricminer_tokens[[app_name]])) { + + .Env$metricminer_tokens[[app_name]] <- get_stored_token(app_name) + # only print this message if we are successful + if (!is.null(.Env$metricminer_tokens[[app_name]])) message("Using user-supplied token stored using authorize(\"", app_name, "\")") + } + # Attempt to grab a cached credential if (is.null(.Env$metricminer_tokens[[app_name]])) { - .Env$metricminer_tokens[[app_name]] <- get_cached_token(app_name) + .Env$metricminer_tokens[[app_name]] <- get_cached_token(app_name) + + # only print this message if we are successful + if (!is.null(.Env$metricminer_tokens[[app_name]])) message("Using user-supplied cached token using authorize(\"", app_name, "\")") + } + + if (is.null(.Env$metricminer_tokens[[app_name]])) warning("No token found. Please run `authorize()` to supply token.") + + if (!try) { + stop("Authorization required for the called function. Quitting.") } return(invisible(.Env$metricminer_tokens[[app_name]])) } -# A function that attempts to grab cached credentials -get_cached_token <- function(app_name) { +# A function that attempts to grab stored credentials +get_stored_token <- function(app_name) { if (app_name == "calendly") token <- getOption("calendly_api") if (app_name == "github") token <- getOption("github_api") if (app_name == "google") token <- try(readRDS(".httr-oauth"), silent = TRUE) + return(token) +} + +# A function that attempts to grab cached credentials +get_cached_token <- function(app_name) { + if (app_name == "calendly") token <- try(readRDS(file.path(cache_secrets_folder(), "calendly.RDS")), silent = TRUE) + if (app_name == "github") token <- try(readRDS(file.path(cache_secrets_folder(), "github.RDS")), silent = TRUE) + if (app_name == "google") token <- try(readRDS(".httr-oauth"), silent = TRUE) + + if (grepl("Error", token[1])) { + token <- NULL + } return(token) } diff --git a/R/utils.R b/R/utils.R index baaba5c..0e26531 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,5 @@ utils::globalVariables(c( - "scopes", "set_token", "browseURL", "remove_token", "get_token", "get_github", "get_calendly" + "scopes", "set_token", "browseURL", "remove_token", "get_token", "get_github", "get_calendly", "%>%" )) #' Supported endpoints #' @description This is function stores endpoints and supported app names @@ -41,3 +41,24 @@ key_encrypt_creds_path <- function() { full.names = TRUE ) } +cache_secrets_folder <- function() { + file_path <- list.files( + pattern = "cached-secrets", + recursive = TRUE, + system.file("extdata", package = "metricminer"), + full.names = TRUE, + include.dirs = TRUE, + ) + + if (length(file_path) == 0) { + dir.create(file.path(system.file("extdata", package = "metricminer"), + "cached-secrets"), recursive = TRUE, showWarnings = FALSE) + } + list.files( + pattern = "cached-secrets", + recursive = TRUE, + system.file("extdata", package = "metricminer"), + full.names = TRUE, + include.dirs = TRUE, + ) +} diff --git a/README.md b/README.md deleted file mode 100644 index f391b1e..0000000 --- a/README.md +++ /dev/null @@ -1,10 +0,0 @@ -# metricminer - -Compatibility for mining from: - -- Google Analytics -- Google Forms -- Slack -- Slido -- CRAN -- GitHub diff --git a/man/clean_repo_metrics.Rd b/man/clean_repo_metrics.Rd new file mode 100644 index 0000000..430b62d --- /dev/null +++ b/man/clean_repo_metrics.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/github.R +\name{clean_repo_metrics} +\alias{clean_repo_metrics} +\title{Cleaning metrics from GitHub} +\usage{ +clean_repo_metrics(repo_name, repo_metric_list) +} +\arguments{ +\item{repo_name}{The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `metricminer`} + +\item{repo_metric_list}{a list containing the metrics c} +} +\value{ +Metrics for a repo on GitHub +} +\description{ +This is a function to get metrics for all the repos underneath an organization +} diff --git a/man/get_ga_stats.Rd b/man/get_ga_stats.Rd index 2d755b2..d5744f7 100644 --- a/man/get_ga_stats.Rd +++ b/man/get_ga_stats.Rd @@ -7,8 +7,9 @@ get_ga_stats( property_id, start_date = "2015-08-14", + body_params = NULL, end_date = NULL, - type = "metrics" + stats_type = "metrics" ) } \arguments{ @@ -16,7 +17,11 @@ get_ga_stats( \item{start_date}{YYYY-MM-DD format of what metric you'd like to collect metrics from to start. Default is the earliest date Google Analytics were collected.} +\item{body_params}{The body parameters for the request} + \item{end_date}{YYYY-MM-DD format of what metric you'd like to collect metrics from to end. Default is today.} + +\item{stats_type}{Do you want to retrieve metrics or dimensions?} } \description{ This is a function to get the Google Analytics accounts that this user has access to @@ -30,7 +35,7 @@ accounts <- get_ga_user() properties_list <- get_ga_properties(account_id = accounts$id[1]) property_id <- gsub("properties/", "", properties_list$properties$name[1]) -metrics <- get_ga_stats(property_id, type = "metrics") -dimensions <- get_ga_stats(property_id, type = "dimensions") +metrics <- get_ga_stats(property_id, stats_type = "metrics") +dimensions <- get_ga_stats(property_id, stats_type = "dimensions") } } diff --git a/man/get_ga_user.Rd b/man/get_ga_user.Rd index 77301a6..0310d5f 100644 --- a/man/get_ga_user.Rd +++ b/man/get_ga_user.Rd @@ -4,7 +4,10 @@ \alias{get_ga_user} \title{Get Google Analytics Accounts} \usage{ -get_ga_user() +get_ga_user(request_type = "GET") +} +\arguments{ +\item{request_type}{Is this a GET or a POST?} } \description{ This is a function to get the Google Analytics accounts that this user has access to diff --git a/man/get_github_repo.Rd b/man/get_github.Rd similarity index 63% rename from man/get_github_repo.Rd rename to man/get_github.Rd index 838ca56..22fef41 100644 --- a/man/get_github_repo.Rd +++ b/man/get_github.Rd @@ -1,17 +1,15 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/github.R -\name{get_github_repo} -\alias{get_github_repo} -\title{Get the repository info} +\name{get_github} +\alias{get_github} +\title{Handler function for GET requests from GitHub} \usage{ -get_github_repo(token, owner, repo) +get_github(token = NULL, url) } \arguments{ \item{token}{You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function} -\item{owner}{The owner} - -\item{repo}{The repository} +\item{url}{What is the URL endpoint we are attempting to grab here?} } \value{ Information regarding a github account @@ -19,10 +17,3 @@ Information regarding a github account \description{ This is a function to get the GitHub user's info } -\examples{ -\dontrun{ - -authorize("github") -get_github_repo() -} -} diff --git a/man/get_github_metrics.Rd b/man/get_github_metrics.Rd index 81a1a53..de9917f 100644 --- a/man/get_github_metrics.Rd +++ b/man/get_github_metrics.Rd @@ -2,27 +2,34 @@ % Please edit documentation in R/github.R \name{get_github_metrics} \alias{get_github_metrics} -\title{Get the metrics from GitHub on a repo} +\title{Get the repository metrics} \usage{ -get_github_metrics(token, owner, repo) +get_github_metrics( + repo, + token = NULL, + count = "all", + data_format = "dataframe" +) } \arguments{ +\item{repo}{The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl/metricminer`} + \item{token}{You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function} -\item{owner}{Who is the owner of this account? For example in the repository fhdsl/metricminer, fhdsl is the owner} +\item{count}{How many items would you like to recieve? Put "all" to retrieve all records.} -\item{repo}{What is the repository name? For example in the repository fhdsl/metricminer, "metricminer" is the repo name.} +\item{data_format}{Default is to return a curated data frame. However if you'd like to see the raw information returned from GitHub set format to "raw".} } \value{ Information regarding a github account } \description{ -This is a function to get the GitHub user's info +This is a function to get the information about a repository } \examples{ \dontrun{ authorize("github") -get_github_user() +metrics <- get_github_metrics(repo = "fhdsl/metricminer") } } diff --git a/man/get_github_user.Rd b/man/get_github_user.Rd index ee5aa69..82c3890 100644 --- a/man/get_github_user.Rd +++ b/man/get_github_user.Rd @@ -4,31 +4,20 @@ \alias{get_github_user} \title{Get the GitHub User's info} \usage{ -get_github_user(token) - -get_github_user(token) +get_github_user(token = NULL) } \arguments{ \item{token}{You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function} } \value{ -Information regarding a github account - Information regarding a github account } \description{ -This is a function to get the GitHub user's info - This is a function to get the GitHub user's info } \examples{ \dontrun{ -authorize("github") -get_github_user() -} -\dontrun{ - authorize("github") get_github_user() } diff --git a/man/get_repo_list.Rd b/man/get_repo_list.Rd new file mode 100644 index 0000000..a7317dc --- /dev/null +++ b/man/get_repo_list.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/github.R +\name{get_repo_list} +\alias{get_repo_list} +\title{Retrieve list of repositories for an owner} +\usage{ +get_repo_list(owner, count = "all", token = NULL) +} +\arguments{ +\item{owner}{The owner of the repository. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl`} + +\item{count}{The number of responses that should be returned. Default is 20 or you can say "all" to retrieve all.} + +\item{token}{You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function} +} +\value{ +Information regarding a github account +} +\description{ +This is a function to get the information about a repository +} +\examples{ +\dontrun{ + +authorize("github") +get_repo_list(owner = "fhdsl") +} + +} diff --git a/man/get_repos_metrics.Rd b/man/get_repos_metrics.Rd new file mode 100644 index 0000000..c248183 --- /dev/null +++ b/man/get_repos_metrics.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/github.R +\name{get_repos_metrics} +\alias{get_repos_metrics} +\title{Retrieve metrics for a list of repos} +\usage{ +get_repos_metrics( + owner = NULL, + repo_names = NULL, + token = NULL, + data_format = "dataframe" +) +} +\arguments{ +\item{owner}{The owner of the repository. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl`} + +\item{repo_names}{a character vector of repositories you'd like to collect metrics from.} + +\item{token}{You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function} + +\item{data_format}{Default is to return a curated data frame. However if you'd like to see the raw information returned from GitHub set format to "raw".} +} +\value{ +Information regarding a github account +} +\description{ +This is a function to get metrics for a list of repos. You can provide an owner and attempt retrieve all repos from a +particular organization, or you can provide a character vector of repos like " +} +\examples{ +\dontrun{ + +authorize("github") +all_repos_metrics <- get_repos_metrics(owner = "fhdsl") + +repo_names <- c("fhdsl/metricminer", "jhudsl/OTTR_Template") +some_repos_metrics <- get_repos_metrics(repo_names = repo_names) + +} + +} diff --git a/man/gh_repo_wrapper.Rd b/man/gh_repo_wrapper.Rd new file mode 100644 index 0000000..a1707e4 --- /dev/null +++ b/man/gh_repo_wrapper.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/github.R +\name{gh_repo_wrapper} +\alias{gh_repo_wrapper} +\title{Wrapper function for gh repo calls} +\usage{ +gh_repo_wrapper( + api_call, + owner, + repo, + token = NULL, + count = Inf, + data_format = "dataframe" +) +} +\arguments{ +\item{api_call}{an API call and endpoint like "GET /repos/{owner}/{repo}/activity". That has `owner` and `user`.} + +\item{owner}{The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `fhdsl`} + +\item{repo}{The repository name. So for `https://github.com/fhdsl/metricminer`, it would be `metricminer`} + +\item{token}{You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function} + +\item{count}{How many items would you like to receive? Put "all" to retrieve all records.} + +\item{data_format}{What format should the data be returned in? Default is dataframe. But if you'd like the original raw results, saw "raw".} +} +\value{ +Metrics for a repo on GitHub +} +\description{ +This is a function that wraps up gh calls for us +} diff --git a/man/request_ga.Rd b/man/request_ga.Rd index 84e9b4a..1b5de63 100644 --- a/man/request_ga.Rd +++ b/man/request_ga.Rd @@ -4,7 +4,7 @@ \alias{request_ga} \title{Handler for API requests from Google Analytics} \usage{ -request_ga(token, url, query = NULL, body_params = NULL, type) +request_ga(token, url, query = NULL, body_params = NULL, request_type) } \arguments{ \item{token}{credentials for access to Google using OAuth. `authorize("google")`} @@ -15,7 +15,7 @@ request_ga(token, url, query = NULL, body_params = NULL, type) \item{body_params}{The body parameters for the request} -\item{type}{Is this a GET or a POST?} +\item{request_type}{Is this a GET or a POST?} } \description{ This is a function that handles requests from Google Analytics