Nothing
.undertowVersion <- "1.6.0"
.solrVersion <- "5.5.0"
.test <- function() {
solr <- TestSolr()
on.exit(solr$kill())
get("testPackage", getNamespace("BiocGenerics"))("rsolr")
}
uriPort <- function(x) {
parseURI(x)$port
}
portIsOpen <- function(x) {
con <- file()
sink(con, type="message")
on.exit({
sink(NULL, type="message")
close(con)
})
s <- suppressWarnings(make.socket(port = x, fail=FALSE))
if (s$socket == 0L) {
FALSE
} else {
close.socket(s)
TRUE
}
}
solrIsReady <- function(uri) {
schema <- try(read(RestUri(uri)$schema), silent=TRUE)
!is(schema, "try-error")
}
getSolrHome <- function() {
file.path(tempdir(), "solr")
}
getSolrLogs <- function() {
file.path(tempdir(), "solr-logs")
}
populateSolrHome <- function(customSchema=NULL) {
solr.home <- getSolrHome()
unlink(solr.home, recursive=TRUE)
file.copy(system.file("solr", package="rsolr"),
dirname(solr.home), recursive=TRUE)
if (!is.null(customSchema)) {
sampleCorePath <- file.path(solr.home, "cores", "techproducts")
corePath <- file.path(solr.home, "cores", name(customSchema))
file.rename(sampleCorePath, corePath)
saveXML(customSchema, file.path(corePath, "conf", "schema.xml"))
writeLines(paste0("name=", name(customSchema)),
file.path(corePath, "core.properties"))
unlink(file.path(corePath, "data"), recursive=TRUE)
}
solr.home
}
getDownloadURL <- function() {
paste0("https://github.com/bremeld/solr-undertow/releases/download/",
"v", .undertowVersion, "-release/solr-undertow-", .undertowVersion,
"-with-solr-", .solrVersion, ".zip")
}
downloadSolr <- function() {
url <- getDownloadURL()
dest <- tempfile()
### FIXME: drop curl method with R 3.2.2
if (download.file(url, dest, method="curl", extra='-L') != 0L) {
stop("download of Solr (undertow) failed")
}
dest
}
unpack <- function(file, exdir) {
unzip(file, exdir=exdir)
}
maybeInstallSolr <- function() {
if (!interactive()) {
installSolr()
} else {
message("Install solr?")
res <- readline("y/n: ")
if (res == "y") {
installSolr()
} else {
stop("Please install Solr to run tests/examples")
}
}
}
installSolr <- function() {
message("Solr installation not found, installing...")
file <- downloadSolr()
unpack(file, getInstallPath())
}
getSolrPath <- function() {
subdir <- file_path_sans_ext(basename(getDownloadURL()))
file.path(getInstallPath(), subdir)
}
getInstallPath <- function() {
tools::R_user_dir("rsolr")
}
solrIsInstalled <- function() {
file.exists(getSolrPath())
}
getUndertowConfig <- function() {
list(solr.undertow=
list(solrHome=getSolrHome(),
solrLogs=getSolrLogs(),
tempDir=tempdir(),
solrVersion=.solrVersion,
solrWarFile=file.path(getSolrPath(), "example", "solr-wars",
paste0("solr-", .solrVersion, ".zip")),
shutdown=list(password="rsolr", gracefulDelay="0s")))
}
toHOCON <- function(x) {
gsub("\"([A-z.]+)\":", "\\1:", x)
}
runSolr <- function() {
if (!solrIsInstalled()) {
message("Solr not found")
maybeInstallSolr()
}
config <- getUndertowConfig()
configPath <- tempfile("example-solr", fileext=".conf")
writeLines(toHOCON(toJSON(config)), configPath)
bin <- file.path(getSolrPath(), "bin", "solr-undertow")
Sys.chmod(bin, "0755")
system(paste(paste0('"', bin, '"'), paste0('"', configPath, '"')),
wait=FALSE, ignore.stdout=!isTRUE(getOption("verbose")))
}
setClassUnion("SolrSchemaORNULL", c("SolrSchema", "NULL"))
.ExampleSolr <-
setRefClass("ExampleSolr",
fields = list(
uri = "character",
customSchema = "SolrSchemaORNULL"
),
methods = list(
start = function() {
if (.self$isRunning()) {
.self$kill()
}
populateSolrHome(.self$customSchema)
message("Starting Solr...")
message("Use options(verbose=TRUE) to diagnose any problems.")
runSolr()
while(!solrIsReady(.self$uri)) {
Sys.sleep(0.1)
}
if (!interactive())
Sys.sleep(Sys.getenv("RSOLR_TEST_START_SLEEP", 1L))
message("Solr started at: ", .self$uri)
},
kill = function() {
if (.self$isRunning()) {
unlink(getSolrHome(), recursive=TRUE)
read(RestUri("http://localhost:9983"), password="rsolr")
} else {
warning("Test solr not running")
}
port <- uriPort(uri)
while(portIsOpen(port)) {
Sys.sleep(0.1)
}
##Sys.sleep(1) # wait a bit for it to stop
},
isRunning = function() {
portIsOpen(uriPort(uri))
}))
TestSolr <- function(schema = NULL, start = TRUE, restart=FALSE)
{
uri <- file.path("http://localhost:8983/solr",
if (is.null(schema)) "techproducts" else name(schema))
solr <- .ExampleSolr$new(uri = uri, customSchema = schema)
if (start && (!solr$isRunning() || restart)) {
solr$start()
}
solr
}
setMethod("show", "ExampleSolr", function(object) {
cat("ExampleSolr instance\n")
cat("uri: ", object$uri, "\n", sep="")
if (!is.null(object$customSchema)) {
cat("customSchema: ", name(object$customSchema), "\n", sep="")
}
})
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.