#' Get information about other visualizations from VIZLAB to generate the landing page
#'
#' the github package from the GitHub repo rgithub (https://github.com/cscheid/rgithub)
#' was moved to GRAN and called grithub
#' @param dev logical create development version of landing page
#' @export
publishLandingPage <- function(dev = FALSE){
file.copy(from=system.file('landing', package="vizlab"), to=getwd(),
recursive = TRUE, overwrite = TRUE)
oldwd <- getwd()
setwd('landing')
on.exit(setwd(oldwd))
viz <- as.viz('landing')
viz <- as.publisher(viz)
viz$dev <- dev
publish(viz)
}
#' Get a vector a repository names for a specific organization
#'
#' @param org character, name of GitHub organization in which to pull out repository names
#' @importFrom grithub get.organization.repositories get.github.context
getRepoNames <- function(org){
vizlab_repos <- get.organization.repositories(org, ctx = get.github.context())
repo_nms <- unlist(lapply(vizlab_repos$content, function(r){ r[['name']]}))
}
#' Get the full file path for the raw viz.yaml within a repository
#'
#' @param org character, name of GitHub organization in which to look for a repository
#' @param repo character, name of the repository to find the viz.yaml
#' @importFrom grithub get.repository.path
getVizYamlUrl <- function(org, repo){
p <- get.repository.path(org, repo, "viz.yaml")
viz.yaml_url <- p$content$html_url
viz.yaml_url <- gsub(pattern = "github.com", replacement = "raw.githubusercontent.com", viz.yaml_url)
viz.yaml_url <- gsub(pattern = "blob/", replacement = "", viz.yaml_url)
return(viz.yaml_url)
}
#' Load yamls and find if the published date has passed yet
#'
#' @param org character, name of GitHub organization in which to look for a repository
#' @param repo character, name of the repository to find the viz.yaml
#' @param dev logical create development version of landing page
#' @importFrom yaml yaml.load_file
getVizInfo <- function(org, repo, dev){
viz.yaml_url <- getVizYamlUrl(org, repo)
if(length(viz.yaml_url) == 0){
return()
}
# the warning "NAs introduced by coercion: . is not a real" can be avoided by
# not setting any value to .; for example, in hurricane-harvey's data-sources
# item, we have "line6: .", which introduces this error.
viz.yaml <- yaml.load_file(url(viz.yaml_url))
has_publish_date <- !is.null(viz.yaml$info$`publish-date`)
if(has_publish_date) {
publish_date <- as.Date(viz.yaml$info$`publish-date`)
if(!dev){
# for prod, verify that the publish date is today or already past
is_published <- publish_date <= Sys.Date()
} else {
# for dev, publish anything that actually has a date in the field
is_published <- TRUE
}
} else {
is_published <- FALSE
}
if(!is_published){
# if it is not going to be published, jump out of this function
return()
}
viz_info <- viz.yaml$info
viz_url <- viz_info$url
if(is.null(viz_url)) {
viz_url <- viz_info$path
if(!grepl('^http', viz_url)){
viz_url <- paste0("https://owi.usgs.gov/vizlab/",viz_url)
}
}
if(substring(viz_url, nchar(viz_url)) != "/"){
viz_url <- paste0(viz_url,"/")
}
#what viz info needs to look like:
thumbnail_stuff <- list(url = viz_info$`thumbnail-landing`$url,
alttext = viz_info$`thumbnail-landing`$alttext)
if(is.null(thumbnail_stuff$url)){
publish_stuff <- viz.yaml$publish
landing_context <- lapply(publish_stuff, function(x) x$context$thumbnails$landing)
if(length(landing_context) > 0){
publish_id <- which(sapply(landing_context, function(x) !is.null(x)))
if(length(publish_id) > 0 && any(publish_id)){
thumb_landing_id <- unlist(landing_context)
real_thumb_id <- publish_stuff[[publish_id]][['depends']][[thumb_landing_id]]
thumb_index <- which(sapply(publish_stuff, function(x) x[['id']] == real_thumb_id))
publish_thumb_info <- publish(publish_stuff[[thumb_index]])
thumbnail_stuff[['url']] <- publish_thumb_info[['url']]
thumbnail_stuff[['alttext']] <- publish_thumb_info[['alttext']]
}
}
}
viz_info_required <- list(id=viz_info$id,
template="templates/vizzies.mustache",
publisher="section",
"publish-date"=publish_date,
context=list(name=viz_info$name,
thumbnail=paste0(viz_url,
checkRelVizUrl(thumbnail_stuff[['url']])),
alttext=thumbnail_stuff[['alttext']],
path=checkRelVizUrl(viz_url),
description=viz_info$description))
viz_info_required <- as.viz(viz_info_required)
viz_info_required <- as.publisher(viz_info_required)
return(viz_info_required)
}
#' function to keep the absolute viz path or make the path relative
#'
#' @param path the path defined in the viz object
#'
checkRelVizUrl <- function(path){
if(!is.null(path)){
if(grepl('^/', path)){
path <- paste0('.', path)
} else if(grepl('^http', path)){
path <- path
}
}
return(path)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.