diff --git a/DESCRIPTION b/DESCRIPTION index b676ac4..784705a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: googlesheets Title: Manage your Google spreadsheets in R -Version: 0.0.0.9000 +Version: 0.0.0.9001 Description: R API for Google Spreadsheets Authors@R: c( person("Jennifer", "Bryan", , "jenny@stat.ubc.ca", c("aut", "cre")), diff --git a/NAMESPACE b/NAMESPACE index 71a8630..b7654cb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,12 +2,6 @@ S3method(print,googlesheet) S3method(print,googlesheet_ls) -export(add_ws) -export(authorize) -export(copy_ss) -export(delete_ss) -export(delete_ws) -export(download_ss) export(edit_cells) export(extract_key_from_url) export(get_cells) @@ -16,14 +10,23 @@ export(get_row) export(get_via_cf) export(get_via_csv) export(get_via_lf) +export(gs_auth) +export(gs_copy) +export(gs_delete) +export(gs_download) +export(gs_grepdel) +export(gs_key) export(gs_ls) -export(identify_ss) -export(list_sheets) -export(list_ws) -export(new_ss) -export(register_ss) -export(rename_ws) +export(gs_new) +export(gs_title) +export(gs_upload) +export(gs_url) +export(gs_vecdel) +export(gs_ws_delete) +export(gs_ws_feed) +export(gs_ws_ls) +export(gs_ws_new) +export(gs_ws_rename) export(reshape_cf) export(simplify_cf) -export(upload_ss) importFrom(dplyr,"%>%") diff --git a/R/consume-data.R b/R/consume-data.R index c39021b..97753cd 100644 --- a/R/consume-data.R +++ b/R/consume-data.R @@ -24,7 +24,7 @@ #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") #' oceania_csv <- get_via_csv(gap_ss, ws = "Oceania") #' str(oceania_csv) #' oceania_csv @@ -34,14 +34,14 @@ get_via_csv <- function(ss, ws = 1, ..., verbose = TRUE) { stopifnot(ss %>% inherits("googlesheet")) - this_ws <- get_ws(ss, ws, verbose) + this_ws <- gs_ws(ss, ws, verbose) if(is.null(this_ws$exportcsv)) { stop(paste("This appears to be an \"old\" Google Sheet. The old Sheets do", "not offer the API access required by this function.", "Consider converting it from an old Sheet to a new Sheet.", "Or use another data consumption function, such as get_via_lf()", - "or get_via_cf(). Or use download_ss() to export it to a local", + "or get_via_cf(). Or use gs_download() to export it to a local", "file and then read it into R.")) } @@ -94,7 +94,7 @@ get_via_csv <- function(ss, ws = 1, ..., verbose = TRUE) { #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") #' oceania_lf <- get_via_lf(gap_ss, ws = "Oceania") #' str(oceania_lf) #' oceania_lf @@ -105,7 +105,7 @@ get_via_lf <- function(ss, ws = 1, verbose = TRUE) { stopifnot(ss %>% inherits("googlesheet")) - this_ws <- get_ws(ss, ws, verbose) + this_ws <- gs_ws(ss, ws, verbose) req <- gsheets_GET(this_ws$listfeed) ns <- xml2::xml_ns_rename(xml2::xml_ns(req$content), d1 = "feed") @@ -178,7 +178,7 @@ get_via_lf <- function(ss, ws = 1, verbose = TRUE) { #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") #' get_via_cf(gap_ss, "Asia", max_row = 4) #' reshape_cf(get_via_cf(gap_ss, "Asia", max_row = 4)) #' reshape_cf(get_via_cf(gap_ss, "Asia", @@ -195,7 +195,7 @@ get_via_cf <- stopifnot(ss %>% inherits("googlesheet")) - this_ws <- get_ws(ss, ws, verbose) + this_ws <- gs_ws(ss, ws, verbose) if(is.null(limits)) { limits <- list("min-row" = min_row, "max-row" = max_row, @@ -303,7 +303,7 @@ get_via_cf <- #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") #' get_row(gap_ss, "Europe", row = 1) #' simplify_cf(get_row(gap_ss, "Europe", row = 1)) #' } @@ -329,7 +329,7 @@ get_row <- function(ss, ws = 1, row, verbose = TRUE) { #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") #' get_col(gap_ss, "Oceania", col = 1:2) #' reshape_cf(get_col(gap_ss, "Oceania", col = 1:2)) #' } @@ -356,7 +356,7 @@ get_col <- function(ss, ws = 1, col, verbose = TRUE) { #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") #' get_cells(gap_ss, "Europe", range = "B3:D7") #' simplify_cf(get_cells(gap_ss, "Europe", range = "A1:F1")) #' } @@ -382,7 +382,7 @@ get_cells <- function(ss, ws = 1, range, verbose = TRUE) { #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") #' get_via_cf(gap_ss, "Asia", max_row = 4) #' reshape_cf(get_via_cf(gap_ss, "Asia", max_row = 4)) #' } @@ -428,7 +428,7 @@ reshape_cf <- function(x, header = TRUE) { dplyr::select_(~ row, ~ col, ~ cell_text) %>% tidyr::spread_("col", "cell_text", convert = TRUE) %>% dplyr::select_(~ -row) %>% - setNames(var_names) + stats::setNames(var_names) } #' Simplify data from the cell feed @@ -460,7 +460,7 @@ reshape_cf <- function(x, header = TRUE) { #' @examples #' \dontrun{ #' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- register_ss(gap_key) +#' gap_ss <- gs_key(gap_key) #' get_row(gap_ss, row = 1) #' simplify_cf(get_row(gap_ss, row = 1)) #' simplify_cf(get_row(gap_ss, row = 1), notation = "R1C1") diff --git a/R/download-spreadsheets.R b/R/download-spreadsheets.R deleted file mode 100644 index cd87ad3..0000000 --- a/R/download-spreadsheets.R +++ /dev/null @@ -1,109 +0,0 @@ -#' Download a Google spreadsheet -#' -#' Export a Google sheet as a .csv, .pdf, or .xlsx file. You can download a -#' sheet that you own or a sheet owned by a third party that has been made -#' accessible via the sharing dialog options. You can download an entire -#' spreadsheet or a single worksheet from a spreadsheet if you provide worksheet -#' identifying information. If the chosen format is csv, the first worksheet -#' will be exported, unless another worksheet is specified. If pdf format is -#' chosen, all sheets will be catenated into one PDF document. -#' -#' @param from sheet-identifying information, either a googlesheet object or a -#' character vector of length one, giving a URL, sheet title, key or -#' worksheets feed -#' @param key character string guaranteed to provide unique key of the sheet; -#' overrides \code{from} -#' @param ws positive integer or character string specifying index or title, -#' respectively, of the worksheet to export; if \code{NULL} then the entire -#' spreadsheet will be exported -#' @param to path to write file, if it does not contain the absolute path, then -#' the file is relative to the current working directory; file extension must -#' be one of .csv, .pdf, or .xlsx -#' @param overwrite logical indicating whether to overwrite an existing local -#' file -#' @param verbose logical; do you want informative message? -#' -#' @examples -#' \dontrun{ -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' download_ss(gap_key, to = "gapminder.xlsx") -#' file.remove("gapminder.xlsx") -#' } -#' -#' @export -download_ss <- function(from, key = NULL, ws = NULL, to = "my_sheet.xlsx", - overwrite = FALSE, verbose = TRUE) { - - if(is.null(key)) { # figure out the sheet from 'from =' - - if(!inherits(from, "googlesheet")) { - from <- from %>% identify_ss() - } - if(is.na(from$alt_key)) { ## this is a "new" sheet - key <- from$sheet_key - } else { ## this is an "old" sheet - key <- from$alt_key - } - title <- from$sheet_title - } # otherwise ... take key at face value - - ext <- tools::file_ext(to) - if(!(ext %in% c("csv", "pdf", "xlsx"))) { - stop(sprintf("Cannot download Google spreadsheet as this format: %s", ext)) - } - - # export a single worksheet - if(!is.null(ws)) { - - this_ws <- register_ss(key = key, verbose = FALSE) %>% get_ws(ws) -# if(!inherits(from, "googlesheet")) { -# this_ws <- register_ss(key, verbose = FALSE) %>% get_ws(ws) -# } else { -# this_ws <- from %>% get_ws(ws) -# } - - export_links <- c( - csv = this_ws$exportcsv, - pdf = httr::modify_url(this_ws$exportcsv, query = list(format = "pdf")), - xlsx = httr::modify_url(this_ws$exportcsv, query = list(format = "xlsx"))) - } else { - # get export links for entire spreadsheet - the_url <- - paste("https://www.googleapis.com/drive/v2/files", key, sep = "/") - - req <- gdrive_GET(the_url) - export_links <- c( - csv = req$content$exportLinks$'text/csv', # first sheet only - pdf = req$content$exportLinks$'application/pdf', - xlsx = req$content$exportLinks$'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') - } - - ext_match <- grepl(ext, names(export_links)) - if(any(ext_match)) { - link <- export_links %>% `[[`(ext) - } else { - mess <- sprintf(paste("Download as a %s file is not supported for this", - "sheet. Is this perhaps an \"old\" Google Sheet?"), - ext) - stop(mess) - } - - if (interactive()) { - gdrive_GET(link, httr::write_disk(to, overwrite = overwrite), - httr::progress()) - } else { - gdrive_GET(link, httr::write_disk(to, overwrite = overwrite)) - } - - if(file.exists(to)) { - - if(verbose) { - message(sprintf("Sheet successfully downloaded: %s", normalizePath(to))) - } - - } else { - - stop(sprintf("Cannot confirm the file download :(")) - - } -} diff --git a/R/edit-data.R b/R/edit-data.R index 7ec2d7d..f2b61c0 100644 --- a/R/edit-data.R +++ b/R/edit-data.R @@ -27,15 +27,15 @@ #' #' @examples #' \dontrun{ -#' yo <- new_ss("yo") +#' yo <- gs_new("yo") #' yo <- edit_cells(yo, input = head(iris), header = TRUE, trim = TRUE) #' get_via_csv(yo) #' -#' yo <- add_ws(yo, "byrow_FALSE") +#' yo <- gs_ws_new(yo, "byrow_FALSE") #' yo <- edit_cells(yo, ws = "byrow_FALSE", LETTERS[1:5], "A8") #' get_via_cf(yo, ws = "byrow_FALSE", min_row = 7) %>% simplify_cf() #' -#' yo <- add_ws(yo, "byrow_TRUE") +#' yo <- gs_ws_new(yo, "byrow_TRUE") #' yo <- edit_cells(yo, ws = "byrow_TRUE", LETTERS[1:5], "A8", byrow = TRUE) #' get_via_cf(yo, ws = "byrow_TRUE", min_row = 7) %>% simplify_cf() #' } @@ -46,7 +46,7 @@ edit_cells <- function(ss, ws = 1, input = '', anchor = 'A1', verbose = TRUE) { catch_hopeless_input(input) - this_ws <- get_ws(ss, ws, verbose = FALSE) + this_ws <- gs_ws(ss, ws, verbose = FALSE) limits <- @@ -65,10 +65,10 @@ edit_cells <- function(ss, ws = 1, input = '', anchor = 'A1', if(limits$`max-row` > this_ws$row_extent || limits$`max-col` > this_ws$col_extent) { ss <- ss %>% - resize_ws(this_ws$ws_title, - max(this_ws$row_extent, limits$`max-row`), - max(this_ws$col_extent, limits$`max-col`), - verbose) + gs_ws_resize(this_ws$ws_title, + max(this_ws$row_extent, limits$`max-row`), + max(this_ws$col_extent, limits$`max-col`), + verbose) Sys.sleep(1) } @@ -136,11 +136,12 @@ edit_cells <- function(ss, ws = 1, input = '', anchor = 'A1', Sys.sleep(1) ss <- ss %>% - resize_ws(this_ws$ws_title, limits$`max-row`, limits$`max-col`, verbose) + gs_ws_resize(this_ws$ws_title, limits$`max-row`, + limits$`max-col`, verbose) } Sys.sleep(1) - ss <- ss %>% register_ss(verbose = FALSE) + ss <- ss$sheet_key %>% gs_key(verbose = FALSE) invisible(ss) } diff --git a/R/edit-spreadsheets.R b/R/edit-spreadsheets.R deleted file mode 100644 index 49458ae..0000000 --- a/R/edit-spreadsheets.R +++ /dev/null @@ -1,619 +0,0 @@ -#' Create a new spreadsheet -#' -#' Create a new (empty) spreadsheet in your Google Drive. The new sheet will -#' contain 1 default worksheet titled "Sheet1". -#' -#' @param title the title for the new sheet -#' @param verbose logical; do you want informative message? -#' -#' @return a googlesheet object -#' -#' @examples -#' \dontrun{ -#' foo <- new_ss("foo") -#' foo -#' } -#' -#' @export -new_ss <- function(title = "my_sheet", verbose = TRUE) { - - ## TO DO? warn if sheet with same title alredy exists? - ## right now we proceed quietly, because sheet is identified by key - - the_body <- list(title = title, - mimeType = "application/vnd.google-apps.spreadsheet") - - req <- - gdrive_POST(url = "https://www.googleapis.com/drive/v2/files", - body = the_body) - - new_sheet_key <- httr::content(req)$id - ## I set verbose = FALSE here because it seems weird to message "Spreadsheet - ## identified!" in this context, esp. to do so *before* message confirming - ## creation - ss <- identify_ss(new_sheet_key, verbose = FALSE) - - if(verbose) { - message(sprintf("Sheet \"%s\" created in Google Drive.", ss$sheet_title)) - } - - ss %>% - register_ss() %>% - invisible() - -} - -#' Move spreadsheets to trash on Google Drive -#' -#' You must own a sheet in order to move it to the trash. If you try to delete a -#' sheet you do not own, a 403 Forbidden HTTP status code will be returned; such -#' shared spreadsheets can only be moved to the trash manually in the web -#' browser. If you trash a spreadsheet that is shared with others, it will no -#' longer appear in any of their Google Drives. If you delete something by -#' mistake, remain calm, and visit the -#' \href{https://drive.google.com/drive/#trash}{trash in Google Drive}, find the -#' sheet, and restore it. -#' -#' @param x sheet-identifying information, either a googlesheet object or a -#' character vector of length one, giving a URL, sheet title, key or -#' worksheets feed; if \code{x} is specified, the \code{regex} argument will -#' be ignored -#' @param regex character; a regular expression; sheets whose titles match will -#' be deleted -#' @param ... optional arguments to be passed to \code{\link{grepl}} when -#' matching \code{regex} to sheet titles -#' @param verbose logical; do you want informative message? -#' -#' @return tbl_df with one row per specified or matching sheet, a variable -#' holding spreadsheet titles, a logical vector indicating deletion success -#' -#' @note If there are multiple sheets with the same name and you don't want to -#' delete them all, identify the sheet to be deleted via key. -#' -#' @examples -#' \dontrun{ -#' foo <- new_ss("foo") -#' foo <- edit_cells(foo, input = head(iris)) -#' delete_ss("foo") -#' } -#' -#' @export -delete_ss <- function(x = NULL, regex = NULL, verbose = TRUE, ...) { - - ## this can be cleaned up once identify_ss() becomes less rigid - - if(!is.null(x)) { - - ## I set verbose = FALSE here mostly for symmetry with new_ss - x_ss <- x %>% - identify_ss(verbose = FALSE) - # this will throw error if no sheet is uniquely identified; tolerate for - # now, but once identify_ss() is revised, add something here to test whether - # we've successfully identified at least one sheet for deletion; to delete - # multiple sheets or avoid error in case of no sheets, current workaround is - # to use the regex argument - if(is.na(x_ss$alt_key)) { ## this is a "new" sheet - keys_to_delete <- x_ss$sheet_key - } else { ## this is an "old" sheet - keys_to_delete <- x_ss$alt_key - } - titles_to_delete <- x_ss$sheet_title - - } else { - - if(is.null(regex)) { - - stop("You must specify which sheet(s) to delete.") - - } else { - - ss_df <- gs_ls() - delete_me <- grepl(regex, ss_df$sheet_title, ...) - keys_to_delete <- - ifelse(ss_df$version == "new", ss_df$sheet_key, - ss_df$alt_key)[delete_me] - titles_to_delete <- ss_df$sheet_title[delete_me] - - if(length(titles_to_delete) == 0L) { - if(verbose) { - sprintf("No matching sheets found.") %>% - message() - } - return(invisible(NULL)) - } - } - } - - if(verbose) { - sprintf("Sheets found and slated for deletion:\n%s", - titles_to_delete %>% - paste(collapse = "\n")) %>% - message() - } - - the_url <- paste("https://www.googleapis.com/drive/v2/files", - keys_to_delete, "trash", sep = "/") - - post <- lapply(the_url, gdrive_POST, body = NULL) - statii <- vapply(post, `[[`, FUN.VALUE = integer(1), "status_code") - sitrep <- - dplyr::data_frame_(list(ss_title = ~ titles_to_delete, - deleted = ~(statii == 200))) - - if(verbose) { - if(all(sitrep$deleted)) { - message("Success. All moved to trash in Google Drive.") - } else { - sprintf("Oops. These sheets were NOT deleted:\n%s", - sitrep$ss_title[!sitrep$deleted] %>% - paste(collapse = "\n")) %>% - message() - } - } - - sitrep %>% invisible() - -} - - -#' Make a copy of an existing spreadsheet -#' -#' You can copy a spreadsheet that you own or a sheet owned by a third party -#' that has been made accessible via the sharing dialog options. If the sheet -#' you want to copy is visible in the listing provided by -#' \code{\link{gs_ls}}, you can specify it by title (or any of the other -#' spreadsheet-identifying methods). Otherwise, you'll have to explicitly -#' specify it by key. -#' -#' @param from sheet-identifying information, either a googlesheet object or a -#' character vector of length one, giving a URL, sheet title, key or -#' worksheets feed -#' @param key character string guaranteed to provide unique key of the sheet; -#' overrides \code{from} -#' @param to character string giving the new title of the sheet; if \code{NULL}, -#' then the copy will be titled "Copy of ..." -#' @param verbose logical; do you want informative message? -#' -#' @note if two sheets with the same name exist in your Google drive then sheet -#' with the most recent "last updated" timestamp will be copied. -#' -#' @seealso \code{\link{identify_ss}}, \code{\link{extract_key_from_url}} -#' -#' @examples -#' \dontrun{ -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "Gapminder_copy") -#' gap_ss -#' } -#' -#' @export -copy_ss <- function(from, key = NULL, to = NULL, verbose = TRUE) { - - if(is.null(key)) { # figure out the sheet from 'from =' - from_ss <- from %>% identify_ss() - if(is.na(from_ss$alt_key)) { ## this is a "new" sheet - key <- from_ss$sheet_key - } else { ## this is an "old" sheet - key <- from_ss$alt_key - } - title <- from_ss$sheet_title - } else { # else ... take key at face value - title <- key - } - - the_body <- list("title" = to) - - the_url <- - paste("https://www.googleapis.com/drive/v2/files", key, "copy", sep = "/") - - req <- gdrive_POST(the_url, body = the_body) - - new_title <- httr::content(req)$title - - ## see new_ss() for why I set verbose = FALSE here - new_ss <- try(new_title %>% identify_ss(verbose = FALSE), silent = TRUE) - - cannot_find_sheet <- inherits(new_ss, "try-error") - - if(verbose) { - if(cannot_find_sheet) { - message("Cannot verify whether spreadsheet copy was successful.") - } else { - message(sprintf("Successful copy! New sheet is titled \"%s\".", - new_ss$sheet_title)) - } - } - - if(cannot_find_sheet) { - invisible(NULL) - } else { - new_ss %>% - register_ss(verbose = verbose) %>% - invisible() - } - -} - -#' Add a new (empty) worksheet to spreadsheet -#' -#' Add a new (empty) worksheet to spreadsheet: specify title and worksheet -#' extent (number of rows and columns). The title of the new worksheet can not -#' be the same as any existing worksheets in the sheet. -#' -#' @param ss a registered Google sheet -#' @param ws_title character string for title of new worksheet -#' @param nrow number of rows (default is 1000) -#' @param ncol number of columns (default is 26) -#' @param verbose logical; do you want informative message? -#' -#' @return a googlesheet object, resulting from re-registering the host -#' spreadsheet after adding the new worksheet -#' -#' @examples -#' \dontrun{ -#' # get a copy of the Gapminder spreadsheet -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "Gapminder_copy") -#' gap_ss <- add_ws(gap_ss, ws_title = "Atlantis") -#' gap_ss -#' } -#' -#' @export -add_ws <- function(ss, ws_title = "Sheet1", - nrow = 1000, ncol = 26, verbose = TRUE) { - - stopifnot(ss %>% inherits("googlesheet")) - - ws_title_exist <- ws_title %in% list_ws(ss) - - if(ws_title_exist) { - stop(sprintf(paste("A worksheet titled \"%s\" already exists, please", - "choose a different name."), ws_title)) - } - - the_body <- - XML::xmlNode("entry", - namespaceDefinitions = - c("http://www.w3.org/2005/Atom", - gs = "http://schemas.google.com/spreadsheets/2006"), - XML::xmlNode("title", ws_title), - XML::xmlNode("gs:rowCount", nrow), - XML::xmlNode("gs:colCount", ncol)) - - the_body <- XML::toString.XMLNode(the_body) - - req <- gsheets_POST(ss$ws_feed, the_body) - - ss_refresh <- ss %>% register_ss(verbose = FALSE) - - ws_title_exist <- ws_title %in% list_ws(ss_refresh) - - if(verbose) { - if(ws_title_exist) { - message(sprintf("Worksheet \"%s\" added to sheet \"%s\".", - ws_title, ss_refresh$sheet_title)) - } else { - message(sprintf(paste("Cannot verify whether worksheet \"%s\" was added", - "to sheet \"%s\"."), ws_title, - ss_refresh$sheet_title)) - } - } - - if(ws_title_exist) { - ss_refresh %>% invisible() - } else { - NULL - } - -} - -#' Delete a worksheet from a spreadsheet -#' -#' The worksheet and all of its contents will be removed from the spreadsheet. -#' -#' @inheritParams get_via_lf -#' @param verbose logical; do you want informative message? -#' -#' @examples -#' \dontrun{ -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") -#' list_ws(gap_ss) -#' gap_ss <- add_ws(gap_ss, "new_stuff") -#' gap_ss <- edit_cells(gap_ss, "new_stuff", input = head(iris), header = TRUE, -#' trim = TRUE) -#' gap_ss -#' gap_ss <- delete_ws(gap_ss, "new_stuff") -#' list_ws(gap_ss) -#' gap_ss <- delete_ws(gap_ss, ws = 3) -#' list_ws(gap_ss) -#' delete_ss(gap_ss) -#' } -#' -#' @export -delete_ws <- function(ss, ws = 1, verbose = TRUE) { - - stopifnot(ss %>% inherits("googlesheet")) - - this_ws <- ss %>% get_ws(ws) - - req <- gsheets_DELETE(this_ws$ws_id) - - ss_refresh <- ss %>% register_ss(verbose = FALSE) - - ws_title_exist <- this_ws$ws_title %in% list_ws(ss_refresh) - - if(verbose) { - if(ws_title_exist) { - message(sprintf(paste("Cannot verify whether worksheet \"%s\" was", - "deleted from sheet \"%s\"."), - this_ws$ws_title, ss_refresh$sheet_title)) - } else { - message(sprintf("Worksheet \"%s\" deleted from sheet \"%s\".", - this_ws$ws_title, ss$sheet_title)) - } - } - - if(ws_title_exist) { - NULL - } else { - ss_refresh %>% invisible() - } - -} - -#' Rename a worksheet -#' -#' Give a worksheet a new title that does not duplicate the title of any -#' existing worksheet within the spreadsheet. -#' -#' @param ss a registered Google sheet -#' @param from positive integer or character string specifying index or title, -#' respectively, of the worksheet -#' @param to character string for new title of worksheet -#' @param verbose logical; do you want informative message? -#' -#' @note Since the edit link is used in the PUT request, the version path in the -#' url changes everytime changes are made to the worksheet, hence consecutive -#' function calls using the same edit link from the same sheet object without -#' 'refreshing' it by re-registering results in a HTTP 409 Conflict. -#' -#' @examples -#' \dontrun{ -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- copy_ss(key = gap_key, to = "gap_copy") -#' list_ws(gap_ss) -#' gap_ss <- rename_ws(gap_ss, from = "Oceania", to = "ANZ") -#' list_ws(gap_ss) -#' gap_ss <- rename_ws(gap_ss, from = 1, to = "I am the first sheet!") -#' list_ws(gap_ss) -#' delete_ss(gap_ss) -#' } -#' -#' @export -rename_ws <- function(ss, from = 1, to, verbose = TRUE) { - - stopifnot(ss %>% inherits("googlesheet")) - - this_ws <- ss %>% get_ws(from) - from_title <- this_ws$ws_title - - req <- modify_ws(ss, from = from, to = to) - ## req carries updated info about the affected worksheet ... but I find it - ## easier to just re-register the spreadsheet - - Sys.sleep(1) - ss_refresh <- ss %>% register_ss(verbose = FALSE) - - from_is_gone <- !(from_title %in% list_ws(ss_refresh)) - to_is_there <- to %in% list_ws(ss_refresh) - - if(verbose) { - if(from_is_gone && to_is_there) { - message(sprintf("Worksheet \"%s\" renamed to \"%s\".", from_title, to)) - } else { - message(sprintf(paste("Cannot verify whether worksheet \"%s\" was", - "renamed to \"%s\"."), from_title, to)) - } - } - - if(from_is_gone && to_is_there) { - ss_refresh %>% invisible() - } else { - NULL - } - -} - -#' Resize a worksheet -#' -#' Set the number of rows and columns of a worksheet. We use this function -#' internally during cell updates, if the data would exceed the current -#' worksheet extent. It is possible a user might want to use this directly? -#' -#' @inheritParams get_via_lf -#' @param row_extent integer for new row extent -#' @param col_extent integer for new column extent -#' @param verbose logical; do you want informative message? -#' -#' @note Setting rows and columns to less than the current worksheet dimensions -#' will delete contents without warning! -#' -#' @examples -#' \dontrun{ -#' yo <- new_ss("yo") -#' yo <- edit_cells(yo, input = head(iris), header = TRUE, trim = TRUE) -#' get_via_csv(yo) -#' yo <- resize_ws(yo, ws = "Sheet1", row_extent = 5, col_extent = 4) -#' get_via_csv(yo) -#' yo <- resize_ws(yo, ws = 1, row_extent = 3, col_extent = 3) -#' get_via_csv(yo) -#' yo <- resize_ws(yo, row_extent = 2, col_extent = 2) -#' get_via_csv(yo) -#' delete_ss(yo) -#' } -#' -#' @keywords internal -resize_ws <- function(ss, ws = 1, - row_extent = NULL, col_extent = NULL, verbose = TRUE) { - - stopifnot(ss %>% inherits("googlesheet")) - - this_ws <- ss %>% get_ws(ws, verbose) - - # if row or col extent not specified, make it the same as before - if(is.null(row_extent)) { - row_extent <- this_ws$row_extent - } - if(is.null(col_extent)) { - col_extent <- this_ws$col_extent - } - - req <- - modify_ws(ss, ws, - new_dim = c(row_extent = row_extent, col_extent = col_extent)) - - new_row_extent <- req$content$rowCount %>% as.integer() - new_col_extent <- req$content$colCount %>% as.integer() - - success <- all.equal(c(new_row_extent, new_col_extent), - c(row_extent, col_extent)) - - if(verbose && success) { - message(sprintf("Worksheet \"%s\" dimensions changed to %d x %d.", - this_ws$ws_title, new_row_extent, new_col_extent)) - } - - if(success) { - ss %>% - register_ss(verbose = FALSE) %>% - invisible() - } else{ - NULL - } -} - -#' Modify a worksheet's title or size -#' -#' @inheritParams get_via_lf - -#' @param ss a registered Google sheet -#' @param from positive integer or character string specifying index or title, -#' respectively, of the worksheet -#' @param to character string for new title of worksheet -#' @param new_dim list of length 2 specifying the row and column extent of the -#' worksheet -#' -#' @keywords internal -modify_ws <- function(ss, from, to = NULL, new_dim = NULL) { - - stopifnot(ss %>% inherits("googlesheet")) - - this_ws <- ss %>% get_ws(from, verbose = FALSE) - - req <- gsheets_GET(this_ws$ws_id, to_xml = FALSE) - contents <- req$content - - if(!is.null(to)) { # our purpose is to rename a worksheet - - if(to %in% list_ws(ss)) { - stop(sprintf(paste("A worksheet titled \"%s\" already exists in sheet", - "\"%s\". Please choose another worksheet title."), - to, ss$sheet_title)) - } - - ## TO DO: we should probably be doing something more XML-y here, instead - ## of doing XML --> string --> regex based subsitution --> XML - title_replacement <- paste0("\\1", to, "\\3") - the_body <- contents %>% - sub("()(.*)()", title_replacement, .) - } - - if(!is.null(new_dim)) { # our purpose is to resize a worksheet - - row_replacement <- paste0("\\1", new_dim["row_extent"], "\\3") - col_replacement <- paste0("\\1", new_dim["col_extent"], "\\3") - - the_body <- contents %>% - sub("()(.*)()", row_replacement, .) %>% - sub("()(.*)()", col_replacement, .) - } - - gsheets_PUT(this_ws$edit, the_body) - -} - -#' Upload a file and convert it to a Google Sheet -#' -#' Google supports the following file types to be converted to a Google -#' spreadsheet: .xls, .xlsx, .csv, .tsv, .txt, .tab, .xlsm, .xlt, .xltx, .xltm, -#' .ods. The newly uploaded file will appear in the top level of your Google -#' Sheets home screen. -#' -#' @param file the file to upload, if it does not contain the absolute path, -#' then the file is relative to the current working directory -#' @param sheet_title the title of the spreadsheet; optional, -#' if not specified then the name of the file will be used -#' @param verbose logical; do you want informative message? -#' -#' @examples -#' \dontrun{ -#' write.csv(head(iris, 5), "iris.csv", row.names = FALSE) -#' iris_ss <- upload_ss("iris.csv") -#' iris_ss -#' get_via_lf(iris_ss) -#' file.remove("iris.csv") -#' delete_ss(iris_ss) -#' } -#' -#' @export -upload_ss <- function(file, sheet_title = NULL, verbose = TRUE) { - - if(!file.exists(file)) { - stop(sprintf("\"%s\" does not exist!", file)) - } - - ext <- c("xls", "xlsx", "csv", "tsv", "txt", "tab", "xlsm", "xlt", - "xltx", "xltm", "ods") - - if(!(tools::file_ext(file) %in% ext)) { - stop(sprintf(paste("Cannot convert file with this extension to a Google", - "Spreadsheet: %s"), tools::file_ext(file))) - } - - if(is.null(sheet_title)) { - sheet_title <- file %>% basename() %>% tools::file_path_sans_ext() - } - - req <- - gdrive_POST(url = "https://www.googleapis.com/drive/v2/files", - body = list(title = sheet_title, - mimeType = "application/vnd.google-apps.spreadsheet")) - - new_sheet_key <- httr::content(req)$id - - # append sheet_key to put_url - put_url <- httr::modify_url("https://www.googleapis.com/", - path = paste0("upload/drive/v2/files/", - new_sheet_key)) - - gdrive_PUT(put_url, the_body = file) - - ss_df <- gs_ls() - success <- new_sheet_key %in% ss_df$sheet_key - - if(success) { - if(verbose) { - message(sprintf(paste("\"%s\" uploaded to Google Drive and converted", - "to a Google Sheet named \"%s\""), - basename(file), sheet_title)) - } - } else { - stop(sprintf("Cannot confirm the file upload :(")) - } - - new_sheet_key %>% - register_ss(verbose = FALSE) %>% - invisible() - -} diff --git a/R/print.R b/R/googlesheet-print.R similarity index 55% rename from R/print.R rename to R/googlesheet-print.R index a701854..f15f5e6 100644 --- a/R/print.R +++ b/R/googlesheet-print.R @@ -1,30 +1,32 @@ -#' Print information about a Google spreadsheet registered with googlesheets -#' -#' Display information about a Google spreadsheet that has been registered with -#' \code{googlesheets}: the title of the spreadsheet, date-time of registration, -#' date-time of last update (at time of registration), the number of worksheets -#' contained, worksheet titles and extent, and sheet key. -#' -#' @param x googlesheet object returned by \code{register_ss} and other -#' \code{googlesheets} functions +#' Print information about a Google Sheet registered with \code{googlesheets} +#' +#' Display information about a Google spreadsheet that has been registered with +#' \code{googlesheets}: the title of the spreadsheet, date-time of registration, +#' date-time of last update (at time of registration), visibility, permissions, +#' version, the number of worksheets contained, worksheet titles and extent, and +#' sheet key. +#' +#' @param x \code{\link{googlesheet}} object returned by functions such as \code{\link{gs_title}}, \code{\link{gs_key}}, and friends #' @param ... potential further arguments (required for Method/Generic reasons) #' #' @examples #' \dontrun{ -#' foo <- new_ss("foo") +#' foo <- gs_new("foo") #' foo #' print(foo) #' } #' #' @export -print.googlesheet <- function(x, ...) { - +print.googlesheet <- function(x, ...) { + sprintf(" Spreadsheet title: %s\n", x$sheet_title) %>% cat() - sprintf(" Date of googlesheets::register_ss: %s\n", - x$get_date %>% format.POSIXct(usetz = TRUE)) %>% cat() + sprintf(" Date of googlesheets registration: %s\n", + x$reg_date %>% format.POSIXct(usetz = TRUE)) %>% cat() sprintf(" Date of last spreadsheet update: %s\n", x$updated %>% format.POSIXct(usetz = TRUE)) %>% cat() sprintf(" visibility: %s\n", x$visibility) %>% cat() + sprintf(" permissions: %s\n", x$perm) %>% cat() + sprintf(" version: %s\n", x$version) %>% cat() cat("\n") ws_output <- diff --git a/R/googlesheet.R b/R/googlesheet.R index 8345944..31c6885 100644 --- a/R/googlesheet.R +++ b/R/googlesheet.R @@ -1,53 +1,135 @@ -#' The googlesheet object -#' -#' The googlesheet object stores information that \code{googlesheets} requires in -#' order to communicate with the -#' \href{https://developers.google.com/google-apps/spreadsheets/}{Google Sheets -#' API}. -#' -#' Very little of this is of interest to the user. A googlesheet object -#' includes the fields: -#' -#' \itemize{ -#' \item \code{sheet_key} the key of the spreadsheet -#' \item \code{sheet_title} the title of the spreadsheet -#' \item \code{n_ws} the number of worksheets contained in the spreadsheet -#' \item \code{ws_feed} the "worksheets feed" of the spreadsheet -#' \item \code{sheet_id} the id of the spreadsheet -#' \item \code{updated} the time of last update (at time of registration) -#' \item \code{get_date} the time of registration -#' \item \code{visibility} visibility of spreadsheet (Google's confusing -#' vocabulary); actually, does not describe a property of spreadsheet itself but -#' rather whether requests will be made with or without authentication -#' \item \code{is_public} logical indicating visibility is "public", as opposed to "private" -#' \item \code{author_name} the name of the owner -#' \item \code{author_email} the email of the owner -#' \item \code{links} data.frame of links specific to the spreadsheet -#' \item \code{ws} a data.frame about the worksheets contained in the -#' spreadsheet -#' \item \code{alt_key} alternate key; applies only to "old" sheets -#' } -#' -#' TO DO: this documentation is neither here nor there. Either the object is -#' self-explanatory and this isn't really needed. Or this needs to get beefed -#' up. Probably the latter. -#' -#' @name googlesheet +## nothing here is exported +## where do googlesheet objects come from? +## from the user-facing sheet registration functions in gs_register.R: +## gs_title(), gs_key(), gs_url(), gs_ws_feed() +## in all cases, sheet-identifying info is parlayed into a ws_feed +## then as.googlesheet.ws_feed() gets called to register the sheet +## and produce a googlesheet object + googlesheet <- function() { structure(list(sheet_key = character(), sheet_title = character(), n_ws = integer(), ws_feed = character(), - sheet_id = character(), updated = character() %>% as.POSIXct(), - get_date = character() %>% as.POSIXct(), + reg_date = character() %>% as.POSIXct(), visibility = character(), is_public = logical(), - author_name = character(), - author_email = character(), + author = character(), + email = character(), + perm = character(), + version = character(), links = character(), # initialize as data.frame? ws = list(), + ## from the spreadsheets feed alt_key = NA_character_), class = c("googlesheet", "list")) +} + +as.googlesheet <- + function(x, ssf = NULL, verbose = TRUE, ...) UseMethod("as.googlesheet") + +as.googlesheet.ws_feed <- function(x, ssf = NULL, verbose = TRUE, ...) { + + req <- gsheets_GET(x) + + if(grepl("html", req$headers[["content-type"]])) { + ## TO DO: give more specific error message. Have they said "public" when + ## they meant "private" or vice versa? What's the actual problem and + ## solution? + stop("Please check visibility settings.") + } + + ns <- xml2::xml_ns_rename(xml2::xml_ns(req$content), d1 = "feed") + + ss <- googlesheet() + + ss$sheet_key <- req$url %>% extract_key_from_url() + ss$sheet_title <- req$content %>% + xml2::xml_find_one("./feed:title", ns) %>% xml2::xml_text() + ss$n_ws <- req$content %>% + xml2::xml_find_one("./openSearch:totalResults", ns) %>% xml2::xml_text() %>% + as.integer() + + ss$ws_feed <- req$url # same as the "self" link below ... pick one? + + ss$updated <- req$headers$`last-modified` %>% httr::parse_http_date() + ss$reg_date <- req$headers$date %>% httr::parse_http_date() + + ss$visibility <- req$url %>% dirname() %>% basename() + ss$is_public <- ss$visibility == "public" + + ss$author <- req$content %>% + xml2::xml_find_one("./feed:author/feed:name", ns) %>% xml2::xml_text() + ss$email <- req$content %>% + xml2::xml_find_one("./feed:author/feed:email", ns) %>% xml2::xml_text() + + ss$perm <- ss$ws_feed %>% + stringr::str_detect("values") %>% + ifelse("r", "rw") + ss$version <- "old" ## we revise this once we get the links, below ... + + links <- req$content %>% xml2::xml_find_all("./feed:link", ns) + ss$links <- dplyr::data_frame_(list( + rel = ~ links %>% xml2::xml_attr("rel"), + type = ~ links %>% xml2::xml_attr("type"), + href = ~ links %>% xml2::xml_attr("href") + )) + + if(grepl("^https://docs.google.com/spreadsheets/d", + ss$links$href[ss$links$rel == "alternate"])) { + ss$version <- "new" + } + + ws <- req$content %>% xml2::xml_find_all("./feed:entry", ns) + ws_info <- dplyr::data_frame_(list( + ws_id = ~ ws %>% xml2::xml_find_all("feed:id", ns) %>% xml2::xml_text(), + ws_key = ~ ws_id %>% basename(), + ws_title = + ~ ws %>% xml2::xml_find_all("feed:title", ns) %>% xml2::xml_text(), + row_extent = + ~ ws %>% xml2::xml_find_all("gs:rowCount", ns) %>% + xml2::xml_text() %>% as.integer(), + col_extent = + ~ ws %>% xml2::xml_find_all("gs:colCount", ns) %>% + xml2::xml_text() %>% as.integer() + )) + + ## use the first worksheet to learn about the links available + ## why we do this? + ## because the 'edit' link will not be available for sheets accessed via + ## public visibility or to which user does not have write permission + link_rels <- ws[1] %>% + xml2::xml_find_all("feed:link", ns) %>% + xml2::xml_attrs() %>% + vapply(`[`, FUN.VALUE = character(1), "rel") + ## here's what we expect here + # [1] "http://schemas.google.com/spreadsheets/2006#listfeed" + # [2] "http://schemas.google.com/spreadsheets/2006#cellsfeed" + # [3] "http://schemas.google.com/visualization/2008#visualizationApi" + # [4] "http://schemas.google.com/spreadsheets/2006#exportcsv" + # [5] "self" + # [6] "edit" <-- absent in some cases + names(link_rels) <- + link_rels %>% basename() %>% gsub("200[[:digit:]]\\#", '', .) + ## here's what we expect here + ## "listfeed" "cellsfeed" "visualizationApi" "exportcsv" "self" ?"edit"? + + ws_links <- ws %>% xml2::xml_find_all("feed:link", ns) + ws_links <- lapply(link_rels, function(x) { + xpath <- paste0("../*[@rel='", x, "']") + ws_links %>% + xml2::xml_find_all(xpath, ns) %>% + xml2::xml_attr("href") + }) %>% + dplyr::as_data_frame() + + ss$ws <- dplyr::bind_cols(ws_info, ws_links) + + if(!is.null(ssf)) { + ss$alt_key <- ssf$alt_key + } + + ss } diff --git a/R/auth.R b/R/gs-auth.R similarity index 97% rename from R/auth.R rename to R/gs-auth.R index acb6114..09518b0 100644 --- a/R/auth.R +++ b/R/gs-auth.R @@ -17,7 +17,7 @@ #' Google account. #' #' @export -authorize <- function(new_user = FALSE) { +gs_auth <- function(new_user = FALSE) { if(new_user && file.exists(".httr-oauth")) { message("Removing old credentials ...") @@ -57,7 +57,7 @@ authorize <- function(new_user = FALSE) { get_google_token <- function() { if(is.null(.state$token)) { - authorize() + gs_auth() } httr::config(token = .state$token) diff --git a/R/gs_copy.R b/R/gs_copy.R new file mode 100644 index 0000000..fd10b42 --- /dev/null +++ b/R/gs_copy.R @@ -0,0 +1,58 @@ +#' Copy of an existing spreadsheet +#' +#' You can copy a spreadsheet that you own or a sheet owned by a third party +#' that has been made accessible via the sharing dialog options. This function +#' calls the \href{https://developers.google.com/drive/v2/reference/}{Google +#' Drive API}. +#' +#' @param from a \code{\link{googlesheet}} object, i.e. a registered Google +#' sheet +#' @param to character string giving the new title of the sheet; if \code{NULL}, +#' then the copy will be titled "Copy of ..." +#' @param verbose logical; do you want informative message? +#' +#' @examples +#' \dontrun{ +#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +#' gap_ss <- gs_copy(gs_key(gap_key), to = "Gapminder_copy") +#' gap_ss +#' } +#' +#' @export +gs_copy <- function(from, to = NULL, verbose = TRUE) { + + stopifnot(inherits(from, "googlesheet")) + + key <- gs_get_alt_key(from) + title <- from$sheet_title + + the_body <- list("title" = to) + + the_url <- + paste("https://www.googleapis.com/drive/v2/files", key, "copy", sep = "/") + + req <- gdrive_POST(the_url, body = the_body) + + new_title <- httr::content(req)$title + + new_ss <- try(gs_title(new_title, verbose = FALSE), silent = TRUE) + + cannot_find_sheet <- inherits(new_ss, "try-error") + + if(verbose) { + if(cannot_find_sheet) { + message("Cannot verify whether spreadsheet copy was successful.") + } else { + message(sprintf("Successful copy! New sheet is titled \"%s\".", + new_ss$sheet_title)) + } + } + + if(cannot_find_sheet) { + invisible(NULL) + } else { + new_ss %>% + invisible() + } + +} diff --git a/R/gs_delete.R b/R/gs_delete.R new file mode 100644 index 0000000..5aefea8 --- /dev/null +++ b/R/gs_delete.R @@ -0,0 +1,132 @@ +#' Delete a spreadsheet +#' +#' Move a spreadsheet to trash on Google Drive. You must own a sheet in order to +#' move it to the trash. If you try to delete a sheet you do not own, a 403 +#' Forbidden HTTP status code will be returned; third party spreadsheets can +#' only be moved to the trash manually in the web browser (which only removes +#' them from your Google Sheets home screen, in any case). If you trash a +#' spreadsheet that is shared with others, it will no longer appear in any of +#' their Google Drives. If you delete something by mistake, remain calm, and +#' visit the \href{https://drive.google.com/drive/#trash}{trash in Google +#' Drive}, find the sheet, and restore it. +#' +#' @param x a \code{\link{googlesheet}} object, i.e. a registered Google sheet +#' @param verbose logical; do you want informative message? +#' +#' @return logical indicating if the deletion was successful +#' +#' @seealso \code{\link{gs_grepdel}} and \code{\link{gs_vecdel}} for handy +#' wrappers to help you delete multiple sheets at once by title +#' +#' @examples +#' \dontrun{ +#' foo <- gs_new("new_sheet") +#' gs_delete(foo) +#' +#' foo <- gs_new("new_sheet") +#' gs_delete(gs_title("new_sheet")) +#' } +#' +#' @export +gs_delete <- function(x, verbose = TRUE) { + + key <- gs_get_alt_key(x) + the_url <- paste("https://www.googleapis.com/drive/v2/files", + key, "trash", sep = "/") + + post <- gdrive_POST(the_url, body = NULL) + status <- post$status_code + + if(verbose) { + if(status == 200L) { + sprintf("Success. \"%s\" moved to trash in Google Drive.", + x$sheet_title) %>% + message() + } else { + sprintf("Oops. \"%s\" was NOT deleted.", x$sheet_title) %>% + message() + } + } + + if(status == 200L) invisible(TRUE) else invisible(FALSE) + +} + +#' Delete several sheets at once by title +#' +#' These functions violate the general convention of operating on a registered +#' Google sheet, i.e. on a \code{\link{googlesheet}} object. But the need to +#' delete a bunch of sheets at once, based on a vector of titles or on a regular +#' expression, came up so much during development and testing, that it seemed +#' wise to package this as a function. +#' +#' @examples +#' \dontrun{ +#' sheet_title <- c("cat", "catherine", "tomCAT", "abdicate", "FLYCATCHER") +#' ss <- lapply(paste0("TEST-", sheet_title), gs_new) +#' # list, for safety!, then delete 'TEST-abdicate' and 'TEST-catherine' +#' gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]+$") +#' gs_grepdel(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]+$") +#' +#' # list, for safety!, then delete the rest, +#' # i.e. 'TEST-cat', 'TEST-tomCAT', and 'TEST-FLYCATCHER' +#' gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) +#' gs_grepdel(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) +#' +#' ## using gs_vecdel() +#' sheet_title <- c("cat", "catherine", "tomCAT", "abdicate", "FLYCATCHER") +#' ss <- lapply(paste0("TEST-", sheet_title), gs_new) +#' # delete two of these sheets +#' gs_vecdel(c("TEST-cat", "TEST-abdicate")) +#' # see? they are really gone, but the others remain +#' gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) +#' # delete the remainder +#' gs_vecdel(c("TEST-FLYCATCHER", "TEST-tomCAT", "TEST-catherine")) +#' # see? they are all gone now +#' gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) +#' } +#' +#' @param regex character; a regular expression; sheets whose titles match will +#' be deleted +#' @param ... optional arguments to be passed to \code{\link{grep}} when +#' matching \code{regex} to sheet titles +#' @param verbose logical; do you want informative message? +#' +#' @export +gs_grepdel <- function(regex, ..., verbose = TRUE) { + + stopifnot(is.character(regex)) + + delete_me <- gs_ls(regex, ..., verbose = verbose) + + if(is.null(delete_me)) { + invisible(NULL) + } else { + lapply(delete_me$sheet_key, function(x) { + gs_delete(gs_key(x, verbose = verbose), verbose = verbose) + }) %>% + unlist() + } + +} + +#' @rdname gs_grepdel +#' @param vec character vector of sheet titles to delete +#' @export +gs_vecdel <- function(vec, verbose = TRUE) { + + stopifnot(is.character(vec)) + + delete_me <- gs_ls(verbose = FALSE) %>% + dplyr::filter_(~ sheet_title %in% vec) + + if(nrow(delete_me)) { + lapply(delete_me$sheet_key, function(x) { + gs_delete(gs_key(x, verbose = verbose), verbose = verbose) + }) %>% + unlist() + } else { + invisible(NULL) + } + +} diff --git a/R/gs_download.R b/R/gs_download.R new file mode 100644 index 0000000..0da8cd1 --- /dev/null +++ b/R/gs_download.R @@ -0,0 +1,92 @@ +#' Download a spreadsheet +#' +#' Export a Google Sheet as a .csv, .pdf, or .xlsx file. You can download a +#' sheet that you own or a sheet owned by a third party that has been made +#' accessible via the sharing dialog options. You can download the entire +#' spreadsheet (.pdf and .xlsx formats) or a single worksheet. This function +#' calls the \href{https://developers.google.com/drive/v2/reference/}{Google +#' Drive API}. +#' +#' @param from a \code{\link{googlesheet}} object, i.e. a registered Google +#' sheet +#' @param ws positive integer or character string specifying index or title, +#' respectively, of the worksheet to export; if \code{NULL} then the entire +#' spreadsheet will be exported (.pdf and xlsx formats) or the first worksheet +#' will be exported (.csv format) +#' @param to path to write file; file extension must be one of .csv, .pdf, or +#' .xlsx, which dictates the export format +#' @param overwrite logical, indicating whether to overwrite an existing local +#' file +#' @param verbose logical; do you want informative message? +#' +#' @examples +#' \dontrun{ +#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +#' gs_download(gs_key(gap_key), to = "gapminder.xlsx") +#' file.remove("gapminder.xlsx") +#' } +#' +#' @export +gs_download <- + function(from, ws = NULL, to = "my_sheet.xlsx", + overwrite = FALSE, verbose = TRUE) { + + stopifnot(inherits(from, "googlesheet")) + + ext <- tools::file_ext(to) + if(!(ext %in% c("csv", "pdf", "xlsx"))) { + stop(sprintf("Cannot download Google spreadsheet as this format: %s", ext)) + } + + if(is.null(ws)) { + + key <- gs_get_alt_key(from) + the_url <- + paste("https://www.googleapis.com/drive/v2/files", key, sep = "/") + + req <- gdrive_GET(the_url) + export_links <- c( + csv = req$content$exportLinks$'text/csv', # first sheet only + pdf = req$content$exportLinks$'application/pdf', + xlsx = req$content$exportLinks$'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet') + + } else { + + this_ws <- from %>% gs_ws(ws) + export_links <- c( + csv = this_ws$exportcsv, + pdf = httr::modify_url(this_ws$exportcsv, query = list(format = "pdf")), + xlsx = httr::modify_url(this_ws$exportcsv, query = list(format = "xlsx"))) + + } + + ext_match <- grepl(ext, names(export_links)) + if(any(ext_match)) { + link <- export_links %>% `[[`(ext) + } else { + mess <- sprintf(paste("Download as a %s file is not supported for this", + "sheet. Is this perhaps an \"old\" Google Sheet?"), + ext) + stop(mess) + } + + if(interactive()) { + gdrive_GET(link, httr::write_disk(to, overwrite = overwrite), + httr::progress()) + } else { + gdrive_GET(link, httr::write_disk(to, overwrite = overwrite)) + } + + if(file.exists(to)) { + + if(verbose) { + message(sprintf("Sheet successfully downloaded: %s", normalizePath(to))) + } + + } else { + + stop(sprintf("Cannot confirm the file download :(")) + + } + +} diff --git a/R/gs_ls.R b/R/gs_ls.R index 458b01f..8f6b82a 100644 --- a/R/gs_ls.R +++ b/R/gs_ls.R @@ -1,4 +1,4 @@ -#' List available spreadsheets +#' List spreadsheets à la Google Sheets home screen #' #' Lists spreadsheets that the user would see in the Google Sheets home screen: #' \url{https://docs.google.com/spreadsheets/}. This function returns the @@ -8,28 +8,37 @@ #' \code{gs_ls} will require authentication. #' #' This listing gives a \emph{partial} view of the sheets available for access -#' (why just partial? see below). For these sheets, get sheet title, sheet key, -#' owner, user's permission, date-time of last update, version (old vs new -#' sheet?), various links, and an alternate key (only relevant to old sheets). +#' (why just partial? see below). For these sheets, we retrieve sheet title, +#' sheet key, author, user's permission, date-time of last update, version (old +#' vs new sheet?), various links, and an alternate key (only relevant to old +#' sheets). #' #' The resulting table provides a map between readily available information, #' such as sheet title, and more obscure information you might use in scripts, -#' such as the sheet key. This sort of "table lookup" is implemented in the -#' helper function \code{\link{identify_ss}}. +#' such as the sheet key. This sort of "table lookup" is exploited in the +#' functions \code{\link{gs_title}}, \code{\link{gs_key}}, \code{\link{gs_url}}, +#' and \code{\link{gs_ws_feed}}, which register a sheet based on various forms +#' of user input. #' -#' Which sheets show up here? Certainly those owned by the user. But also a -#' subset of the sheets owned by others but visible to the user. We have yet to -#' find explicit Google documentation on this matter. Anecdotally, sheets owned -#' by a third party but for which the user has read access seem to appear in -#' this listing if the user has visited them in the browser. This is an +#' Which sheets show up in this table? Certainly those owned by the user. But +#' also a subset of the sheets owned by others but visible to the user. We have +#' yet to find explicit Google documentation on this matter. Anecdotally, sheets +#' owned by a third party but for which the user has read access seem to appear +#' in this listing if the user has visited them in the browser. This is an #' important point for usability because a sheet can be summoned by title #' instead of key \emph{only} if it appears in this listing. For shared sheets -#' that may not appear in this listing, a more robust workflow is to extract the -#' key from the browser URL via \code{\link{extract_key_from_url}} and -#' explicitly specify the sheet in \code{googlesheets} functions by key. +#' that may not appear in this listing, a more robust workflow is to specify the +#' sheet via its browser URL or unique sheet key. +#' +#' @param regex character; a regular expression; if non-\code{NULL} only sheets +#' whose titles match will be listed +#' @param ... optional arguments to be passed to \code{\link{grep}} when +#' matching \code{regex} to sheet titles +#' @param verbose logical; do you want informative message? #' #' @return a \code{googlesheet_ls} object, which is a -#' \code{\link[dplyr]{tbl_df}} with one row per sheet +#' \code{\link[dplyr]{tbl_df}} with one row per sheet (we use a custom class +#' only to control how this object is printed) #' #' @examples #' \dontrun{ @@ -37,7 +46,7 @@ #' } #' #' @export -gs_ls <- function() { +gs_ls <- function(regex = NULL, ..., verbose = TRUE) { # only calling spreadsheets feed from here, so hardwiring url the_url <- "https://spreadsheets.google.com/feeds/spreadsheets/private/full" @@ -65,7 +74,7 @@ gs_ls <- function() { sheet_title = ~ entries %>% xml2::xml_find_all(".//feed:title", ns) %>% xml2::xml_text(), - owner = + author = ~ entries %>% xml2::xml_find_all(".//feed:author//feed:name", ns) %>% xml2::xml_text(), perm = ~ link_dat$ws_feed %>% @@ -73,7 +82,7 @@ gs_ls <- function() { ifelse("r", "rw"), version = ~ ifelse(grepl("^https://docs.google.com/spreadsheets/d", link_dat$alternate), "new", "old"), - last_updated = + updated = ~ entries %>% xml2::xml_find_all(".//feed:updated", ns) %>% xml2::xml_text() %>% as.POSIXct(format = "%Y-%m-%dT%H:%M:%S", tz = "UTC"), @@ -87,7 +96,22 @@ gs_ls <- function() { extract_key_from_url(link_dat$alternate)) )) - structure(ret, class = c("googlesheet_ls", class(ret))) + ret <- structure(ret, class = c("googlesheet_ls", class(ret))) + + if(is.null(regex)) { + return(ret) + } + + keep_me <- grep(regex, ret$sheet_title, ...) + + if(length(keep_me) == 0L) { + if(verbose) { + message("No matching sheets found.") + } + invisible(NULL) + } else { + ret[keep_me, ] + } } @@ -95,10 +119,10 @@ gs_ls <- function() { print.googlesheet_ls <- function(x, ...) { x %>% dplyr::mutate_(sheet_title = ~ ellipsize(sheet_title, 24), - owner = ~ ellipsize(owner, 13), + author = ~ ellipsize(author, 13), ## wish I knew how to drop seconds from last_updated! sheet_key = ~ ellipsize(sheet_key, 9)) %>% - print + print() } ellipsize <- function(x, n = 20) { diff --git a/R/gs_new.R b/R/gs_new.R new file mode 100644 index 0000000..60f11b5 --- /dev/null +++ b/R/gs_new.R @@ -0,0 +1,45 @@ +#' Create a new spreadsheet +#' +#' Create a new (empty) spreadsheet in your Google Drive. The new sheet will +#' contain 1 default worksheet titled "Sheet1". This function +#' calls the \href{https://developers.google.com/drive/v2/reference/}{Google +#' Drive API}. +#' +#' @param title the title for the new sheet +#' @param verbose logical; do you want informative message? +#' +#' @return a \code{\link{googlesheet}} object +#' +#' @examples +#' \dontrun{ +#' foo <- gs_new("foo") +#' foo +#' } +#' +#' @export +gs_new <- function(title = "my_sheet", verbose = TRUE) { + + ## TO DO? warn if sheet with same title alredy exists? + ## right now we proceed quietly, because sheet is identified by key + + the_body <- list(title = title, + mimeType = "application/vnd.google-apps.spreadsheet") + + req <- + gdrive_POST(url = "https://www.googleapis.com/drive/v2/files", + body = the_body) + + new_sheet_key <- httr::content(req)$id + ## I set verbose = FALSE here because it seems weird to message "Spreadsheet + ## identified!" in this context, esp. to do so *before* message confirming + ## creation + ss <- gs_key(new_sheet_key, verbose = FALSE) + + if(verbose) { + message(sprintf("Sheet \"%s\" created in Google Drive.", ss$sheet_title)) + } + + ss %>% + invisible() + +} diff --git a/R/gs_old-sheets.R b/R/gs_old-sheets.R new file mode 100644 index 0000000..008d51c --- /dev/null +++ b/R/gs_old-sheets.R @@ -0,0 +1,22 @@ +## not exported +## use upstream of Google Drive API, which requires a sheet's alternate key +gs_get_alt_key <- function(x) { + + if(x$version == "new") { + x$sheet_key + } else { + if(is.na(x$alt_key)) { + paste("This googlesheet object is missing the alternate sheet", + "key necessary to perform this operation on an \"old\" Google", + "Sheet. The alternate key can only be learned from the", + "spreadsheets feed and, therefore with authentication.", + "Re-register the sheet in a way that allows information", + "to be looked up in the spreadsheet feed and try again.", + "See the help for functions gs_title(), gs_key(), etc.") %>% + stop() + } else { + x$alt_key + } + } + +} diff --git a/R/gs_register.R b/R/gs_register.R new file mode 100644 index 0000000..d7b0343 --- /dev/null +++ b/R/gs_register.R @@ -0,0 +1,238 @@ +## TO DO: gs_gs + +#' Register a Google Sheet +#' +#' The \code{googlesheets} package must gather information on a Google Sheet +#' from \href{https://developers.google.com/google-apps/spreadsheets/}{the API} +#' prior to any requests to read or write data. We call this +#' \strong{registering} the sheet and store the result in a \code{googlesheet} +#' object. Note this object does not contain any sheet data, but rather contains +#' metadata about the sheet. We populate a \code{googlesheet} +#' object with information from the +#' \href{https://developers.google.com/google-apps/spreadsheets/#working_with_worksheets}{worksheets +#' feed} and, if available, also from the +#' \href{https://developers.google.com/google-apps/spreadsheets/#retrieving_a_list_of_spreadsheets}{spreadsheets +#' feed}. Choose from the functions below depending on the type of +#' sheet-identifying input you will provide. Is it a sheet title, key, +#' browser URL, or worksheets feed (another URL, mostly used internally)? +#' +#' A registered \code{googlesheet} will contain information on: +#' +#' \itemize{ +#' \item \code{sheet_key} the key of the spreadsheet +#' \item \code{sheet_title} the title of the spreadsheet +#' \item \code{n_ws} the number of worksheets contained in the spreadsheet +#' \item \code{ws_feed} the "worksheets feed" of the spreadsheet +#' \item \code{updated} the time of last update (at time of registration) +#' \item \code{reg_date} the time of registration +#' \item \code{visibility} visibility of spreadsheet (Google's confusing +#' vocabulary); actually, does not describe a property of spreadsheet +#' itself but rather whether requests will be made with or without +#' authentication +#' \item \code{is_public} logical indicating visibility is "public" (meaning +#' unauthenticated requests will be sent), as opposed to "private" (meaning +#' authenticated requests will be sent) +#' \item \code{author} the name of the owner +#' \item \code{email} the email of the owner +#' \item \code{links} data.frame of links specific to the spreadsheet +#' \item \code{ws} a data.frame about the worksheets contained in the +#' spreadsheet +#' } +#' +#' A \code{googlesheet} object will contain this information from the +#' spreadsheets feed if it was available at the time of registration: +#' +#' \itemize{ +#' \item \code{alt_key} alternate key; applies only to "old" sheets +#' } +#' +#' Since the spreadsheets feed contains private user data, \code{googlesheets} +#' must use authentication to access it. So a \code{googlesheet} object will +#' only contain info from the spreadsheets feed if \code{lookup = TRUE}, which +#' directs us to look up sheet-identifying information in the spreadsheets feed. +#' +#' @name googlesheet +#' +#' @param x sheet-identifying information; a character vector of length one +#' holding sheet title, key, browser URL or worksheets feed +#' @param lookup logical, optional. Controls whether \code{googlesheets} will +#' place authenticated API requests during registration. If unspecified, will +#' be set to \code{TRUE} if authentication has previously been used in this R +#' session or if working directory contains a file named \code{.httr-oauth}. +#' @param visibility character, either "public" or "private". Consulted during +#' explicit construction of a worksheets feed from a key, which happens only +#' when \code{lookup = FALSE} and \code{googlesheets} is prevented from +#' looking up information in the spreadsheets feed. If unspecified, will be +#' set to "public" if \code{lookup = FALSE} and "private" if \code{lookup = +#' TRUE}. +#' @param verbose logical +#' +#' @return a \code{googlesheet} object +#' +#' @export +gs_title <- function(x, verbose = TRUE) { + + stopifnot(length(x) == 1L, is.character(x)) + + ssf <- x %>% + gs_lookup("sheet_title", verbose) + + x <- structure(ssf$ws_feed, class = "ws_feed") + x %>% + as.googlesheet(ssf, verbose) + +} + +#' @rdname googlesheet +#' @export +gs_key <- function(x, lookup = NULL, visibility = NULL, verbose = TRUE) { + + stopifnot(length(x) == 1L, is.character(x)) + + lookup <- set_lookup(lookup, verbose) + visibility <- set_visibility(visibility, lookup) + + if(lookup) { + ssf <- x %>% + gs_lookup("sheet_key", verbose) + x <- ssf$ws_feed + } else { + x <- x %>% construct_ws_feed_from_key(visibility) + if(verbose) { + sprintf("Worksheets feed constructed with %s visibility", visibility) %>% + message() + } + ssf <- NULL + } + + x <- structure(x, class = "ws_feed") + x %>% + as.googlesheet(ssf, verbose) + +} + +#' @rdname googlesheet +#' @export +gs_url <- function(x, lookup = NULL, visibility = NULL, verbose = TRUE) { + + stopifnot(length(x) == 1L, is.character(x), + stringr::str_detect(x, "^https://")) + + lookup <- set_lookup(lookup, verbose) + visibility <- set_visibility(visibility, lookup) + + if(verbose) { + paste0("Sheet-identifying info appears to be a browser URL.\n", + "googlesheets will attempt to extract sheet key from the URL.") %>% + message() + } + + x <- extract_key_from_url(x) + if(verbose) { + sprintf("Putative key: %s", x) %>% message() + } + + x %>% + gs_key(lookup, visibility, verbose) + +} + +#' @rdname googlesheet +#' @export +gs_ws_feed <- function(x, lookup = NULL, verbose = TRUE) { + + ws_feed_regex <- "https://spreadsheets.google.com/feeds/worksheets" + stopifnot(length(x) == 1L, is.character(x), + stringr::str_detect(x, ws_feed_regex)) + + lookup <- set_lookup(lookup, verbose) + + if(lookup) { + ssf <- x %>% + gs_lookup("ws_feed", verbose) + } else { + ssf <- NULL + } + + x <- structure(x, class = "ws_feed") + x %>% + as.googlesheet(ssf, verbose) + +} + +## TO DO: decide how to handle googlesheets as input +# as.googlesheet.googlesheet <- function(x, ssf = NULL, verbose = TRUE, ...) { +# +# x <- structure(x$ws_feed, class = "ws_feed") +# x %>% +# as.googlesheet() +# +# } + +set_lookup <- function(lookup = NULL, verbose = TRUE) { + + if(is.null(lookup)) { + lookup <- !is.null(.state$token) || file.exists(".httr-oauth") + } else { + stopifnot(is.logical(lookup)) + } + if(verbose) { + sprintf("Authentication will %sbe used.", if(lookup) "" else "not ") %>% + message() + } + + lookup + +} + +set_visibility <- function(visibility = NULL, lookup = TRUE) { + + if(is.null(visibility)) { + if(lookup) { + visibility <- "private" + } else { + visibility <- "public" + } + } else { + stopifnot(visibility %in% c("public", "private")) + } + + visibility + +} + +## for internal use only x = character holding title | key | ws_feed +## +## x will be sought in the variable named 'lvar' in the tbl_df returned by +## gs_ls(), which wraps the spreadsheets feed +## +## return value = return of gs_ls() limited to the row where x matched +gs_lookup <- function(x, lvar = "sheet_title", verbose = TRUE) { + + ssf <- gs_ls() + + i <- which(ssf[[lvar]] == x) + + if(length(i) < 1) { + mess <- + sprintf(paste("\"%s\" doesn't match %s of any sheet returned by gs_ls()", + "(which should reflect user's Google Sheets home screen)."), + x, lvar) + stop(mess) + } else if(length(i) > 1) { + mess <- + sprintf(paste("\"%s\" matches %s for multiple sheets returned by gs_ls()", + "(which should reflect user's Google Sheets home screen).", + "Suggest you identify this sheet by unique key instead."), + x, lvar) + stop(mess) + } + + if(verbose) { + sprintf("Sheet successfully identifed: \"%s\"", ssf$sheet_title[i]) %>% + message() + } + + ssf[i, ] + +} diff --git a/R/gs_upload.R b/R/gs_upload.R new file mode 100644 index 0000000..5875221 --- /dev/null +++ b/R/gs_upload.R @@ -0,0 +1,75 @@ +#' Upload a file and convert it to a Google Sheet +#' +#' Google supports the following file types to be converted to a Google +#' spreadsheet: .xls, .xlsx, .csv, .tsv, .txt, .tab, .xlsm, .xlt, .xltx, .xltm, +#' .ods. The newly uploaded file will appear in your Google Sheets home screen. +#' This function calls the +#' \href{https://developers.google.com/drive/v2/reference/}{Google Drive API}. +#' +#' @param file path to the file to upload +#' @param sheet_title the title of the spreadsheet; optional, if not specified +#' then the name of the file will be used +#' @param verbose logical; do you want informative message? +#' +#' @examples +#' \dontrun{ +#' write.csv(head(iris, 5), "iris.csv", row.names = FALSE) +#' iris_ss <- gs_upload("iris.csv") +#' iris_ss +#' get_via_lf(iris_ss) +#' file.remove("iris.csv") +#' gs_delete(iris_ss) +#' } +#' +#' @export +gs_upload <- function(file, sheet_title = NULL, verbose = TRUE) { + + if(!file.exists(file)) { + stop(sprintf("\"%s\" does not exist!", file)) + } + + ext <- c("xls", "xlsx", "csv", "tsv", "txt", "tab", "xlsm", "xlt", + "xltx", "xltm", "ods") + + if(!(tools::file_ext(file) %in% ext)) { + stop(sprintf(paste("Cannot convert file with this extension to a Google", + "Spreadsheet: %s"), tools::file_ext(file))) + } + + if(is.null(sheet_title)) { + sheet_title <- file %>% basename() %>% tools::file_path_sans_ext() + } + + req <- gdrive_POST( + url = "https://www.googleapis.com/drive/v2/files", + body = list(title = sheet_title, + mimeType = "application/vnd.google-apps.spreadsheet")) + + new_sheet_key <- httr::content(req)$id + + put_url <- httr::modify_url("https://www.googleapis.com/", + path = paste0("upload/drive/v2/files/", + new_sheet_key)) + + ret <- gdrive_PUT(put_url, the_body = file) + ## TO DO: use ret to assess success? + + ss_df <- gs_ls() + success <- new_sheet_key %in% ss_df$sheet_key + + if(success) { + if(verbose) { + sprintf(paste("\"%s\" uploaded to Google Drive and converted", + "to a Google Sheet named \"%s\""), + basename(file), sheet_title) %>% + message() + } + } else { + stop(sprintf("Cannot confirm the file upload :(")) + } + + new_sheet_key %>% + gs_key(verbose = FALSE) %>% + invisible() + +} diff --git a/R/gs_ws.R b/R/gs_ws.R new file mode 100644 index 0000000..6d54426 --- /dev/null +++ b/R/gs_ws.R @@ -0,0 +1,366 @@ +#' Add a new worksheet to spreadsheet +#' +#' Add a new (empty) worksheet to spreadsheet: specify title and worksheet +#' extent (number of rows and columns). The title of the new worksheet can not +#' be the same as any existing worksheets in the sheet. +#' +#' @param ss a \code{\link{googlesheet}} object, i.e. a registered Google +#' sheet +#' @param ws_title character string for title of new worksheet +#' @param nrow number of rows (default is 1000) +#' @param ncol number of columns (default is 26) +#' @param verbose logical; do you want informative message? +#' +#' @return a \code{\link{googlesheet}} object +#' +#' @examples +#' \dontrun{ +#' # get a copy of the Gapminder spreadsheet +#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +#' gap_ss <- gs_copy(gs_key(gap_key), to = "Gapminder_copy") +#' gap_ss <- gs_ws_new(gap_ss, ws_title = "Atlantis") +#' gap_ss +#' } +#' +#' @export +gs_ws_new <- function(ss, ws_title = "Sheet1", + nrow = 1000, ncol = 26, verbose = TRUE) { + + stopifnot(ss %>% inherits("googlesheet")) + + ws_title_exist <- ws_title %in% gs_ws_ls(ss) + + if(ws_title_exist) { + stop(sprintf(paste("A worksheet titled \"%s\" already exists, please", + "choose a different name."), ws_title)) + } + + the_body <- + XML::xmlNode("entry", + namespaceDefinitions = + c("http://www.w3.org/2005/Atom", + gs = "http://schemas.google.com/spreadsheets/2006"), + XML::xmlNode("title", ws_title), + XML::xmlNode("gs:rowCount", nrow), + XML::xmlNode("gs:colCount", ncol)) + + the_body <- XML::toString.XMLNode(the_body) + + req <- gsheets_POST(ss$ws_feed, the_body) + + ss_refresh <- ss$sheet_key %>% gs_key(verbose = FALSE) + + ws_title_exist <- ws_title %in% gs_ws_ls(ss_refresh) + + if(verbose) { + if(ws_title_exist) { + message(sprintf("Worksheet \"%s\" added to sheet \"%s\".", + ws_title, ss_refresh$sheet_title)) + } else { + message(sprintf(paste("Cannot verify whether worksheet \"%s\" was added", + "to sheet \"%s\"."), ws_title, + ss_refresh$sheet_title)) + } + } + + if(ws_title_exist) { + ss_refresh %>% invisible() + } else { + NULL + } + +} + +#' Delete a worksheet from a spreadsheet +#' +#' The worksheet and all of its contents will be removed from the spreadsheet. +#' +#' @inheritParams get_via_lf +#' @param verbose logical; do you want informative message? +#' +#' @return a \code{\link{googlesheet}} object +#' +#' @examples +#' \dontrun{ +#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +#' gap_ss <- gap_key %>% +#' gs_key() %>% +#' gs_copy(to = "gap_copy") +#' # non-pipe equivalent: gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") +#' gs_ws_ls(gap_ss) +#' gap_ss <- gs_ws_new(gap_ss, "new_stuff") +#' gap_ss <- edit_cells(gap_ss, "new_stuff", input = head(iris), header = TRUE, +#' trim = TRUE) +#' gap_ss +#' gap_ss <- gs_ws_delete(gap_ss, "new_stuff") +#' gs_ws_ls(gap_ss) +#' gap_ss <- gs_ws_delete(gap_ss, ws = 3) +#' gs_ws_ls(gap_ss) +#' gs_delete(gap_ss) +#' } +#' +#' @export +gs_ws_delete <- function(ss, ws = 1, verbose = TRUE) { + + stopifnot(ss %>% inherits("googlesheet")) + + this_ws <- ss %>% gs_ws(ws) + + req <- gsheets_DELETE(this_ws$ws_id) + + ss_refresh <- ss$sheet_key %>% gs_key(verbose = FALSE) + + ws_title_exist <- this_ws$ws_title %in% gs_ws_ls(ss_refresh) + + if(verbose) { + if(ws_title_exist) { + message(sprintf(paste("Cannot verify whether worksheet \"%s\" was", + "deleted from sheet \"%s\"."), + this_ws$ws_title, ss_refresh$sheet_title)) + } else { + message(sprintf("Worksheet \"%s\" deleted from sheet \"%s\".", + this_ws$ws_title, ss$sheet_title)) + } + } + + if(ws_title_exist) { + NULL + } else { + ss_refresh %>% invisible() + } + +} + +#' Rename a worksheet +#' +#' Give a worksheet a new title that does not duplicate the title of any +#' existing worksheet within the spreadsheet. +#' +#' @param ss a \code{\link{googlesheet}} object, i.e. a registered Google +#' sheet +#' @param from positive integer or character string specifying index or title, +#' respectively, of the worksheet +#' @param to character string for new title of worksheet +#' @param verbose logical; do you want informative message? +#' +#' @return a \code{\link{googlesheet}} object +#' +#' @note Since the edit link is used in the PUT request, the version path in the +#' url changes everytime changes are made to the worksheet, hence consecutive +#' function calls using the same edit link from the same sheet object without +#' 'refreshing' it by re-registering results in a HTTP 409 Conflict. +#' +#' @examples +#' \dontrun{ +#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +#' gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") +#' gs_ws_ls(gap_ss) +#' gap_ss <- gs_ws_rename(gap_ss, from = "Oceania", to = "ANZ") +#' gs_ws_ls(gap_ss) +#' gap_ss <- gs_ws_rename(gap_ss, from = 1, to = "I am the first sheet!") +#' gs_ws_ls(gap_ss) +#' gs_delete(gap_ss) +#' } +#' +#' @export +gs_ws_rename <- function(ss, from = 1, to, verbose = TRUE) { + + stopifnot(ss %>% inherits("googlesheet")) + + this_ws <- ss %>% gs_ws(from) + from_title <- this_ws$ws_title + + ss_refresh <- gs_ws_modify(ss, from = from, to = to) + + from_is_gone <- !(from_title %in% gs_ws_ls(ss_refresh)) + to_is_there <- to %in% gs_ws_ls(ss_refresh) + + if(verbose) { + if(from_is_gone && to_is_there) { + message(sprintf("Worksheet \"%s\" renamed to \"%s\".", from_title, to)) + } else { + message(sprintf(paste("Cannot verify whether worksheet \"%s\" was", + "renamed to \"%s\"."), from_title, to)) + } + } + + ss_refresh %>% invisible() + +} + +#' Resize a worksheet +#' +#' Set the number of rows and columns of a worksheet. We use this function +#' internally during cell updates, if the data would exceed the current +#' worksheet extent, and to trim worksheet down to fit the data exactly. Is it +#' possible a user might want to use this directly? +#' +#' @inheritParams get_via_lf +#' @param row_extent integer for new row extent +#' @param col_extent integer for new column extent +#' @param verbose logical; do you want informative message? +#' +#' @note Setting rows and columns to less than the current worksheet dimensions +#' will delete contents without warning! +#' +#' @examples +#' \dontrun{ +#' yo <- gs_new("yo") +#' yo <- edit_cells(yo, input = head(iris), header = TRUE, trim = TRUE) +#' get_via_csv(yo) +#' yo <- gs_ws_resize(yo, ws = "Sheet1", row_extent = 5, col_extent = 4) +#' get_via_csv(yo) +#' yo <- gs_ws_resize(yo, ws = 1, row_extent = 3, col_extent = 3) +#' get_via_csv(yo) +#' yo <- gs_ws_resize(yo, row_extent = 2, col_extent = 2) +#' get_via_csv(yo) +#' gs_delete(yo) +#' } +#' +#' @keywords internal +gs_ws_resize <- function(ss, ws = 1, + row_extent = NULL, col_extent = NULL, verbose = TRUE) { + + stopifnot(ss %>% inherits("googlesheet")) + + this_ws <- ss %>% gs_ws(ws, verbose) + + # if row or col extent not specified, make it the same as before + if(is.null(row_extent)) { + row_extent <- this_ws$row_extent + } + if(is.null(col_extent)) { + col_extent <- this_ws$col_extent + } + + ss_refresh <- + gs_ws_modify(ss, ws, + new_dim = c(row_extent = row_extent, col_extent = col_extent)) + this_ws <- ss_refresh %>% gs_ws(ws, verbose) + + new_row_extent <- this_ws$row_extent %>% as.integer() + new_col_extent <- this_ws$col_extent %>% as.integer() + + success <- all.equal(c(new_row_extent, new_col_extent), + c(row_extent, col_extent)) + + if(verbose && success) { + message(sprintf("Worksheet \"%s\" dimensions changed to %d x %d.", + this_ws$ws_title, new_row_extent, new_col_extent)) + } + + ss_refresh %>% + invisible() + +} + +#' Modify a worksheet's title or size +#' +#' @inheritParams get_via_lf + +#' @param ss a \code{\link{googlesheet}} object, i.e. a registered Google +#' sheet +#' @param from positive integer or character string specifying index or title, +#' respectively, of the worksheet +#' @param to character string for new title of worksheet +#' @param new_dim list of length 2 specifying the row and column extent of the +#' worksheet +#' +#' @return a \code{\link{googlesheet}} object +#' +#' @keywords internal +gs_ws_modify <- function(ss, from, to = NULL, new_dim = NULL) { + + stopifnot(ss %>% inherits("googlesheet")) + + this_ws <- ss %>% gs_ws(from, verbose = FALSE) + + req <- gsheets_GET(this_ws$ws_id, to_xml = FALSE) + contents <- req$content + + if(!is.null(to)) { # our purpose is to rename a worksheet + + if(to %in% gs_ws_ls(ss)) { + stop(sprintf(paste("A worksheet titled \"%s\" already exists in sheet", + "\"%s\". Please choose another worksheet title."), + to, ss$sheet_title)) + } + + ## TO DO: we should probably be doing something more XML-y here, instead + ## of doing XML --> string --> regex based subsitution --> XML + title_replacement <- paste0("\\1", to, "\\3") + the_body <- contents %>% + sub("()(.*)()", title_replacement, .) + } + + if(!is.null(new_dim)) { # our purpose is to resize a worksheet + + row_replacement <- paste0("\\1", new_dim["row_extent"], "\\3") + col_replacement <- paste0("\\1", new_dim["col_extent"], "\\3") + + the_body <- contents %>% + sub("()(.*)()", row_replacement, .) %>% + sub("()(.*)()", col_replacement, .) + } + + req <- gsheets_PUT(this_ws$edit, the_body) + ## TO DO (?): inspect req + req$url %>% + extract_key_from_url() %>% + gs_key() + +} + +#' Retrieve a worksheet-describing list from a googlesheet +#' +#' From a \code{\link{googlesheet}}, retrieve a list (actually a row of a +#' data.frame) giving everything we know about a specific worksheet. +#' +#' @inheritParams get_via_lf +#' @param verbose logical, indicating whether to give a message re: title of the +#' worksheet being accessed +#' +#' @keywords internal +gs_ws <- function(ss, ws, verbose = TRUE) { + + stopifnot(inherits(ss, "googlesheet"), + length(ws) == 1L, + is.character(ws) || (is.numeric(ws) && ws > 0)) + + if(is.character(ws)) { + index <- match(ws, ss$ws$ws_title) + if(is.na(index)) { + stop(sprintf("Worksheet %s not found.", ws)) + } else { + ws <- index + } + } + ws <- ws %>% as.integer() + if(ws > ss$n_ws) { + stop(sprintf("Spreadsheet only contains %d worksheets.", ss$n_ws)) + } + if(verbose) { + message(sprintf("Accessing worksheet titled \"%s\"", ss$ws$ws_title[ws])) + } + ss$ws[ws, ] +} + +#' List the worksheets in a Google Sheet +#' +#' Retrieve the titles of all the worksheets in a \code{\link{googlesheet}}. +#' +#' @inheritParams get_via_lf +#' +#' @examples +#' \dontrun{ +#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +#' gap_ss <- gs_key(gap_key) +#' gs_ws_ls(gap_ss) +#' } +#' @export +gs_ws_ls <- function(ss) { + + stopifnot(inherits(ss, "googlesheet")) + + ss$ws$ws_title +} diff --git a/R/http-requests.R b/R/http-requests.R index 138ffbd..412fc09 100644 --- a/R/http-requests.R +++ b/R/http-requests.R @@ -25,7 +25,7 @@ gsheets_GET <- function(url, to_xml = TRUE, ...) { req$headers[["content-type"]], fixed = TRUE)) { # DIAGNOSTIC EXPERIMENT: If I always call gs_ls() here, which seems to - # trigger token refresh more reliably when needed (vs register_ss), does + # trigger token refresh more reliably when needed (vs registration), does # this problem go away? If so, I'll put that info to good use with a less # stupid fix. if(grepl("public", url)) { @@ -49,7 +49,7 @@ gsheets_GET <- function(url, to_xml = TRUE, ...) { req$content <- httr::content(req, as = "text", encoding = "UTF-8") - # This is only FALSE when calling modify_ws() where we are using regex + # This is only FALSE when calling gs_ws_modify() where we are using regex # substitution, waiting for xml2 to support changing xml_doc() if(to_xml) { req$content <- req$content %>% xml2::read_xml() @@ -85,7 +85,7 @@ gsheets_POST <- function(url, the_body) { req$content <- httr::content(req, as = "text", encoding = "UTF-8") if(!is.null(req$content)) { - ## known example of this: POST request triggered by add_ws() + ## known example of this: POST request triggered by gs_ws_new() req$content <- req$content %>% xml2::read_xml() } @@ -137,7 +137,7 @@ gsheets_PUT <- function(url, the_body) { req$content <- httr::content(req, type = "text/xml") if(!is.null(req$content)) { - ## known example of this: POST request triggered by add_ws() + ## known example of this: POST request triggered by gs_ws_new() req$content <- XML::xmlToList(req$content) } @@ -148,7 +148,7 @@ gsheets_PUT <- function(url, the_body) { #' Make POST request to Google Drive API #' -#' Used in new_ss(), delete_ss(), copy_ss() +#' Used in gs_new(), gs_delete(), gs_copy() #' #' @param url URL for POST request #' @param ... optional; further named parameters, such as \code{query}, @@ -172,7 +172,7 @@ gdrive_POST <- function(url, ...) { #' Make PUT request to Google Drive API #' -#' Used in upload_ss() +#' Used in gs_upload() #' #' @param url URL for PUT request #' @param the_body body of PUT request @@ -200,7 +200,7 @@ gdrive_PUT <- function(url, the_body) { #' Make GET request to Google Drive API #' -#' Used in download_ss() +#' Used in gs_download() #' #' @param url URL for GET request #' @param ... optional; further named parameters, such as \code{query}, diff --git a/R/register.R b/R/register.R deleted file mode 100644 index c05f4df..0000000 --- a/R/register.R +++ /dev/null @@ -1,360 +0,0 @@ -#' Get a listing of spreadsheets -#' -#' Please use \code{\link{gs_ls}} instead. This function is going away. -#' -#' @return a \code{googlesheet_ls} object, which is a -#' \code{\link[dplyr]{tbl_df}} with one row per sheet -#' -#' @examples -#' \dontrun{ -#' gs_ls() -#' } -#' -#' @export -list_sheets <- gs_ls - -#' Retrieve the identifiers for a spreadsheet -#' -#' Initialize a googlesheet object that holds identifying information for a -#' specific spreadsheet. Intended primarily for internal use. Unless -#' \code{verify = FALSE}, it calls \code{\link{list_sheets}} and attempts to -#' return information from the row uniquely specified by input \code{x}. Since -#' \code{\link{list_sheets}} fetches non-public user data, authorization will be -#' required. A googlesheet object contains much more information than that -#' available via \code{\link{list_sheets}}, so many components will not be -#' populated until the sheet is registered properly, such as via -#' \code{\link{register_ss}}, which is called internally in many -#' \code{googlesheets} functions. If \code{verify = FALSE}, then user must -#' provide either sheet key, URL or a worksheets feed, as opposed to sheet -#' title. In this case, the information will be taken at face value, i.e. no -#' proactive verification or look-up on Google Drive. -#' -#' This function is will be revised to be less dogmatic about only identifying -#' ONE sheet. -#' -#' @param x sheet-identifying information, either a googlesheet object or a -#' character vector of length one, giving a URL, sheet title, key or -#' worksheets feed -#' @param method optional character string specifying the method of sheet -#' identification; if given, must be one of: URL, key, title, ws_feed, or ss -#' @param verify logical, default is TRUE, indicating if sheet should be looked -#' up in the list of sheets obtained via \code{\link{list_sheets}} -#' @param visibility character, default is "private", indicating whether to form -#' a worksheets feed that anticipates requests with authentication ("private") -#' or without ("public"); only consulted when \code{verify = FALSE} -#' @param verbose logical -#' -#' @return a googlesheet object -#' -#' @examples -#' \dontrun{ -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_id_only <- identify_ss(gap_key) -#' gap_id_only # see? not much info at this point -#' gap_ss <- register_ss(gap_id) -#' gap_ss # much more available after registration -#' } -#' -#' @export -identify_ss <- function(x, method = NULL, verify = TRUE, - visibility = "private", verbose = TRUE) { - - if(!inherits(x, "googlesheet")) { - if(!is.character(x)) { - stop(paste("The information that specifies the sheet must be character,", - "regardless of whether it is the URL, title, key or", - "worksheets feed.")) - } else { - if(length(x) != 1) { - stop(paste("The character vector that specifies the sheet must be of", - "length 1.")) - } - } - } - - method <- - match.arg(method, - choices = c('unknown', 'url', 'key', 'title', 'ws_feed', 'ss')) - - ## is x a googlesheet object? - if(method == 'ss' || inherits(x, "googlesheet")) { - if(verify) { - if(verbose) { - message("Identifying info is a googlesheet object; googlesheets will re-identify the sheet based on sheet key.") - } - x <- x$sheet_key - method <- 'key' - } else { ## it's a googlesheet, no verification requested - ## so just pass it on through - return(x) - } - } ## if x was ss, x is now a key - - ## is x a URL but NOT a worksheets feed? - ws_feed_start <- "https://spreadsheets.google.com/feeds/worksheets" - if(method == 'url' || - (x %>% stringr::str_detect("^https://") && - !(x %>% stringr::str_detect(ws_feed_start)) - )) { - if(verbose) { - paste0("Identifying info will be processed as a URL.\n", - "googlesheets will attempt to extract sheet key from the URL.") %>% - message() - } - x <- x %>% extract_key_from_url() - method <- 'key' - if(verbose) { - mess <- sprintf("Putative key: %s", x) - message(mess) - } - } ## if x was URL (but not ws_feed), x is now a key - - ## x is now known or presumed to be key, title, or ws_feed - - if(!verify) { - if(method == 'title') { - stop("Impossible to identify a sheet based on title when verify = FALSE. googlesheets must look up the title to obtain key or worksheets feed.") - } - - ## if method still unknown, make a guess between key or ws_feed - if(method == 'unknown') { - if(x %>% stringr::str_detect(ws_feed_start)) { - method <- 'ws_feed' - } else { - method <- 'key' - } - } - - if(verbose) { - message(sprintf("Identifying info will be handled as: %s.", method)) - } - - ss <- googlesheet() - - if(method == 'key') { - ss$sheet_key <- x - ss$ws_feed <- construct_ws_feed_from_key(x, visibility) - } - - if(method == 'ws_feed') { - ss$ws_feed <- x - ss$sheet_key <- x %>% extract_key_from_url() - } - - if(verbose) { - message(sprintf("Unverified sheet key: %s.", ss$sheet_key)) - #message(sprintf("Unverified worksheets feed: %s.", ss$ws_feed)) - } - - return(ss) - } - - ## we need listing of sheets visible to this user - ssfeed_df <- list_sheets() %>% - dplyr::select_(~ sheet_title, ~sheet_key, ~ws_feed, ~alt_key) - - ## can we find x in the variables that hold identifiers? - match_here <- ssfeed_df %>% - ## using llply, not match, to detect multiple matches - plyr::llply(function(z) which(z == x)) - - n_match <- match_here %>% plyr::laply(length) - - if(any(n_match > 1)) { # oops! multiple matches within identifier(s) - mess <- sprintf(paste("Identifying info \"%s\" has multiple matches in", - "these identifiers: %s\n"), x, - names(match_here)[n_match > 1]) - stop(mess) - } else { # at most one match per identifier, so unlist now - match_here <- match_here %>% unlist() - } - - if(all(n_match < 1)) { # oops! no match anywhere - mess <- sprintf(paste("Identifying info \"%s\" doesn't match title, key,", - "or worksheets feed for any sheet listed in the", - "Google sheets home screen for authorized user."), x) - stop(mess) - } - - if(match_here %>% unique() %>% length() > 1) { # oops! conflicting matches - mess <- sprintf(paste("Identifying info \"%s\" has conflicting matches in", - "multiple identifiers: %s\n"), x, - names(match_here)[n_match > 0] %>% - stringr::str_c(collapse = ", ")) - stop(mess) - } - - the_match <- match_here %>% unique() - x_ss <- ssfeed_df[the_match, ] %>% as.list() - - if(verbose) { - #mess <- sprintf("Sheet identified!\nsheet_title: %s\nsheet_key: %s\nws_feed: %s\n", x_ss$sheet_title, x_ss$sheet_key, x_ss$ws_feed) - mess <- sprintf("Sheet identified!\nsheet_title: %s\nsheet_key: %s", - x_ss$sheet_title, x_ss$sheet_key) - message(mess) - if(!is.na(x_ss$alt_key)) { - mess <- sprintf("alt_key: %s", x_ss$alt_key) - message(mess) - } - } - - ss <- googlesheet() - ss$sheet_key <- x_ss$sheet_key - ss$sheet_title <- x_ss$sheet_title - ss$ws_feed <- x_ss$ws_feed - ss$alt_key <- x_ss$alt_key - - ss -} - -#' Register a Google spreadsheet -#' -#' Specify a Google spreadsheet via its URL, unique key, title, or worksheets -#' feed and register it for further use. This function returns an object of -#' class \code{googlesheet}, which contains all the information other -#' \code{googlesheets} functions will need to consume data from the sheet or to -#' edit the sheet. This object also contains sheet information that may be of -#' interest to the user, such as the time of last update, the number of -#' worksheets contained, and their titles. -#' -#' @param x character vector of length one, with sheet-identifying information; -#' valid inputs are title, key, URL, worksheets feed -#' @param key character vector of length one that is guaranteed to be unique key -#' for sheet; supercedes argument \code{x} -#' @param ws_feed character vector of length one that is guaranteed to be -#' worksheets feed for sheet; supercedes arguments \code{x} and \code{key} -#' @param visibility either "public" or "private"; used to specify visibility -#' when sheet identified via \code{key} -#' @param verbose logical; do you want informative message? -#' -#' @return Object of class googlesheet. -#' -#' @note Re: the reported extent of the worksheets. Contain your excitement, -#' because it may not be what you think or hope it is. It does not report how -#' many rows or columns are actually nonempty. This cannot be determined via -#' the Google sheets API without consuming the data and noting which cells are -#' populated. Therefore, these numbers often reflect the default extent of a -#' new worksheet, e.g., 1000 rows and 26 columns at the time or writing, and -#' provide an upper bound on the true number of rows and columns. -#' -#' @note The visibility can only be "public" if the sheet is "Published to the -#' web". Gotcha: this is different from setting the sheet to "Public on the -#' web" in the visibility options in the sharing dialog of a Google Sheets -#' file. -#' -#' @examples -#' \dontrun{ -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- register_ss(gap_key) -#' gap_ss -#' get_row(gap_ss, "Africa", row = 1) -#' } -#' -#' @export -register_ss <- function(x, key = NULL, ws_feed = NULL, - visibility = "private", verbose = TRUE) { - - if(is.null(ws_feed)) { - if(is.null(key)) { # get ws_feed from x - this_ss <- x %>% - identify_ss(visibility = TRUE, verbose = verbose) - ws_feed <- this_ss$ws_feed - } else { # take key at face value - ws_feed <- construct_ws_feed_from_key(key, visibility) - } - } # else ... take ws_feed at face value - - req <- gsheets_GET(ws_feed) - - if(grepl("html", req$headers[["content-type"]])) { - ## TO DO: give more specific error message. Have they said "public" when - ## they meant "private" or vice versa? What's the actual problem and - ## solution? - stop("Please check visibility settings.") - } - - ns <- xml2::xml_ns_rename(xml2::xml_ns(req$content), d1 = "feed") - - ss <- googlesheet() - - ss$sheet_key <- ws_feed %>% extract_key_from_url() - ss$sheet_title <- req$content %>% - xml2::xml_find_one("./feed:title", ns) %>% xml2::xml_text() - ss$n_ws <- req$content %>% - xml2::xml_find_one("./openSearch:totalResults", ns) %>% xml2::xml_text() %>% - as.integer() - - ss$ws_feed <- req$url # same as sheet_id ... pick one? - ss$sheet_id <- req$content %>% # same as ws_feed ... pick one? - # for that matter, this URL appears a third time as the "self" link below :( - xml2::xml_find_one("./feed:id", ns) %>% xml2::xml_text() - - ss$updated <- req$headers$`last-modified` %>% httr::parse_http_date() - ss$get_date <- req$headers$date %>% httr::parse_http_date() - - ss$visibility <- req$url %>% dirname() %>% basename() - ss$is_public <- ss$visibility == "public" - - ss$author_name <- req$content %>% - xml2::xml_find_one("./feed:author/feed:name", ns) %>% xml2::xml_text() - ss$author_email <- req$content %>% - xml2::xml_find_one("./feed:author/feed:email", ns) %>% xml2::xml_text() - - links <- req$content %>% xml2::xml_find_all("./feed:link", ns) - ss$links <- dplyr::data_frame_(list( - rel = ~ links %>% xml2::xml_attr("rel"), - type = ~ links %>% xml2::xml_attr("type"), - href = ~ links %>% xml2::xml_attr("href") - )) - - ## if we have info from the spreadsheet feed, use it - ## that's the only way to populate alt_key - if(exists("this_ss")) { - ss$alt_key <- this_ss$alt_key - } - - ws <- req$content %>% xml2::xml_find_all("./feed:entry", ns) - ws_info <- dplyr::data_frame_(list( - ws_id = ~ ws %>% xml2::xml_find_all("feed:id", ns) %>% xml2::xml_text(), - ws_key = ~ ws_id %>% basename(), - ws_title = - ~ ws %>% xml2::xml_find_all("feed:title", ns) %>% xml2::xml_text(), - row_extent = - ~ ws %>% xml2::xml_find_all("gs:rowCount", ns) %>% - xml2::xml_text() %>% as.integer(), - col_extent = - ~ ws %>% xml2::xml_find_all("gs:colCount", ns) %>% - xml2::xml_text() %>% as.integer() - )) - - ## use the first worksheet to learn about the links available why we do this? - ## because the 'edit' link will not be available for sheets accessed via - ## public visibility or to which user does not have write permission - link_rels <- ws[1] %>% - xml2::xml_find_all("feed:link", ns) %>% - xml2::xml_attrs() %>% - vapply(`[`, FUN.VALUE = character(1), "rel") - ## here's what we expect here - # [1] "http://schemas.google.com/spreadsheets/2006#listfeed" - # [2] "http://schemas.google.com/spreadsheets/2006#cellsfeed" - # [3] "http://schemas.google.com/visualization/2008#visualizationApi" - # [4] "http://schemas.google.com/spreadsheets/2006#exportcsv" - # [5] "self" - # [6] "edit" <-- absent in some cases - names(link_rels) <- - link_rels %>% basename() %>% gsub("200[[:digit:]]\\#", '', .) - ## here's what we expect here - ## "listfeed" "cellsfeed" "visualizationApi" "exportcsv" "self" ?"edit"? - - ws_links <- ws %>% xml2::xml_find_all("feed:link", ns) - ws_links <- lapply(link_rels, function(x) { - xpath <- paste0("../*[@rel='", x, "']") - ws_links %>% - xml2::xml_find_all(xpath, ns) %>% - xml2::xml_attr("href") - }) %>% - dplyr::as_data_frame() - - ss$ws <- dplyr::bind_cols(ws_info, ws_links) - ss -} diff --git a/R/utils.R b/R/utils.R index 1c4cf65..bbc8989 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,65 +1,16 @@ -#' Retrieve a worksheet-describing list from a googlesheet +#' Extract sheet key from a URL #' -#' From a googlesheet, retrieve a list (actually a row of a data.frame) giving -#' everything we know about a specific worksheet. +#' Extract a sheet's unique key from a wide variety of URLs, i.e. a browser URL +#' for both old and new Sheets, the "worksheets feed", and other links returned +#' by the Sheets API. #' -#' @inheritParams get_via_lf -#' @param verbose logical, indicating whether to give a message re: title of the -#' worksheet being accessed -#' -#' @keywords internal -get_ws <- function(ss, ws, verbose = TRUE) { - - stopifnot(inherits(ss, "googlesheet"), - length(ws) == 1L, - is.character(ws) || (is.numeric(ws) && ws > 0)) - - if(is.character(ws)) { - index <- match(ws, ss$ws$ws_title) - if(is.na(index)) { - stop(sprintf("Worksheet %s not found.", ws)) - } else { - ws <- index %>% as.integer() - } - } - if(ws > ss$n_ws) { - stop(sprintf("Spreadsheet only contains %d worksheets.", ss$n_ws)) - } - if(verbose) { - message(sprintf("Accessing worksheet titled \"%s\"", ss$ws$ws_title[ws])) - } - ss$ws[ws, ] -} - -#' List the worksheets in a googlesheet -#' -#' Retrieve the titles of all the worksheets in a gpreadsheet. -#' -#' @inheritParams get_via_lf -#' -#' @examples -#' \dontrun{ -#' gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -#' gap_ss <- register_ss(gap_key) -#' list_ws(gap_ss) -#' } -#' @export -list_ws <- function(ss) { - - stopifnot(inherits(ss, "googlesheet")) - - ss$ws$ws_title -} - -#' Extract sheet key from its browser URL -#' -#' @param url URL seen in the browser when visiting the sheet +#' @param url character; a URL associated with a Google Sheet #' #' @examples #' \dontrun{ #' gap_url <- "https://docs.google.com/spreadsheets/d/1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA/" #' gap_key <- extract_key_from_url(gap_url) -#' gap_ss <- register_ss(gap_key) +#' gap_ss <- gs_key(gap_key) #' gap_ss #' } #' diff --git a/README.Rmd b/README.Rmd index 1859d68..1053ed2 100644 --- a/README.Rmd +++ b/README.Rmd @@ -17,6 +17,12 @@ knitr::opts_chunk$set( ) ``` +```{r make-clean, echo = FALSE, include = FALSE} +## if previous compilation errored out, intended clean up may be incomplete +suppressWarnings( + file.remove(c("~/tmp/gapminder-africa.csv", "~/tmp/gapminder.xlsx"))) +googlesheets::gs_vecdel(c("foo", "mini-gap", "iris"), verbose = FALSE) +``` --- Google Sheets R API @@ -59,22 +65,32 @@ What other ideas do you have? devtools::install_github("jennybc/googlesheets") ``` +*We plan to submit to CRAN in late May or early June 2015, so feedback on functionality and usability is especially valuable to us now!* + ### Take a look at the vignette -This README is arguably as or more useful as the vignette and both are still under development. But feel free to [check out the current state of the vignette](http://htmlpreview.github.io/?https://raw.githubusercontent.com/jennybc/googlesheets/master/vignettes/basic-usage.html). +No, actually, __don't__. This README is much more current than the vignette, though that will have to change soon! + +If you insist, [check out the current state of the vignette](http://htmlpreview.github.io/?https://raw.githubusercontent.com/jennybc/googlesheets/master/vignettes/basic-usage.html). ### Load googlesheets -`googlesheets` is designed for use with the `%>%` pipe operator and, to a lesser extent, the data-wrangling mentality of `dplyr`. The examples here use both, but we'll soon develop a vignette that shows usage with plain vanilla R. `googlesheets` uses `dplyr` internally but does not require the user to do so. +`googlesheets` is designed for use with the `%>%` pipe operator and, to a lesser extent, the data-wrangling mentality of [`dplyr`](http://cran.r-project.org/web/packages/dplyr/index.html). This README uses both, but the examples in the help files emphasize usage with plain vanilla R, if that's how you roll. `googlesheets` uses `dplyr` internally but does not require the user to do so. You can make the `%>%` pipe operator availble in your own work by loading [`dplyr`](http://cran.r-project.org/web/packages/dplyr/index.html) or [`magrittr`](http://cran.r-project.org/web/packages/magrittr/index.html). ```{r load-package} library("googlesheets") suppressMessages(library("dplyr")) ``` +### Function naming convention + +*implementation not yet 100% complete ... but we'll get there soon* + +All functions start with `gs_`, which plays nicely with tab completion in RStudio, for example. If the function has something to do with worksheets or tabs within a spreadsheet, it will start with `gs_ws_`. + ### See some spreadsheets you can access -The `gs_ls()` function returns the sheets you would see in your Google Sheets home screen: . This should include sheets that you own and may also show sheets owned by others but that you are permitted to access, especially if you have clicked on a link shared by the owner. Expect a prompt to authenticate yourself in the browser at this point (more below re: authentication). +The `gs_ls()` function returns the sheets you would see in your Google Sheets home screen: . This should include sheets that you own and may also show sheets owned by others but that you are permitted to access, if you visited the sheet in the browser. Expect a prompt to authenticate yourself in the browser at this point (more below re: authentication). ```{r list-sheets} (my_sheets <- gs_ls()) @@ -82,53 +98,55 @@ The `gs_ls()` function returns the sheets you would see in your Google Sheets ho my_sheets %>% glimpse() ``` +### Get a Google spreadsheet to practice with + +If you don't have any suitable Google Sheets lying around, or if you just want to follow along verbatim with this vignette, this bit of code will copy a sheet from the `googlesheets` Google user into your Drive. The sheet holds some of the [Gapminder data](https://github.com/jennybc/gapminder). + +```{r copy-gapminder, eval = FALSE} +gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +gs_copy(gs_key(gap_key), to = "Gapminder") +``` + +If that seems to have worked, go check that you see a sheet named "Gapminder" listed in your Google Sheets home screen: . You could also run `gs_ls()` again and make sure the Gapminder sheet is listed. + ### Register a spreadsheet -If you plan to consume data from a sheet or edit it, you must first register it. Basically this is where `googlesheets` makes a note of important info about the sheet that's needed to access via the Sheets API. Once registered, you can print the result to get some basic info about the sheet. +If you plan to consume data from a sheet or edit it, you must first __register__ it. This is how `googlesheets` records important info about the sheet that is required downstream by the Google Sheets or Google Drive APIs. Once registered, you can print the result to get some basic info about the sheet. + +`googlesheets` provides several registration functions. Specifying the sheet by title? Use `gs_title()`. By key? Use `gs_key()`. You get the idea. ```{r register-sheet} -# Hey let's look at the Gapminder data -gap <- register_ss("Gapminder") +gap <- gs_title("Gapminder") gap # Need to access a sheet you do not own? # Access it by key if you know it! gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap <- gap_key %>% register_ss +gap <- gap_key %>% gs_key -# googlesheets may be able to determine the key from the browser URL -# may not work (yet) for old sheets ... open an issue if have problem +# Have a sharing link? +# Access it by URL! gap_url <- "https://docs.google.com/spreadsheets/d/1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA/" -gap <- gap_url %>% register_ss +gap <- gap_url %>% gs_url +# note: registration via URL may not work for "old" sheets ``` -### Get a Google spreadsheet to practice with - -If you don't have any suitable Google Sheets lying around, or if you just want to follow along verbatim with this vignette, this bit of code will copy a sheet from the `googlesheets` Google user into your Drive. The sheet holds some of the [Gapminder data](https://github.com/jennybc/gapminder). - -```{r copy-gapminder, eval = FALSE} -gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -copy_ss(key = gap_key, to = "Gapminder") -``` +These functions return a registered sheet as a `googlesheet` object, which is the first argument to practically every function in this package. Likewise, almost every function returns a freshly registered `googlesheet` object, ready to be stored or piped into the next command. -If that seems to have worked, go check that you see a sheet named Gapminder listed in your Google Sheets home screen: . You could also try `gs_ls()` again and make sure the Gapminder sheet is listed. +### Consume data -Now register your copy of the Gapminder sheet and you can follow along: +#### Ignorance is bliss -```{r register-gapminder, eval = FALSE} -gap <- register_ss("Gapminder") -gap -``` +*coming soon: a wrapper for the functions described below that just gets the data you want, while you remain blissfully ignorant of how we're doing it* -### Consume data +#### Specify the consumption method There are three ways to consume data from a worksheet within a Google spreadsheet. The order goes from fastest-but-more-limited to slowest-but-most-flexible: * `get_via_csv()`: Don't let the name scare you! Nothing is written to file during this process. The name just reflects that, under the hood, we request the data via the "exportcsv" link. For cases where `get_via_csv()` and `get_via_lf()` both work, we see that `get_via_csv()` is around __50 times faster__. Use this when your data occupies a nice rectangle in the sheet and you're willing to consume all of it. You will get a `tbl_df` back, which is basically just a `data.frame`. - * `get_via_lf()`: Gets data via the ["list feed"](https://developers.google.com/google-apps/spreadsheets/#working_with_list-based_feeds), which consumes data row-by-row. Like `get_via_csv()`, this is appropriate when your data occupies a nice rectangle. You will again get a `tbl_df` back, but your variable names may have been mangled (by Google, not us!). Specifically, variable names will be forcefully lowercased and all non-alpha-numeric characters will be removed. Why do we even have this function? The list feed supports some query parameters for sorting and filtering the data, which we plan to support in the near future (#17). + * `get_via_lf()`: Gets data via the ["list feed"](https://developers.google.com/google-apps/spreadsheets/#working_with_list-based_feeds), which consumes data row-by-row. Like `get_via_csv()`, this is appropriate when your data occupies a nice rectangle. You will again get a `tbl_df` back, but your variable names may have been mangled (by Google, not us!). Specifically, variable names will be forcefully lowercased and all non-alpha-numeric characters will be removed. Why do we even have this function? The list feed supports some query parameters for sorting and filtering the data, which we plan to support (#17). * `get_via_cf()`: Get data via the ["cell feed"](https://developers.google.com/google-apps/spreadsheets/#working_with_cell-based_feeds), which consumes data cell-by-cell. This is appropriate when you want to consume arbitrary cells, rows, columns, and regions of the sheet. It works great for small amounts of data but can be rather slow otherwise. `get_via_cf()` returns a `tbl_df` with __one row per cell__. You can specify cell limits directly in `get_via_cf()` or use convenience wrappers `get_row()`, `get_col()` or `get_cells()` for some common special cases. See below for demos of `reshape_cf()` and `simplify_cf()` which help with post-processing. - ```{r csv-list-and-cell-feed} # Get the data for worksheet "Oceania": the super-fast csv way oceania_csv <- gap %>% get_via_csv(ws = "Oceania") @@ -193,23 +211,25 @@ gap %>% You can use `googlesheets` to create new spreadsheets. ```{r new-sheet} -foo <- new_ss("foo") +foo <- gs_new("foo") foo ``` -By default, there will be an empty worksheet called "Sheet1". You can also add, rename, and delete worksheets within an existing sheet via `add_ws()`, `rename_ws()`, and `delete_ws()`. Copy an entire spreadsheet with `copy_ss()`. +By default, there will be an empty worksheet called "Sheet1". You can also add, rename, and delete worksheets within an existing sheet via `gs_ws_new()`, `gs_ws_rename()`, and `gs_ws_delete()`. Copy an entire spreadsheet with `gs_copy()`. + +*`gs_new()` and `gs_ws_new()` will soon gain the ability to populate with data upon creation (#116)* ### Edit cells -You can modify the data in sheet cells via `edit_cells()`. We'll work on the completely empty sheet created above, `foo`. If your edit populates the sheet with everything it should have, set `trim = TRUE` and we will resize the sheet to match the data. Then the nominal worksheet extent is much more informative (vs. the default of 1000 rows and 26 columns). +You can modify the data in sheet cells via `edit_cells()`. We'll work on the completely empty sheet created above, `foo`. If your edit populates the sheet with everything it should have, set `trim = TRUE` and we will resize the sheet to match the data. Then the nominal worksheet extent is much more informative (vs. the default of 1000 rows and 26 columns) and any future consumption via the cell feed will be much faster. ```{r edit-cells} foo <- foo %>% edit_cells(input = head(iris), header = TRUE, trim = TRUE) ``` -Go to [your spreadsheets home page](https://docs.google.com/spreadsheets/u/0/), find the new sheet `foo` and look at it. You should see some iris data in the first (and only) worksheet. We'll also take a look at it here, by consuming `foo` via the list feed. +Go to [your Google Sheets home screen](https://docs.google.com/spreadsheets/u/0/), find the new sheet `foo` and look at it. You should see some iris data in the first (and only) worksheet. We'll also take a look at it here, by consuming `foo` via the list feed. -Note that we always store the returned value from `edit_cells()` (and all other sheet editing functions). That's because the registration info changes whenever we edit the sheet and we re-register it inside these functions, so this idiom will help you make sequential edits and queries to the same sheet. +Note how we always store the returned value from `edit_cells()` (and all other sheet editing functions). That's because the registration info changes whenever we edit the sheet and we re-register it inside these functions, so this idiom will help you make sequential edits and queries to the same sheet. ```{r consume-edited-cells} foo %>% get_via_lf() @@ -222,7 +242,7 @@ Read the function documentation for `edit_cells()` for how to specify where the Let's clean up by deleting the `foo` spreadsheet we've been playing with. ```{r delete-sheet} -delete_ss("foo") +gs_delete(foo) ``` ### Upload delimited files or Excel workbooks @@ -231,7 +251,7 @@ Here's how we can create a new spreadsheet from a suitable local file. First, we ```{r new-sheet-from-file} iris %>% head(5) %>% write.csv("iris.csv", row.names = FALSE) -iris_ss <- upload_ss("iris.csv") +iris_ss <- gs_upload("iris.csv") iris_ss iris_ss %>% get_via_lf() file.remove("iris.csv") @@ -240,7 +260,7 @@ file.remove("iris.csv") Now we'll upload a multi-sheet Excel workbook. Slowly. ```{r new-sheet-from-xlsx} -gap_xlsx <- upload_ss("tests/testthat/mini-gap.xlsx") +gap_xlsx <- gs_upload(system.file("mini-gap.xlsx", package = "googlesheets")) gap_xlsx gap_xlsx %>% get_via_lf(ws = "Oceania") ``` @@ -248,8 +268,8 @@ gap_xlsx %>% get_via_lf(ws = "Oceania") And we clean up after ourselves on Google Drive. ```{r delete-moar-sheets} -delete_ss("iris") -delete_ss("mini-gap") +gs_delete(iris_ss) +gs_delete(gap_xlsx) ``` ### Download sheets as csv, pdf, or xlsx file @@ -257,7 +277,8 @@ delete_ss("mini-gap") You can download a Google Sheet as a csv, pdf, or xlsx file. Downloading the spreadsheet as a csv file will export the first worksheet (default) unless another worksheet is specified. ```{r export-sheet-as-csv} -download_ss("Gapminder", ws = "Africa", to = "~/tmp/gapminder-africa.csv") +gs_title("Gapminder") %>% + gs_download(ws = "Africa", to = "~/tmp/gapminder-africa.csv") ## is it there? yes! read.csv("~/tmp/gapminder-africa.csv") %>% head() ``` @@ -265,7 +286,8 @@ read.csv("~/tmp/gapminder-africa.csv") %>% head() Download the entire spreadsheet as an Excel workbook. ```{r export-sheet-as-xlsx} -download_ss("Gapminder", to = "~/tmp/gapminder.xlsx") +gs_title("Gapminder") %>% + gs_download(to = "~/tmp/gapminder.xlsx") ``` Go check it out in Excel, if you wish! @@ -282,10 +304,10 @@ If you use a function that requires authentication, it will be auto-triggered. B ```{r auth, eval = FALSE} # Give googlesheets permission to access your spreadsheets and google drive -authorize() +gs_auth() ``` -Use `authorize(new_user = TRUE)`, to force the process to begin anew. Otherwise, the credentials left behind will be used to refresh your access token as needed. +Use `gs_auth(new_user = TRUE)`, to force the process to begin anew. Otherwise, the credentials left behind will be used to refresh your access token as needed. ### "Old" Google Sheets diff --git a/README.md b/README.md index f979bb0..751bd97 100644 --- a/README.md +++ b/README.md @@ -43,72 +43,94 @@ What other ideas do you have? devtools::install_github("jennybc/googlesheets") ``` +*We plan to submit to CRAN in late May or early June 2015, so feedback on functionality and usability is especially valuable to us now!* + ### Take a look at the vignette -This README is arguably as or more useful as the vignette and both are still under development. But feel free to [check out the current state of the vignette](http://htmlpreview.github.io/?https://raw.githubusercontent.com/jennybc/googlesheets/master/vignettes/basic-usage.html). +No, actually, **don't**. This README is much more current than the vignette, though that will have to change soon! + +If you insist, [check out the current state of the vignette](http://htmlpreview.github.io/?https://raw.githubusercontent.com/jennybc/googlesheets/master/vignettes/basic-usage.html). ### Load googlesheets -`googlesheets` is designed for use with the `%>%` pipe operator and, to a lesser extent, the data-wrangling mentality of `dplyr`. The examples here use both, but we'll soon develop a vignette that shows usage with plain vanilla R. `googlesheets` uses `dplyr` internally but does not require the user to do so. +`googlesheets` is designed for use with the `%>%` pipe operator and, to a lesser extent, the data-wrangling mentality of [`dplyr`](http://cran.r-project.org/web/packages/dplyr/index.html). This README uses both, but the examples in the help files emphasize usage with plain vanilla R, if that's how you roll. `googlesheets` uses `dplyr` internally but does not require the user to do so. You can make the `%>%` pipe operator availble in your own work by loading [`dplyr`](http://cran.r-project.org/web/packages/dplyr/index.html) or [`magrittr`](http://cran.r-project.org/web/packages/magrittr/index.html). ``` r library("googlesheets") suppressMessages(library("dplyr")) ``` +### Function naming convention + +*implementation not yet 100% complete ... but we'll get there soon* + +All functions start with `gs_`, which plays nicely with tab completion in RStudio, for example. If the function has something to do with worksheets or tabs within a spreadsheet, it will start with `gs_ws_`. + ### See some spreadsheets you can access -The `gs_ls()` function returns the sheets you would see in your Google Sheets home screen: . This should include sheets that you own and may also show sheets owned by others but that you are permitted to access, especially if you have clicked on a link shared by the owner. Expect a prompt to authenticate yourself in the browser at this point (more below re: authentication). +The `gs_ls()` function returns the sheets you would see in your Google Sheets home screen: . This should include sheets that you own and may also show sheets owned by others but that you are permitted to access, if you visited the sheet in the browser. Expect a prompt to authenticate yourself in the browser at this point (more below re: authentication). ``` r (my_sheets <- gs_ls()) -#> Source: local data frame [30 x 10] +#> Source: local data frame [32 x 10] #> -#> sheet_title owner perm version last_updated -#> 1 gas_mileage woo.kara r new 2015-05-01 23:37:42 -#> 2 Ari's Anchor Text Scrap… anahmani r old 2015-05-01 21:13:59 -#> 3 #rhizo15 #tw m.hawksey r new 2015-05-01 18:54:05 -#> 4 EasyTweetSheet - Shared m.hawksey r new 2015-05-02 00:38:33 -#> 5 test-gs-old-sheet2 gspreadr rw old 2015-04-30 23:33:48 -#> 6 test-gs-mini-gapminder rpackagetest r new 2015-04-25 18:25:43 -#> 7 test-gs-iris-private gspreadr rw new 2015-04-25 15:18:05 -#> 8 1F0iNuYW4v_oG69s7c5Nzdo… gspreadr rw new 2015-04-25 02:32:24 -#> 9 gs-test-testing helper gspreadr rw new 2015-04-25 02:31:42 -#> 10 test-gs-old-sheet rpackagetest r new 2015-04-24 21:46:56 +#> sheet_title author perm version updated +#> 1 Ari's Anchor Text Scrap… anahmani r old 2015-05-08 18:24:16 +#> 2 #rhizo15 #tw m.hawksey r new 2015-05-08 20:00:01 +#> 3 EasyTweetSheet - Shared m.hawksey r new 2015-05-08 21:58:48 +#> 4 gas_mileage woo.kara r new 2015-05-04 01:14:13 +#> 5 #TalkPay Tweets iskaldur r new 2015-05-02 06:25:14 +#> 6 test-gs-old-sheet2 gspreadr rw old 2015-04-30 23:33:48 +#> 7 test-gs-mini-gapminder rpackagetest r new 2015-04-25 18:25:43 +#> 8 test-gs-iris-private gspreadr rw new 2015-04-25 15:18:05 +#> 9 1F0iNuYW4v_oG69s7c5Nzdo… gspreadr rw new 2015-04-25 02:32:24 +#> 10 gs-test-testing helper gspreadr rw new 2015-04-25 02:31:42 #> .. ... ... ... ... ... #> Variables not shown: sheet_key (chr), ws_feed (chr), alternate (chr), self #> (chr), alt_key (chr) # (expect a prompt to authenticate with Google interactively HERE) my_sheets %>% glimpse() -#> Observations: 30 +#> Observations: 32 #> Variables: -#> $ sheet_title (chr) "gas_mileage", "Ari's Anchor Text Scraper", "#rhi... -#> $ owner (chr) "woo.kara", "anahmani", "m.hawksey", "m.hawksey",... -#> $ perm (chr) "r", "r", "r", "r", "rw", "r", "rw", "rw", "rw", ... -#> $ version (chr) "new", "old", "new", "new", "old", "new", "new", ... -#> $ last_updated (time) 2015-05-01 23:37:42, 2015-05-01 21:13:59, 2015-0... -#> $ sheet_key (chr) "1WH65aJjlmhOWYMFkhDuKPcRa5mloOtsTCKxrF7erHgI", "... -#> $ ws_feed (chr) "https://spreadsheets.google.com/feeds/worksheets... -#> $ alternate (chr) "https://docs.google.com/spreadsheets/d/1WH65aJjl... -#> $ self (chr) "https://spreadsheets.google.com/feeds/spreadshee... -#> $ alt_key (chr) NA, "0Av8m6X4cYe9hdFFLU1lWUndCWHNzVWZZRWFNZHQtYXc... +#> $ sheet_title (chr) "Ari's Anchor Text Scraper", "#rhizo15 #tw", "Easy... +#> $ author (chr) "anahmani", "m.hawksey", "m.hawksey", "woo.kara", ... +#> $ perm (chr) "r", "r", "r", "r", "r", "rw", "r", "rw", "rw", "r... +#> $ version (chr) "old", "new", "new", "new", "new", "old", "new", "... +#> $ updated (time) 2015-05-08 18:24:16, 2015-05-08 20:00:01, 2015-05... +#> $ sheet_key (chr) "tQKSYVRwBXssUfYEaMdt-aw", "1oBQNnsMY8Qkuui6BAE8Tn... +#> $ ws_feed (chr) "https://spreadsheets.google.com/feeds/worksheets/... +#> $ alternate (chr) "https://spreadsheets.google.com/ccc?key=0Av8m6X4c... +#> $ self (chr) "https://spreadsheets.google.com/feeds/spreadsheet... +#> $ alt_key (chr) "0Av8m6X4cYe9hdFFLU1lWUndCWHNzVWZZRWFNZHQtYXc", NA... ``` +### Get a Google spreadsheet to practice with + +If you don't have any suitable Google Sheets lying around, or if you just want to follow along verbatim with this vignette, this bit of code will copy a sheet from the `googlesheets` Google user into your Drive. The sheet holds some of the [Gapminder data](https://github.com/jennybc/gapminder). + +``` r +gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +gs_copy(gs_key(gap_key), to = "Gapminder") +``` + +If that seems to have worked, go check that you see a sheet named "Gapminder" listed in your Google Sheets home screen: . You could also run `gs_ls()` again and make sure the Gapminder sheet is listed. + ### Register a spreadsheet -If you plan to consume data from a sheet or edit it, you must first register it. Basically this is where `googlesheets` makes a note of important info about the sheet that's needed to access via the Sheets API. Once registered, you can print the result to get some basic info about the sheet. +If you plan to consume data from a sheet or edit it, you must first **register** it. This is how `googlesheets` records important info about the sheet that is required downstream by the Google Sheets or Google Drive APIs. Once registered, you can print the result to get some basic info about the sheet. + +`googlesheets` provides several registration functions. Specifying the sheet by title? Use `gs_title()`. By key? Use `gs_key()`. You get the idea. ``` r -# Hey let's look at the Gapminder data -gap <- register_ss("Gapminder") -#> Sheet identified! -#> sheet_title: Gapminder -#> sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA +gap <- gs_title("Gapminder") +#> Sheet successfully identifed: "Gapminder" gap #> Spreadsheet title: Gapminder -#> Date of googlesheets::register_ss: 2015-05-02 00:52:03 GMT +#> Date of googlesheets registration: 2015-05-08 22:14:25 GMT #> Date of last spreadsheet update: 2015-03-23 20:34:08 GMT #> visibility: private +#> permissions: rw +#> version: new #> #> Contains 5 worksheets: #> (Title): (Nominal worksheet extent as rows x columns) @@ -123,47 +145,37 @@ gap # Need to access a sheet you do not own? # Access it by key if you know it! gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap <- gap_key %>% register_ss -#> Sheet identified! -#> sheet_title: Gapminder -#> sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA +gap <- gap_key %>% gs_key +#> Authentication will be used. +#> Sheet successfully identifed: "Gapminder" -# googlesheets may be able to determine the key from the browser URL -# may not work (yet) for old sheets ... open an issue if have problem +# Have a sharing link? +# Access it by URL! gap_url <- "https://docs.google.com/spreadsheets/d/1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA/" -gap <- gap_url %>% register_ss -#> Identifying info will be processed as a URL. +gap <- gap_url %>% gs_url +#> Authentication will be used. +#> Sheet-identifying info appears to be a browser URL. #> googlesheets will attempt to extract sheet key from the URL. #> Putative key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA -#> Sheet identified! -#> sheet_title: Gapminder -#> sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA +#> Authentication will be used. +#> Sheet successfully identifed: "Gapminder" +# note: registration via URL may not work for "old" sheets ``` -### Get a Google spreadsheet to practice with - -If you don't have any suitable Google Sheets lying around, or if you just want to follow along verbatim with this vignette, this bit of code will copy a sheet from the `googlesheets` Google user into your Drive. The sheet holds some of the [Gapminder data](https://github.com/jennybc/gapminder). - -``` r -gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -copy_ss(key = gap_key, to = "Gapminder") -``` +These functions return a registered sheet as a `googlesheet` object, which is the first argument to practically every function in this package. Likewise, almost every function returns a freshly registered `googlesheet` object, ready to be stored or piped into the next command. -If that seems to have worked, go check that you see a sheet named Gapminder listed in your Google Sheets home screen: . You could also try `gs_ls()` again and make sure the Gapminder sheet is listed. +### Consume data -Now register your copy of the Gapminder sheet and you can follow along: +#### Ignorance is bliss -``` r -gap <- register_ss("Gapminder") -gap -``` +*coming soon: a wrapper for the functions described below that just gets the data you want, while you remain blissfully ignorant of how we're doing it* -### Consume data +#### Specify the consumption method There are three ways to consume data from a worksheet within a Google spreadsheet. The order goes from fastest-but-more-limited to slowest-but-most-flexible: - `get_via_csv()`: Don't let the name scare you! Nothing is written to file during this process. The name just reflects that, under the hood, we request the data via the "exportcsv" link. For cases where `get_via_csv()` and `get_via_lf()` both work, we see that `get_via_csv()` is around **50 times faster**. Use this when your data occupies a nice rectangle in the sheet and you're willing to consume all of it. You will get a `tbl_df` back, which is basically just a `data.frame`. -- `get_via_lf()`: Gets data via the ["list feed"](https://developers.google.com/google-apps/spreadsheets/#working_with_list-based_feeds), which consumes data row-by-row. Like `get_via_csv()`, this is appropriate when your data occupies a nice rectangle. You will again get a `tbl_df` back, but your variable names may have been mangled (by Google, not us!). Specifically, variable names will be forcefully lowercased and all non-alpha-numeric characters will be removed. Why do we even have this function? The list feed supports some query parameters for sorting and filtering the data, which we plan to support in the near future (\#17). +- `get_via_lf()`: Gets data via the ["list feed"](https://developers.google.com/google-apps/spreadsheets/#working_with_list-based_feeds), which consumes data row-by-row. Like `get_via_csv()`, this is appropriate when your data occupies a nice rectangle. You will again get a `tbl_df` back, but your variable names may have been mangled (by Google, not us!). Specifically, variable names will be forcefully lowercased and all non-alpha-numeric characters will be removed. Why do we even have this function? The list feed supports some query parameters for sorting and filtering the data, which we plan to support (\#17). - `get_via_cf()`: Get data via the ["cell feed"](https://developers.google.com/google-apps/spreadsheets/#working_with_cell-based_feeds), which consumes data cell-by-cell. This is appropriate when you want to consume arbitrary cells, rows, columns, and regions of the sheet. It works great for small amounts of data but can be rather slow otherwise. `get_via_cf()` returns a `tbl_df` with **one row per cell**. You can specify cell limits directly in `get_via_cf()` or use convenience wrappers `get_row()`, `get_col()` or `get_cells()` for some common special cases. See below for demos of `reshape_cf()` and `simplify_cf()` which help with post-processing. ``` r @@ -373,42 +385,45 @@ gap %>% You can use `googlesheets` to create new spreadsheets. ``` r -foo <- new_ss("foo") +foo <- gs_new("foo") #> Sheet "foo" created in Google Drive. -#> Identifying info is a googlesheet object; googlesheets will re-identify the sheet based on sheet key. -#> Sheet identified! -#> sheet_title: foo -#> sheet_key: 1PuKdPTW3Yu53w4SSGjv0pvIXx-b4IIj3bZD0rLs6ub4 foo #> Spreadsheet title: foo -#> Date of googlesheets::register_ss: 2015-05-02 00:52:12 GMT -#> Date of last spreadsheet update: 2015-05-02 00:52:10 GMT +#> Date of googlesheets registration: 2015-05-08 22:14:32 GMT +#> Date of last spreadsheet update: 2015-05-08 22:14:31 GMT #> visibility: private +#> permissions: rw +#> version: new #> #> Contains 1 worksheets: #> (Title): (Nominal worksheet extent as rows x columns) #> Sheet1: 1000 x 26 #> -#> Key: 1PuKdPTW3Yu53w4SSGjv0pvIXx-b4IIj3bZD0rLs6ub4 +#> Key: 1FbvMz7bUiSKRuQjKU7SjmXpWGUYUA3djybHTsXZ25Yg ``` -By default, there will be an empty worksheet called "Sheet1". You can also add, rename, and delete worksheets within an existing sheet via `add_ws()`, `rename_ws()`, and `delete_ws()`. Copy an entire spreadsheet with `copy_ss()`. +By default, there will be an empty worksheet called "Sheet1". You can also add, rename, and delete worksheets within an existing sheet via `gs_ws_new()`, `gs_ws_rename()`, and `gs_ws_delete()`. Copy an entire spreadsheet with `gs_copy()`. + +*`gs_new()` and `gs_ws_new()` will soon gain the ability to populate with data upon creation (\#116)* ### Edit cells -You can modify the data in sheet cells via `edit_cells()`. We'll work on the completely empty sheet created above, `foo`. If your edit populates the sheet with everything it should have, set `trim = TRUE` and we will resize the sheet to match the data. Then the nominal worksheet extent is much more informative (vs. the default of 1000 rows and 26 columns). +You can modify the data in sheet cells via `edit_cells()`. We'll work on the completely empty sheet created above, `foo`. If your edit populates the sheet with everything it should have, set `trim = TRUE` and we will resize the sheet to match the data. Then the nominal worksheet extent is much more informative (vs. the default of 1000 rows and 26 columns) and any future consumption via the cell feed will be much faster. ``` r foo <- foo %>% edit_cells(input = head(iris), header = TRUE, trim = TRUE) #> Range affected by the update: "A1:E7" #> Worksheet "Sheet1" successfully updated with 35 new value(s). #> Accessing worksheet titled "Sheet1" +#> Authentication will be used. +#> Sheet successfully identifed: "foo" +#> Accessing worksheet titled "Sheet1" #> Worksheet "Sheet1" dimensions changed to 7 x 5. ``` -Go to [your spreadsheets home page](https://docs.google.com/spreadsheets/u/0/), find the new sheet `foo` and look at it. You should see some iris data in the first (and only) worksheet. We'll also take a look at it here, by consuming `foo` via the list feed. +Go to [your Google Sheets home screen](https://docs.google.com/spreadsheets/u/0/), find the new sheet `foo` and look at it. You should see some iris data in the first (and only) worksheet. We'll also take a look at it here, by consuming `foo` via the list feed. -Note that we always store the returned value from `edit_cells()` (and all other sheet editing functions). That's because the registration info changes whenever we edit the sheet and we re-register it inside these functions, so this idiom will help you make sequential edits and queries to the same sheet. +Note how we always store the returned value from `edit_cells()` (and all other sheet editing functions). That's because the registration info changes whenever we edit the sheet and we re-register it inside these functions, so this idiom will help you make sequential edits and queries to the same sheet. ``` r foo %>% get_via_lf() @@ -431,10 +446,8 @@ Read the function documentation for `edit_cells()` for how to specify where the Let's clean up by deleting the `foo` spreadsheet we've been playing with. ``` r -delete_ss("foo") -#> Sheets found and slated for deletion: -#> foo -#> Success. All moved to trash in Google Drive. +gs_delete(foo) +#> Success. "foo" moved to trash in Google Drive. ``` ### Upload delimited files or Excel workbooks @@ -443,19 +456,21 @@ Here's how we can create a new spreadsheet from a suitable local file. First, we ``` r iris %>% head(5) %>% write.csv("iris.csv", row.names = FALSE) -iris_ss <- upload_ss("iris.csv") +iris_ss <- gs_upload("iris.csv") #> "iris.csv" uploaded to Google Drive and converted to a Google Sheet named "iris" iris_ss #> Spreadsheet title: iris -#> Date of googlesheets::register_ss: 2015-05-02 00:52:24 GMT -#> Date of last spreadsheet update: 2015-05-02 00:52:23 GMT +#> Date of googlesheets registration: 2015-05-08 22:14:45 GMT +#> Date of last spreadsheet update: 2015-05-08 22:14:43 GMT #> visibility: private +#> permissions: rw +#> version: new #> #> Contains 1 worksheets: #> (Title): (Nominal worksheet extent as rows x columns) #> iris: 6 x 5 #> -#> Key: 1eVg35u6UEQrsoBLtZtbGTes4CKy8_sZ6jojGQC6pkN0 +#> Key: 1hVwexynuPsTxVDbTk6-aB6PqCwbVV9zyxt3WfwRrfU4 iris_ss %>% get_via_lf() #> Accessing worksheet titled "iris" #> Source: local data frame [5 x 5] @@ -473,13 +488,15 @@ file.remove("iris.csv") Now we'll upload a multi-sheet Excel workbook. Slowly. ``` r -gap_xlsx <- upload_ss("tests/testthat/mini-gap.xlsx") +gap_xlsx <- gs_upload(system.file("mini-gap.xlsx", package = "googlesheets")) #> "mini-gap.xlsx" uploaded to Google Drive and converted to a Google Sheet named "mini-gap" gap_xlsx #> Spreadsheet title: mini-gap -#> Date of googlesheets::register_ss: 2015-05-02 00:52:28 GMT -#> Date of last spreadsheet update: 2015-05-02 00:52:27 GMT +#> Date of googlesheets registration: 2015-05-08 22:14:50 GMT +#> Date of last spreadsheet update: 2015-05-08 22:14:48 GMT #> visibility: private +#> permissions: rw +#> version: new #> #> Contains 5 worksheets: #> (Title): (Nominal worksheet extent as rows x columns) @@ -489,7 +506,7 @@ gap_xlsx #> Europe: 20 x 6 #> Oceania: 20 x 6 #> -#> Key: 1kLpGLJkhtIX3G8dxH9EVH6ZUDPUder0eDgAZmzCJi3E +#> Key: 1dZMbPWsEVJlfu1a0SoryJoWGRDfMXj-uLDGwRjRGgmI gap_xlsx %>% get_via_lf(ws = "Oceania") #> Accessing worksheet titled "Oceania" #> Source: local data frame [5 x 6] @@ -505,14 +522,10 @@ gap_xlsx %>% get_via_lf(ws = "Oceania") And we clean up after ourselves on Google Drive. ``` r -delete_ss("iris") -#> Sheets found and slated for deletion: -#> iris -#> Success. All moved to trash in Google Drive. -delete_ss("mini-gap") -#> Sheets found and slated for deletion: -#> mini-gap -#> Success. All moved to trash in Google Drive. +gs_delete(iris_ss) +#> Success. "iris" moved to trash in Google Drive. +gs_delete(gap_xlsx) +#> Success. "mini-gap" moved to trash in Google Drive. ``` ### Download sheets as csv, pdf, or xlsx file @@ -520,10 +533,9 @@ delete_ss("mini-gap") You can download a Google Sheet as a csv, pdf, or xlsx file. Downloading the spreadsheet as a csv file will export the first worksheet (default) unless another worksheet is specified. ``` r -download_ss("Gapminder", ws = "Africa", to = "~/tmp/gapminder-africa.csv") -#> Sheet identified! -#> sheet_title: Gapminder -#> sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA +gs_title("Gapminder") %>% + gs_download(ws = "Africa", to = "~/tmp/gapminder-africa.csv") +#> Sheet successfully identifed: "Gapminder" #> Accessing worksheet titled "Africa" #> Sheet successfully downloaded: /Users/jenny/tmp/gapminder-africa.csv ## is it there? yes! @@ -540,10 +552,9 @@ read.csv("~/tmp/gapminder-africa.csv") %>% head() Download the entire spreadsheet as an Excel workbook. ``` r -download_ss("Gapminder", to = "~/tmp/gapminder.xlsx") -#> Sheet identified! -#> sheet_title: Gapminder -#> sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA +gs_title("Gapminder") %>% + gs_download(to = "~/tmp/gapminder.xlsx") +#> Sheet successfully identifed: "Gapminder" #> Sheet successfully downloaded: /Users/jenny/tmp/gapminder.xlsx ``` @@ -562,10 +573,10 @@ If you use a function that requires authentication, it will be auto-triggered. B ``` r # Give googlesheets permission to access your spreadsheets and google drive -authorize() +gs_auth() ``` -Use `authorize(new_user = TRUE)`, to force the process to begin anew. Otherwise, the credentials left behind will be used to refresh your access token as needed. +Use `gs_auth(new_user = TRUE)`, to force the process to begin anew. Otherwise, the credentials left behind will be used to refresh your access token as needed. ### "Old" Google Sheets diff --git a/tests/testthat/mini-gap.csv b/inst/mini-gap.csv similarity index 100% rename from tests/testthat/mini-gap.csv rename to inst/mini-gap.csv diff --git a/tests/testthat/mini-gap.ods b/inst/mini-gap.ods similarity index 100% rename from tests/testthat/mini-gap.ods rename to inst/mini-gap.ods diff --git a/tests/testthat/mini-gap.tsv b/inst/mini-gap.tsv similarity index 100% rename from tests/testthat/mini-gap.tsv rename to inst/mini-gap.tsv diff --git a/tests/testthat/mini-gap.txt b/inst/mini-gap.txt similarity index 100% rename from tests/testthat/mini-gap.txt rename to inst/mini-gap.txt diff --git a/tests/testthat/mini-gap.xlsx b/inst/mini-gap.xlsx similarity index 100% rename from tests/testthat/mini-gap.xlsx rename to inst/mini-gap.xlsx diff --git a/man/copy_ss.Rd b/man/copy_ss.Rd deleted file mode 100644 index 121b47d..0000000 --- a/man/copy_ss.Rd +++ /dev/null @@ -1,44 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{copy_ss} -\alias{copy_ss} -\title{Make a copy of an existing spreadsheet} -\usage{ -copy_ss(from, key = NULL, to = NULL, verbose = TRUE) -} -\arguments{ -\item{from}{sheet-identifying information, either a googlesheet object or a -character vector of length one, giving a URL, sheet title, key or -worksheets feed} - -\item{key}{character string guaranteed to provide unique key of the sheet; -overrides \code{from}} - -\item{to}{character string giving the new title of the sheet; if \code{NULL}, -then the copy will be titled "Copy of ..."} - -\item{verbose}{logical; do you want informative message?} -} -\description{ -You can copy a spreadsheet that you own or a sheet owned by a third party -that has been made accessible via the sharing dialog options. If the sheet -you want to copy is visible in the listing provided by -\code{\link{gs_ls}}, you can specify it by title (or any of the other -spreadsheet-identifying methods). Otherwise, you'll have to explicitly -specify it by key. -} -\note{ -if two sheets with the same name exist in your Google drive then sheet - with the most recent "last updated" timestamp will be copied. -} -\examples{ -\dontrun{ -gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "Gapminder_copy") -gap_ss -} -} -\seealso{ -\code{\link{identify_ss}}, \code{\link{extract_key_from_url}} -} - diff --git a/man/delete_ss.Rd b/man/delete_ss.Rd deleted file mode 100644 index 29b547e..0000000 --- a/man/delete_ss.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{delete_ss} -\alias{delete_ss} -\title{Move spreadsheets to trash on Google Drive} -\usage{ -delete_ss(x = NULL, regex = NULL, verbose = TRUE, ...) -} -\arguments{ -\item{x}{sheet-identifying information, either a googlesheet object or a -character vector of length one, giving a URL, sheet title, key or -worksheets feed; if \code{x} is specified, the \code{regex} argument will -be ignored} - -\item{regex}{character; a regular expression; sheets whose titles match will -be deleted} - -\item{verbose}{logical; do you want informative message?} - -\item{...}{optional arguments to be passed to \code{\link{grepl}} when -matching \code{regex} to sheet titles} -} -\value{ -tbl_df with one row per specified or matching sheet, a variable - holding spreadsheet titles, a logical vector indicating deletion success -} -\description{ -You must own a sheet in order to move it to the trash. If you try to delete a -sheet you do not own, a 403 Forbidden HTTP status code will be returned; such -shared spreadsheets can only be moved to the trash manually in the web -browser. If you trash a spreadsheet that is shared with others, it will no -longer appear in any of their Google Drives. If you delete something by -mistake, remain calm, and visit the -\href{https://drive.google.com/drive/#trash}{trash in Google Drive}, find the -sheet, and restore it. -} -\note{ -If there are multiple sheets with the same name and you don't want to - delete them all, identify the sheet to be deleted via key. -} -\examples{ -\dontrun{ -foo <- new_ss("foo") -foo <- edit_cells(foo, input = head(iris)) -delete_ss("foo") -} -} - diff --git a/man/download_ss.Rd b/man/download_ss.Rd deleted file mode 100644 index 9f00680..0000000 --- a/man/download_ss.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/download-spreadsheets.R -\name{download_ss} -\alias{download_ss} -\title{Download a Google spreadsheet} -\usage{ -download_ss(from, key = NULL, ws = NULL, to = "my_sheet.xlsx", - overwrite = FALSE, verbose = TRUE) -} -\arguments{ -\item{from}{sheet-identifying information, either a googlesheet object or a -character vector of length one, giving a URL, sheet title, key or -worksheets feed} - -\item{key}{character string guaranteed to provide unique key of the sheet; -overrides \code{from}} - -\item{ws}{positive integer or character string specifying index or title, -respectively, of the worksheet to export; if \code{NULL} then the entire -spreadsheet will be exported} - -\item{to}{path to write file, if it does not contain the absolute path, then -the file is relative to the current working directory; file extension must -be one of .csv, .pdf, or .xlsx} - -\item{overwrite}{logical indicating whether to overwrite an existing local -file} - -\item{verbose}{logical; do you want informative message?} -} -\description{ -Export a Google sheet as a .csv, .pdf, or .xlsx file. You can download a -sheet that you own or a sheet owned by a third party that has been made -accessible via the sharing dialog options. You can download an entire -spreadsheet or a single worksheet from a spreadsheet if you provide worksheet -identifying information. If the chosen format is csv, the first worksheet -will be exported, unless another worksheet is specified. If pdf format is -chosen, all sheets will be catenated into one PDF document. -} -\examples{ -\dontrun{ -gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -download_ss(gap_key, to = "gapminder.xlsx") -file.remove("gapminder.xlsx") -} -} - diff --git a/man/edit_cells.Rd b/man/edit_cells.Rd index 8936c3c..7a3492f 100644 --- a/man/edit_cells.Rd +++ b/man/edit_cells.Rd @@ -45,15 +45,15 @@ from the anchor across a row or down a column. } \examples{ \dontrun{ -yo <- new_ss("yo") +yo <- gs_new("yo") yo <- edit_cells(yo, input = head(iris), header = TRUE, trim = TRUE) get_via_csv(yo) -yo <- add_ws(yo, "byrow_FALSE") +yo <- gs_ws_new(yo, "byrow_FALSE") yo <- edit_cells(yo, ws = "byrow_FALSE", LETTERS[1:5], "A8") get_via_cf(yo, ws = "byrow_FALSE", min_row = 7) \%>\% simplify_cf() -yo <- add_ws(yo, "byrow_TRUE") +yo <- gs_ws_new(yo, "byrow_TRUE") yo <- edit_cells(yo, ws = "byrow_TRUE", LETTERS[1:5], "A8", byrow = TRUE) get_via_cf(yo, ws = "byrow_TRUE", min_row = 7) \%>\% simplify_cf() } diff --git a/man/extract_key_from_url.Rd b/man/extract_key_from_url.Rd index 1508d49..ce67de9 100644 --- a/man/extract_key_from_url.Rd +++ b/man/extract_key_from_url.Rd @@ -2,21 +2,23 @@ % Please edit documentation in R/utils.R \name{extract_key_from_url} \alias{extract_key_from_url} -\title{Extract sheet key from its browser URL} +\title{Extract sheet key from a URL} \usage{ extract_key_from_url(url) } \arguments{ -\item{url}{URL seen in the browser when visiting the sheet} +\item{url}{character; a URL associated with a Google Sheet} } \description{ -Extract sheet key from its browser URL +Extract a sheet's unique key from a wide variety of URLs, i.e. a browser URL +for both old and new Sheets, the "worksheets feed", and other links returned +by the Sheets API. } \examples{ \dontrun{ gap_url <- "https://docs.google.com/spreadsheets/d/1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA/" gap_key <- extract_key_from_url(gap_url) -gap_ss <- register_ss(gap_key) +gap_ss <- gs_key(gap_key) gap_ss } } diff --git a/man/gdrive_GET.Rd b/man/gdrive_GET.Rd index 8c74045..ae40fbc 100644 --- a/man/gdrive_GET.Rd +++ b/man/gdrive_GET.Rd @@ -14,7 +14,7 @@ gdrive_GET(url, ...) parameters will be combined with \code{\link[httr]{config}}.} } \description{ -Used in download_ss() +Used in gs_download() } \keyword{internal} diff --git a/man/gdrive_POST.Rd b/man/gdrive_POST.Rd index 438a189..f2f0be5 100644 --- a/man/gdrive_POST.Rd +++ b/man/gdrive_POST.Rd @@ -14,7 +14,7 @@ gdrive_POST(url, ...) parameters will be combined with \code{\link[httr]{config}}.} } \description{ -Used in new_ss(), delete_ss(), copy_ss() +Used in gs_new(), gs_delete(), gs_copy() } \keyword{internal} diff --git a/man/gdrive_PUT.Rd b/man/gdrive_PUT.Rd index c9fda75..36e3cd4 100644 --- a/man/gdrive_PUT.Rd +++ b/man/gdrive_PUT.Rd @@ -12,7 +12,7 @@ gdrive_PUT(url, the_body) \item{the_body}{body of PUT request} } \description{ -Used in upload_ss() +Used in gs_upload() } \keyword{internal} diff --git a/man/get_cells.Rd b/man/get_cells.Rd index 1d57854..9a963b8 100644 --- a/man/get_cells.Rd +++ b/man/get_cells.Rd @@ -25,7 +25,7 @@ Get data via the cell feed for a rectangular range of cells \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") get_cells(gap_ss, "Europe", range = "B3:D7") simplify_cf(get_cells(gap_ss, "Europe", range = "A1:F1")) } diff --git a/man/get_col.Rd b/man/get_col.Rd index 34e825e..c19a267 100644 --- a/man/get_col.Rd +++ b/man/get_col.Rd @@ -24,7 +24,7 @@ Get data via the cell feed for one column or for a range of columns. \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") get_col(gap_ss, "Oceania", col = 1:2) reshape_cf(get_col(gap_ss, "Oceania", col = 1:2)) } diff --git a/man/get_google_token.Rd b/man/get_google_token.Rd index 32711be..a8161ac 100644 --- a/man/get_google_token.Rd +++ b/man/get_google_token.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/auth.R +% Please edit documentation in R/gs-auth.R \name{get_google_token} \alias{get_google_token} \title{Retrieve Google token from environment} diff --git a/man/get_row.Rd b/man/get_row.Rd index 9209078..70570f2 100644 --- a/man/get_row.Rd +++ b/man/get_row.Rd @@ -24,7 +24,7 @@ Get data via the cell feed for one row or for a range of rows. \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") get_row(gap_ss, "Europe", row = 1) simplify_cf(get_row(gap_ss, "Europe", row = 1)) } diff --git a/man/get_via_cf.Rd b/man/get_via_cf.Rd index e96b515..df5468c 100644 --- a/man/get_via_cf.Rd +++ b/man/get_via_cf.Rd @@ -59,7 +59,7 @@ feed will return all cells, which defaults to 1000 rows and 26 columns. \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") get_via_cf(gap_ss, "Asia", max_row = 4) reshape_cf(get_via_cf(gap_ss, "Asia", max_row = 4)) reshape_cf(get_via_cf(gap_ss, "Asia", diff --git a/man/get_via_csv.Rd b/man/get_via_csv.Rd index 5cf3987..7444d4a 100644 --- a/man/get_via_csv.Rd +++ b/man/get_via_csv.Rd @@ -37,7 +37,7 @@ data, this is the fastest way to get it. \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") oceania_csv <- get_via_csv(gap_ss, ws = "Oceania") str(oceania_csv) oceania_csv diff --git a/man/get_via_lf.Rd b/man/get_via_lf.Rd index e880026..5b0db67 100644 --- a/man/get_via_lf.Rd +++ b/man/get_via_lf.Rd @@ -37,7 +37,7 @@ When you use the listfeed, the Sheets API transforms the variable or \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") oceania_lf <- get_via_lf(gap_ss, ws = "Oceania") str(oceania_lf) oceania_lf diff --git a/man/googlesheet.Rd b/man/googlesheet.Rd index 16baea9..00937af 100644 --- a/man/googlesheet.Rd +++ b/man/googlesheet.Rd @@ -1,43 +1,91 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/googlesheet.R +% Please edit documentation in R/gs_register.R \name{googlesheet} \alias{googlesheet} -\title{The googlesheet object} +\alias{gs_key} +\alias{gs_title} +\alias{gs_url} +\alias{gs_ws_feed} +\title{Register a Google Sheet} \usage{ -googlesheet() +gs_title(x, verbose = TRUE) + +gs_key(x, lookup = NULL, visibility = NULL, verbose = TRUE) + +gs_url(x, lookup = NULL, visibility = NULL, verbose = TRUE) + +gs_ws_feed(x, lookup = NULL, verbose = TRUE) +} +\arguments{ +\item{x}{sheet-identifying information; a character vector of length one +holding sheet title, key, browser URL or worksheets feed} + +\item{verbose}{logical} + +\item{lookup}{logical, optional. Controls whether \code{googlesheets} will +place authenticated API requests during registration. If unspecified, will +be set to \code{TRUE} if authentication has previously been used in this R +session or if working directory contains a file named \code{.httr-oauth}.} + +\item{visibility}{character, either "public" or "private". Consulted during +explicit construction of a worksheets feed from a key, which happens only +when \code{lookup = FALSE} and \code{googlesheets} is prevented from +looking up information in the spreadsheets feed. If unspecified, will be +set to "public" if \code{lookup = FALSE} and "private" if \code{lookup = +TRUE}.} +} +\value{ +a \code{googlesheet} object } \description{ -The googlesheet object stores information that \code{googlesheets} requires in -order to communicate with the -\href{https://developers.google.com/google-apps/spreadsheets/}{Google Sheets -API}. +The \code{googlesheets} package must gather information on a Google Sheet +from \href{https://developers.google.com/google-apps/spreadsheets/}{the API} +prior to any requests to read or write data. We call this +\strong{registering} the sheet and store the result in a \code{googlesheet} +object. Note this object does not contain any sheet data, but rather contains +metadata about the sheet. We populate a \code{googlesheet} +object with information from the +\href{https://developers.google.com/google-apps/spreadsheets/#working_with_worksheets}{worksheets +feed} and, if available, also from the +\href{https://developers.google.com/google-apps/spreadsheets/#retrieving_a_list_of_spreadsheets}{spreadsheets +feed}. Choose from the functions below depending on the type of +sheet-identifying input you will provide. Is it a sheet title, key, +browser URL, or worksheets feed (another URL, mostly used internally)? } \details{ -Very little of this is of interest to the user. A googlesheet object -includes the fields: +A registered \code{googlesheet} will contain information on: + +\itemize{ + \item \code{sheet_key} the key of the spreadsheet + \item \code{sheet_title} the title of the spreadsheet + \item \code{n_ws} the number of worksheets contained in the spreadsheet + \item \code{ws_feed} the "worksheets feed" of the spreadsheet + \item \code{updated} the time of last update (at time of registration) + \item \code{reg_date} the time of registration + \item \code{visibility} visibility of spreadsheet (Google's confusing + vocabulary); actually, does not describe a property of spreadsheet + itself but rather whether requests will be made with or without + authentication + \item \code{is_public} logical indicating visibility is "public" (meaning + unauthenticated requests will be sent), as opposed to "private" (meaning + authenticated requests will be sent) + \item \code{author} the name of the owner + \item \code{email} the email of the owner + \item \code{links} data.frame of links specific to the spreadsheet + \item \code{ws} a data.frame about the worksheets contained in the + spreadsheet +} + +A \code{googlesheet} object will contain this information from the +spreadsheets feed if it was available at the time of registration: \itemize{ -\item \code{sheet_key} the key of the spreadsheet -\item \code{sheet_title} the title of the spreadsheet -\item \code{n_ws} the number of worksheets contained in the spreadsheet -\item \code{ws_feed} the "worksheets feed" of the spreadsheet -\item \code{sheet_id} the id of the spreadsheet -\item \code{updated} the time of last update (at time of registration) -\item \code{get_date} the time of registration -\item \code{visibility} visibility of spreadsheet (Google's confusing -vocabulary); actually, does not describe a property of spreadsheet itself but -rather whether requests will be made with or without authentication -\item \code{is_public} logical indicating visibility is "public", as opposed to "private" -\item \code{author_name} the name of the owner -\item \code{author_email} the email of the owner -\item \code{links} data.frame of links specific to the spreadsheet -\item \code{ws} a data.frame about the worksheets contained in the -spreadsheet -\item \code{alt_key} alternate key; applies only to "old" sheets + \item \code{alt_key} alternate key; applies only to "old" sheets } -TO DO: this documentation is neither here nor there. Either the object is -self-explanatory and this isn't really needed. Or this needs to get beefed -up. Probably the latter. +Since the spreadsheets feed contains private user data, \code{googlesheets} +must use authentication to access it. So a \code{googlesheet} object will +only contain info from the spreadsheets feed if \code{lookup = TRUE}, which +directs us to look up sheet-identifying information in the spreadsheets feed. } diff --git a/man/authorize.Rd b/man/gs_auth.Rd similarity index 87% rename from man/authorize.Rd rename to man/gs_auth.Rd index c02bbf6..440c1ef 100644 --- a/man/authorize.Rd +++ b/man/gs_auth.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/auth.R -\name{authorize} -\alias{authorize} +% Please edit documentation in R/gs-auth.R +\name{gs_auth} +\alias{gs_auth} \title{Authorize \code{googlesheets} to access user data from Google} \usage{ -authorize(new_user = FALSE) +gs_auth(new_user = FALSE) } \arguments{ \item{new_user}{logical, defaults to \code{FALSE}. Set to \code{TRUE} if you diff --git a/man/gs_copy.Rd b/man/gs_copy.Rd new file mode 100644 index 0000000..07feb3c --- /dev/null +++ b/man/gs_copy.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/gs_copy.R +\name{gs_copy} +\alias{gs_copy} +\title{Copy of an existing spreadsheet} +\usage{ +gs_copy(from, to = NULL, verbose = TRUE) +} +\arguments{ +\item{from}{a \code{\link{googlesheet}} object, i.e. a registered Google +sheet} + +\item{to}{character string giving the new title of the sheet; if \code{NULL}, +then the copy will be titled "Copy of ..."} + +\item{verbose}{logical; do you want informative message?} +} +\description{ +You can copy a spreadsheet that you own or a sheet owned by a third party +that has been made accessible via the sharing dialog options. This function +calls the \href{https://developers.google.com/drive/v2/reference/}{Google +Drive API}. +} +\examples{ +\dontrun{ +gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +gap_ss <- gs_copy(gs_key(gap_key), to = "Gapminder_copy") +gap_ss +} +} + diff --git a/man/gs_delete.Rd b/man/gs_delete.Rd new file mode 100644 index 0000000..5753dfd --- /dev/null +++ b/man/gs_delete.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/gs_delete.R +\name{gs_delete} +\alias{gs_delete} +\title{Delete a spreadsheet} +\usage{ +gs_delete(x, verbose = TRUE) +} +\arguments{ +\item{x}{a \code{\link{googlesheet}} object, i.e. a registered Google sheet} + +\item{verbose}{logical; do you want informative message?} +} +\value{ +logical indicating if the deletion was successful +} +\description{ +Move a spreadsheet to trash on Google Drive. You must own a sheet in order to +move it to the trash. If you try to delete a sheet you do not own, a 403 +Forbidden HTTP status code will be returned; third party spreadsheets can +only be moved to the trash manually in the web browser (which only removes +them from your Google Sheets home screen, in any case). If you trash a +spreadsheet that is shared with others, it will no longer appear in any of +their Google Drives. If you delete something by mistake, remain calm, and +visit the \href{https://drive.google.com/drive/#trash}{trash in Google +Drive}, find the sheet, and restore it. +} +\examples{ +\dontrun{ +foo <- gs_new("new_sheet") +gs_delete(foo) + +foo <- gs_new("new_sheet") +gs_delete(gs_title("new_sheet")) +} +} +\seealso{ +\code{\link{gs_grepdel}} and \code{\link{gs_vecdel}} for handy + wrappers to help you delete multiple sheets at once by title +} + diff --git a/man/gs_download.Rd b/man/gs_download.Rd new file mode 100644 index 0000000..854e59c --- /dev/null +++ b/man/gs_download.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/gs_download.R +\name{gs_download} +\alias{gs_download} +\title{Download a spreadsheet} +\usage{ +gs_download(from, ws = NULL, to = "my_sheet.xlsx", overwrite = FALSE, + verbose = TRUE) +} +\arguments{ +\item{from}{a \code{\link{googlesheet}} object, i.e. a registered Google +sheet} + +\item{ws}{positive integer or character string specifying index or title, +respectively, of the worksheet to export; if \code{NULL} then the entire +spreadsheet will be exported (.pdf and xlsx formats) or the first worksheet +will be exported (.csv format)} + +\item{to}{path to write file; file extension must be one of .csv, .pdf, or +.xlsx, which dictates the export format} + +\item{overwrite}{logical, indicating whether to overwrite an existing local +file} + +\item{verbose}{logical; do you want informative message?} +} +\description{ +Export a Google Sheet as a .csv, .pdf, or .xlsx file. You can download a +sheet that you own or a sheet owned by a third party that has been made +accessible via the sharing dialog options. You can download the entire +spreadsheet (.pdf and .xlsx formats) or a single worksheet. This function +calls the \href{https://developers.google.com/drive/v2/reference/}{Google +Drive API}. +} +\examples{ +\dontrun{ +gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +gs_download(gs_key(gap_key), to = "gapminder.xlsx") +file.remove("gapminder.xlsx") +} +} + diff --git a/man/gs_grepdel.Rd b/man/gs_grepdel.Rd new file mode 100644 index 0000000..3dab956 --- /dev/null +++ b/man/gs_grepdel.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/gs_delete.R +\name{gs_grepdel} +\alias{gs_grepdel} +\alias{gs_vecdel} +\title{Delete several sheets at once by title} +\usage{ +gs_grepdel(regex, ..., verbose = TRUE) + +gs_vecdel(vec, verbose = TRUE) +} +\arguments{ +\item{regex}{character; a regular expression; sheets whose titles match will +be deleted} + +\item{...}{optional arguments to be passed to \code{\link{grep}} when +matching \code{regex} to sheet titles} + +\item{verbose}{logical; do you want informative message?} + +\item{vec}{character vector of sheet titles to delete} +} +\description{ +These functions violate the general convention of operating on a registered +Google sheet, i.e. on a \code{\link{googlesheet}} object. But the need to +delete a bunch of sheets at once, based on a vector of titles or on a regular +expression, came up so much during development and testing, that it seemed +wise to package this as a function. +} +\examples{ +\dontrun{ +sheet_title <- c("cat", "catherine", "tomCAT", "abdicate", "FLYCATCHER") +ss <- lapply(paste0("TEST-", sheet_title), gs_new) +# list, for safety!, then delete 'TEST-abdicate' and 'TEST-catherine' +gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]+$") +gs_grepdel(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]+$") + +# list, for safety!, then delete the rest, +# i.e. 'TEST-cat', 'TEST-tomCAT', and 'TEST-FLYCATCHER' +gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) +gs_grepdel(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) + +## using gs_vecdel() +sheet_title <- c("cat", "catherine", "tomCAT", "abdicate", "FLYCATCHER") +ss <- lapply(paste0("TEST-", sheet_title), gs_new) +# delete two of these sheets +gs_vecdel(c("TEST-cat", "TEST-abdicate")) +# see? they are really gone, but the others remain +gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) +# delete the remainder +gs_vecdel(c("TEST-FLYCATCHER", "TEST-tomCAT", "TEST-catherine")) +# see? they are all gone now +gs_ls(regex = "TEST-[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) +} +} + diff --git a/man/gs_ls.Rd b/man/gs_ls.Rd index ffcb8b0..779e454 100644 --- a/man/gs_ls.Rd +++ b/man/gs_ls.Rd @@ -2,13 +2,23 @@ % Please edit documentation in R/gs_ls.R \name{gs_ls} \alias{gs_ls} -\title{List available spreadsheets} +\title{List spreadsheets à la Google Sheets home screen} \usage{ -gs_ls() +gs_ls(regex = NULL, ..., verbose = TRUE) +} +\arguments{ +\item{regex}{character; a regular expression; if non-\code{NULL} only sheets +whose titles match will be listed} + +\item{...}{optional arguments to be passed to \code{\link{grep}} when +matching \code{regex} to sheet titles} + +\item{verbose}{logical; do you want informative message?} } \value{ a \code{googlesheet_ls} object, which is a - \code{\link[dplyr]{tbl_df}} with one row per sheet + \code{\link[dplyr]{tbl_df}} with one row per sheet (we use a custom class + only to control how this object is printed) } \description{ Lists spreadsheets that the user would see in the Google Sheets home screen: @@ -20,25 +30,27 @@ feed} of the Google Sheets API. Since this is non-public user data, use of } \details{ This listing gives a \emph{partial} view of the sheets available for access -(why just partial? see below). For these sheets, get sheet title, sheet key, -owner, user's permission, date-time of last update, version (old vs new -sheet?), various links, and an alternate key (only relevant to old sheets). +(why just partial? see below). For these sheets, we retrieve sheet title, +sheet key, author, user's permission, date-time of last update, version (old +vs new sheet?), various links, and an alternate key (only relevant to old +sheets). The resulting table provides a map between readily available information, such as sheet title, and more obscure information you might use in scripts, -such as the sheet key. This sort of "table lookup" is implemented in the -helper function \code{\link{identify_ss}}. +such as the sheet key. This sort of "table lookup" is exploited in the +functions \code{\link{gs_title}}, \code{\link{gs_key}}, \code{\link{gs_url}}, +and \code{\link{gs_ws_feed}}, which register a sheet based on various forms +of user input. -Which sheets show up here? Certainly those owned by the user. But also a -subset of the sheets owned by others but visible to the user. We have yet to -find explicit Google documentation on this matter. Anecdotally, sheets owned -by a third party but for which the user has read access seem to appear in -this listing if the user has visited them in the browser. This is an +Which sheets show up in this table? Certainly those owned by the user. But +also a subset of the sheets owned by others but visible to the user. We have +yet to find explicit Google documentation on this matter. Anecdotally, sheets +owned by a third party but for which the user has read access seem to appear +in this listing if the user has visited them in the browser. This is an important point for usability because a sheet can be summoned by title instead of key \emph{only} if it appears in this listing. For shared sheets -that may not appear in this listing, a more robust workflow is to extract the -key from the browser URL via \code{\link{extract_key_from_url}} and -explicitly specify the sheet in \code{googlesheets} functions by key. +that may not appear in this listing, a more robust workflow is to specify the +sheet via its browser URL or unique sheet key. } \examples{ \dontrun{ diff --git a/man/new_ss.Rd b/man/gs_new.Rd similarity index 51% rename from man/new_ss.Rd rename to man/gs_new.Rd index f8f0d3f..30401a4 100644 --- a/man/new_ss.Rd +++ b/man/gs_new.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{new_ss} -\alias{new_ss} +% Please edit documentation in R/gs_new.R +\name{gs_new} +\alias{gs_new} \title{Create a new spreadsheet} \usage{ -new_ss(title = "my_sheet", verbose = TRUE) +gs_new(title = "my_sheet", verbose = TRUE) } \arguments{ \item{title}{the title for the new sheet} @@ -12,15 +12,17 @@ new_ss(title = "my_sheet", verbose = TRUE) \item{verbose}{logical; do you want informative message?} } \value{ -a googlesheet object +a \code{\link{googlesheet}} object } \description{ Create a new (empty) spreadsheet in your Google Drive. The new sheet will -contain 1 default worksheet titled "Sheet1". +contain 1 default worksheet titled "Sheet1". This function +calls the \href{https://developers.google.com/drive/v2/reference/}{Google +Drive API}. } \examples{ \dontrun{ -foo <- new_ss("foo") +foo <- gs_new("foo") foo } } diff --git a/man/gs_upload.Rd b/man/gs_upload.Rd new file mode 100644 index 0000000..ef7f417 --- /dev/null +++ b/man/gs_upload.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/gs_upload.R +\name{gs_upload} +\alias{gs_upload} +\title{Upload a file and convert it to a Google Sheet} +\usage{ +gs_upload(file, sheet_title = NULL, verbose = TRUE) +} +\arguments{ +\item{file}{path to the file to upload} + +\item{sheet_title}{the title of the spreadsheet; optional, if not specified +then the name of the file will be used} + +\item{verbose}{logical; do you want informative message?} +} +\description{ +Google supports the following file types to be converted to a Google +spreadsheet: .xls, .xlsx, .csv, .tsv, .txt, .tab, .xlsm, .xlt, .xltx, .xltm, +.ods. The newly uploaded file will appear in your Google Sheets home screen. +This function calls the +\href{https://developers.google.com/drive/v2/reference/}{Google Drive API}. +} +\examples{ +\dontrun{ +write.csv(head(iris, 5), "iris.csv", row.names = FALSE) +iris_ss <- gs_upload("iris.csv") +iris_ss +get_via_lf(iris_ss) +file.remove("iris.csv") +gs_delete(iris_ss) +} +} + diff --git a/man/get_ws.Rd b/man/gs_ws.Rd similarity index 65% rename from man/get_ws.Rd rename to man/gs_ws.Rd index 41fb819..55e41d5 100644 --- a/man/get_ws.Rd +++ b/man/gs_ws.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/utils.R -\name{get_ws} -\alias{get_ws} +% Please edit documentation in R/gs_ws.R +\name{gs_ws} +\alias{gs_ws} \title{Retrieve a worksheet-describing list from a googlesheet} \usage{ -get_ws(ss, ws, verbose = TRUE) +gs_ws(ss, ws, verbose = TRUE) } \arguments{ \item{ss}{a registered Google spreadsheet} @@ -16,8 +16,8 @@ respectively, of the worksheet to consume} worksheet being accessed} } \description{ -From a googlesheet, retrieve a list (actually a row of a data.frame) giving -everything we know about a specific worksheet. +From a \code{\link{googlesheet}}, retrieve a list (actually a row of a +data.frame) giving everything we know about a specific worksheet. } \keyword{internal} diff --git a/man/delete_ws.Rd b/man/gs_ws_delete.Rd similarity index 55% rename from man/delete_ws.Rd rename to man/gs_ws_delete.Rd index a92576b..a6e6c30 100644 --- a/man/delete_ws.Rd +++ b/man/gs_ws_delete.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{delete_ws} -\alias{delete_ws} +% Please edit documentation in R/gs_ws.R +\name{gs_ws_delete} +\alias{gs_ws_delete} \title{Delete a worksheet from a spreadsheet} \usage{ -delete_ws(ss, ws = 1, verbose = TRUE) +gs_ws_delete(ss, ws = 1, verbose = TRUE) } \arguments{ \item{ss}{a registered Google spreadsheet} @@ -14,23 +14,29 @@ respectively, of the worksheet to consume} \item{verbose}{logical; do you want informative message?} } +\value{ +a \code{\link{googlesheet}} object +} \description{ The worksheet and all of its contents will be removed from the spreadsheet. } \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") -list_ws(gap_ss) -gap_ss <- add_ws(gap_ss, "new_stuff") +gap_ss <- gap_key \%>\% + gs_key() \%>\% + gs_copy(to = "gap_copy") +# non-pipe equivalent: gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") +gs_ws_ls(gap_ss) +gap_ss <- gs_ws_new(gap_ss, "new_stuff") gap_ss <- edit_cells(gap_ss, "new_stuff", input = head(iris), header = TRUE, trim = TRUE) gap_ss -gap_ss <- delete_ws(gap_ss, "new_stuff") -list_ws(gap_ss) -gap_ss <- delete_ws(gap_ss, ws = 3) -list_ws(gap_ss) -delete_ss(gap_ss) +gap_ss <- gs_ws_delete(gap_ss, "new_stuff") +gs_ws_ls(gap_ss) +gap_ss <- gs_ws_delete(gap_ss, ws = 3) +gs_ws_ls(gap_ss) +gs_delete(gap_ss) } } diff --git a/man/gs_ws_ls.Rd b/man/gs_ws_ls.Rd new file mode 100644 index 0000000..c10939f --- /dev/null +++ b/man/gs_ws_ls.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2 (4.1.1): do not edit by hand +% Please edit documentation in R/gs_ws.R +\name{gs_ws_ls} +\alias{gs_ws_ls} +\title{List the worksheets in a Google Sheet} +\usage{ +gs_ws_ls(ss) +} +\arguments{ +\item{ss}{a registered Google spreadsheet} +} +\description{ +Retrieve the titles of all the worksheets in a \code{\link{googlesheet}}. +} +\examples{ +\dontrun{ +gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" +gap_ss <- gs_key(gap_key) +gs_ws_ls(gap_ss) +} +} + diff --git a/man/modify_ws.Rd b/man/gs_ws_modify.Rd similarity index 63% rename from man/modify_ws.Rd rename to man/gs_ws_modify.Rd index b218d2a..fc4b6f4 100644 --- a/man/modify_ws.Rd +++ b/man/gs_ws_modify.Rd @@ -1,13 +1,14 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{modify_ws} -\alias{modify_ws} +% Please edit documentation in R/gs_ws.R +\name{gs_ws_modify} +\alias{gs_ws_modify} \title{Modify a worksheet's title or size} \usage{ -modify_ws(ss, from, to = NULL, new_dim = NULL) +gs_ws_modify(ss, from, to = NULL, new_dim = NULL) } \arguments{ -\item{ss}{a registered Google sheet} +\item{ss}{a \code{\link{googlesheet}} object, i.e. a registered Google +sheet} \item{from}{positive integer or character string specifying index or title, respectively, of the worksheet} @@ -17,6 +18,9 @@ respectively, of the worksheet} \item{new_dim}{list of length 2 specifying the row and column extent of the worksheet} } +\value{ +a \code{\link{googlesheet}} object +} \description{ Modify a worksheet's title or size } diff --git a/man/add_ws.Rd b/man/gs_ws_new.Rd similarity index 59% rename from man/add_ws.Rd rename to man/gs_ws_new.Rd index 5026137..49c9287 100644 --- a/man/add_ws.Rd +++ b/man/gs_ws_new.Rd @@ -1,13 +1,15 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{add_ws} -\alias{add_ws} -\title{Add a new (empty) worksheet to spreadsheet} +% Please edit documentation in R/gs_ws.R +\name{gs_ws_new} +\alias{gs_ws_new} +\title{Add a new worksheet to spreadsheet} \usage{ -add_ws(ss, ws_title = "Sheet1", nrow = 1000, ncol = 26, verbose = TRUE) +gs_ws_new(ss, ws_title = "Sheet1", nrow = 1000, ncol = 26, + verbose = TRUE) } \arguments{ -\item{ss}{a registered Google sheet} +\item{ss}{a \code{\link{googlesheet}} object, i.e. a registered Google +sheet} \item{ws_title}{character string for title of new worksheet} @@ -18,8 +20,7 @@ add_ws(ss, ws_title = "Sheet1", nrow = 1000, ncol = 26, verbose = TRUE) \item{verbose}{logical; do you want informative message?} } \value{ -a googlesheet object, resulting from re-registering the host - spreadsheet after adding the new worksheet +a \code{\link{googlesheet}} object } \description{ Add a new (empty) worksheet to spreadsheet: specify title and worksheet @@ -30,8 +31,8 @@ be the same as any existing worksheets in the sheet. \dontrun{ # get a copy of the Gapminder spreadsheet gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "Gapminder_copy") -gap_ss <- add_ws(gap_ss, ws_title = "Atlantis") +gap_ss <- gs_copy(gs_key(gap_key), to = "Gapminder_copy") +gap_ss <- gs_ws_new(gap_ss, ws_title = "Atlantis") gap_ss } } diff --git a/man/rename_ws.Rd b/man/gs_ws_rename.Rd similarity index 62% rename from man/rename_ws.Rd rename to man/gs_ws_rename.Rd index b4228c1..a44850e 100644 --- a/man/rename_ws.Rd +++ b/man/gs_ws_rename.Rd @@ -1,13 +1,14 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{rename_ws} -\alias{rename_ws} +% Please edit documentation in R/gs_ws.R +\name{gs_ws_rename} +\alias{gs_ws_rename} \title{Rename a worksheet} \usage{ -rename_ws(ss, from = 1, to, verbose = TRUE) +gs_ws_rename(ss, from = 1, to, verbose = TRUE) } \arguments{ -\item{ss}{a registered Google sheet} +\item{ss}{a \code{\link{googlesheet}} object, i.e. a registered Google +sheet} \item{from}{positive integer or character string specifying index or title, respectively, of the worksheet} @@ -16,6 +17,9 @@ respectively, of the worksheet} \item{verbose}{logical; do you want informative message?} } +\value{ +a \code{\link{googlesheet}} object +} \description{ Give a worksheet a new title that does not duplicate the title of any existing worksheet within the spreadsheet. @@ -29,13 +33,13 @@ Since the edit link is used in the PUT request, the version path in the \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") -list_ws(gap_ss) -gap_ss <- rename_ws(gap_ss, from = "Oceania", to = "ANZ") -list_ws(gap_ss) -gap_ss <- rename_ws(gap_ss, from = 1, to = "I am the first sheet!") -list_ws(gap_ss) -delete_ss(gap_ss) +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") +gs_ws_ls(gap_ss) +gap_ss <- gs_ws_rename(gap_ss, from = "Oceania", to = "ANZ") +gs_ws_ls(gap_ss) +gap_ss <- gs_ws_rename(gap_ss, from = 1, to = "I am the first sheet!") +gs_ws_ls(gap_ss) +gs_delete(gap_ss) } } diff --git a/man/resize_ws.Rd b/man/gs_ws_resize.Rd similarity index 64% rename from man/resize_ws.Rd rename to man/gs_ws_resize.Rd index 410799f..8511c4f 100644 --- a/man/resize_ws.Rd +++ b/man/gs_ws_resize.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{resize_ws} -\alias{resize_ws} +% Please edit documentation in R/gs_ws.R +\name{gs_ws_resize} +\alias{gs_ws_resize} \title{Resize a worksheet} \usage{ -resize_ws(ss, ws = 1, row_extent = NULL, col_extent = NULL, +gs_ws_resize(ss, ws = 1, row_extent = NULL, col_extent = NULL, verbose = TRUE) } \arguments{ @@ -22,7 +22,8 @@ respectively, of the worksheet to consume} \description{ Set the number of rows and columns of a worksheet. We use this function internally during cell updates, if the data would exceed the current -worksheet extent. It is possible a user might want to use this directly? +worksheet extent, and to trim worksheet down to fit the data exactly. Is it +possible a user might want to use this directly? } \note{ Setting rows and columns to less than the current worksheet dimensions @@ -30,16 +31,16 @@ Setting rows and columns to less than the current worksheet dimensions } \examples{ \dontrun{ -yo <- new_ss("yo") +yo <- gs_new("yo") yo <- edit_cells(yo, input = head(iris), header = TRUE, trim = TRUE) get_via_csv(yo) -yo <- resize_ws(yo, ws = "Sheet1", row_extent = 5, col_extent = 4) +yo <- gs_ws_resize(yo, ws = "Sheet1", row_extent = 5, col_extent = 4) get_via_csv(yo) -yo <- resize_ws(yo, ws = 1, row_extent = 3, col_extent = 3) +yo <- gs_ws_resize(yo, ws = 1, row_extent = 3, col_extent = 3) get_via_csv(yo) -yo <- resize_ws(yo, row_extent = 2, col_extent = 2) +yo <- gs_ws_resize(yo, row_extent = 2, col_extent = 2) get_via_csv(yo) -delete_ss(yo) +gs_delete(yo) } } \keyword{internal} diff --git a/man/identify_ss.Rd b/man/identify_ss.Rd deleted file mode 100644 index 28be20a..0000000 --- a/man/identify_ss.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/register.R -\name{identify_ss} -\alias{identify_ss} -\title{Retrieve the identifiers for a spreadsheet} -\usage{ -identify_ss(x, method = NULL, verify = TRUE, visibility = "private", - verbose = TRUE) -} -\arguments{ -\item{x}{sheet-identifying information, either a googlesheet object or a -character vector of length one, giving a URL, sheet title, key or -worksheets feed} - -\item{method}{optional character string specifying the method of sheet -identification; if given, must be one of: URL, key, title, ws_feed, or ss} - -\item{verify}{logical, default is TRUE, indicating if sheet should be looked -up in the list of sheets obtained via \code{\link{list_sheets}}} - -\item{visibility}{character, default is "private", indicating whether to form -a worksheets feed that anticipates requests with authentication ("private") -or without ("public"); only consulted when \code{verify = FALSE}} - -\item{verbose}{logical} -} -\value{ -a googlesheet object -} -\description{ -Initialize a googlesheet object that holds identifying information for a -specific spreadsheet. Intended primarily for internal use. Unless -\code{verify = FALSE}, it calls \code{\link{list_sheets}} and attempts to -return information from the row uniquely specified by input \code{x}. Since -\code{\link{list_sheets}} fetches non-public user data, authorization will be -required. A googlesheet object contains much more information than that -available via \code{\link{list_sheets}}, so many components will not be -populated until the sheet is registered properly, such as via -\code{\link{register_ss}}, which is called internally in many -\code{googlesheets} functions. If \code{verify = FALSE}, then user must -provide either sheet key, URL or a worksheets feed, as opposed to sheet -title. In this case, the information will be taken at face value, i.e. no -proactive verification or look-up on Google Drive. -} -\details{ -This function is will be revised to be less dogmatic about only identifying -ONE sheet. -} -\examples{ -\dontrun{ -gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_id_only <- identify_ss(gap_key) -gap_id_only # see? not much info at this point -gap_ss <- register_ss(gap_id) -gap_ss # much more available after registration -} -} - diff --git a/man/list_sheets.Rd b/man/list_sheets.Rd deleted file mode 100644 index 966d997..0000000 --- a/man/list_sheets.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/register.R -\name{list_sheets} -\alias{list_sheets} -\title{Get a listing of spreadsheets} -\usage{ -list_sheets() -} -\value{ -a \code{googlesheet_ls} object, which is a - \code{\link[dplyr]{tbl_df}} with one row per sheet -} -\description{ -Please use \code{\link{gs_ls}} instead. This function is going away. -} -\examples{ -\dontrun{ -gs_ls() -} -} - diff --git a/man/list_ws.Rd b/man/list_ws.Rd deleted file mode 100644 index d2877e1..0000000 --- a/man/list_ws.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/utils.R -\name{list_ws} -\alias{list_ws} -\title{List the worksheets in a googlesheet} -\usage{ -list_ws(ss) -} -\arguments{ -\item{ss}{a registered Google spreadsheet} -} -\description{ -Retrieve the titles of all the worksheets in a gpreadsheet. -} -\examples{ -\dontrun{ -gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- register_ss(gap_key) -list_ws(gap_ss) -} -} - diff --git a/man/print.googlesheet.Rd b/man/print.googlesheet.Rd index 42fbe0e..e8efeef 100644 --- a/man/print.googlesheet.Rd +++ b/man/print.googlesheet.Rd @@ -1,26 +1,26 @@ % Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/print.R +% Please edit documentation in R/googlesheet-print.R \name{print.googlesheet} \alias{print.googlesheet} -\title{Print information about a Google spreadsheet registered with googlesheets} +\title{Print information about a Google Sheet registered with \code{googlesheets}} \usage{ \method{print}{googlesheet}(x, ...) } \arguments{ -\item{x}{googlesheet object returned by \code{register_ss} and other -\code{googlesheets} functions} +\item{x}{\code{\link{googlesheet}} object returned by functions such as \code{\link{gs_title}}, \code{\link{gs_key}}, and friends} \item{...}{potential further arguments (required for Method/Generic reasons)} } \description{ Display information about a Google spreadsheet that has been registered with \code{googlesheets}: the title of the spreadsheet, date-time of registration, -date-time of last update (at time of registration), the number of worksheets -contained, worksheet titles and extent, and sheet key. +date-time of last update (at time of registration), visibility, permissions, +version, the number of worksheets contained, worksheet titles and extent, and +sheet key. } \examples{ \dontrun{ -foo <- new_ss("foo") +foo <- gs_new("foo") foo print(foo) } diff --git a/man/register_ss.Rd b/man/register_ss.Rd deleted file mode 100644 index 9faa77f..0000000 --- a/man/register_ss.Rd +++ /dev/null @@ -1,59 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/register.R -\name{register_ss} -\alias{register_ss} -\title{Register a Google spreadsheet} -\usage{ -register_ss(x, key = NULL, ws_feed = NULL, visibility = "private", - verbose = TRUE) -} -\arguments{ -\item{x}{character vector of length one, with sheet-identifying information; -valid inputs are title, key, URL, worksheets feed} - -\item{key}{character vector of length one that is guaranteed to be unique key -for sheet; supercedes argument \code{x}} - -\item{ws_feed}{character vector of length one that is guaranteed to be -worksheets feed for sheet; supercedes arguments \code{x} and \code{key}} - -\item{visibility}{either "public" or "private"; used to specify visibility -when sheet identified via \code{key}} - -\item{verbose}{logical; do you want informative message?} -} -\value{ -Object of class googlesheet. -} -\description{ -Specify a Google spreadsheet via its URL, unique key, title, or worksheets -feed and register it for further use. This function returns an object of -class \code{googlesheet}, which contains all the information other -\code{googlesheets} functions will need to consume data from the sheet or to -edit the sheet. This object also contains sheet information that may be of -interest to the user, such as the time of last update, the number of -worksheets contained, and their titles. -} -\note{ -Re: the reported extent of the worksheets. Contain your excitement, - because it may not be what you think or hope it is. It does not report how - many rows or columns are actually nonempty. This cannot be determined via - the Google sheets API without consuming the data and noting which cells are - populated. Therefore, these numbers often reflect the default extent of a - new worksheet, e.g., 1000 rows and 26 columns at the time or writing, and - provide an upper bound on the true number of rows and columns. - -The visibility can only be "public" if the sheet is "Published to the - web". Gotcha: this is different from setting the sheet to "Public on the - web" in the visibility options in the sharing dialog of a Google Sheets - file. -} -\examples{ -\dontrun{ -gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- register_ss(gap_key) -gap_ss -get_row(gap_ss, "Africa", row = 1) -} -} - diff --git a/man/reshape_cf.Rd b/man/reshape_cf.Rd index d809e5d..7642821 100644 --- a/man/reshape_cf.Rd +++ b/man/reshape_cf.Rd @@ -18,7 +18,7 @@ Reshape cell-level data and convert to data.frame \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- copy_ss(key = gap_key, to = "gap_copy") +gap_ss <- gs_copy(gs_key(gap_key), to = "gap_copy") get_via_cf(gap_ss, "Asia", max_row = 4) reshape_cf(get_via_cf(gap_ss, "Asia", max_row = 4)) } diff --git a/man/simplify_cf.Rd b/man/simplify_cf.Rd index 1dbd073..48e91f8 100644 --- a/man/simplify_cf.Rd +++ b/man/simplify_cf.Rd @@ -43,7 +43,7 @@ present in the data from the cell feed, i.e. if the original call to \examples{ \dontrun{ gap_key <- "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA" -gap_ss <- register_ss(gap_key) +gap_ss <- gs_key(gap_key) get_row(gap_ss, row = 1) simplify_cf(get_row(gap_ss, row = 1)) simplify_cf(get_row(gap_ss, row = 1), notation = "R1C1") diff --git a/man/upload_ss.Rd b/man/upload_ss.Rd deleted file mode 100644 index c9e1042..0000000 --- a/man/upload_ss.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2 (4.1.1): do not edit by hand -% Please edit documentation in R/edit-spreadsheets.R -\name{upload_ss} -\alias{upload_ss} -\title{Upload a file and convert it to a Google Sheet} -\usage{ -upload_ss(file, sheet_title = NULL, verbose = TRUE) -} -\arguments{ -\item{file}{the file to upload, if it does not contain the absolute path, -then the file is relative to the current working directory} - -\item{sheet_title}{the title of the spreadsheet; optional, -if not specified then the name of the file will be used} - -\item{verbose}{logical; do you want informative message?} -} -\description{ -Google supports the following file types to be converted to a Google -spreadsheet: .xls, .xlsx, .csv, .tsv, .txt, .tab, .xlsm, .xlt, .xltx, .xltm, -.ods. The newly uploaded file will appear in the top level of your Google -Sheets home screen. -} -\examples{ -\dontrun{ -write.csv(head(iris, 5), "iris.csv", row.names = FALSE) -iris_ss <- upload_ss("iris.csv") -iris_ss -get_via_lf(iris_ss) -file.remove("iris.csv") -delete_ss(iris_ss) -} -} - diff --git a/tests/testthat/iris_identify_ss.rds b/tests/testthat/iris_identify_ss.rds index 0ba2b1f..ae71e53 100644 Binary files a/tests/testthat/iris_identify_ss.rds and b/tests/testthat/iris_identify_ss.rds differ diff --git a/tests/testthat/test-cell-edit.R b/tests/testthat/test-cell-edit.R index b272aec..31a8012 100644 --- a/tests/testthat/test-cell-edit.R +++ b/tests/testthat/test-cell-edit.R @@ -1,7 +1,8 @@ context("edit cells") pts_copy <- p_("pts-copy") -ss <- copy_ss(key = pts_key, to = pts_copy, verbose = FALSE) +ss <- gs_copy(gs_key(pts_key, lookup = FALSE, verbose = FALSE), + to = pts_copy, verbose = FALSE) ws <- "for_updating" test_that("Input converts to character vector (or not)", { @@ -45,18 +46,18 @@ test_that("Single cell can be updated", { test_that("Cell update can force resize of worksheet", { - ss <- register_ss(ss) - ss <- ss %>% resize_ws(ws, 20, 26) + ss <- gs_key(ss$sheet_key) + ss <- ss %>% gs_ws_resize(ws, 20, 26) Sys.sleep(1) # force worksheet extent to be increased expect_message(ss <- edit_cells(ss, ws, "Way out there!", "R1C30"), "dimensions changed") Sys.sleep(1) - expect_equal(ss %>% get_ws(ws) %>% `[[`("col_extent"), 30) + expect_equal(ss %>% gs_ws(ws) %>% `[[`("col_extent"), 30) # clean up - ss <- ss %>% resize_ws(ws, 22, 26) + ss <- ss %>% gs_ws_resize(ws, 22, 26) }) iris_ish <- iris %>% head(3) %>% dplyr::as.tbl() @@ -92,7 +93,7 @@ test_that("2-dimensional things can be uploaded", { test_that("Vectors can be uploaded", { - ss <- register_ss(ss) + ss <- gs_key(ss$sheet_key) # byrow = FALSE ss <- ss %>% edit_cells(ws, LETTERS[1:5], "A8") @@ -117,4 +118,9 @@ test_that("We can trim worksheet extent to fit uploaded data", { }) -delete_ss(regex = TEST, verbose = FALSE) +delete_me <- gs_ls(regex = TEST, verbose = FALSE) +if(!is.null(delete_me)) { + lapply(delete_me$sheet_key, function(x) { + gs_delete(gs_key(x, verbose = FALSE), verbose = FALSE) + }) +} diff --git a/tests/testthat/test-cell-specification.R b/tests/testthat/test-cell-specification.R index dab56c5..74deb4c 100644 --- a/tests/testthat/test-cell-specification.R +++ b/tests/testthat/test-cell-specification.R @@ -4,7 +4,7 @@ test_that("Ranges can be converted to a cell limit list", { jfun <- function(x) x %>% as.list() %>% - setNames(c("min-row", "max-row", "min-col", "max-col")) + stats::setNames(c("min-row", "max-row", "min-col", "max-col")) expect_equal("C1" %>% cellranger::as.cell_limits() %>% limit_list(), jfun(c(1 , 1, 3, 3))) diff --git a/tests/testthat/test-consume-data-private.R b/tests/testthat/test-consume-data-private.R index f33fa40..806b855 100644 --- a/tests/testthat/test-consume-data-private.R +++ b/tests/testthat/test-consume-data-private.R @@ -1,7 +1,7 @@ context("consume data with private visibility") ## consuming data owned by authorized user, namely gspreadr -ss <- register_ss(ws_feed = iris_pvt_ws_feed) +ss <- gs_ws_feed(iris_pvt_ws_feed, verbose = FALSE) ## tests here are very minimal; more detailed data consumption tests are done ## with public visiblity, i.e. on Sheets authorized user does not own, which diff --git a/tests/testthat/test-consume-data-public-selective.R b/tests/testthat/test-consume-data-public-selective.R index 0e1704e..9b7b0fb 100644 --- a/tests/testthat/test-consume-data-public-selective.R +++ b/tests/testthat/test-consume-data-public-selective.R @@ -1,7 +1,7 @@ context("consume data with public visibility, selectively") ## consuming data owned by someone else, namely rpackagetest -ss <- register_ss(ws_feed = gap_ws_feed) +ss <- gs_ws_feed(gap_ws_feed, lookup = FALSE, verbose = FALSE) test_that("We can get data from specific cells using limits", { diff --git a/tests/testthat/test-consume-data-public-whole-sheets.R b/tests/testthat/test-consume-data-public-whole-sheets.R index 37dbeaf..96f749e 100644 --- a/tests/testthat/test-consume-data-public-whole-sheets.R +++ b/tests/testthat/test-consume-data-public-whole-sheets.R @@ -1,7 +1,7 @@ context("consume data with public visibility, whole sheets") ## consuming data owned by someone else, namely rpackagetest -ss <- register_ss(ws_feed = gap_ws_feed) +ss <- gs_ws_feed(gap_ws_feed, lookup = FALSE, verbose = FALSE) test_that("We can get all data from the list feed (pub)", { diff --git a/tests/testthat/test-consume-data-tricky.R b/tests/testthat/test-consume-data-tricky.R index 4877fea..565fbee 100644 --- a/tests/testthat/test-consume-data-tricky.R +++ b/tests/testthat/test-consume-data-tricky.R @@ -1,6 +1,6 @@ context("consume tricky data") -ss <- register_ss(key = pts_key, visibility = "public") +ss <- gs_key(pts_key, lookup = FALSE, visibility = "public", verbose = FALSE) test_that("We can handle embedded empty cells via csv", { diff --git a/tests/testthat/test-gs-create-delete-copy.R b/tests/testthat/test-gs-create-delete-copy.R index 3d16e3a..f7b0112 100644 --- a/tests/testthat/test-gs-create-delete-copy.R +++ b/tests/testthat/test-gs-create-delete-copy.R @@ -4,66 +4,34 @@ test_that("Spreadsheet can be created and deleted", { sheet_title <- p_("hello-bye") - expect_message(new_ss <- new_ss(sheet_title), "created") + expect_message(new_ss <- gs_new(sheet_title), "created") expect_is(new_ss, "googlesheet") Sys.sleep(1) ss_df <- gs_ls() expect_true(sheet_title %in% ss_df$sheet_title) - expect_message(tmp <- delete_ss(sheet_title), "moved to trash") + expect_message(tmp <- gs_delete(new_ss), "moved to trash") + expect_true(tmp) Sys.sleep(1) ss_df <- gs_ls() expect_false(sheet_title %in% ss_df$sheet_title) }) -test_that("Regexes work for deleting multiple sheets", { - - sheet_title <- p_(c("cat", "catherine", "tomCAT", "abdicate", "FLYCATCHER")) - sapply(sheet_title, new_ss) - - Sys.sleep(1) - delete_ss(p_("cat")) - Sys.sleep(1) - ss_df <- gs_ls() - expect_false(p_("cat") %in% ss_df$sheet_title) - expect_true(all(sheet_title[-1] %in% ss_df$sheet_title)) - - delete_ss(regex = p_("[a-zA-Z]*cat[a-zA-Z]*$")) - Sys.sleep(1) - ss_df <- gs_ls() - expect_false(any(grepl("catherine|abdicate", ss_df$sheet_title) & - grepl(TEST, ss_df$sheet_title))) - expect_true(all(p_(c("tomCAT", "FLYCATCHER")) %in% ss_df$sheet_title)) - - delete_ss(regex = "[a-zA-Z]*cat[a-zA-Z]*$", ignore.case = TRUE) - Sys.sleep(1) - ss_df <- gs_ls() - expect_false(any(sheet_title %in% ss_df$sheet_title)) - -}) - -test_that("Spreadsheet can be copied", { +test_that("Spreadsheet can be copied and deleted", { copy_of <- p_(paste("Copy of", iris_pvt_title)) - copy_ss <- copy_ss(iris_pvt_key, to = copy_of) + copy_ss <- gs_copy(gs_key(iris_pvt_key), to = copy_of) expect_is(copy_ss, "googlesheet") eggplants <- p_("eggplants are purple") - copy_ss_2 <- copy_ss(iris_pvt_key, to = eggplants) + copy_ss_2 <- gs_copy(gs_key(iris_pvt_key), to = eggplants) expect_is(copy_ss_2, "googlesheet") ss_df <- gs_ls() expect_true(all(c(copy_of, eggplants) %in% ss_df$sheet_title)) - delete_ss(copy_of) - delete_ss(eggplants) - -}) - -test_that("Nonexistent spreadsheet can NOT be deleted or copied", { - - expect_error(delete_ss("flyingpig"), "doesn't match") - expect_error(copy_ss("flyingpig"), "doesn't match") + tmp <- gs_vecdel(c(copy_of, eggplants)) + expect_true(all(tmp)) }) @@ -73,27 +41,13 @@ test_that("Old Sheets can be copied and deleted", { ## it's been "helpfully" converted to a new sheet by google AGAIN :( check_old_sheet() - ss <- register_ss(old_title) + ss <- gs_title(old_title) - ## pre-register my_copy <- p_("test-old-sheet-copy") - expect_message(ss_copy <- ss %>% copy_ss(to = my_copy), "Successful copy!") - Sys.sleep(1) - expect_message(delete_ss(ss_copy), "moved to trash") + expect_message(ss_copy <- ss %>% gs_copy(to = my_copy), "Successful copy!") Sys.sleep(1) + expect_message(gs_delete(ss_copy), "moved to trash") - ## delete by title - expect_message(ss_copy <- - copy_ss(from = old_title, to = my_copy), "Successful copy!") - Sys.sleep(1) - expect_message(delete_ss(my_copy), "moved to trash") - Sys.sleep(1) - - # delete by URL - expect_message(ss_copy <- - copy_ss(from = old_url, to = my_copy), "Successful copy!") - Sys.sleep(1) - expect_message(delete_ss(my_copy), "moved to trash") }) -delete_ss(regex = TEST, verbose = FALSE) +gs_grepdel(TEST, verbose = FALSE) diff --git a/tests/testthat/test-gs-download.R b/tests/testthat/test-gs-download.R index f242ef0..d6d203d 100644 --- a/tests/testthat/test-gs-download.R +++ b/tests/testthat/test-gs-download.R @@ -2,12 +2,12 @@ context("download sheets") test_that("Spreadsheet can be exported", { - ss <- register_ss(ws_feed = gap_ws_feed) + ss <- gs_ws_feed(gap_ws_feed, lookup = FALSE) temp_dir <- tempdir() # bad format - expect_error(download_ss(ss, to = "pts.txt"), + expect_error(gs_download(ss, to = "pts.txt"), "Cannot download Google spreadsheet as this format") # good formats @@ -15,7 +15,7 @@ test_that("Spreadsheet can be exported", { to_files <- file.path(temp_dir, paste0("oceania.", fmts)) for(to in to_files) { expect_message(ss %>% - download_ss(ws = "Oceania", to = to, overwrite = TRUE), + gs_download(ws = "Oceania", to = to, overwrite = TRUE), "successfully downloaded") } @@ -24,6 +24,22 @@ test_that("Spreadsheet can be exported", { }) +test_that("Spreadsheet can be exported w/o specifying the worksheet", { + + ss <- gs_ws_feed(gap_ws_feed, lookup = FALSE) + + temp_dir <- tempdir() + + to <- file.path(temp_dir, "sheet_one.csv") + expect_message(ss %>% gs_download(to = to, overwrite = TRUE), + "successfully downloaded") + + expect_true(file.exists(to)) + expect_true(file.remove(to)) + +}) + + test_that("Old Sheets can be exported", { ## don't even bother if we can't see this sheet in the spreadsheets feed or if @@ -34,20 +50,20 @@ test_that("Old Sheets can be exported", { ## we must register by title, in order to get info from the spreadsheets feed, ## which, in turn, is the only way to populate the alt_key ## this means we must have visited the sheet in the browser at least once! - ss <- register_ss(old_title) + ss <- gs_title(old_title) # csv should not work - expect_error(ss %>% download_ss(to = file.path(temp_dir, "old.csv")), + expect_error(ss %>% gs_download(to = file.path(temp_dir, "old.csv")), "not supported") # good formats and different specifications - expect_message(ss %>% download_ss(to = file.path(temp_dir, "old.xlsx"), + expect_message(ss %>% gs_download(to = file.path(temp_dir, "old.xlsx"), overwrite = TRUE), "successfully downloaded") - expect_message(ss %>% download_ss(to = file.path(temp_dir, "old.xlsx"), + expect_message(ss %>% gs_download(to = file.path(temp_dir, "old.xlsx"), overwrite = TRUE), "successfully downloaded") - expect_message(ss %>% download_ss(to = file.path(temp_dir, "old.pdf"), + expect_message(ss %>% gs_download(to = file.path(temp_dir, "old.pdf"), overwrite = TRUE), "successfully downloaded") diff --git a/tests/testthat/test-gs-ls.R b/tests/testthat/test-gs-ls.R new file mode 100644 index 0000000..6c5ac0a --- /dev/null +++ b/tests/testthat/test-gs-ls.R @@ -0,0 +1,36 @@ +context("list sheets") + +test_that("Spreadsheets visible to authenticated user can be listed", { + + ss_list <- gs_ls() + expect_is(ss_list, "googlesheet_ls") + expect_more_than(nrow(ss_list), 0) + +}) + +test_that("Regexes work for limiting sheet listing", { + + sheet_title <- c("cat", "catherine", "tomCAT", "abdicate", "FLYCATCHER") + ss <- lapply(p_(sheet_title), gs_new) + names(ss) <- sheet_title + + # this should NOT pick up 'cat', 'tomCAT', or 'FLYCATCHER' + ss_df <- gs_ls(regex = p_("[a-zA-Z]*cat[a-zA-Z]+$")) + expect_identical(sort(ss_df$sheet_title), + sort(p_(c("catherine", "abdicate")))) + + # this should NOT pick up 'cat' or 'tomCAT' + ss_df <- gs_ls(regex = p_("[a-zA-Z]*cat[a-zA-Z]+$"), ignore.case = TRUE) + expect_identical(sort(ss_df$sheet_title), + sort(p_(c("catherine", "abdicate", "FLYCATCHER")))) + + # this should pick up all + ss_df <- gs_ls(regex = p_("[a-zA-Z]*cat[a-zA-Z]*$"), ignore.case = TRUE) + expect_identical(sort(ss_df$sheet_title), sort(p_(sheet_title))) + + ## delete them all + ret <- lapply(ss_df$sheet_key, function(x) gs_delete(gs_key(x))) + expect_true(all(unlist(ret))) + +}) + diff --git a/tests/testthat/test-gs-register.R b/tests/testthat/test-gs-register.R index afb29d3..64bb1d5 100644 --- a/tests/testthat/test-gs-register.R +++ b/tests/testthat/test-gs-register.R @@ -1,11 +1,5 @@ context("register sheets") -test_that("Spreadsheets visible to authenticated user can be listed", { - ss_list <- gs_ls() - expect_is(ss_list, "tbl_df") - expect_more_than(nrow(ss_list), 0) -}) - test_that("Spreadsheet can be ID'd via URL, key, title, ws_feed or ss", { ## NOTE: we've got to look for stuff we (gspreadr) own here, because this is @@ -16,69 +10,61 @@ test_that("Spreadsheet can be ID'd via URL, key, title, ws_feed or ss", { } ## let identify_ss() determine the method - expect_equal_to_iris_identify(iris_pvt_url) - expect_equal_to_iris_identify(iris_pvt_key) - expect_equal_to_iris_identify(iris_pvt_title) - expect_equal_to_iris_identify(iris_pvt_ws_feed) - iris_gs <- identify_ss(iris_pvt_key) - expect_equal_to_iris_identify(iris_gs) + #expect_equal_to_iris_identify(iris_pvt_url) + #expect_equal_to_iris_identify(iris_pvt_key) + #expect_equal_to_iris_identify(iris_pvt_title) + #expect_equal_to_iris_identify(iris_pvt_ws_feed) + #iris_gs <- identify_ss(iris_pvt_key) + #expect_equal_to_iris_identify(iris_gs) ## explicitly provide the correct method - expect_equal_to_iris_identify(iris_pvt_url, method = "url") - expect_equal_to_iris_identify(iris_pvt_key, method = "key") - expect_equal_to_iris_identify(iris_pvt_title, method = "title") - expect_equal_to_iris_identify(iris_pvt_ws_feed, method = "ws_feed") - expect_equal_to_iris_identify(iris_gs, method = "ss") + #expect_equal_to_iris_identify(iris_pvt_url, method = "url") + + #expect_equal_to_iris_identify(iris_pvt_key, method = "key") + #expect_equal_to_iris_identify(iris_pvt_title, method = "title") + #expect_equal_to_iris_identify(iris_pvt_ws_feed, method = "ws_feed") + #expect_equal_to_iris_identify(iris_gs, method = "ss") ## request NO verification expect_iris_key <- function(x) { expect_equal(identify_ss(x, verify = FALSE)$sheet_key, iris_pvt_key) } - expect_iris_key(iris_pvt_url) - expect_iris_key(iris_pvt_ws_feed) - expect_iris_key(iris_pvt_key) - expect_iris_key(iris_gs) + #expect_iris_key(iris_pvt_url) + #expect_iris_key(iris_pvt_ws_feed) + #expect_iris_key(iris_pvt_key) + #expect_iris_key(iris_gs) ## note this "works" but proclaims the title as the key - expect_equal(identify_ss( - iris_pvt_title, verify = FALSE)$sheet_key, iris_pvt_title) + #expect_equal(identify_ss( + #iris_pvt_title, verify = FALSE)$sheet_key, iris_pvt_title) }) test_that("Bad spreadsheet ID throws informative error", { ## errors that prevent attempt to identify spreadsheet - expect_error(identify_ss(4L), "must be character") - expect_error(identify_ss(c("Gapminder", "Gapminder")), "must be of length 1") + #expect_error(identify_ss(4L), "must be character") + #expect_error(identify_ss(c("Gapminder", "Gapminder")), "must be of length 1") ## explicit declaration of an invalid method - expect_error(identify_ss(pts_key, method = "eggplant"), "Error in match.arg") + #expect_error(identify_ss(pts_key, method = "eggplant"), "Error in match.arg") ## incompatible choices for method and verify - expect_error(identify_ss("eggplant", method = "title", verify = FALSE), - "must look up the title") + #expect_error(identify_ss("eggplant", method = "title", verify = FALSE), + #"must look up the title") ## errors caused by well-formed input that refers to a nonexistent spreadsheet - expect_error(identify_ss("spatula"), "doesn't match") + #expect_error(identify_ss("spatula"), "doesn't match") nonexistent_ws_feed <- sub(iris_pvt_key, "flyingpig", iris_pvt_ws_feed) - expect_error(register_ss(ws_feed = nonexistent_ws_feed), - "client error: \\(400\\) Bad Request") - expect_error(register_ss(nonexistent_ws_feed), "doesn't match") + expect_error(gs_ws_feed(nonexistent_ws_feed), "doesn't match") + expect_error(gs_ws_feed(nonexistent_ws_feed), "doesn't match") nonexistent_url <- sub(iris_pvt_key, "flyingpig", iris_pvt_url) - expect_error(register_ss(nonexistent_url), "doesn't match") + expect_error(gs_url(nonexistent_url), "doesn't match") nonexistent_key <- "flyingpig" - expect_error(register_ss(key = nonexistent_key), - "client error: \\(400\\) Bad Request") - - # error because the title of one worksheet matches the key of another - expect_error(register_ss(wtf1_key), - "conflicting matches in multiple identifiers: sheet_title, sheet_key") - - # but everything's ok if we explicitly declare input is a key - expect_is(register_ss(key = wtf1_key), "googlesheet") + expect_error(gs_key(nonexistent_key), "doesn't match") }) @@ -86,23 +72,19 @@ test_that("Spreadsheet can be registered via URL, key, title, ws_feed or ss", { expect_googlesheet <- function(x) expect_is(x, "googlesheet") - ## let identify_ss() determine the method - expect_googlesheet(register_ss(iris_pvt_ws_feed)) - expect_googlesheet(register_ss(iris_pvt_title)) - expect_googlesheet(register_ss(iris_pvt_key)) - expect_googlesheet(register_ss(iris_pvt_url)) - iris_gs <- identify_ss(iris_pvt_key) - expect_googlesheet(register_ss(iris_gs)) - - ## explicitly declare identifier to be key or ws_feed - expect_googlesheet(register_ss(key = iris_pvt_key)) - expect_googlesheet(register_ss(ws_feed = iris_pvt_ws_feed)) + expect_googlesheet(gs_ws_feed(iris_pvt_ws_feed)) + expect_googlesheet(gs_title(iris_pvt_title)) + expect_googlesheet(gs_key(iris_pvt_key)) + expect_googlesheet(gs_url(iris_pvt_url)) + # am I going to create gs_gs()? + #iris_gs <- identify_ss(iris_pvt_key) + #expect_googlesheet(register_ss(iris_gs)) }) test_that("We get correct number and titles of worksheets", { - ss <- register_ss(ws_feed = gap_ws_feed) + ss <- gs_ws_feed(gap_ws_feed, lookup = FALSE) expect_equal(ss$n_ws, 5L) expect_true(all(c("Asia", "Africa", "Americas", "Europe", "Oceania") %in% ss$ws$ws_title)) diff --git a/tests/testthat/test-gs-upload.R b/tests/testthat/test-gs-upload.R index c29910b..cca61ff 100644 --- a/tests/testthat/test-gs-upload.R +++ b/tests/testthat/test-gs-upload.R @@ -2,9 +2,9 @@ context("upload sheets") test_that("Nonexistent or wrong-extension files throw error", { - expect_error(upload_ss("I dont exist.csv"), "does not exist") + expect_error(gs_upload("I dont exist.csv"), "does not exist") ## note this expects working directory to be tests/testthat/ !! - expect_error(upload_ss("test-gs-upload.R"), + expect_error(gs_upload("test-gs-upload.R"), "Cannot convert file with this extension") }) @@ -15,8 +15,9 @@ test_that("Different file formats can be uploaded", { paste("mini-gap", c("xlsx", "tsv", "csv", "txt", "ods"), sep = ".") upload_titles <- p_(files_to_upload) - tmp <- mapply(upload_ss, file = files_to_upload, sheet_title = upload_titles, - SIMPLIFY = FALSE) + tmp <- mapply(gs_upload, + file = system.file(files_to_upload, package = "googlesheets"), + sheet_title = upload_titles, SIMPLIFY = FALSE) Sys.sleep(1) expect_true(all(vapply(tmp, class, character(2))[1, ] == "googlesheet")) @@ -29,4 +30,4 @@ test_that("Different file formats can be uploaded", { }) -delete_ss(regex = TEST, verbose = FALSE) +gs_grepdel(TEST, verbose = FALSE) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 4caca03..56e93db 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,10 +1,10 @@ context("utility functions") -ss <- register_ss(ws_feed = gap_ws_feed) +ss <- gs_ws_feed(gap_ws_feed, lookup = FALSE, verbose = FALSE) test_that("We can get list of worksheets in a spreadsheet", { - ws_listing <- ss %>% list_ws() + ws_listing <- ss %>% gs_ws_ls() expect_true(all(c('Asia', 'Africa', 'Americas', 'Europe', 'Oceania') %in% ws_listing)) @@ -13,34 +13,34 @@ test_that("We can get list of worksheets in a spreadsheet", { test_that("We can obtain worksheet info from a registered spreadsheet", { ## retrieve by worksheet title - africa <- get_ws(ss, "Africa") + africa <- gs_ws(ss, "Africa") expect_equal(africa$ws_title, "Africa") expect_equal(africa$row_extent, 625L) ## retrieve by positive integer - europe <- get_ws(ss, 4) + europe <- gs_ws(ss, 4) expect_equal(europe$ws_title, "Europe") expect_equal(europe$col_extent, 6L) ## doubles get truncated, i.e. 1.3 --> 1 - asia <- get_ws(ss, 3.3) + asia <- gs_ws(ss, 3.3) expect_equal(asia$ws_title, "Asia") }) test_that("We throw error for bad worksheet request", { - expect_error(get_ws(ss, -3)) - expect_error(get_ws(ss, factor(1))) - expect_error(get_ws(ss, LETTERS)) + expect_error(gs_ws(ss, -3)) + expect_error(gs_ws(ss, factor(1))) + expect_error(gs_ws(ss, LETTERS)) - expect_error(get_ws(ss, "Mars"), "not found") - expect_error(get_ws(ss, 100L), "only contains") + expect_error(gs_ws(ss, "Mars"), "not found") + expect_error(gs_ws(ss, 100L), "only contains") }) test_that("We can get list of worksheets in a spreadsheet", { - ws_listing <- ss %>% list_ws() + ws_listing <- ss %>% gs_ws_ls() expect_true(all(c('Asia', 'Africa', 'Americas', 'Europe', 'Oceania') %in% ws_listing)) }) diff --git a/tests/testthat/test-ws-edits.R b/tests/testthat/test-ws-edits.R index 976ce0b..3f09b40 100644 --- a/tests/testthat/test-ws-edits.R +++ b/tests/testthat/test-ws-edits.R @@ -1,13 +1,14 @@ context("edit worksheets") pts_copy <- p_("pts-copy") -ss <- copy_ss(key = pts_key, to = pts_copy, verbose = FALSE) +ss <- gs_copy(gs_key(pts_key, lookup = FALSE, verbose = FALSE), + to = pts_copy, verbose = FALSE) test_that("Add a new worksheet", { ss_before <- ss - ss_after <- add_ws(ss_before, "Test Sheet") + ss_after <- gs_ws_new(ss_before, "Test Sheet") expect_is(ss_after, "googlesheet") @@ -24,67 +25,67 @@ test_that("Add a new worksheet", { test_that("Delete a worksheet by title and index", { - ss_before <- register_ss(ss) + ss_before <- gs_key(ss$sheet_key) - expect_message(ss_after <- delete_ws(ss_before, "Test Sheet"), "deleted") + expect_message(ss_after <- gs_ws_delete(ss_before, "Test Sheet"), "deleted") expect_is(ss_after, "googlesheet") expect_equal(ss_before$n_ws - 1, ss_after$n_ws) expect_false("Test Sheet" %in% ss_after$ws$ws_title) - expect_message(ss_after <- add_ws(ss_after, "one more to delete"), "added") + expect_message(ss_after <- gs_ws_new(ss_after, "one more to delete"), "added") ws_pos <- match("one more to delete", ss_after$ws$ws_title) - expect_message(ss_final <- delete_ws(ss_after, ws_pos), "deleted") + expect_message(ss_final <- gs_ws_delete(ss_after, ws_pos), "deleted") expect_equal(ss_after$n_ws - 1, ss_final$n_ws) expect_false("one more to delete" %in% ss_final$ws$ws_title) ## can't delete a non-existent worksheet - expect_error(delete_ws(ss_before, "Hello World")) + expect_error(gs_ws_delete(ss_before, "Hello World")) }) test_that("Worksheet is renamed by title and index", { - ss_before <- register_ss(ss) - ss_after <- rename_ws(ss_before, "shipwrecks", "oops") + ss_before <- gs_key(ss$sheet_key) + ss_after <- gs_ws_rename(ss_before, "shipwrecks", "oops") expect_is(ss_after, "googlesheet") expect_true("oops" %in% ss_after$ws$ws_title) expect_false("shipwrecks" %in% ss_after$ws$ws_title) - ss_final <- rename_ws(ss_after, 4, "shipwrecks") + ss_final <- gs_ws_rename(ss_after, 4, "shipwrecks") expect_is(ss_final, "googlesheet") expect_false("oops" %in% ss_final$ws$ws_title) expect_true("shipwrecks" %in% ss_final$ws$ws_title) ## renaming not allowed to cause duplication of a worksheet name - expect_error(rename_ws(ss_final, "shipwrecks", "embedded_empty_cells"), + expect_error(gs_ws_rename(ss_final, "shipwrecks", "embedded_empty_cells"), "already exists") }) test_that("Worksheet is resized by title and index", { - ss_before <- register_ss(ss) + ss_before <- gs_key(ss$sheet_key) ws_title_pos <- match("for_resizing", ss_before$ws$ws_title) row <- sample(1:20, 2) col <- sample(1:10, 2) - ss_after <- resize_ws(ss_before, "for_resizing", - row_extent = row[1], col_extent = col[1]) + ss_after <- gs_ws_resize(ss_before, "for_resizing", + row_extent = row[1], col_extent = col[1]) expect_equal(ss_after$ws$row_extent[ws_title_pos], row[1]) expect_equal(ss_after$ws$col_extent[ws_title_pos], col[1]) - ss_final <- resize_ws(ss_after, ws_title_pos, - row_extent = row[2], col_extent = col[2]) + ss_final <- gs_ws_resize(ss_after, ws_title_pos, + row_extent = row[2], col_extent = col[2]) expect_equal(ss_final$ws$row_extent[ws_title_pos], row[2]) expect_equal(ss_final$ws$col_extent[ws_title_pos], col[2]) }) -delete_ss(regex = TEST, verbose = FALSE) +gs_grepdel(TEST, verbose = FALSE) diff --git a/tests/testthat/test-zz-clean-up.R b/tests/testthat/test-zz-clean-up.R index 1b22fff..dfe346b 100644 --- a/tests/testthat/test-zz-clean-up.R +++ b/tests/testthat/test-zz-clean-up.R @@ -1 +1 @@ -delete_ss(regex = TEST, verbose = FALSE) +gs_grepdel(TEST, verbose = FALSE) diff --git a/vignettes/basic-usage.R b/vignettes/basic-usage.R index ad0d3c8..9c61caa 100644 --- a/vignettes/basic-usage.R +++ b/vignettes/basic-usage.R @@ -21,31 +21,23 @@ if(length(HTTR_OAUTH) > 0) { ## ----pre-clean, include = FALSE------------------------------------------ ## if a previous compilation of this document leaves anything behind, i.e. if it ## aborts, clean up Google Drive first -my_patterns <- c("hi I am new here") -my_patterns <- my_patterns %>% stringr::str_c(collapse = "|") -delete_ss(regex = my_patterns, verbose = FALSE) +gs_vecdel("hi I am new here", verbose = FALSE) ## ----copy-gapminder, eval = FALSE---------------------------------------- # gap_key <- "1hS762lIJd2TRUTVOqoOP7g-h4MDQs6b2vhkTzohg8bE" -# copy_ss(key = gap_key, to = "Gapminder") +# gs_copy(gs_key(gap_key), to = "Gapminder") ## ----list-sheets--------------------------------------------------------- my_sheets <- gs_ls() - -## ----view-my-sheets, echo = FALSE---------------------------------------- -my_sheets %>% - head %>% - mutate(sheet_title = substr(sheet_title, 1, 10), - sheet_key = sheet_key %>% substr(1, 7) %>% stringr::str_c("...")) %>% - select(-ws_feed) +my_sheets ## ------------------------------------------------------------------------ -gap <- register_ss("Gapminder") +gap <- gs_title("Gapminder") gap ## ------------------------------------------------------------------------ (gap_key <- my_sheets$sheet_key[my_sheets$sheet_title == "Gapminder"]) -ss2 <- register_ss(gap_key) +ss2 <- gs_key(gap_key) ss2 ## ------------------------------------------------------------------------ @@ -62,30 +54,31 @@ oceania_reshaped <- reshape_cf(oceania_cell_feed) str(oceania_reshaped) head(oceania_reshaped, 10) -## ----create and delete spreadsheet--------------------------------------- +## ----createspreadsheet--------------------------------------------------- # Create a new empty spreadsheet by title -new_ss("hi I am new here") +gs_new("hi I am new here") gs_ls() %>% filter(sheet_title == "hi I am new here") +## ----delete spreadsheet-------------------------------------------------- # Move spreadsheet to trash -delete_ss("hi I am new here") +gs_delete(gs_title("hi I am new here")) gs_ls() %>% filter(sheet_title == "hi I am new here") ## ----new-sheet-new-ws-delete-ws------------------------------------------ -new_ss("hi I am new here") -x <- register_ss("hi I am new here") +gs_new("hi I am new here") +x <- gs_title("hi I am new here") x -x <- add_ws(x, ws_title = "foo", nrow = 10, ncol = 10) +x <- gs_ws_new(x, ws_title = "foo", nrow = 10, ncol = 10) x -delete_ws(x, ws = "foo") -x <- register_ss("hi I am new here") +gs_ws_delete(x, ws = "foo") +x <- gs_title("hi I am new here") x ## ----new-ws-rename-ws-delete-ws------------------------------------------ -rename_ws(x, "Sheet1", "First Sheet") +gs_ws_rename(x, "Sheet1", "First Sheet") ## ----delete-sheet-------------------------------------------------------- -delete_ss("hi I am new here") +gs_delete(gs_title("hi I am new here")) ## ----, fig.width=7, fig.height=7, eval = FALSE--------------------------- # diff --git a/vignettes/basic-usage.Rmd b/vignettes/basic-usage.Rmd index 4dc1378..65e8cda 100644 --- a/vignettes/basic-usage.Rmd +++ b/vignettes/basic-usage.Rmd @@ -12,7 +12,7 @@ vignette: > \usepackage[utf8]{inputenc} --- -__NOTE__: The vignette is still under development. Stuff here is not written in stone. The [README](https://github.com/jennybc/googlesheets) on GitHub has gotten alot more love recently, so you might want to read that instead or in addition to this (2015-03-23). +__NOTE__: The vignette is still under development. Stuff here is not written in stone. The [README](https://github.com/jennybc/googlesheets) on GitHub has gotten __alot more love recently__, so you should read that instead or in addition to this (2015-05-08). Seriously, we've only been making sure this thing compiles, but not updating the text. ```{r load package} library(googlesheets) @@ -25,9 +25,9 @@ This vignette shows the basic functionality of `googlesheets`. In order to access spreadsheets that are not "published to the web" and in order to access __any__ spreadsheets by title (vs key), you need to authenticate with Google. Many `googlesheets` functions require authentication and, if necessary, will simply trigger the interactive process we describe here. -The `authorize()` function uses OAuth2 for authentication, but don't worry if you don't know what that means. The first time, you will be kicked into a web browser. You'll be asked to login to your Google account and give `googlesheets` permission to access Sheets and Google Drive. Successful login will lead to the creation of an access token, which will automatically be stored in a file named `.httr-oath` in current working directory. These tokens are perishable and, for the most part, they will be refreshed automatically when they go stale. Under the hood, we use the `httr` package to manage this. +The `gs_auth()` function uses OAuth2 for authentication, but don't worry if you don't know what that means. The first time, you will be kicked into a web browser. You'll be asked to login to your Google account and give `googlesheets` permission to access Sheets and Google Drive. Successful login will lead to the creation of an access token, which will automatically be stored in a file named `.httr-oath` in current working directory. These tokens are perishable and, for the most part, they will be refreshed automatically when they go stale. Under the hood, we use the `httr` package to manage this. -If you want to switch to a different Google account, run `authorize(new_user = TRUE)`, as this will delete the previously stored token and get a new one for the new account. +If you want to switch to a different Google account, run `gs_auth(new_user = TRUE)`, as this will delete the previously stored token and get a new one for the new account. *In a hidden chunk, we are logging into Google as a user associated with this package, so we can work with some Google spreadsheets later in this vignette.* @@ -51,9 +51,7 @@ if(length(HTTR_OAUTH) > 0) { ```{r pre-clean, include = FALSE} ## if a previous compilation of this document leaves anything behind, i.e. if it ## aborts, clean up Google Drive first -my_patterns <- c("hi I am new here") -my_patterns <- my_patterns %>% stringr::str_c(collapse = "|") -delete_ss(regex = my_patterns, verbose = FALSE) +gs_vecdel("hi I am new here", verbose = FALSE) ``` @@ -63,7 +61,7 @@ If you don't have any Google Sheets yet, or if you just want to follow along ver ```{r copy-gapminder, eval = FALSE} gap_key <- "1hS762lIJd2TRUTVOqoOP7g-h4MDQs6b2vhkTzohg8bE" -copy_ss(key = gap_key, to = "Gapminder") +gs_copy(gs_key(gap_key), to = "Gapminder") ``` # List your spreadsheets @@ -72,28 +70,19 @@ As an authenticated user, you can get a (partial) listing of accessible sheets. ```{r list-sheets} my_sheets <- gs_ls() +my_sheets ``` -Explore the `my_sheets` object. Here's a look at the top of ours, where we've truncated the variables `sheet_title` and `sheet_key` and suppressed the variable `ws_id` for readability. - -```{r view-my-sheets, echo = FALSE} -my_sheets %>% - head %>% - mutate(sheet_title = substr(sheet_title, 1, 10), - sheet_key = sheet_key %>% substr(1, 7) %>% stringr::str_c("...")) %>% - select(-ws_feed) -``` - -This provides a nice overview of the spreadsheets you can access and is useful for looking up the __key__ of a spreadsheet (see below). +This provides a nice overview of the spreadsheets you can access. # Register a spreadsheet -Before you can access a spreadsheet, you must first __register__ it. This returns an object that is of little interest to the user, but is needed by various `googlesheets` functions in order to retrieve or edit spreadsheet data. +Before you can access a spreadsheet, you must first __register__ it. This returns a `googlesheets` object that is needed by downstream functions in order to retrieve or edit spreadsheet data. -Let's register the Gapminder spreadsheet we spied in the list above and that you may have copied into your Google Drive. We can use `str()` to get an overview of the spreadsheet. +Let's register the Gapminder spreadsheet we spied in the list above and that you may have copied into your Google Drive. We have a nice `print` method for these objects, so print to screen for some basic info. ```{r} -gap <- register_ss("Gapminder") +gap <- gs_title("Gapminder") gap ``` @@ -103,11 +92,11 @@ Besides using the spreadsheet title, you can also specify a spreadsheet in three * By URL: copy and paste the URL in your browser while visiting the spreadsheet. * By the "worksheets feed": under the hood, this is how `googlesheets` actually gets spreadsheet information from the API. Unlikely to be relevant to a regular user. -Here's an example of using the sheet title to retrieve the key, then registering the sheet by key. While registration by title is handy for interactive use, registration by key is preferred for scripts. +Here's an example of registering a sheet via key. While registration by title is handy for interactive use, registration by key might be preferred when programming. ```{r} (gap_key <- my_sheets$sheet_key[my_sheets$sheet_title == "Gapminder"]) -ss2 <- register_ss(gap_key) +ss2 <- gs_key(gap_key) ss2 ``` @@ -115,8 +104,9 @@ ss2 Spreadsheet data is parcelled out into __worksheets__. To consume data from a Google spreadsheet, you'll need to specify a registered spreadsheet and, within that, a worksheet. Specify the worksheet either by name or positive integer index. -There are two ways to consume data. +There are three ways to consume data. + * *The csv way ... bring this over from README* * The "list feed": only suitable for well-behaved tabular data. Think: data that looks like an R data.frame * The "cell feed": for everything else. Of course, you can get well-behaved tabular data with the cell feed but it's up to 3x slower and will require post-processing (reshaping and coercion). @@ -163,7 +153,7 @@ There are two basic modes of consuming data stored in a worksheet (quotes taken *Rework this for the new era.* -Under the hood, `gspread` functions must access a spreadsheet with either public or private __visiblity__. Visibility determines whether or not authorization will be used for a request. +Under the hood, `googlesheets` functions must access a spreadsheet with either public or private __visiblity__. Visibility determines whether or not authorization will be used for a request. No authorization is used when visibility is set to "public", which will only work for spreadsheets that have been "Published to the Web". Note that requests with visibility set to "public" __will not work__ for spreadsheets that are made "Public on the web" from the "Visibility options" portion of the sharing dialog of a Google Sheets file. In summary, "Published to the web" and "Public on the web" are __different__ ways to share a spreadsheet. @@ -185,43 +175,50 @@ To access public spreadsheets, you will either need the key of the spreadsheet ( ### Add or delete spreadsheet -To add or delete a spreadsheet in your Google Drive, use `new_ss()` or `delete_ss()` and simply pass in the title of the spreadsheet as a character string. The new spreadsheet by default will contain one worksheet titled "Sheet1". Recall we demonstrate the use of `copy_ss()` at the start of this vignette. +To add a spreadsheet to your Google Drive, use `gs_new()` and simply pass in the title of the spreadsheet as a character string. The new spreadsheet will contain one worksheet titled "Sheet1" by default. Recall we demonstrate the use of `gs_copy()` at the start of this vignette, which is another common way to get a new sheet. -```{r create and delete spreadsheet} +or delete +or `gs_delete()` + +```{r createspreadsheet} # Create a new empty spreadsheet by title -new_ss("hi I am new here") +gs_new("hi I am new here") gs_ls() %>% filter(sheet_title == "hi I am new here") +``` + +Delete a spreadsheet with `gs_delete()`. This function operates on a registered `googlesheet`, so enclose your sheet identifying information in a suitable function. Here we specify (and delete) the above sheet by title, then confirm it is no longer in our sheet listing. +```{r delete spreadsheet} # Move spreadsheet to trash -delete_ss("hi I am new here") +gs_delete(gs_title("hi I am new here")) gs_ls() %>% filter(sheet_title == "hi I am new here") ``` ### Add, delete, or rename a worksheet -To add a worksheet to a spreadsheet, pass in the spreadsheet object, title of new worksheet and the number of rows and columns. To delete a worksheet from a spreadsheet, pass in the spreadsheet object and the title of the worksheet. Note that after adding or deleting a worksheet, the local spreadsheet object will not be automatically updated to include the new worksheet(s) information, you must register the spreadsheet again to update local knowledge about, e.g., the contituent worksheets. Notice that we store the sheet back to `x` after adding the worksheet. This is because adding a worksheet changes the information associate with a registered sheet and, within editing function like `add_ws()`, we re-register the sheet and return the current sheet info. +To add a worksheet to a spreadsheet, pass in the spreadsheet object, title of new worksheet and the number of rows and columns. To delete a worksheet from a spreadsheet, pass in the spreadsheet object and the title of the worksheet. Note that after adding or deleting a worksheet, the local `googlesheet` object will not be automatically updated to include the new worksheet(s) information, you must register the spreadsheet again to update local knowledge about, e.g., the contituent worksheets. Notice that we store the sheet back to `x` after adding the worksheet. This is because adding a worksheet changes the information associated with a registered sheet and, within editing functions like `gs_ws_new()`, we re-register the sheet and return the current sheet info. ```{r new-sheet-new-ws-delete-ws} -new_ss("hi I am new here") -x <- register_ss("hi I am new here") +gs_new("hi I am new here") +x <- gs_title("hi I am new here") x -x <- add_ws(x, ws_title = "foo", nrow = 10, ncol = 10) +x <- gs_ws_new(x, ws_title = "foo", nrow = 10, ncol = 10) x -delete_ws(x, ws = "foo") -x <- register_ss("hi I am new here") +gs_ws_delete(x, ws = "foo") +x <- gs_title("hi I am new here") x ``` To rename a worksheet, pass in the spreadsheet object, the worksheet's current name and the new name you want it to be. ```{r new-ws-rename-ws-delete-ws} -rename_ws(x, "Sheet1", "First Sheet") +gs_ws_rename(x, "Sheet1", "First Sheet") ``` Tidy up by getting rid of the sheet we've playing with. ```{r delete-sheet} -delete_ss("hi I am new here") +gs_delete(gs_title("hi I am new here")) ``` # Worksheet Operations diff --git a/vignettes/basic-usage.html b/vignettes/basic-usage.html index 813fd6c..a60f433 100644 --- a/vignettes/basic-usage.html +++ b/vignettes/basic-usage.html @@ -10,7 +10,7 @@ - + googlesheets Basic Usage @@ -54,7 +54,7 @@
@@ -79,53 +79,59 @@

2015-05-01

-

NOTE: The vignette is still under development. Stuff here is not written in stone. The README on GitHub has gotten alot more love recently, so you might want to read that instead or in addition to this (2015-03-23).

+

NOTE: The vignette is still under development. Stuff here is not written in stone. The README on GitHub has gotten alot more love recently, so you should read that instead or in addition to this (2015-05-08). Seriously, we’ve only been making sure this thing compiles, but not updating the text.

library(googlesheets)
 suppressMessages(library(dplyr))

This vignette shows the basic functionality of googlesheets.

User Authentication

In order to access spreadsheets that are not “published to the web” and in order to access any spreadsheets by title (vs key), you need to authenticate with Google. Many googlesheets functions require authentication and, if necessary, will simply trigger the interactive process we describe here.

-

The authorize() function uses OAuth2 for authentication, but don’t worry if you don’t know what that means. The first time, you will be kicked into a web browser. You’ll be asked to login to your Google account and give googlesheets permission to access Sheets and Google Drive. Successful login will lead to the creation of an access token, which will automatically be stored in a file named .httr-oath in current working directory. These tokens are perishable and, for the most part, they will be refreshed automatically when they go stale. Under the hood, we use the httr package to manage this.

-

If you want to switch to a different Google account, run authorize(new_user = TRUE), as this will delete the previously stored token and get a new one for the new account.

+

The gs_auth() function uses OAuth2 for authentication, but don’t worry if you don’t know what that means. The first time, you will be kicked into a web browser. You’ll be asked to login to your Google account and give googlesheets permission to access Sheets and Google Drive. Successful login will lead to the creation of an access token, which will automatically be stored in a file named .httr-oath in current working directory. These tokens are perishable and, for the most part, they will be refreshed automatically when they go stale. Under the hood, we use the httr package to manage this.

+

If you want to switch to a different Google account, run gs_auth(new_user = TRUE), as this will delete the previously stored token and get a new one for the new account.

In a hidden chunk, we are logging into Google as a user associated with this package, so we can work with some Google spreadsheets later in this vignette.

Get a Google spreadsheet to practice with

If you don’t have any Google Sheets yet, or if you just want to follow along verbatim with this vignette, this bit of code will copy a sheet from the googlesheets Google user into your Drive. The sheet holds some of the Gapminder data.

gap_key <- "1hS762lIJd2TRUTVOqoOP7g-h4MDQs6b2vhkTzohg8bE"
-copy_ss(key = gap_key, to = "Gapminder")
+gs_copy(gs_key(gap_key), to = "Gapminder")

List your spreadsheets

As an authenticated user, you can get a (partial) listing of accessible sheets. If you have not yet authenticated, you will be prompted to do so. If it’s been a while since you authenticated, you’ll see a message about refreshing a stale OAuth token.

-
my_sheets <- gs_ls()
-

Explore the my_sheets object. Here’s a look at the top of ours, where we’ve truncated the variables sheet_title and sheet_key and suppressed the variable ws_id for readability.

-
## Source: local data frame [6 x 9]
+
my_sheets <- gs_ls()
+my_sheets
+
## Source: local data frame [33 x 10]
 ## 
-##   sheet_title        owner perm version        last_updated  sheet_key
-## 1  Ari's Anch     anahmani    r     old 2015-05-02 00:56:31 tQKSYVR...
-## 2  gas_mileag     woo.kara    r     new 2015-05-01 23:37:42 1WH65aJ...
-## 3  #rhizo15 #    m.hawksey    r     new 2015-05-01 18:54:05 1oBQNns...
-## 4  EasyTweetS    m.hawksey    r     new 2015-05-02 00:38:33 14mAbIi...
-## 5  test-gs-ol     gspreadr   rw     old 2015-04-30 23:33:48 t0lmRSk...
-## 6  test-gs-mi rpackagetest    r     new 2015-04-25 18:25:43 1BMtx1V...
-## Variables not shown: alternate (chr), self (chr), alt_key (chr)
-

This provides a nice overview of the spreadsheets you can access and is useful for looking up the key of a spreadsheet (see below).

+## sheet_title author perm version updated +## 1 foo gspreadr rw new 2015-05-08 22:14:30 +## 2 Ari's Anchor Text Scrap… anahmani r old 2015-05-08 18:24:16 +## 3 #rhizo15 #tw m.hawksey r new 2015-05-08 20:00:01 +## 4 EasyTweetSheet - Shared m.hawksey r new 2015-05-08 21:58:48 +## 5 gas_mileage woo.kara r new 2015-05-04 01:14:13 +## 6 #TalkPay Tweets iskaldur r new 2015-05-02 06:25:14 +## 7 test-gs-old-sheet2 gspreadr rw old 2015-04-30 23:33:48 +## 8 test-gs-mini-gapminder rpackagetest r new 2015-04-25 18:25:43 +## 9 test-gs-iris-private gspreadr rw new 2015-04-25 15:18:05 +## 10 1F0iNuYW4v_oG69s7c5Nzdo… gspreadr rw new 2015-04-25 02:32:24 +## .. ... ... ... ... ... +## Variables not shown: sheet_key (chr), ws_feed (chr), alternate (chr), self +## (chr), alt_key (chr)
+

This provides a nice overview of the spreadsheets you can access.

Register a spreadsheet

-

Before you can access a spreadsheet, you must first register it. This returns an object that is of little interest to the user, but is needed by various googlesheets functions in order to retrieve or edit spreadsheet data.

-

Let’s register the Gapminder spreadsheet we spied in the list above and that you may have copied into your Google Drive. We can use str() to get an overview of the spreadsheet.

-
gap <- register_ss("Gapminder")
-
## Sheet identified!
-## sheet_title: Gapminder
-## sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA
+

Before you can access a spreadsheet, you must first register it. This returns a googlesheets object that is needed by downstream functions in order to retrieve or edit spreadsheet data.

+

Let’s register the Gapminder spreadsheet we spied in the list above and that you may have copied into your Google Drive. We have a nice print method for these objects, so print to screen for some basic info.

+
gap <- gs_title("Gapminder")
+
## Sheet successfully identifed: "Gapminder"
gap
##                   Spreadsheet title: Gapminder
-##   Date of googlesheets::register_ss: 2015-05-02 01:38:07 GMT
+##   Date of googlesheets registration: 2015-05-08 22:14:37 GMT
 ##     Date of last spreadsheet update: 2015-03-23 20:34:08 GMT
 ##                          visibility: private
+##                         permissions: rw
+##                             version: new
 ## 
 ## Contains 5 worksheets:
 ## (Title): (Nominal worksheet extent as rows x columns)
@@ -142,18 +148,19 @@ 

Register a spreadsheet

  • By URL: copy and paste the URL in your browser while visiting the spreadsheet.
  • By the “worksheets feed”: under the hood, this is how googlesheets actually gets spreadsheet information from the API. Unlikely to be relevant to a regular user.
  • -

    Here’s an example of using the sheet title to retrieve the key, then registering the sheet by key. While registration by title is handy for interactive use, registration by key is preferred for scripts.

    +

    Here’s an example of registering a sheet via key. While registration by title is handy for interactive use, registration by key might be preferred when programming.

    (gap_key <- my_sheets$sheet_key[my_sheets$sheet_title == "Gapminder"])
    ## [1] "1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA"
    -
    ss2 <- register_ss(gap_key)
    -
    ## Sheet identified!
    -## sheet_title: Gapminder
    -## sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA
    +
    ss2 <- gs_key(gap_key)
    +
    ## Authentication will be used.
    +## Sheet successfully identifed: "Gapminder"
    ss2
    ##                   Spreadsheet title: Gapminder
    -##   Date of googlesheets::register_ss: 2015-05-02 01:38:08 GMT
    +##   Date of googlesheets registration: 2015-05-08 22:14:37 GMT
     ##     Date of last spreadsheet update: 2015-03-23 20:34:08 GMT
     ##                          visibility: private
    +##                         permissions: rw
    +##                             version: new
     ## 
     ## Contains 5 worksheets:
     ## (Title): (Nominal worksheet extent as rows x columns)
    @@ -168,17 +175,20 @@ 

    Register a spreadsheet

    Consuming data from a worksheet

    Spreadsheet data is parcelled out into worksheets. To consume data from a Google spreadsheet, you’ll need to specify a registered spreadsheet and, within that, a worksheet. Specify the worksheet either by name or positive integer index.

    -

    There are two ways to consume data.

    +

    There are three ways to consume data.

      +
    • The csv way … bring this over from README
    • The “list feed”: only suitable for well-behaved tabular data. Think: data that looks like an R data.frame
    • The “cell feed”: for everything else. Of course, you can get well-behaved tabular data with the cell feed but it’s up to 3x slower and will require post-processing (reshaping and coercion).

    Example of getting nice tabular data from the “list feed”:

    gap
    ##                   Spreadsheet title: Gapminder
    -##   Date of googlesheets::register_ss: 2015-05-02 01:38:07 GMT
    +##   Date of googlesheets registration: 2015-05-08 22:14:37 GMT
     ##     Date of last spreadsheet update: 2015-03-23 20:34:08 GMT
     ##                          visibility: private
    +##                         permissions: rw
    +##                             version: new
     ## 
     ## Contains 5 worksheets:
     ## (Title): (Nominal worksheet extent as rows x columns)
    @@ -282,7 +292,7 @@ 

    Consuming data from a worksheet

    Visibility stuff

    Rework this for the new era.

    -

    Under the hood, gspread functions must access a spreadsheet with either public or private visiblity. Visibility determines whether or not authorization will be used for a request.

    +

    Under the hood, googlesheets functions must access a spreadsheet with either public or private visiblity. Visibility determines whether or not authorization will be used for a request.

    No authorization is used when visibility is set to “public”, which will only work for spreadsheets that have been “Published to the Web”. Note that requests with visibility set to “public” will not work for spreadsheets that are made “Public on the web” from the “Visibility options” portion of the sharing dialog of a Google Sheets file. In summary, “Published to the web” and “Public on the web” are different ways to share a spreadsheet.

    Authorization is used when visibility is set to “private”.

    @@ -301,98 +311,94 @@

    Add, delete, rename spreadsheets and worksheets

    needs updating; lots of this already in README

    Add or delete spreadsheet

    -

    To add or delete a spreadsheet in your Google Drive, use new_ss() or delete_ss() and simply pass in the title of the spreadsheet as a character string. The new spreadsheet by default will contain one worksheet titled “Sheet1”. Recall we demonstrate the use of copy_ss() at the start of this vignette.

    +

    To add a spreadsheet to your Google Drive, use gs_new() and simply pass in the title of the spreadsheet as a character string. The new spreadsheet will contain one worksheet titled “Sheet1” by default. Recall we demonstrate the use of gs_copy() at the start of this vignette, which is another common way to get a new sheet.

    +

    or delete or gs_delete()

    # Create a new empty spreadsheet by title
    -new_ss("hi I am new here")
    -
    ## Sheet "hi I am new here" created in Google Drive.
    -## Identifying info is a googlesheet object; googlesheets will re-identify the sheet based on sheet key.
    -## Sheet identified!
    -## sheet_title: hi I am new here
    -## sheet_key: 1OCtwyOb3K83Pyhpak2cMsH7jZbyUTrdq3soQT6t7ZTA
    +gs_new("hi I am new here")
    +
    ## Sheet "hi I am new here" created in Google Drive.
    gs_ls() %>% filter(sheet_title == "hi I am new here")
    ## Source: local data frame [1 x 10]
     ## 
    -##        sheet_title    owner perm version        last_updated
    -## 1 hi I am new here gspreadr   rw     new 2015-05-02 01:38:11
    +##        sheet_title   author perm version             updated
    +## 1 hi I am new here gspreadr   rw     new 2015-05-08 22:14:39
     ## Variables not shown: sheet_key (chr), ws_feed (chr), alternate (chr), self
     ##   (chr), alt_key (chr)
    +

    Delete a spreadsheet with gs_delete(). This function operates on a registered googlesheet, so enclose your sheet identifying information in a suitable function. Here we specify (and delete) the above sheet by title, then confirm it is no longer in our sheet listing.

    # Move spreadsheet to trash
    -delete_ss("hi I am new here")
    -
    ## Sheets found and slated for deletion:
    -## hi I am new here
    -## Success. All moved to trash in Google Drive.
    +gs_delete(gs_title("hi I am new here"))
    +
    ## Sheet successfully identifed: "hi I am new here"
    +## Success. "hi I am new here" moved to trash in Google Drive.
    gs_ls() %>% filter(sheet_title == "hi I am new here")
    ## Source: local data frame [0 x 10]
     ## 
    -## Variables not shown: sheet_title (chr), owner (chr), perm (chr), version
    -##   (chr), last_updated (time), sheet_key (chr), ws_feed (chr), alternate
    -##   (chr), self (chr), alt_key (chr)
    +## Variables not shown: sheet_title (chr), author (chr), perm (chr), version +## (chr), updated (time), sheet_key (chr), ws_feed (chr), alternate (chr), +## self (chr), alt_key (chr)

    Add, delete, or rename a worksheet

    -

    To add a worksheet to a spreadsheet, pass in the spreadsheet object, title of new worksheet and the number of rows and columns. To delete a worksheet from a spreadsheet, pass in the spreadsheet object and the title of the worksheet. Note that after adding or deleting a worksheet, the local spreadsheet object will not be automatically updated to include the new worksheet(s) information, you must register the spreadsheet again to update local knowledge about, e.g., the contituent worksheets. Notice that we store the sheet back to x after adding the worksheet. This is because adding a worksheet changes the information associate with a registered sheet and, within editing function like add_ws(), we re-register the sheet and return the current sheet info.

    -
    new_ss("hi I am new here")
    -
    ## Sheet "hi I am new here" created in Google Drive.
    -## Identifying info is a googlesheet object; googlesheets will re-identify the sheet based on sheet key.
    -## Sheet identified!
    -## sheet_title: hi I am new here
    -## sheet_key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w
    -
    x <- register_ss("hi I am new here")
    -
    ## Sheet identified!
    -## sheet_title: hi I am new here
    -## sheet_key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w
    +

    To add a worksheet to a spreadsheet, pass in the spreadsheet object, title of new worksheet and the number of rows and columns. To delete a worksheet from a spreadsheet, pass in the spreadsheet object and the title of the worksheet. Note that after adding or deleting a worksheet, the local googlesheet object will not be automatically updated to include the new worksheet(s) information, you must register the spreadsheet again to update local knowledge about, e.g., the contituent worksheets. Notice that we store the sheet back to x after adding the worksheet. This is because adding a worksheet changes the information associated with a registered sheet and, within editing functions like gs_ws_new(), we re-register the sheet and return the current sheet info.

    +
    gs_new("hi I am new here")
    +
    ## Sheet "hi I am new here" created in Google Drive.
    +
    x <- gs_title("hi I am new here")
    +
    ## Sheet successfully identifed: "hi I am new here"
    x
    ##                   Spreadsheet title: hi I am new here
    -##   Date of googlesheets::register_ss: 2015-05-02 01:38:18 GMT
    -##     Date of last spreadsheet update: 2015-05-02 01:38:15 GMT
    +##   Date of googlesheets registration: 2015-05-08 22:14:49 GMT
    +##     Date of last spreadsheet update: 2015-05-08 22:14:46 GMT
     ##                          visibility: private
    +##                         permissions: rw
    +##                             version: new
     ## 
     ## Contains 1 worksheets:
     ## (Title): (Nominal worksheet extent as rows x columns)
     ## Sheet1: 1000 x 26
     ## 
    -## Key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w
    -
    x <- add_ws(x, ws_title = "foo", nrow = 10, ncol = 10)
    +## Key: 1t5RJT_v6fmljtJXVd01Me9bL6vGHJ11q1-XrSo2KvWM +
    x <- gs_ws_new(x, ws_title = "foo", nrow = 10, ncol = 10)
    ## Worksheet "foo" added to sheet "hi I am new here".
    x
    ##                   Spreadsheet title: hi I am new here
    -##   Date of googlesheets::register_ss: 2015-05-02 01:38:20 GMT
    -##     Date of last spreadsheet update: 2015-05-02 01:38:19 GMT
    +##   Date of googlesheets registration: 2015-05-08 22:14:49 GMT
    +##     Date of last spreadsheet update: 2015-05-08 22:14:49 GMT
     ##                          visibility: private
    +##                         permissions: rw
    +##                             version: new
     ## 
     ## Contains 2 worksheets:
     ## (Title): (Nominal worksheet extent as rows x columns)
     ## Sheet1: 1000 x 26
     ## foo: 10 x 10
     ## 
    -## Key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w
    -
    delete_ws(x, ws = "foo")
    +## Key: 1t5RJT_v6fmljtJXVd01Me9bL6vGHJ11q1-XrSo2KvWM +
    gs_ws_delete(x, ws = "foo")
    ## Accessing worksheet titled "foo"
     ## Worksheet "foo" deleted from sheet "hi I am new here".
    -
    x <- register_ss("hi I am new here")
    -
    ## Sheet identified!
    -## sheet_title: hi I am new here
    -## sheet_key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w
    +
    x <- gs_title("hi I am new here")
    +
    ## Sheet successfully identifed: "hi I am new here"
    x
    ##                   Spreadsheet title: hi I am new here
    -##   Date of googlesheets::register_ss: 2015-05-02 01:38:23 GMT
    -##     Date of last spreadsheet update: 2015-05-02 01:38:20 GMT
    +##   Date of googlesheets registration: 2015-05-08 22:14:51 GMT
    +##     Date of last spreadsheet update: 2015-05-08 22:14:50 GMT
     ##                          visibility: private
    +##                         permissions: rw
    +##                             version: new
     ## 
     ## Contains 1 worksheets:
     ## (Title): (Nominal worksheet extent as rows x columns)
     ## Sheet1: 1000 x 26
     ## 
    -## Key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w
    +## Key: 1t5RJT_v6fmljtJXVd01Me9bL6vGHJ11q1-XrSo2KvWM

    To rename a worksheet, pass in the spreadsheet object, the worksheet’s current name and the new name you want it to be.

    -
    rename_ws(x, "Sheet1", "First Sheet")
    +
    gs_ws_rename(x, "Sheet1", "First Sheet")
    ## Accessing worksheet titled "Sheet1"
    +## Authentication will be used.
    +## Sheet successfully identifed: "hi I am new here"
     ## Worksheet "Sheet1" renamed to "First Sheet".

    Tidy up by getting rid of the sheet we’ve playing with.

    -
    delete_ss("hi I am new here")
    -
    ## Sheets found and slated for deletion:
    -## hi I am new here
    -## Success. All moved to trash in Google Drive.
    +
    gs_delete(gs_title("hi I am new here"))
    +
    ## Sheet successfully identifed: "hi I am new here"
    +## Success. "hi I am new here" moved to trash in Google Drive.
    diff --git a/vignettes/basic-usage.md b/vignettes/basic-usage.md index 4dfd507..b598a6b 100644 --- a/vignettes/basic-usage.md +++ b/vignettes/basic-usage.md @@ -2,7 +2,7 @@ Joanna Zhao, Jenny Bryan `r Sys.Date()` -__NOTE__: The vignette is still under development. Stuff here is not written in stone. The [README](https://github.com/jennybc/googlesheets) on GitHub has gotten alot more love recently, so you might want to read that instead or in addition to this (2015-03-23). +__NOTE__: The vignette is still under development. Stuff here is not written in stone. The [README](https://github.com/jennybc/googlesheets) on GitHub has gotten __alot more love recently__, so you should read that instead or in addition to this (2015-05-08). Seriously, we've only been making sure this thing compiles, but not updating the text. ```r @@ -16,9 +16,9 @@ This vignette shows the basic functionality of `googlesheets`. In order to access spreadsheets that are not "published to the web" and in order to access __any__ spreadsheets by title (vs key), you need to authenticate with Google. Many `googlesheets` functions require authentication and, if necessary, will simply trigger the interactive process we describe here. -The `authorize()` function uses OAuth2 for authentication, but don't worry if you don't know what that means. The first time, you will be kicked into a web browser. You'll be asked to login to your Google account and give `googlesheets` permission to access Sheets and Google Drive. Successful login will lead to the creation of an access token, which will automatically be stored in a file named `.httr-oath` in current working directory. These tokens are perishable and, for the most part, they will be refreshed automatically when they go stale. Under the hood, we use the `httr` package to manage this. +The `gs_auth()` function uses OAuth2 for authentication, but don't worry if you don't know what that means. The first time, you will be kicked into a web browser. You'll be asked to login to your Google account and give `googlesheets` permission to access Sheets and Google Drive. Successful login will lead to the creation of an access token, which will automatically be stored in a file named `.httr-oath` in current working directory. These tokens are perishable and, for the most part, they will be refreshed automatically when they go stale. Under the hood, we use the `httr` package to manage this. -If you want to switch to a different Google account, run `authorize(new_user = TRUE)`, as this will delete the previously stored token and get a new one for the new account. +If you want to switch to a different Google account, run `gs_auth(new_user = TRUE)`, as this will delete the previously stored token and get a new one for the new account. *In a hidden chunk, we are logging into Google as a user associated with this package, so we can work with some Google spreadsheets later in this vignette.* @@ -34,7 +34,7 @@ If you don't have any Google Sheets yet, or if you just want to follow along ver ```r gap_key <- "1hS762lIJd2TRUTVOqoOP7g-h4MDQs6b2vhkTzohg8bE" -copy_ss(key = gap_key, to = "Gapminder") +gs_copy(gs_key(gap_key), to = "Gapminder") ``` # List your spreadsheets @@ -44,41 +44,43 @@ As an authenticated user, you can get a (partial) listing of accessible sheets. ```r my_sheets <- gs_ls() +my_sheets ``` -Explore the `my_sheets` object. Here's a look at the top of ours, where we've truncated the variables `sheet_title` and `sheet_key` and suppressed the variable `ws_id` for readability. - - ``` -## Source: local data frame [6 x 9] +## Source: local data frame [33 x 10] ## -## sheet_title owner perm version last_updated sheet_key -## 1 Ari's Anch anahmani r old 2015-05-02 00:56:31 tQKSYVR... -## 2 gas_mileag woo.kara r new 2015-05-01 23:37:42 1WH65aJ... -## 3 #rhizo15 # m.hawksey r new 2015-05-01 18:54:05 1oBQNns... -## 4 EasyTweetS m.hawksey r new 2015-05-02 00:38:33 14mAbIi... -## 5 test-gs-ol gspreadr rw old 2015-04-30 23:33:48 t0lmRSk... -## 6 test-gs-mi rpackagetest r new 2015-04-25 18:25:43 1BMtx1V... -## Variables not shown: alternate (chr), self (chr), alt_key (chr) +## sheet_title author perm version updated +## 1 foo gspreadr rw new 2015-05-08 22:14:30 +## 2 Ari's Anchor Text Scrap… anahmani r old 2015-05-08 18:24:16 +## 3 #rhizo15 #tw m.hawksey r new 2015-05-08 20:00:01 +## 4 EasyTweetSheet - Shared m.hawksey r new 2015-05-08 21:58:48 +## 5 gas_mileage woo.kara r new 2015-05-04 01:14:13 +## 6 #TalkPay Tweets iskaldur r new 2015-05-02 06:25:14 +## 7 test-gs-old-sheet2 gspreadr rw old 2015-04-30 23:33:48 +## 8 test-gs-mini-gapminder rpackagetest r new 2015-04-25 18:25:43 +## 9 test-gs-iris-private gspreadr rw new 2015-04-25 15:18:05 +## 10 1F0iNuYW4v_oG69s7c5Nzdo… gspreadr rw new 2015-04-25 02:32:24 +## .. ... ... ... ... ... +## Variables not shown: sheet_key (chr), ws_feed (chr), alternate (chr), self +## (chr), alt_key (chr) ``` -This provides a nice overview of the spreadsheets you can access and is useful for looking up the __key__ of a spreadsheet (see below). +This provides a nice overview of the spreadsheets you can access. # Register a spreadsheet -Before you can access a spreadsheet, you must first __register__ it. This returns an object that is of little interest to the user, but is needed by various `googlesheets` functions in order to retrieve or edit spreadsheet data. +Before you can access a spreadsheet, you must first __register__ it. This returns a `googlesheets` object that is needed by downstream functions in order to retrieve or edit spreadsheet data. -Let's register the Gapminder spreadsheet we spied in the list above and that you may have copied into your Google Drive. We can use `str()` to get an overview of the spreadsheet. +Let's register the Gapminder spreadsheet we spied in the list above and that you may have copied into your Google Drive. We have a nice `print` method for these objects, so print to screen for some basic info. ```r -gap <- register_ss("Gapminder") +gap <- gs_title("Gapminder") ``` ``` -## Sheet identified! -## sheet_title: Gapminder -## sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA +## Sheet successfully identifed: "Gapminder" ``` ```r @@ -87,9 +89,11 @@ gap ``` ## Spreadsheet title: Gapminder -## Date of googlesheets::register_ss: 2015-05-02 01:38:07 GMT +## Date of googlesheets registration: 2015-05-08 22:14:37 GMT ## Date of last spreadsheet update: 2015-03-23 20:34:08 GMT ## visibility: private +## permissions: rw +## version: new ## ## Contains 5 worksheets: ## (Title): (Nominal worksheet extent as rows x columns) @@ -108,7 +112,7 @@ Besides using the spreadsheet title, you can also specify a spreadsheet in three * By URL: copy and paste the URL in your browser while visiting the spreadsheet. * By the "worksheets feed": under the hood, this is how `googlesheets` actually gets spreadsheet information from the API. Unlikely to be relevant to a regular user. -Here's an example of using the sheet title to retrieve the key, then registering the sheet by key. While registration by title is handy for interactive use, registration by key is preferred for scripts. +Here's an example of registering a sheet via key. While registration by title is handy for interactive use, registration by key might be preferred when programming. ```r @@ -120,13 +124,12 @@ Here's an example of using the sheet title to retrieve the key, then registering ``` ```r -ss2 <- register_ss(gap_key) +ss2 <- gs_key(gap_key) ``` ``` -## Sheet identified! -## sheet_title: Gapminder -## sheet_key: 1HT5B8SgkKqHdqHJmn5xiuaC04Ngb7dG9Tv94004vezA +## Authentication will be used. +## Sheet successfully identifed: "Gapminder" ``` ```r @@ -135,9 +138,11 @@ ss2 ``` ## Spreadsheet title: Gapminder -## Date of googlesheets::register_ss: 2015-05-02 01:38:08 GMT +## Date of googlesheets registration: 2015-05-08 22:14:37 GMT ## Date of last spreadsheet update: 2015-03-23 20:34:08 GMT ## visibility: private +## permissions: rw +## version: new ## ## Contains 5 worksheets: ## (Title): (Nominal worksheet extent as rows x columns) @@ -154,8 +159,9 @@ ss2 Spreadsheet data is parcelled out into __worksheets__. To consume data from a Google spreadsheet, you'll need to specify a registered spreadsheet and, within that, a worksheet. Specify the worksheet either by name or positive integer index. -There are two ways to consume data. +There are three ways to consume data. + * *The csv way ... bring this over from README* * The "list feed": only suitable for well-behaved tabular data. Think: data that looks like an R data.frame * The "cell feed": for everything else. Of course, you can get well-behaved tabular data with the cell feed but it's up to 3x slower and will require post-processing (reshaping and coercion). @@ -168,9 +174,11 @@ gap ``` ## Spreadsheet title: Gapminder -## Date of googlesheets::register_ss: 2015-05-02 01:38:07 GMT +## Date of googlesheets registration: 2015-05-08 22:14:37 GMT ## Date of last spreadsheet update: 2015-03-23 20:34:08 GMT ## visibility: private +## permissions: rw +## version: new ## ## Contains 5 worksheets: ## (Title): (Nominal worksheet extent as rows x columns) @@ -329,7 +337,7 @@ There are two basic modes of consuming data stored in a worksheet (quotes taken *Rework this for the new era.* -Under the hood, `gspread` functions must access a spreadsheet with either public or private __visiblity__. Visibility determines whether or not authorization will be used for a request. +Under the hood, `googlesheets` functions must access a spreadsheet with either public or private __visiblity__. Visibility determines whether or not authorization will be used for a request. No authorization is used when visibility is set to "public", which will only work for spreadsheets that have been "Published to the Web". Note that requests with visibility set to "public" __will not work__ for spreadsheets that are made "Public on the web" from the "Visibility options" portion of the sharing dialog of a Google Sheets file. In summary, "Published to the web" and "Public on the web" are __different__ ways to share a spreadsheet. @@ -351,20 +359,19 @@ To access public spreadsheets, you will either need the key of the spreadsheet ( ### Add or delete spreadsheet -To add or delete a spreadsheet in your Google Drive, use `new_ss()` or `delete_ss()` and simply pass in the title of the spreadsheet as a character string. The new spreadsheet by default will contain one worksheet titled "Sheet1". Recall we demonstrate the use of `copy_ss()` at the start of this vignette. +To add a spreadsheet to your Google Drive, use `gs_new()` and simply pass in the title of the spreadsheet as a character string. The new spreadsheet will contain one worksheet titled "Sheet1" by default. Recall we demonstrate the use of `gs_copy()` at the start of this vignette, which is another common way to get a new sheet. + +or delete +or `gs_delete()` ```r # Create a new empty spreadsheet by title -new_ss("hi I am new here") +gs_new("hi I am new here") ``` ``` ## Sheet "hi I am new here" created in Google Drive. -## Identifying info is a googlesheet object; googlesheets will re-identify the sheet based on sheet key. -## Sheet identified! -## sheet_title: hi I am new here -## sheet_key: 1OCtwyOb3K83Pyhpak2cMsH7jZbyUTrdq3soQT6t7ZTA ``` ```r @@ -374,21 +381,23 @@ gs_ls() %>% filter(sheet_title == "hi I am new here") ``` ## Source: local data frame [1 x 10] ## -## sheet_title owner perm version last_updated -## 1 hi I am new here gspreadr rw new 2015-05-02 01:38:11 +## sheet_title author perm version updated +## 1 hi I am new here gspreadr rw new 2015-05-08 22:14:39 ## Variables not shown: sheet_key (chr), ws_feed (chr), alternate (chr), self ## (chr), alt_key (chr) ``` +Delete a spreadsheet with `gs_delete()`. This function operates on a registered `googlesheet`, so enclose your sheet identifying information in a suitable function. Here we specify (and delete) the above sheet by title, then confirm it is no longer in our sheet listing. + + ```r # Move spreadsheet to trash -delete_ss("hi I am new here") +gs_delete(gs_title("hi I am new here")) ``` ``` -## Sheets found and slated for deletion: -## hi I am new here -## Success. All moved to trash in Google Drive. +## Sheet successfully identifed: "hi I am new here" +## Success. "hi I am new here" moved to trash in Google Drive. ``` ```r @@ -398,36 +407,30 @@ gs_ls() %>% filter(sheet_title == "hi I am new here") ``` ## Source: local data frame [0 x 10] ## -## Variables not shown: sheet_title (chr), owner (chr), perm (chr), version -## (chr), last_updated (time), sheet_key (chr), ws_feed (chr), alternate -## (chr), self (chr), alt_key (chr) +## Variables not shown: sheet_title (chr), author (chr), perm (chr), version +## (chr), updated (time), sheet_key (chr), ws_feed (chr), alternate (chr), +## self (chr), alt_key (chr) ``` ### Add, delete, or rename a worksheet -To add a worksheet to a spreadsheet, pass in the spreadsheet object, title of new worksheet and the number of rows and columns. To delete a worksheet from a spreadsheet, pass in the spreadsheet object and the title of the worksheet. Note that after adding or deleting a worksheet, the local spreadsheet object will not be automatically updated to include the new worksheet(s) information, you must register the spreadsheet again to update local knowledge about, e.g., the contituent worksheets. Notice that we store the sheet back to `x` after adding the worksheet. This is because adding a worksheet changes the information associate with a registered sheet and, within editing function like `add_ws()`, we re-register the sheet and return the current sheet info. +To add a worksheet to a spreadsheet, pass in the spreadsheet object, title of new worksheet and the number of rows and columns. To delete a worksheet from a spreadsheet, pass in the spreadsheet object and the title of the worksheet. Note that after adding or deleting a worksheet, the local `googlesheet` object will not be automatically updated to include the new worksheet(s) information, you must register the spreadsheet again to update local knowledge about, e.g., the contituent worksheets. Notice that we store the sheet back to `x` after adding the worksheet. This is because adding a worksheet changes the information associated with a registered sheet and, within editing functions like `gs_ws_new()`, we re-register the sheet and return the current sheet info. ```r -new_ss("hi I am new here") +gs_new("hi I am new here") ``` ``` ## Sheet "hi I am new here" created in Google Drive. -## Identifying info is a googlesheet object; googlesheets will re-identify the sheet based on sheet key. -## Sheet identified! -## sheet_title: hi I am new here -## sheet_key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w ``` ```r -x <- register_ss("hi I am new here") +x <- gs_title("hi I am new here") ``` ``` -## Sheet identified! -## sheet_title: hi I am new here -## sheet_key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w +## Sheet successfully identifed: "hi I am new here" ``` ```r @@ -436,19 +439,21 @@ x ``` ## Spreadsheet title: hi I am new here -## Date of googlesheets::register_ss: 2015-05-02 01:38:18 GMT -## Date of last spreadsheet update: 2015-05-02 01:38:15 GMT +## Date of googlesheets registration: 2015-05-08 22:14:49 GMT +## Date of last spreadsheet update: 2015-05-08 22:14:46 GMT ## visibility: private +## permissions: rw +## version: new ## ## Contains 1 worksheets: ## (Title): (Nominal worksheet extent as rows x columns) ## Sheet1: 1000 x 26 ## -## Key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w +## Key: 1t5RJT_v6fmljtJXVd01Me9bL6vGHJ11q1-XrSo2KvWM ``` ```r -x <- add_ws(x, ws_title = "foo", nrow = 10, ncol = 10) +x <- gs_ws_new(x, ws_title = "foo", nrow = 10, ncol = 10) ``` ``` @@ -461,20 +466,22 @@ x ``` ## Spreadsheet title: hi I am new here -## Date of googlesheets::register_ss: 2015-05-02 01:38:20 GMT -## Date of last spreadsheet update: 2015-05-02 01:38:19 GMT +## Date of googlesheets registration: 2015-05-08 22:14:49 GMT +## Date of last spreadsheet update: 2015-05-08 22:14:49 GMT ## visibility: private +## permissions: rw +## version: new ## ## Contains 2 worksheets: ## (Title): (Nominal worksheet extent as rows x columns) ## Sheet1: 1000 x 26 ## foo: 10 x 10 ## -## Key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w +## Key: 1t5RJT_v6fmljtJXVd01Me9bL6vGHJ11q1-XrSo2KvWM ``` ```r -delete_ws(x, ws = "foo") +gs_ws_delete(x, ws = "foo") ``` ``` @@ -483,13 +490,11 @@ delete_ws(x, ws = "foo") ``` ```r -x <- register_ss("hi I am new here") +x <- gs_title("hi I am new here") ``` ``` -## Sheet identified! -## sheet_title: hi I am new here -## sheet_key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w +## Sheet successfully identifed: "hi I am new here" ``` ```r @@ -498,26 +503,30 @@ x ``` ## Spreadsheet title: hi I am new here -## Date of googlesheets::register_ss: 2015-05-02 01:38:23 GMT -## Date of last spreadsheet update: 2015-05-02 01:38:20 GMT +## Date of googlesheets registration: 2015-05-08 22:14:51 GMT +## Date of last spreadsheet update: 2015-05-08 22:14:50 GMT ## visibility: private +## permissions: rw +## version: new ## ## Contains 1 worksheets: ## (Title): (Nominal worksheet extent as rows x columns) ## Sheet1: 1000 x 26 ## -## Key: 1AxDsu8P4akRfK1ORe9cw8OebiZb5-uZKXRg7hj48T5w +## Key: 1t5RJT_v6fmljtJXVd01Me9bL6vGHJ11q1-XrSo2KvWM ``` To rename a worksheet, pass in the spreadsheet object, the worksheet's current name and the new name you want it to be. ```r -rename_ws(x, "Sheet1", "First Sheet") +gs_ws_rename(x, "Sheet1", "First Sheet") ``` ``` ## Accessing worksheet titled "Sheet1" +## Authentication will be used. +## Sheet successfully identifed: "hi I am new here" ## Worksheet "Sheet1" renamed to "First Sheet". ``` @@ -525,13 +534,12 @@ Tidy up by getting rid of the sheet we've playing with. ```r -delete_ss("hi I am new here") +gs_delete(gs_title("hi I am new here")) ``` ``` -## Sheets found and slated for deletion: -## hi I am new here -## Success. All moved to trash in Google Drive. +## Sheet successfully identifed: "hi I am new here" +## Success. "hi I am new here" moved to trash in Google Drive. ``` # Worksheet Operations