refactor to split code by service (#44)

* bump version * refactor to split code by service
ijlyttle · Oct 3, 2020 · 3a3b396 · 3a3b396
1 parent 86ca980
commit 3a3b396
Show file tree

Hide file tree

Showing 12 changed files with 406 additions and 401 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: vembedr
 Title: Embed Video in HTML
-Version: 0.1.3.9001
+Version: 0.1.3.9002
 Authors@R: c(
     person(
       given = "Ian", 

diff --git a/R/embed.R b/R/embed.R
@@ -43,176 +43,6 @@
 #'
 NULL
 
-#' @rdname embed
-#' @export
-#
-embed_vimeo <- function(id,
-                        width = NULL, height = 300, ratio = c("16by9", "4by3"),
-                        frameborder = 0, allowfullscreen = TRUE,
-                        query = NULL, fragment = NULL){
-
-  ratio <- match.arg(ratio)
-  dim <- get_width_height(width, height, ratio)
-
-  allowfullscreen <- .convert_allowfullscreen(allowfullscreen)
-
-  url <- httr::parse_url("https://player.vimeo.com/video")
-
-  # update url
-  url$path <- paste(url$path, id, sep = "/")
-  url$query <- query
-  url$fragment <- fragment
-
-  iframe <- htmltools::tags$iframe(
-    class = "vimeo-embed",
-    src = httr::build_url(url),
-    width = dim$width,
-    height = dim$height,
-    frameborder = frameborder,
-    webkitallowfullscreen = allowfullscreen,
-    mozallowfullscreen = allowfullscreen,
-    allowfullscreen = allowfullscreen
-  )
-
-  embed <- create_embed(iframe, "vembedr_embed_vimeo", ratio)
-
-  embed
-}
-
-#' @rdname embed
-#' @export
-#
-embed_youtube <- function(id,
-                          width = NULL, height = 300, ratio = c("16by9", "4by3"),
-                          frameborder = 0, allowfullscreen = TRUE,
-                          query = NULL){
-
-  ratio <- match.arg(ratio)
-  dim <- get_width_height(width, height, ratio)
-
-  allowfullscreen <- .convert_allowfullscreen(allowfullscreen)
-
-  url <- httr::parse_url("https://www.youtube.com/embed")
-
-  url$path <- paste(url$path, id, sep = "/")
-  url$query <- query
-
-  iframe <- htmltools::tags$iframe(
-    src = httr::build_url(url),
-    width = dim$width,
-    height = dim$height,
-    frameborder = frameborder,
-    allowfullscreen = allowfullscreen
-  )
-
-  embed <- create_embed(iframe, "vembedr_embed_youtube", ratio)
-
-  embed
-}
-
-#' @rdname embed
-#' @export
-#
-embed_user2016 <- function(id,
-                           width = NULL, height = 300, ratio = c("16by9", "4by3"),
-                           frameborder = 0, allowfullscreen = TRUE){
-
-  id <- c("Events", "useR-international-R-User-conference", "useR2016", id)
-
-  embed_channel9(id, width, height, ratio, frameborder, allowfullscreen)
-}
-
-#' @rdname embed
-#' @export
-#
-embed_user2017 <- function(id,
-                           width = NULL, height = 300, ratio = c("16by9", "4by3"),
-                           frameborder = 0, allowfullscreen = TRUE){
-
-  id <- c(
-    "Events",
-    "useR-international-R-User-conferences",
-    "useR-International-R-User-2017-Conference",
-    id
-  )
-
-  embed_channel9(id, width, height, ratio, frameborder, allowfullscreen)
-}
-
-#' @rdname embed
-#' @export
-#'
-embed_channel9 <- function(id,
-                           width = NULL, height = 300, ratio = c("16by9", "4by3"),
-                           frameborder = 0, allowfullscreen = TRUE){
-
-  ratio <- match.arg(ratio)
-  dim <- get_width_height(width, height, ratio)
-
-  allowfullscreen <- .convert_allowfullscreen(allowfullscreen)
-
-  url <- httr::parse_url("https://channel9.msdn.com")
-
-  url$path <- paste0(url$path, c(id, "player"), collapse = "/")
-
-  iframe <- htmltools::tags$iframe(
-    src = httr::build_url(url),
-    width = dim$width,
-    height = dim$height,
-    frameborder = frameborder,
-    allowfullscreen = allowfullscreen
-  )
-
-  embed <- create_embed(iframe, "vembedr_embed_channel9", ratio)
-
-  embed
-}
-
-#' @rdname embed
-#' @export
-#'
-embed_box <- function(id, custom_domain = getOption("vembedr.box_custom_domain"),
-                      width = NULL, height = 300, ratio = c("16by9", "4by3"),
-                      frameborder = 0, allowfullscreen = TRUE) {
-
-  # adapted from:
-  # https://developer.box.com/docs/box-embed#section-build-box-embed-programatically
-
-  # <iframe
-  #    src="https://{custom_domain}.app.box.com/embed/s/{shared link value}"
-  #    width="{pixels}"
-  #    height="{pixels}"
-  #    frameborder="0"
-  #    allowfullscreen webkitallowfullscreen msallowfullscreen>
-  # </iframe>
-
-  ratio <- match.arg(ratio)
-  dim <- get_width_height(width, height, ratio)
-
-  allowfullscreen <- .convert_allowfullscreen(allowfullscreen)
-
-  host <- "app.box.com"
-  if (!is.null(custom_domain)) {
-    host <- "{custom_domain}.app.box.com"
-  }
-
-  url <- glue::glue("https://{host}/embed/s/{id}")
-
-  iframe <- htmltools::tags$iframe(
-    src = url,
-    width = dim$width,
-    height = dim$height + 60,
-    frameborder = frameborder,
-    allowfullscreen = allowfullscreen,
-    webkitallowfullscreen = allowfullscreen,
-    msallowfullscreen = allowfullscreen
-  )
-
-  embed <- create_embed(iframe, "vembedr_embed_box", ratio)
-
-  embed
-}
-
 # internal function to create embed div
 create_embed <- function(iframe, name, ratio) {
 

diff --git a/R/embed_url.R b/R/embed_url.R
@@ -25,3 +25,32 @@ embed_url <- function(url){
     parse_text() %>%
     eval()
 }
+
+#' @rdname embed
+#' @export
+#
+embed_user2016 <- function(id,
+                           width = NULL, height = 300, ratio = c("16by9", "4by3"),
+                           frameborder = 0, allowfullscreen = TRUE){
+
+  id <- c("Events", "useR-international-R-User-conference", "useR2016", id)
+
+  embed_channel9(id, width, height, ratio, frameborder, allowfullscreen)
+}
+
+#' @rdname embed
+#' @export
+#
+embed_user2017 <- function(id,
+                           width = NULL, height = 300, ratio = c("16by9", "4by3"),
+                           frameborder = 0, allowfullscreen = TRUE){
+
+  id <- c(
+    "Events",
+    "useR-international-R-User-conferences",
+    "useR-International-R-User-2017-Conference",
+    id
+  )
+
+  embed_channel9(id, width, height, ratio, frameborder, allowfullscreen)
+}
diff --git a/R/parse.R b/R/parse.R
@@ -189,103 +189,5 @@ parse_video_url <- function(url) {
   stop("no method available")
 }
 
-.parse.vembedr_youtube <- function(url_parsed, ...) {
-  list(
-    service = "youtube",
-    id = url_parsed$query$v,
-    start_time = url_parsed$query$t
-  )
-}
-
-.parse.vembedr_youtube_short <- function(url_parsed, ...) {
-  list(
-    service = "youtube",
-    id = url_parsed$path,
-    start_time = url_parsed$query$t
-  )
-}
-
-.parse.vembedr_vimeo <- function(url_parsed, ...){
-
-  start_time <- NULL
-  if (!is.null(url_parsed$fragment)){
-    start_time <- sub("^t=", "", url_parsed$fragment) # removes leading "t="
-  }
-
-  list(
-    service = "vimeo",
-    id = url_parsed$path,
-    start_time = start_time
-  )
-}
-
-.parse.vembedr_channel9 <- function(url_parsed, ...){
-
-  path_split <-
-    url_parsed$path %>%
-    strsplit("/") %>%
-    `[[`(1)
-
-  path_user2016 <-
-    c("Events", "useR-international-R-User-conference", "useR2016")
-
-  path_user2017 <-c(
-    "Events",
-    "useR-international-R-User-conferences",
-    "useR-International-R-User-2017-Conference"
-  )
-
-  if (identical(length(path_split), 4L)
-      && identical(path_split[1:3], path_user2016)) {
-    # this is a UseR!2016 link
-    result <- list(
-      service = "user2016",
-      id = path_split[[4]],
-      start_time = NULL
-    )
-  } else if (identical(path_split[1:3], path_user2017)) {
-    # this is a UseR!2017 link
-    result <- list(
-      service = "user2017",
-      id = path_split[[4]],
-      start_time = NULL
-    )
-  }
-  else {
-    # this is a regular Channel 9 link
-    result <- list(
-      service = "channel9",
-      id = url_parsed$path,
-      start_time = NULL
-    )
-  }
-
-  result
-}
-
-.parse.vembedr_box <- function(url_parsed, ...) {
-
-  # determine custom-domain by taking apart hostname
-  hostname_split <- stringr::str_split(url_parsed$hostname, "\\.")[[1]]
-
-  custom_domain <- NULL
-  if (identical(length(hostname_split), 4L)) {
-    custom_domain <- hostname_split[1]
-  }
-
-  # determine id by taking apart path
-  path_split <- stringr::str_split(url_parsed$path, "/")[[1]]
-
-  id <- path_split[2]
-
-  result <- list(
-    service = "box",
-    id = id,
-    custom_domain = custom_domain,
-    start_time = NULL
-  )
-
-  result
-}