Nothing
#' sofa connection client
#'
#' @export
#' @section CouchDB versions:
#' \pkg{sofa} was built assuming CouchDB version 2 or greater. Some
#' functionality of this package will work with versions < 2, while
#' some may not (mango queries, see [db_query()]). I don't
#' plan to support older CouchDB versions per se.
#' @return An object of class `Cushion`, with variables accessible for
#' host, port, path, transport, user, pwd, and headers. Functions are callable
#' to get headers, and to make the base url sent with all requests.
#' @examples \dontrun{
#' # Create a CouchDB connection client
#' user <- Sys.getenv("COUCHDB_TEST_USER")
#' pwd <- Sys.getenv("COUCHDB_TEST_PWD")
#' (x <- Cushion$new(user=user, pwd=pwd))
#'
#' ## metadata
#' x$host
#' x$path
#' x$port
#' x$type
#'
#' ## ping the CouchDB server
#' x$ping()
#'
#' ## get CouchDB version
#' x$version()
#'
#' # create database
#' if (!"stuff" %in% db_list(x)) {
#' db_create(x, "stuff")
#' }
#'
#' # add documents to a database
#' if (!"sofadb" %in% db_list(x)) {
#' db_create(x, "sofadb")
#' }
#' doc1 <- '{"name": "drink", "beer": "IPA", "score": 5}'
#' doc_create(x, dbname="sofadb", docid="abeer", doc1)
#'
#' # bulk create
#' if (!"mymtcars" %in% db_list(x)) {
#' db_create(x, "mymtcars")
#' }
#' db_bulk_create(x, dbname="mymtcars", doc = mtcars)
#' db_list(x)
#'
#' ## database info
#' db_info(x, "mymtcars")
#'
#' ## list dbs
#' db_list(x)
#'
#' ## all docs
#' db_alldocs(x, "mymtcars", limit = 3)
#'
#' ## changes
#' db_changes(x, "mymtcars")
#'
#' # With auth
#' # x <- Cushion$new(user = 'sckott', pwd = 'sckott')
#'
#' # Using Cloudant
#' # z <- Cushion$new(host = "ropensci.cloudant.com", transport = 'https', port = NULL,
#' # user = 'ropensci', pwd = Sys.getenv('CLOUDANT_PWD'))
#' # z
#' # db_list(z)
#' # db_create(z, "stuff2")
#' # db_info(z, "stuff2")
#' # db_alldocs(z, "foobar")
#' }
Cushion <- R6::R6Class(
"Cushion",
public = list(
#' @field host (character) host
host = '127.0.0.1',
#' @field port (integer) port
port = 5984,
#' @field path (character) url path, if any
path = NULL,
#' @field transport (character) transport schema, (http|https)
transport = 'http',
#' @field user (character) username
user = NULL,
#' @field pwd (character) password
pwd = NULL,
#' @field headers (list) named list of headers
headers = NULL,
#' @description Create a new `Cushion` object
#' @param host (character) A base URL (without the transport), e.g.,
#' `localhost`, `127.0.0.1`, or `foobar.cloudant.com`
#' @param port (numeric) Port. Remember that if you don't want a port set,
#' set this parameter to `NULL`. Default: `5984`
#' @param path (character) context path that is appended to the end of
#' the url. e.g., `bar` in `http://foo.com/bar`. Default: `NULL`,
#' ignored
#' @param transport (character) http or https. Default: http
#' @param user,pwd (character) user name, and password. these are used in all
#' requests. if absent, they are not passed to requests
#' @param headers A named list of headers. These headers are used in all
#' requests. To use headers in individual requests and not others, pass
#' in headers via `...` in a function call.
#' @return A new `Cushion` object
initialize = function(host, port, path, transport, user, pwd, headers) {
if (!missing(host)) self$host <- host
if (!missing(port)) self$port <- port
if (!missing(path)) self$path <- path
if (!missing(transport)) self$transport <- transport
if (!missing(user)) self$user <- user
if (!missing(pwd)) self$pwd <- pwd
if (!missing(user) && !missing(pwd)) {
private$auth_headers <- crul::auth(user, pwd)
}
if (!missing(headers)) self$headers <- headers
},
#' @description print method for `Cushion`
#' @param x self
#' @param ... ignored
print = function() {
cat("<sofa - cushion> ", sep = "\n")
cat(paste0(" transport: ", self$transport), sep = "\n")
cat(paste0(" host: ", self$host), sep = "\n")
cat(paste0(" port: ", self$port), sep = "\n")
cat(paste0(" path: ", self$path), sep = "\n")
cat(paste0(" type: ", self$type), sep = "\n")
cat(paste0(" user: ", self$user), sep = "\n")
cat(paste0(" pwd: ", if (!is.null(self$pwd)) '<secret>' else ''),
sep = "\n")
invisible(self)
},
#' @description Ping the CouchDB server
#' @param as (character) One of list (default) or json
#' @param ... curl options passed to [crul::verb-GET]
ping = function(as = 'list', ...) {
sofa_GET(self$make_url(), as = as, query = NULL,
headers = self$get_headers(), auth = self$get_auth(), ...)
},
#' @description Construct full base URL from the pieces in the
#' connection object
make_url = function() {
tmp <- sprintf("%s://%s", self$transport, self$host)
if (!is.null(self$port)) {
tmp <- sprintf("%s:%s", tmp, self$port)
}
if (!is.null(self$path)) {
tmp <- sprintf("%s/%s", tmp, self$path)
}
tmp
},
#' @description Get list of headers that will be sent with
#' each request
get_headers = function() self$headers,
#' @description Get list of auth values, user and pwd
get_auth = function() private$auth_headers,
#' @description Get the CouchDB version as a numeric
version = function() {
z <- self$ping()
ver <- as.numeric(paste0(strx(z$version, '[0-9]'), collapse=""))
if (nchar(ver) < 3) {
ver <- as.numeric(paste0(c(ver, rep("0", times=3-nchar(ver))),
collapse=""))
}
return(ver)
}
),
private = list(
auth_headers = NULL
)
)
check_cushion <- function(x) {
if (!inherits(x, "Cushion")) {
stop("input must be a sofa Cushion object, see ?Cushion", call. = FALSE)
}
}
strx <- function(str, pattern) regmatches(str, gregexpr(pattern, str))[[1]]
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.