Nothing
# File & Folder References --------------------------------------------------
#' boxr S3 Classes
#'
#' boxr implements a series of S3 classes to manage the data returned by the
#' Box API. These classes are built on `list`; if you wish to access the
#' information directly, you can use `unclass(x)`.
#'
#' **`boxr_file_reference`**
#'
#' - describes a file created, modified, or deleted at Box.
#' - returned by [box_ul()], [box_save()], [box_delete_file()], etc.
#' - available methods: [print()].
#'
#' **`boxr_folder_reference`**
#'
#' - describes a folder created or deleted at Box.
#' - returned by [box_dir_create()], [box_delete_folder()].
#' - available methods: [print()].
#'
#' **`boxr_dir_wide_operation_result`**
#'
#' - describes the result of a directory-wide operation.
#' - returned by [box_fetch()] and [box_push()].
#' - available methods: [print()], [summary()].
#'
#' **`boxr_object_list`**
#'
#' - describes a collection of files at Box.
#' - returned by [box_ls()], [box_search()], and related functions.
#' - available methods: [print()], [as.data.frame()].
#'
#' **`boxr_dir_comparison`**
#'
#' - describes the difference between directories.
#' - returned by the internal function [box_dir_diff()].
#' - available methods: [print()], [summary()].
#'
#' **`boxr_collab`**
#'
#' - describes a collaboration (sharing permission).
#' - returned by [box_collab_create()].
#' - available methods: [print()], [as.data.frame()], [as_tibble()].
#'
#' **`boxr_collab_list`**
#'
#' - describes a collection of collaborations.
#' - returned by [box_collab_get()].
#' - available methods: [print()], [as.data.frame()], [as_tibble()].
#'
#' **`boxr_comment`**
#'
#' - describes a comment on a file.
#' - returned by [box_comment_create()].
#' - available methods: [print()], [as.data.frame()], [as_tibble()].
#'
#' **`boxr_comment_list`**
#'
#' - describes a collection of comments on a file.
#' - returned by [box_comment_get()].
#' - available methods: [print()], [as.data.frame()], [as_tibble()].
#'
#' **`boxr_version_list`**
#'
#' - describes a collection of version information on a file.
#' - returned by [box_version_api()].
#' - available methods: [print()], [as.data.frame()], [as_tibble()].
#'
#' @name boxr_S3_classes
NULL
#' @keywords internal
add_file_ref_class <- function(x) {
class(x) <- "boxr_file_reference"
x
}
#' @keywords internal
add_folder_ref_class <- function(x) {
class(x) <- "boxr_folder_reference"
x
}
#' @export
print.boxr_file_reference <- function(x, ...) {
# x <- object$entries[[1]]
cat("\nbox.com remote file reference\n\n")
cat(" name :", x$name, "\n")
if(x$description != "")
cat(" description :", x$description, "\n")
cat(" file id :", x$id, "\n")
cat(" version :", paste0("V", as.numeric(x$etag) + 1), "\n")
cat(" size :", format_bytes(x$size), "\n")
cat(" modified at :",
as.character(as.POSIXct(gsub("T", " ", x$modified_at))), "\n"
)
cat(" created at :",
as.character(as.POSIXct(gsub("T", " ", x$modified_at))), "\n"
)
cat(" uploaded by :", x$modified_by$login, "\n")
cat(" owned by :", x$owned_by$login, "\n")
shared_link <- x$shared_link
if (is.null(shared_link))
shared_link <- "None"
cat(" shared link :", shared_link, "\n\n")
cat(" parent folder name : ", x$parent$name, "\n")
cat(" parent folder id : ", x$parent$id, "\n")
invisible(x)
}
#' @export
print.boxr_folder_reference <- function(x, ...) {
# x <- object$entries[[1]]
cat("\nbox.com remote folder reference\n\n")
cat(" name :", x$name, "\n")
cat(" dir id :", x$id, "\n")
cat(" size :", format_bytes(x$size), "\n")
cat(" modified at :",
as.character(as.POSIXct(gsub("T", " ", x$modified_at))), "\n"
)
cat(" created at :",
as.character(as.POSIXct(gsub("T", " ", x$modified_at))), "\n"
)
cat(" uploaded by :", x$modified_by$login, "\n")
cat(" owned by :", x$owned_by$login, "\n")
shared_link <- x$shared_link
if (is.null(shared_link))
shared_link <- "None"
cat(" shared link :", shared_link, "\n\n")
cat(" parent folder name : ", x$parent$name, "\n")
cat(" parent folder id : ", x$parent$id, "\n")
invisible(x)
}
# Object Lists ------------------------------------------------------------
#' @export
as.data.frame.boxr_object_list <- function(x, ...) {
summarise_row <- function(x) {
path <- paste0(unlist(
lapply(x$path_collection$entries, function(x) x$name)
), collapse = "/")
data.frame(
name = x$name,
type = x$type,
id = x$id,
size = x$size %|0|% NA_integer_,
description = x$description,
owner = x$owned_by$login,
path = path,
modified_at = box_datetime(x$modified_at),
content_modified_at = box_datetime(x$content_modified_at) %|0|% as.POSIXct(NA),
sha1 = x$sha1 %|0|% NA_character_,
version = as.numeric(x$etag) + 1,
version_no = as.numeric(x$etag) + 1,
version_id = x$file_version$id %|0|% NA_character_,
stringsAsFactors = FALSE
)
}
out <- data.frame(dplyr::bind_rows(lapply(x, summarise_row)))
return(out)
}
#' @export
print.boxr_object_list <- function(x, ...) {
# Convert to data.frame
df <- as.data.frame.boxr_object_list(x)
# If it's empty, just cat a short message
if (nrow(df) < 1) {
cat("\nbox.com remote object list: Empty (no objects returned)")
return(df)
}
# For the first 10 objects, show the first 5 cols of the df
df <- df[1:min(nrow(df), 10),]
# If there's nothing in the description field, kill it off
if (all(df$description == ""))
df$description <- NULL
# Lower the width of it a bit
if(!is.null(df$description))
df$description <- trunc_end(df$description)
df$path <- trunc_start(df$path)
df$size <- purrr::map_chr(df$size, purrr::possibly(format_bytes, NA))
cat(paste0("\nbox.com remote object list (", length(x), " objects)\n\n"))
cat(paste0(" Summary of first ", nrow(df), ":\n\n"))
print(df[, 1:5])
cat("\n\nUse as.data.frame() to extract full results.\n")
invisible(x)
}
# Directory-Wide Operations -----------------------------------------------
# A better version of this would keep the whole httr call, in additon
# to the boxr expression called (e.g. upload call : box_ul(blah))
#' @export
print.boxr_dir_wide_operation_result <- function(x, ...) {
boxr_timediff <- function(x)
paste0("took ", format(unclass(x), digits = 3), " ", attr(x, "units"))
f <- x$file_list
tdif <- boxr_timediff(x$end - x$start)
cat("\nboxr", x$operation, "operation\n\n")
# General blurb on the op
cat(paste0(
" User : ", getOption("boxr.username"), "\n",
" Local dir : ", x$local_tld, "\n",
" box.com folder : ", x$box_tld_id, "\n",
" started at : ", x$start , " (", tdif, ")", "\n",
"\n"
))
# Produce a summary of the changes
summarise_ops(x$file_list, x$msg_list)
cat("Use summary() to see individual file operations.")
invisible(x)
}
# This will only really be shown for uploaded files. I can't think of a great
# reason to explicitly 'map' this to local versions of a file at the moment.
#
# A better version of this would keep the whole httr call, in additon
# to the boxr expression called (e.g. upload call : box_ul(blah))
#' @export
summary.boxr_dir_wide_operation_result <- function(object, ...) {
boxr_timediff <- function(x)
paste0("took ", format(unclass(x), digits = 3), " ", attr(x, "units"))
f <- object$file_list
tdif <- boxr_timediff(object$end - object$start)
cat("\nboxr", object$operation, "operation\n\n")
# General blurb on the op
cat(paste0(
" User : ", getOption("boxr.username"), "\n",
" Local dir : ", object$local_tld, "\n",
" box.com folder : ", object$box_tld_id, "\n",
" started at : ", object$start , " (", tdif, ")", "\n",
"\n"
))
# This just justifies the box.com id's
if (!is.null(object$file_list[[17]]) && nrow(object$file_list[[17]]) > 0)
object$file_list[[17]][,1] <- dir_id_tidy(object$file_list[[17]][,1])
# Print out a summary of each of the file lists
print_df_summary(object$file_list, object$msg_list)
invisible(object)
}
# Directory Comparison ----------------------------------------------------
#' @export
print.boxr_dir_comparison <- function(x, ...) {
cat("\nboxr remote:local directory comparison\n\n")
origin <- if (x$call_info$load == "up") "Local directory" else "box.com"
destin <- if (x$call_info$load != "up") "Local directory" else "box.com"
# General blurb on the op
cat(paste0(
" User : ", getOption("boxr.username"), "\n",
" Local dir : ", x$call_info$local_dir, "\n",
" box.com folder : ", x$call_info$dir_id, "\n",
" Direction : ", x$call_info$load, "load", "\n",
" Origin : ", origin, "\n",
" Destination : ", destin, "\n",
"\n"
))
object_list <- x[names(x) != "call_info"]
# Produce a summary of the differences
summarise_ops(object_list, x$call_info$msg)
cat("Use summary() to see individual files.")
invisible(x)
}
#' @export
summary.boxr_dir_comparison <- function(object, ...) {
cat("\nboxr remote:local directory comparison\n\n")
origin <- if (object$call_info$load == "up") "Local directory" else "box.com"
destin <- if (object$call_info$load != "up") "Local directory" else "box.com"
# General blurb on the op
cat(paste0(
" User : ", getOption("boxr.username"), "\n",
" Local dir : ", object$call_info$local_dir, "\n",
" box.com folder : ", object$call_info$dir_id, "\n",
" Direction : ", object$call_info$load, "load", "\n",
" Origin : ", origin, "\n",
" Destination : ", destin, "\n",
"\n"
))
# This just justifies the box.com id's
if (!is.null(object$file_list[[17]]) && nrow(object$file_list[[17]]) > 0)
object$file_list[[17]][,1] <- dir_id_tidy(object$file_list[[17]][,1])
object_list <- object[names(object) != "call_info"]
# Print out a summary of each of the file lists
print_df_summary(object_list, object$call_info$msg)
invisible(object)
}
# Collab Functions -----------------------------------------------
#' @importFrom tibble as_tibble
#' @export
#'
as_tibble.boxr_collab <- function(x, ...) {
stack_row_tbl(x)
}
#' @export
#'
as.data.frame.boxr_collab <- function(x, ...) {
stack_row_df(x)
}
#' @export
#'
print.boxr_collab <- function(x, ...) {
print_dispatch(x, ...)
}
# Collab-list Functions -----------------------------------------------
#' @export
#'
as_tibble.boxr_collab_list <- function(x, ...) {
stack_rows_tbl(x)
}
#' @export
#'
as.data.frame.boxr_collab_list <- function(x, ...) {
stack_rows_df(x)
}
#' @export
#'
print.boxr_collab_list <- function(x, ...) {
print_dispatch(x, ...)
}
# Comment ------------------------------------------------------------
#' @export
#'
as_tibble.boxr_comment <- function(x, ...) {
stack_row_tbl(x)
}
#' @export
#'
as.data.frame.boxr_comment <- function(x, ...) {
stack_row_df(x)
}
#' @export
#'
print.boxr_comment<- function(x, ...) {
print_dispatch(x, ...)
}
# Comment-list -------------------------------------------------------------------
#' @export
#'
as.data.frame.boxr_comment_list <- function(x, ...) {
stack_rows_df(x)
}
#' @export
#'
as_tibble.boxr_comment_list <- function(x, ...) {
stack_rows_tbl(x)
}
#' @export
#'
print.boxr_comment_list <- function(x, ...) {
print_dispatch(x, ...);
}
# Version list -------------------------------------------------------------------
mutate_version_list <- function(x) {
if (is_void(x)) {
return(invisible(NULL))
}
# TODO: this should be in an all-purpose parser for the content
# parse datetimes
x[["modified_at"]] <- box_datetime(x[["modified_at"]])
x[["created_at"]] <- box_datetime(x[["created_at"]])
# arrange by `modified_at`
x <- x[order(x[["modified_at"]]), ]
# change `id` to `version_id`
colnames(x)[colnames(x) == "id"] <- "version_id"
# discard type
x[["type"]] <- NULL
# add `version_no`
col_names <- colnames(x)
x[["version_no"]] <- seq_along(x$version_id) + 1L
x <- x[ ,c("version_no", col_names)]
# discard row names
rownames(x) <- NULL
x
}
#' @export
#'
as.data.frame.boxr_version_list <- function(x, ...) {
x <- stack_rows_df(x)
x <- mutate_version_list(x)
x
}
#' @export
#'
as_tibble.boxr_version_list <- function(x, ...) {
x <- stack_rows_tbl(x)
x <- mutate_version_list(x)
x
}
#' @export
#'
print.boxr_version_list <- function(x, ...) {
print_dispatch(x, ...);
}
# Internal Helper Functions -----------------------------------------------
# A function to make msg_list gramatically sensible where you have only one file
# e.g. "1 files were" -> "1 file was"
grep_tense <- function(msg, n) {
# Non-vectorized version
grepTense <- function(msg, n) {
if(is.na(n) || is.null(n) || n > 1) {
return(msg)
}
msg <- gsub("files", "file", msg)
msg <- gsub("directories", "directory", msg)
msg <- gsub("were", "was", msg)
return(msg)
}
# Apply grepTense along msg and n, return result as vector
mapply(grepTense, msg, n)
}
# Combine the file list and the message list, to print out a summary of the
# operations performed
summarise_ops <- function(file_list, msg_list) {
# Construct the messages by combining the number of rows of the data.frame
# with the message for the operation, e.g. "X " + "files downloaded"
op_summaries <- unlist(mapply(
function(x, msg) {
if (nrow(x) > 0L) paste(nrow(x), grep_tense(msg, nrow(x)))
},
file_list, msg_list
))
# Print the messages out
cat(paste0(
paste(op_summaries[!is.null(op_summaries)], collapse = ", "),
".\n\n"
))
}
# For a file_list and a msg_list, run through the two, printing out the name
# of the operation, and the individual files affected by it
print_df_summary <- function(file_list, msg_list) {
# Non-vectorized print function. Oh, how you wish you'd imported magrittr!
print_df <- function(x, msg) {
if (nrow(x) > 0) {
cat(nrow(x), msg, ":\n")
print(
format(
data.frame(
" " = x[,grepl("full_path",colnames(x))],
check.names = FALSE
),
justify = "left"
),
row.names = FALSE
)
cat("\n\n")
}
}
# Run through the file df's in file_list, print out messages for them
# dummy_var absorbs the result (only the side-effect -- the printing to
# console/terminal) is desired
dummy_var <- mapply(print_df, file_list, msg_list)
}
print_dispatch <- function(x, ...) {
has_tibble <- requireNamespace("tibble", quietly = TRUE)
# should this default TRUE or FALSE?
print_tibble <- getOption("boxr.print_tibble") %||% FALSE
if (has_tibble && print_tibble) {
print_using_tibble(x, ...)
} else {
print_using_df(x, ...)
}
invisible(x)
}
print_using_df <- function(x, ...) {
has_tibble <- requireNamespace("tibble", quietly = TRUE)
df <- as.data.frame(x)
cat("--- printing as data.frame ---\n")
print(df, max = 10 * ncol(df), ...)
cat("\n")
if (has_tibble) {
cat("Use `as.data.frame()` or `as_tibble()` to extract full results.\n")
} else {
cat("Use `as.data.frame()` to extract full results.\n")
}
invisible(x)
}
print_using_tibble <- function(x, ...) {
tbl <- as_tibble(x)
cat("--- printing as tibble ---\n")
print(tbl, ...)
cat("\n")
cat("Use `as_tibble()` or `as.data.frame()` to extract full results.\n")
invisible(x)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.