diff --git a/DESCRIPTION b/DESCRIPTION index d8df75a..88b119b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,9 +5,13 @@ Version: 1.0.0 Author: Displayr Maintainer: Displayr Description: Functions to extract data and interact with web APIs. +Encoding: UTF-8 License: GPL-3 LazyData: TRUE Imports: + curl, + tools, + mime, httr, jsonlite, lubridate, @@ -20,4 +24,4 @@ Imports: Remotes: Displayr/flipTransformations, Tatvic/RGoogleAnalytics Suggests: testthat -RoxygenNote: 6.1.0 +RoxygenNote: 6.1.1 diff --git a/NAMESPACE b/NAMESPACE index 2776812..4bd89b5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(close,qpostcon) export(CheckDropboxToken) export(DownloadXLSX) export(ExportToDropbox) @@ -7,20 +8,32 @@ export(GeocodeIPs) export(GetDirectLink) export(GoogleAnalytics) export(ImportFromDropbox) +export(QFileExists) +export(QFileOpen) +export(QLoadData) +export(QSaveData) importFrom(RGoogleAnalytics,GetProfiles) importFrom(RGoogleAnalytics,GetReportData) importFrom(RGoogleAnalytics,Init) importFrom(RGoogleAnalytics,QueryBuilder) +importFrom(curl,curl) +importFrom(curl,handle_setheaders) +importFrom(curl,new_handle) importFrom(flipTransformations,ParseAsDataFrame) importFrom(flipTransformations,ParseUserEnteredTable) importFrom(httr,GET) +importFrom(httr,HEAD) importFrom(httr,POST) importFrom(httr,add_headers) importFrom(httr,content) +importFrom(httr,handle) importFrom(httr,upload_file) importFrom(httr,write_disk) +importFrom(mime,guess_type) importFrom(readxl,read_excel) importFrom(rgeolocate,maxmind) +importFrom(tools,file_ext) +importFrom(utils,URLencode) importFrom(utils,download.file) importFrom(utils,read.csv) importFrom(utils,write.csv) diff --git a/R/DataMart.R b/R/DataMart.R new file mode 100644 index 0000000..e6ca4e1 --- /dev/null +++ b/R/DataMart.R @@ -0,0 +1,239 @@ +#' Check if a file exists +#' +#' Check whether a file of a given name exists in the Data Mart. +#' +#' @param filename character string. Name of the file to search for +#' +#' @return TRUE if the file exists, otherwise FALSE +#' +#' @importFrom httr HEAD add_headers +#' @importFrom utils URLencode +#' +#' @export +QFileExists <- function(filename) +{ + companySecret <- get0("companySecret", ifnotfound = "") + clientId <- gsub("[^0-9]", "", get0("clientId", ifnotfound = "")) + res <- try(HEAD(paste0("https://app.displayr.com/api/DataMart?filename=", URLencode(filename, TRUE)), + config=add_headers("X-Q-Company-Secret" = companySecret, + "X-Q-Project-ID" = clientId))) + + if (is.null(res$status_code) || res$status_code != 200) + { + warning("File not found.") + return (FALSE) + } else + { + message("File was found.") + return (TRUE) + } +} + +#' Opens a Connection +#' +#' Opens a connection for either reading OR writing to a file of a given name. +#' In the reading case, it opens a stream to the file in the Data Mart. +#' In the writing case, it opens a temporary file for writing to and uploads this to the Data Mart on close. +#' Note that writing to a file which already exists will overwrite that file's contents. +#' +#' @param filename character string. Name of file to be opened +#' @param open character string. A description of how to open the connection +#' @param blocking logical. Whether or not the connection blocks can be specified +#' @param encoding character string. The name of the encoding to be assumed. +#' @param raw logical. Whether this connection should be treated as a byte stream +#' @param method character string. See documentation for connections +#' +#' @return A curl connection (read) or a file connection (write) +#' +#' @importFrom curl curl new_handle handle_setheaders +#' @importFrom httr POST upload_file add_headers handle +#' @importFrom tools file_ext +#' @importFrom utils URLencode +#' +#' @export +QFileOpen <- function(filename, open = "r", blocking = TRUE, + encoding = getOption("encoding"), raw = FALSE, + method = getOption("url.method", "default")) +{ + mode <- tolower(open) + if (mode == "r" || mode == "rb") + { + companySecret <- get0("companySecret", ifnotfound = "") + clientId <- gsub("[^0-9]", "", get0("clientId", ifnotfound = "")) + h <- new_handle() + handle_setheaders(h, + "X-Q-Company-Secret" = companySecret, + "X-Q-Project-ID" = clientId + ) + conn <- try(curl(paste0("https://app.displayr.com/api/DataMart?filename=", URLencode(filename, TRUE)), + open = mode, + handle = h), + silent = TRUE) + + if (!inherits(conn,"connection")) + stop("File not found.") + + + # to allow functions to parse this 'like' a url connection + # e.g. so readRDS will wrap this in gzcon when reading + class(conn) <- append(class(conn), "url") + return (conn) + } else if (mode == "w" || mode == "wb") + { + if (!exists("companySecret") || identical(companySecret, NULL)) + stop("Could not connect to Data Mart.") + + tmpfile <- paste0(tempfile(), ".", file_ext(filename)) + conn <- file(tmpfile, mode, blocking, encoding, raw, method) + class(conn) = append("qpostcon", class(conn)) + + # store attributes for later access + attr(conn, "tmpfile") <- tmpfile + attr(conn, "filename") <- filename + + return (conn) + } else + { + stop("Invalid mode - please use either 'r', 'rb','w' or 'wb'.") + } +} + +#' Closes a QFileOpen connection +#' +#' This is an overload for close.connection which writes the file contents +#' of a connection opened using QFileOpen to the Data Mart. +#' +#' @param con connection object of class 'qpostconn'. Connection opened with QFileOpen +#' @param ... arguments passed to or from other methods. +#' +#' @importFrom httr POST add_headers upload_file +#' @importFrom mime guess_type +#' @importFrom utils URLencode +#' +#' @return NULL invisibly. Called for the purpose of uploading data +#' and assumed to succeed if no errors are thrown. +#' +#' @export +close.qpostcon = function(con, ...) +{ + close.connection(con, ...) + filename <- attr(con, "filename") + tmpfile <- attr(con, "tmpfile") + on.exit(if(file.exists(tmpfile)) file.remove(tmpfile)) + + companySecret <- get0("companySecret", ifnotfound = "") + clientId <- gsub("[^0-9]", "", get0("clientId", ifnotfound = "")) + res <- try(POST(paste0("https://app.displayr.com/api/DataMart?filename=", URLencode(filename, TRUE)), + config = add_headers("Content-Type" = guess_type(filename), + "X-Q-Company-Secret" = companySecret, + "X-Q-Project-ID" = clientId), + encode = "raw", + body = upload_file(tmpfile))) + + if (inherits(res, "try-error") || res$status_code != 200) + { + msg <- "Could not write to data mart." + if (inherits(res, "response")) + msg <- paste0(msg, " Http status: ", res$status_code) + stop(msg) + } + else + { + message("File was written successfully.") + } + + invisible() +} + +#' Loads an object +#' +#' Loads an *.rds file from the data mart and converts this to an R object. +#' +#' @param filename character string. Name of the file to be opened from the Data Mart +#' +#' @return An R object +#' +#' @importFrom httr GET add_headers write_disk +#' @importFrom tools file_ext +#' @importFrom utils URLencode +#' +#' @export +QLoadData <- function(filename) +{ + if (file_ext(filename) != "rds") + stop("Can only load data from *.rds objects.") + + tmpfile <- tempfile() + companySecret <- get0("companySecret", ifnotfound = "") + clientId <- gsub("[^0-9]", "", get0("clientId", ifnotfound = "")) + req <- try(GET(paste0("https://app.displayr.com/api/DataMart?filename=", URLencode(filename, TRUE)), + config=add_headers("X-Q-Company-Secret" = companySecret, + "X-Q-Project-ID" = clientId), + write_disk(tmpfile, overwrite = TRUE))) + + if (inherits(req, "try-error") || req$status_code != 200) + stop("File not found.") + + if (file.exists(tmpfile)) + { + obj <- readRDS(tmpfile) + file.remove(tmpfile) + return (obj) + } + stop("Could not read from file.") +} + +#' Save an object +#' +#' Saves an object to the Data Mart as an *.rds file of the given name. +#' If the name is given an extension, this must be '.rds'. If there is no +#' extension specified, this defaults to '.rds'. +#' +#' @param object object. The object to be uploaded +#' @param filename character string. Name of the file to be written to +#' +#' @importFrom httr POST add_headers upload_file +#' @importFrom tools file_ext +#' @importFrom utils URLencode +#' +#' @return NULL invisibly. Called for the purpose of uploading data +#' and assumed to succeed if no errors are thrown. +#' +#' @export +QSaveData <- function(object, filename) +{ + if (file_ext(filename) == "") + filename <- append(filename, ".rds") + + if (file_ext(filename) != "rds") + stop("File must be of type *.rds") + + tmpfile <- tempfile() + saveRDS(object, tmpfile) + on.exit(if(file.exists(tmpfile)) file.remove(tmpfile)) + + companySecret <- get0("companySecret", ifnotfound = "") + clientId <- gsub("[^0-9]", "", get0("clientId", ifnotfound = "")) + res <- try(POST(paste0("https://app.displayr.com/api/DataMart?filename=", URLencode(filename, TRUE)), + config = add_headers("Content-Type" = "application/x-gzip", # default is gzip for saveRDS + "X-Q-Company-Secret" = companySecret, + "X-Q-Project-ID" = clientId), + encode = "raw", + body = upload_file(tmpfile))) + + if (inherits(res, "try-error") || res$status_code != 200) + { + msg <- "Could not write to data mart." + if (inherits(res, "response")) + msg <- paste0(msg, " Http status: ", res$status_code) + stop(msg) + } + + msg <- paste("Object uploaded to Data Mart To re-import object use:", + " > library(flipAPI)", + paste0(" > QLoadData('", filename, "')"), + sep = "\n") + message(msg) + invisible() +} + diff --git a/man/QFileExists.Rd b/man/QFileExists.Rd new file mode 100644 index 0000000..bfc90a6 --- /dev/null +++ b/man/QFileExists.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DataMart.R +\name{QFileExists} +\alias{QFileExists} +\title{Check if a file exists} +\usage{ +QFileExists(filename) +} +\arguments{ +\item{filename}{character string. Name of the file to search for} +} +\value{ +TRUE if the file exists, otherwise FALSE +} +\description{ +Check whether a file of a given name exists in the Data Mart. +} diff --git a/man/QFileOpen.Rd b/man/QFileOpen.Rd new file mode 100644 index 0000000..df16a0e --- /dev/null +++ b/man/QFileOpen.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DataMart.R +\name{QFileOpen} +\alias{QFileOpen} +\title{Opens a Connection} +\usage{ +QFileOpen(filename, open = "r", blocking = TRUE, + encoding = getOption("encoding"), raw = FALSE, + method = getOption("url.method", "default")) +} +\arguments{ +\item{filename}{character string. Name of file to be opened} + +\item{open}{character string. A description of how to open the connection} + +\item{blocking}{logical. Whether or not the connection blocks can be specified} + +\item{encoding}{character string. The name of the encoding to be assumed.} + +\item{raw}{logical. Whether this connection should be treated as a byte stream} + +\item{method}{character string. See documentation for connections} +} +\value{ +A curl connection (read) or a file connection (write) +} +\description{ +Opens a connection for either reading OR writing to a file of a given name. +In the reading case, it opens a stream to the file in the Data Mart. +In the writing case, it opens a temporary file for writing to and uploads this to the Data Mart on close. +Note that writing to a file which already exists will overwrite that file's contents. +} diff --git a/man/QLoadData.Rd b/man/QLoadData.Rd new file mode 100644 index 0000000..c58ab6e --- /dev/null +++ b/man/QLoadData.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DataMart.R +\name{QLoadData} +\alias{QLoadData} +\title{Loads an object} +\usage{ +QLoadData(filename) +} +\arguments{ +\item{filename}{character string. Name of the file to be opened from the Data Mart} +} +\value{ +An R object +} +\description{ +Loads an *.rds file from the data mart and converts this to an R object. +} diff --git a/man/QSaveData.Rd b/man/QSaveData.Rd new file mode 100644 index 0000000..6007cd6 --- /dev/null +++ b/man/QSaveData.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DataMart.R +\name{QSaveData} +\alias{QSaveData} +\title{Save an object} +\usage{ +QSaveData(object, filename) +} +\arguments{ +\item{object}{object. The object to be uploaded} + +\item{filename}{character string. Name of the file to be written to} +} +\value{ +NULL invisibly. Called for the purpose of uploading data +and assumed to succeed if no errors are thrown. +} +\description{ +Saves an object to the Data Mart as an *.rds file of the given name. +If the name is given an extension, this must be '.rds'. If there is no +extension specified, this defaults to '.rds'. +} diff --git a/man/close.qpostcon.Rd b/man/close.qpostcon.Rd new file mode 100644 index 0000000..b13c028 --- /dev/null +++ b/man/close.qpostcon.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DataMart.R +\name{close.qpostcon} +\alias{close.qpostcon} +\title{Closes a QFileOpen connection} +\usage{ +\method{close}{qpostcon}(con, ...) +} +\arguments{ +\item{con}{connection object of class 'qpostconn'. Connection opened with QFileOpen} + +\item{...}{arguments passed to or from other methods.} +} +\value{ +NULL invisibly. Called for the purpose of uploading data +and assumed to succeed if no errors are thrown. +} +\description{ +This is an overload for close.connection which writes the file contents +of a connection opened using QFileOpen to the Data Mart. +} diff --git a/tests/testthat/helper-datamart.R b/tests/testthat/helper-datamart.R new file mode 100644 index 0000000..991bf96 --- /dev/null +++ b/tests/testthat/helper-datamart.R @@ -0,0 +1 @@ +companySecret <- get0("companySecret", ifnotfound = Sys.getenv("companySecret")) \ No newline at end of file diff --git a/tests/testthat/test-datamart.R b/tests/testthat/test-datamart.R new file mode 100644 index 0000000..5ced0d9 --- /dev/null +++ b/tests/testthat/test-datamart.R @@ -0,0 +1,92 @@ +library (testthat) + +test_that("SaveData/LoadData", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + + # RDS + expect_invisible(QSaveData(mtcars, "mtcars.rds")) + expect_true(QFileExists("mtcars.rds")) + + rds <- QLoadData("mtcars.rds") + expect_equivalent(mtcars, rds) +}) + +test_that("Save/Load Data: bad cases", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + + # Bad cases + bad_name <- "anamethatdoesnotexistfortesting" + expect_warning(expect_false(QFileExists(bad_name))) + expect_error(QLoadData(bad_name)) + expect_error(QSaveData(mtcars,"mtcars.notrds")) +}) + +test_that("File Connection: raw", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + + # Test various file formats + # raw file + filename <- "raw_test" + expect_silent(conn <- QFileOpen(filename, "w")) + txt_string <- "This is a test line." + + writeLines(txt_string, conn) + expect_message(expect_invisible(close(conn))) + + expect_silent(conn <- QFileOpen(filename)) + expect_silent(read_lines <- readLines(conn, warn = FALSE)) + expect_equal(txt_string, read_lines) + + expect_silent(expect_invisible(close(conn))) +}) + +test_that("File Connection: rds", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + + # csv file + filename <- "test.rds" + + expect_silent(conn <- QFileOpen(filename, "w")) + + expect_silent(saveRDS(mtcars, conn, ascii = TRUE)) + expect_message(expect_invisible(close(conn))) + + expect_silent(conn <- QFileOpen(filename)) + expect_silent(csv <- readRDS(gzcon(conn))) + + expect_silent(expect_invisible(close(conn))) +}) + +test_that("File Connection: csv", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + + # csv file + filename <- "test.csv" + + expect_silent(conn <- QFileOpen(filename, "w")) + + expect_silent(write.csv(mtcars, conn)) + expect_message(expect_invisible(close(conn))) + + expect_silent(conn <- QFileOpen(filename)) + expect_silent(csv <- read.csv(conn)) + + expect_silent(expect_invisible(close(conn))) +}) + +test_that("File Connection: json", { + skip_if(!nzchar(companySecret), "Not in test environment or no company set up") + # json file + filename <- "test.json" + + expect_silent(conn <- QFileOpen(filename, "w")) + + expect_silent(writeLines(jsonlite::toJSON(mtcars), conn)) + expect_message(expect_invisible(close(conn))) + + expect_silent(conn <- QFileOpen(filename)) + expect_silent(json <- jsonlite::fromJSON(readLines(conn, warn = FALSE))) + expect_equivalent(json, mtcars) + + expect_silent(expect_invisible(close(conn))) +})