/
search.r
108 lines (100 loc) · 3.75 KB
/
search.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
#' Full text search of Elasticsearch
#'
#' @export
#'
#' @name Search
#' @template search_par
#' @template search_egs
#' @param body Query, either a list or json.
#' @param scroll (character) Specify how long a consistent view of the index should
#' be maintained for scrolled search, e.g., "30s", "1m". See \code{\link{units-time}}.
#' @param search_path (character) The path to use for searching. Default to \code{_search},
#' but in some cases you may already have that in the base url set using \code{\link{connect}},
#' in which case you can set this to \code{NULL}
#' @seealso \code{\link{Search_uri}} \code{\link{scroll}}
Search <- function(index=NULL, type=NULL, q=NULL, df=NULL, analyzer=NULL, default_operator=NULL,
explain=NULL, source=NULL, fields=NULL, sort=NULL, track_scores=NULL, timeout=NULL,
terminate_after=NULL, from=NULL, size=NULL, search_type=NULL, lowercase_expanded_terms=NULL,
analyze_wildcard=NULL, version=FALSE, body=list(), raw=FALSE, asdf=FALSE, scroll=NULL,
search_path="_search", ...) {
search_POST(search_path, esc(index), esc(type),
args=ec(list(df=df, analyzer=analyzer, default_operator=default_operator, explain=explain,
`_source`=source, fields=cl(fields), sort=cl(sort), track_scores=track_scores,
timeout=cn(timeout), terminate_after=cn(terminate_after),
from=cn(from), size=cn(size), search_type=search_type,
lowercase_expanded_terms=lowercase_expanded_terms, analyze_wildcard=analyze_wildcard,
version=version, q=q, scroll=scroll)), body, raw, asdf, ...)
}
search_POST <- function(path, index=NULL, type=NULL, args, body, raw, asdf, ...) {
checkconn()
conn <- es_get_auth()
url <- make_url(conn)
if (is.null(index) && is.null(type)) {
url <- paste(url, path, sep = "/")
} else {
if (is.null(type) && !is.null(index)) {
url <- paste(url, index, path, sep = "/")
} else {
url <- paste(url, index, type, path, sep = "/")
}
}
url <- prune_trailing_slash(url)
body <- check_inputs(body)
tt <- POST(url, make_up(), ..., query = args, body = body)
if (tt$status_code > 202) stop(error_parser(tt, 1), call. = FALSE)
res <- content(tt, as = "text")
if (raw) res else jsonlite::fromJSON(res, asdf)
}
prune_trailing_slash <- function(x) {
gsub("\\/$", "", x)
}
error_parser <- function(y, shard_no = 1) {
res <- content(y)
tryerr <- tryCatch(res$error, error = function(e) e)
if (!is(tryerr, "simpleError")) {
if (!is.null(res$error)) {
y <- res$error
if (grepl("SearchParseException", y)) {
first <- strloc2match(y, 1, ";")
shards <- strsplit(substring(y, regexpr(";", y) + 17, nchar(y)), "\\}\\{")[[1]]
shards <- gsub("\\s}]$|\\s$", "", shards)
paste(first, paste0("1st shard: ", shards[1:shard_no]), sep = "\n")
} else {
y
}
} else {
y
}
} else {
mssg <- tryCatch(http_status(y)$message, error = function(e) e)
if (is(mssg, "simpleError")) {
y$status_code
} else {
mssg
}
}
}
strmatch <- function(x, y) regmatches(x, regexpr(y, x))
strloc2match <- function(x, first, y) substring(x, first, regexpr(y, x) - 1)
# Make sure variable is a numeric or integer --------------
cn <- function(x) {
name <- substitute(x)
if (!is.null(x)) {
tryx <- tryCatch(as.numeric(as.character(x)), warning = function(e) e)
if ("warning" %in% class(tryx)) {
stop(name, " should be a numeric or integer class value", call. = FALSE)
}
if (!is(tryx, "numeric") | is.na(tryx))
stop(name, " should be a numeric or integer class value", call. = FALSE)
return( format(x, digits = 22, scientific = FALSE) )
} else {
NULL
}
}
make_url <- function(x) {
if (is.null(x$port) || nchar(x$port) == 0) {
x$base
} else {
paste(x$base, ":", x$port, sep = "")
}
}