diff --git a/DESCRIPTION b/DESCRIPTION index 1c42843..1043f7a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,7 +7,8 @@ Authors@R: c(person("Whit", "Armstrong", role = "aut"), comment = c(ORCID = "0000-0001-6419-907X")), person("John", "Laing", role = "aut")) Imports: Rcpp (>= 0.11.0), utils -Suggests: xts, zoo, data.table, simplermarkdown, tinytest +Suggests: xts, zoo, data.table, simplermarkdown, tinytest, jsonlite, + RcppSimdJson VignetteBuilder: simplermarkdown LazyLoad: yes LinkingTo: Rcpp, BH diff --git a/NAMESPACE b/NAMESPACE index 97c538f..246a8b5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ export("blpConnect", "bdh", "bds", "beqs", + "bql", "bsrch", "fieldSearch", "fieldInfo", diff --git a/R/RcppExports.R b/R/RcppExports.R index 5f2071c..0d5e17a 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -68,6 +68,10 @@ haveBlp <- function() { .Call(`_Rblpapi_haveBlp`) } +bql_Impl <- function(con, expression, verbose = FALSE) { + .Call(`_Rblpapi_bql_Impl`, con, expression, verbose) +} + bsrch_Impl <- function(con, domain, limit, verbose = FALSE) { .Call(`_Rblpapi_bsrch_Impl`, con, domain, limit, verbose) } diff --git a/R/bql.R b/R/bql.R new file mode 100644 index 0000000..2b3f44b --- /dev/null +++ b/R/bql.R @@ -0,0 +1,304 @@ + +## Copyright (C) 2025 Whit Armstrong and Dirk Eddelbuettel and John Laing +## +## This file is part of Rblpapi +## +## Rblpapi is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 2 of the License, or +## (at your option) any later version. +## +## Rblpapi is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Rblpapi. If not, see . + + +##' This function uses the Bloomberg API to execute 'BQL' (Bloomberg +##' Query Language) queries via the \sQuote{//blp/bqlsvc} service -- +##' the same service used by the Excel \code{=BQL()} function. +##' +##' The service returns a single JSON document. Each queried data +##' item is self-describing: every column carries a declared type +##' (\sQuote{STRING}, \sQuote{DOUBLE}, \sQuote{INT}, \sQuote{DATE}, +##' \sQuote{DATETIME}, \sQuote{BOOLEAN}) which is used to construct +##' properly-typed \code{data.frame} columns. Parsing requires either +##' the \CRANpkg{RcppSimdJson} or the \CRANpkg{jsonlite} package; +##' \CRANpkg{RcppSimdJson} is preferred when both are installed as it +##' is faster on the large documents BQL can return. Both give the same +##' result for the documents the service returns. Set +##' \code{parse=FALSE} to obtain the raw JSON string instead, e.g. for +##' queries whose shape the parser does not handle. +##' +##' Note that \sQuote{//blp/bqlsvc} is not part of the officially +##' documented public API; it is the service behind the Excel BQL +##' add-in and may change without notice. +##' +##' @title Run 'Bloomberg Query Language' (BQL) Queries +##' @param expression A character string with the BQL query, e.g. +##' \code{"get(px_last) for(['IBM US Equity'])"}. +##' @param parse A boolean indicating whether the JSON response should +##' be parsed into \code{data.frame} objects (requires either the +##' \CRANpkg{RcppSimdJson} or the \CRANpkg{jsonlite} package), +##' defaults to \sQuote{TRUE}. If \sQuote{FALSE} the raw JSON string +##' is returned. +##' @param simplify A boolean indicating whether a query returning a +##' single data item should be returned directly as a \code{data.frame} +##' instead of a list of length one, defaults to \sQuote{TRUE}. +##' @param verbose A boolean indicating whether verbose operation is +##' desired, defaults to \sQuote{FALSE}. +##' @param parser A character vector naming the JSON parsers to use in +##' order of preference; the first one which is installed is used. +##' \sQuote{NULL}, the default, takes the \code{bqlParser} option and, +##' failing that, tries \sQuote{RcppSimdJson} then \sQuote{jsonlite}. +##' @param con A connection object as created by a \code{blpConnect} +##' call, and retrieved via the internal function +##' \code{defaultConnection}. +##' @return If \code{parse} is \sQuote{TRUE}, a named list of +##' \code{data.frame} objects, one per data item in the query's +##' \code{get()} clause (or a single \code{data.frame} if +##' \code{simplify} is \sQuote{TRUE} and only one item was queried). +##' Each \code{data.frame} has an \sQuote{ID} column, a value column +##' named after the data item, and any secondary columns (such as +##' \sQuote{DATE} or \sQuote{CURRENCY}) the service returned. If +##' \code{parse} is \sQuote{FALSE}, a character string with the JSON +##' document. +##' @author Alexander Kammerer and Dirk Eddelbuettel +##' @examples +##' \dontrun{ +##' con <- blpConnect() +##' bql("get(px_last) for(['IBM US Equity', 'AAPL US Equity'])") +##' bql("get(px_last, name) for(members('INDU Index'))", simplify=FALSE) +##' } +bql <- function(expression, + parse=TRUE, + simplify=TRUE, + verbose=FALSE, + parser=NULL, + con=defaultConnection()) { + + ## resolve the parser before the request so that a missing package does + ## not discard a response which has already been retrieved + if (parse) parser <- .bqlParser(parser) + res <- bql_Impl(con, expression, verbose) + ## the C++ layer returns nothing at all when the session ended before the + ## response arrived; say so rather than let the JSON parser report the + ## empty string as a truncated document + if (!length(res)) + stop("The BQL request returned no messages, which happens when the ", + "session ends before the response arrives. Check the connection.", + call.=FALSE) + if (!parse) return(.bqlJoin(res)) + .bqlParse(res, simplify=simplify, parser=parser) +} + +## The service delivers responses larger than 4 MiB in several messages, cutting +## the JSON mid-token: the fragments form one document only once joined +.bqlJoin <- function(fragments) paste0(fragments, collapse="") + +## Supported JSON parsers, in order of preference +.bqlParsers <- c("RcppSimdJson", "jsonlite") + +## Select the first of 'want' which is installed. RcppSimdJson comes first by +## default as it is faster on the large documents BQL can return, with jsonlite +## as the fallback; naming one picks it, which also lets the tests exercise +## both. +.bqlParser <- function(want=NULL) { + ## NULL, the default of bql()'s 'parser', means "whatever the option says, + ## else the built-in order". Resolved here so that bql()'s signature, and + ## therefore its help page, does not name an unexported object. + if (is.null(want)) want <- getOption("bqlParser", .bqlParsers) + ## validated here rather than with match.arg(), which would accept an + ## abbreviation and would silently drop an unknown name given alongside a + ## known one. An NA needs no clause of its own: it matches no known name. + if (!is.character(want) || length(want) == 0L || !all(want %in% .bqlParsers)) + stop("'parser' must be one or more of ", + paste0("'", .bqlParsers, "'", collapse=", "), call.=FALSE) + for (p in want) if (requireNamespace(p, quietly=TRUE)) return(p) + ## name only what was actually asked for, which may be a single parser + stop("Parsing BQL responses requires ", + paste0("'", want, "'", collapse=" or "), + "; install it or call bql(..., parse=FALSE) for the raw JSON.", + call.=FALSE) +} + +## Parse one JSON document into nested lists. Both parsers are asked not to +## simplify at all so that they return the very same structure: the typing is +## done from the declared BQL column types in .bqlColumn. The two 'empty' +## arguments make RcppSimdJson agree with jsonlite on '[]' and '{}', which it +## maps to NULL by default. +## +## 'parser' is required rather than defaulted, so that bql() stays the one +## place which decides which parser to use and .bqlParse only passes that +## decision down. +.bqlFromJSON <- function(txt, parser) { + switch(parser, + "RcppSimdJson" = + RcppSimdJson::fparse(txt, + max_simplify_lvl="list", + empty_array=list(), + empty_object=structure(list(), + names=character())), + "jsonlite" = + jsonlite::fromJSON(txt, simplifyVector=FALSE), + ## without this a wrong name would return NULL, and the caller + ## would see an empty result rather than a diagnosis + stop("Unknown BQL JSON parser '", parser, "'", call.=FALSE)) +} + +## Parse a raw BQL JSON response into a named list of data.frames +.bqlParse <- function(json, simplify=TRUE, parser=.bqlParser()) { + parsed <- .bqlFromJSON(.bqlJoin(json), parser) + .bqlCheckExceptions(parsed) + tables <- list() + for (item in parsed[["results"]]) { + nm <- if (is.null(item[["name"]])) "" else item[["name"]] + msgs <- .bqlExceptionMessages(item[["responseExceptions"]]) + if (length(msgs)) + warning("BQL error for item '", nm, "': ", + paste(msgs, collapse="; "), call.=FALSE) + tables[[nm]] <- .bqlItemToDataFrame(item) + } + if (simplify && length(tables) == 1L) return(tables[[1L]]) + tables +} + +## Raise an R error for any top-level 'responseExceptions' the service reported +.bqlCheckExceptions <- function(parsed) { + msgs <- .bqlExceptionMessages(parsed[["responseExceptions"]]) + if (length(msgs)) + stop("BQL error: ", paste(msgs, collapse="; "), call.=FALSE) + invisible(NULL) +} + +.bqlExceptionMessages <- function(excs) { + if (is.null(excs) || length(excs) == 0L) return(character()) + vapply(excs, function(e) { + msg <- e[["message"]] + if (is.null(msg) || !nzchar(msg)) msg <- e[["internalMessage"]] + if (is.null(msg) || !nzchar(msg)) msg <- "unknown BQL error" + msg + }, character(1)) +} + +## Convert one entry of 'results' into a data.frame using the declared +## column types; the value column is named after the data item itself. +## +## The columns are collected in order and named at the end rather than +## assigned by name as they are found: assigning by name would replace an +## earlier column of the same name instead of adding one, silently dropping +## it, and would leave make.unique() below with nothing to do. It also lets +## an item with no columns at all produce an empty data.frame, where +## names(list()) would be NULL and make.unique() would reject it. +.bqlItemToDataFrame <- function(item) { + spec <- function(col, nm) list(list(col=col, nm=nm)) + specs <- list() + idcol <- item[["idColumn"]] + if (!is.null(idcol)) + specs <- c(specs, spec(idcol, .bqlColName(idcol, "ID"))) + valcol <- item[["valuesColumn"]] + if (!is.null(valcol)) + specs <- c(specs, spec(valcol, + if (is.null(item[["name"]]) || !nzchar(item[["name"]])) + .bqlColName(valcol, "VALUE") else item[["name"]])) + for (sec in item[["secondaryColumns"]]) + specs <- c(specs, spec(sec, .bqlColName(sec, "V"))) + + cols <- lapply(specs, function(s) .bqlColumn(s[["col"]])) + names(cols) <- make.unique(vapply(specs, `[[`, character(1), "nm")) + + ## a data.frame needs every column the same length; without this the + ## mismatch would be baked into a corrupt object instead of reported + rows <- unique(lengths(cols)) + if (length(rows) > 1L) + stop("BQL item '", if (is.null(item[["name"]])) "" else item[["name"]], + "' has columns of unequal length: ", + paste0(names(cols), " (", lengths(cols), ")", collapse=", "), + call.=FALSE) + ## avoid data.frame() name mangling and rownames + structure(cols, + class="data.frame", + row.names=if (length(rows)) seq_len(rows) else integer()) +} + +.bqlColName <- function(col, fallback) { + nm <- col[["name"]] + if (is.null(nm) || !nzchar(nm)) fallback else nm +} + +## Convert a BQL column (list with 'type' and 'values') to a typed R vector. +## The values arrive as a list of scalars, one element per row, and are +## flattened with vectorised primitives rather than one element at a time. +## +## JSON null maps to NA for every type; the string placeholders "NaN" and +## "NA" additionally map to NA for numeric columns only, as string columns +## may legitimately contain them (e.g. the ticker of 'NA US Equity'). +## +## A numeric column of JSON numbers, with or without those placeholders, stays +## numeric throughout and so keeps the values exactly as the service sent them, +## rather than losing the last digits to a detour through character. Bloomberg +## sends float-derived prices such as 230.66000366210938, which as.character() +## would truncate to 230.66000366210901. A number written as a string is the +## one case which still takes the detour: it has to be converted from +## character anyway, and telling it apart from a number beforehand would need +## a call per element for every column. +## +## One consequence of letting unlist() pick the type does remain: it coerces a +## logical before a string, so a JSON boolean sharing an array with a JSON +## number becomes 1 or 0 rather than "TRUE" or "FALSE". BQL declares one type +## per column and does not mix the two, and avoiding this would need a call +## per element for every column, which is the cost this function exists to +## avoid. +.bqlColumn <- function(col) { + type <- if (is.null(col[["type"]])) "STRING" else col[["type"]] + vals <- col[["values"]] + n <- length(vals) + vals[lengths(vals) == 0L] <- NA + values <- unlist(vals, use.names=FALSE) + ## unlist() flattens a nested value instead of failing, unlike the vapply() + ## this replaces. This catches a value which flattens to more than one + ## element; one which flattens to exactly one is kept, as it was before. + if (length(values) != n) + stop("BQL column '", .bqlColName(col, "?"), + "' has non-scalar values", call.=FALSE) + ## Blanking the placeholders in the list and flattening again is what keeps + ## a numeric column numeric, and so exact. Only a numeric column is treated + ## this way, as a string column may legitimately hold those spellings, and + ## any other string is a number written as a string which as.numeric() + ## still converts. 'values' is already the character form here, so finding + ## them takes one vectorised pass; a JSON number never prints as one, and a + ## blanked null is NA_character_ rather than "NA", so neither is mistaken + ## for a placeholder. + if (is.character(values) && (type == "DOUBLE" || type == "INT")) { + isph <- values %in% c("NaN", "NA", "") + if (any(isph)) { + vals[isph] <- NA + values <- unlist(vals, use.names=FALSE) + } + } + switch(type, + "DOUBLE" = as.numeric(values), + "INT" = as.integer(values), + "BOOLEAN" = if (is.logical(values)) values + else as.logical(toupper(values)), + ## truncating inside .bqlByUnique truncates the distinct strings + ## rather than every row + "DATE" = .bqlByUnique(as.character(values), + function(u) as.Date(substr(u, 1L, 10L))), + "DATETIME" = .bqlByUnique(as.character(values), as.POSIXct, + format="%Y-%m-%dT%H:%M:%OS", tz="UTC"), + ## a column of only nulls has flattened to a logical vector, so the + ## character types still need the conversion + as.character(values)) +} + +## Parsing a date string costs far more per value than a hash lookup, and BQL +## date columns repeat heavily (one date per period, the same date for many +## securities), so convert only the distinct strings +.bqlByUnique <- function(v, fun, ...) { + u <- unique(v) + fun(u, ...)[match(v, u)] +} diff --git a/inst/tinytest/bql/response_grouped.json b/inst/tinytest/bql/response_grouped.json new file mode 100644 index 0000000..729e555 --- /dev/null +++ b/inst/tinytest/bql/response_grouped.json @@ -0,0 +1 @@ +{"results":{"#mv":{"name":"#mv","offsets":[0,1,2,3,4,5],"namespace":"FUNCTION_DEFAULT","source":"BQLAnalyticsEngine","idColumn":{"name":"ID","type":"STRING","rank":0,"values":["2027.0:Technology","2028.0:Technology","2029.0:Technology","2030.0:Technology","2031.0:Technology","2032.0:Technology"]},"valuesColumn":{"name":"VALUE","type":"DOUBLE","rank":0,"values":[1.5E9,2.25E9,7.5E8,3.1E9,5.0E8,1.2E9]},"secondaryColumns":[{"name":"CURRENCY_OF_ISSUE","type":"ENUM","rank":0,"values":["USD","USD","USD","USD","USD","USD"]},{"name":"MULTIPLIER","type":"DOUBLE","rank":0,"values":[1.0,1.0,1.0,1.0,1.0,1.0]},{"name":"CURRENCY","type":"STRING","rank":0,"values":["USD","USD","USD","USD","USD","USD"]},{"name":"ORIG_IDS","type":"STRING","rank":0,"values":[null,null,null,null,"XX000001 Corp","XX000002 Corp"]},{"name":"YEAR(MATURITY())","type":"INT","rank":0,"values":[2027,2028,2029,2030,2031,2032]},{"name":"INDUSTRY_SECTOR()","type":"STRING","rank":0,"values":["Technology","Technology","Technology","Technology","Technology","Technology"]}],"partialErrorMap":null,"responseExceptions":[],"forUniverse":false,"bqlResponseInfo":null,"defaultDateColumnName":null,"itemPreviewStatistics":null,"indexView":null}},"ordering":[{"requestIndex":0,"responseName":"#mv"}],"responseExceptions":null,"responseTiming":null,"dotString":null,"versionInfo":{"version":"1.288","responseSchemaVersion":"1.0"},"clientContext":{"appName":"EXCEL","clientRequestId":"00000000-0000-0000-0000-000000000000","timestamp":null,"extraMarkers":[]},"screenCounts":null,"payloadId":null} diff --git a/inst/tinytest/bql/response_item_error.json b/inst/tinytest/bql/response_item_error.json new file mode 100644 index 0000000..947202b --- /dev/null +++ b/inst/tinytest/bql/response_item_error.json @@ -0,0 +1 @@ +{"results":{"px_last":{"name":"px_last","offsets":[0],"namespace":"DATAITEM_DEFAULT","source":"CR","idColumn":{"name":"ID","type":"STRING","rank":0,"values":["IBM US Equity"]},"valuesColumn":{"name":"VALUE","type":"DOUBLE","rank":0,"values":[229.33]},"secondaryColumns":[{"name":"DATE","type":"DATE","rank":0,"values":["2024-12-17T00:00:00Z"],"defaultDate":true}],"responseExceptions":[{"message":"Insufficient data for 'XXX US Equity'.","type":"PARTIAL","internalMessage":"Insufficient data for 'XXX US Equity'.","messageCategory":"BQL_DATA_ERROR","messageSubcategory":"NA_SUBCATEGORY","level":0,"nodeName":null,"uniqueException":false,"messageKey":"DATA_UNAVAILABLE"}]}},"ordering":["px_last"],"responseExceptions":[],"versionInfo":{"version":"1.258","responseSchemaVersion":"1.0"},"clientContext":{"appName":"EXCEL","clientRequestId":"00000000-0000-0000-0000-000000000000","timestamp":null,"extraMarkers":[]}} diff --git a/inst/tinytest/bql/response_multi_item.json b/inst/tinytest/bql/response_multi_item.json new file mode 100644 index 0000000..f9e815d --- /dev/null +++ b/inst/tinytest/bql/response_multi_item.json @@ -0,0 +1 @@ +{"results":{"name":{"name":"name","offsets":[0],"namespace":"DATAITEM_DEFAULT","source":"CR","idColumn":{"name":"ID","type":"STRING","rank":0,"values":["IBM US Equity","AAPL US Equity"]},"valuesColumn":{"name":"VALUE","type":"STRING","rank":0,"values":["International Business Machines Corp","Apple Inc"]},"secondaryColumns":[],"responseExceptions":[]},"pe_ratio":{"name":"pe_ratio","offsets":[0],"namespace":"DATAITEM_DEFAULT","source":"CR","idColumn":{"name":"ID","type":"STRING","rank":0,"values":["IBM US Equity","AAPL US Equity"]},"valuesColumn":{"name":"VALUE","type":"DOUBLE","rank":0,"values":[23.1,33.7]},"secondaryColumns":[{"name":"AS_OF_DATE","type":"DATE","rank":0,"values":["2024-12-17T00:00:00Z","2024-12-17T00:00:00Z"]},{"name":"PERIOD_END_DATE","type":"DATE","rank":0,"values":["2024-09-30T00:00:00Z","2024-09-28T00:00:00Z"]},{"name":"REVISION_COUNT","type":"INT","rank":0,"values":[3,5]}],"responseExceptions":[]}},"ordering":["name","pe_ratio"],"responseExceptions":[],"versionInfo":{"version":"1.258","responseSchemaVersion":"1.0"},"clientContext":{"appName":"EXCEL","clientRequestId":"00000000-0000-0000-0000-000000000000","timestamp":null,"extraMarkers":[]}} diff --git a/inst/tinytest/bql/response_px_last.json b/inst/tinytest/bql/response_px_last.json new file mode 100644 index 0000000..0e3afdd --- /dev/null +++ b/inst/tinytest/bql/response_px_last.json @@ -0,0 +1 @@ +{"results":{"px_last":{"name":"px_last","offsets":[0],"namespace":"DATAITEM_DEFAULT","source":"CR","idColumn":{"name":"ID","type":"STRING","rank":0,"values":["IBM US Equity","AAPL US Equity","XXX US Equity"]},"valuesColumn":{"name":"VALUE","type":"DOUBLE","rank":0,"values":[229.33,254.49,"NaN"]},"secondaryColumns":[{"name":"DATE","type":"DATE","rank":0,"values":["2024-12-17T00:00:00Z","2024-12-17T00:00:00Z",null],"defaultDate":true},{"name":"CURRENCY","type":"STRING","rank":0,"values":["USD","USD",null]}],"partialErrorMap":{"errorIterator":null},"responseExceptions":[],"transparency":null,"forUniverse":true,"bqlResponseInfo":null,"defaultDateColumnName":null,"itemPreviewStatistics":null,"indexView":null}},"ordering":["px_last"],"responseExceptions":[],"responseTiming":null,"dotString":null,"versionInfo":{"version":"1.258","responseSchemaVersion":"1.0"},"clientContext":{"appName":"EXCEL","clientRequestId":"00000000-0000-0000-0000-000000000000","timestamp":null,"extraMarkers":[]},"screenCounts":null,"payloadId":null} diff --git a/inst/tinytest/bql/response_string_na.json b/inst/tinytest/bql/response_string_na.json new file mode 100644 index 0000000..b08bf96 --- /dev/null +++ b/inst/tinytest/bql/response_string_na.json @@ -0,0 +1 @@ +{"results":{"ticker":{"name":"ticker","offsets":[0],"namespace":"DATAITEM_DEFAULT","source":"CR","idColumn":{"name":"ID","type":"STRING","rank":0,"values":["IBM US Equity","NA US Equity","AAPL US Equity"]},"valuesColumn":{"name":"VALUE","type":"STRING","rank":0,"values":["IBM","NA","AAPL"]},"secondaryColumns":[],"responseExceptions":[]}},"ordering":["ticker"],"responseExceptions":[],"versionInfo":{"version":"1.258","responseSchemaVersion":"1.0"},"clientContext":{"appName":"EXCEL","clientRequestId":"00000000-0000-0000-0000-000000000000","timestamp":null,"extraMarkers":[]}} diff --git a/inst/tinytest/bql/response_syntax_error.json b/inst/tinytest/bql/response_syntax_error.json new file mode 100644 index 0000000..3620d6a --- /dev/null +++ b/inst/tinytest/bql/response_syntax_error.json @@ -0,0 +1 @@ +{"results":null,"ordering":null,"responseExceptions":[{"message":"Error: Unable to parse request at 'get(px_lastfor'.","type":"PARTIAL","internalMessage":"Error: Unable to parse request at 'get(px_lastfor'.","messageCategory":"BQL_SYNTAX_ERROR","messageSubcategory":"NA_SUBCATEGORY","level":0,"nodeName":null,"uniqueException":false,"messageKey":"PARSER_UNABLE"}],"responseTiming":null,"dotString":null,"versionInfo":{"version":"1.258","responseSchemaVersion":"1.0"},"clientContext":{"appName":"EXCEL","clientRequestId":"00000000-0000-0000-0000-000000000000","timestamp":null,"extraMarkers":[]},"screenCounts":null,"payloadId":null} diff --git a/inst/tinytest/test_bql.R b/inst/tinytest/test_bql.R new file mode 100644 index 0000000..c45f861 --- /dev/null +++ b/inst/tinytest/test_bql.R @@ -0,0 +1,371 @@ +# Copyright (C) 2025 Dirk Eddelbuettel, Whit Armstrong and John Laing +# +# This file is part of Rblpapi. +# +# Rblpapi is free software: you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 2 of the License, or +# (at your option) any later version. +# +# Rblpapi is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Rblpapi. If not, see . + +library(tinytest) +library(Rblpapi) + +## every JSON parser which is installed is tested, and all of them must give +## the very same result +.parsers <- Filter(function(p) requireNamespace(p, quietly=TRUE), + Rblpapi:::.bqlParsers) +if (length(.parsers) == 0L) + exit_file("Skipping as no JSON parser is available") + +.readFixture <- function(file) { + paste(readLines(file.path("bql", file), warn=FALSE), collapse="\n") +} +.parse <- function(file, ...) Rblpapi:::.bqlParse(.readFixture(file), ...) + +## the parser in use labels every assertion; .p is resolved at call time +.with <- function(txt) paste0(txt, " [", .p, "]") + +## compare outcomes and not only successes: a fixture which must raise has to +## raise the same way through every parser and every chunking +.outcome <- function(x, p) tryCatch(suppressWarnings(Rblpapi:::.bqlParse(x, parser=p)), + error = function(e) conditionMessage(e)) + +.allIdentical <- function(x) all(vapply(x[-1], identical, logical(1), x[[1]])) + +## one skeleton for the single-item documents built by hand below; 'values' is +## a vector of JSON literals, one per row, so quote any string value yourself +.oneItemDoc <- function(type, values, name="v") { + paste0('{"results":{"', name, '":{"name":"', name, '","idColumn":{"name":"ID",', + '"type":"STRING","values":[', + paste0('"', seq_along(values), '"', collapse=","), ']},', + '"valuesColumn":{"name":"VALUE","type":"', type, '","values":[', + paste(values, collapse=","), ']},"secondaryColumns":[]}},', + '"responseExceptions":[]}') +} + +## -- offline parsing tests (no Bloomberg connection required) -------------- + +for (.p in .parsers) { + + ## single-item query: one data.frame with declared column types + res <- .parse("response_px_last.json", parser=.p) + expect_true(inherits(res, "data.frame"), info = .with("single item simplifies to data.frame")) + expect_equal(dim(res), c(3L, 4L), info = .with("three rows, four columns")) + expect_equal(colnames(res), c("ID", "px_last", "DATE", "CURRENCY"), info = .with("column names")) + expect_equal(unname(sapply(res, class)), c("character", "numeric", "Date", "character"), + info = .with("column types follow declared JSON types")) + expect_equal(res$px_last[1:2], c(229.33, 254.49), info = .with("numeric values")) + ## expect_identical, not expect_equal: all.equal() treats NaN as equal to + ## NA_real_, so expect_equal would pass even if the placeholder handling + ## were removed altogether and as.numeric("NaN") left a NaN behind + expect_identical(res$px_last[3], NA_real_, info = .with("string 'NaN' becomes NA, not NaN")) + expect_true(is.na(res$DATE[3]) && is.na(res$CURRENCY[3]), info = .with("JSON null becomes NA")) + expect_equal(res$DATE[1], as.Date("2024-12-17"), info = .with("DATE conversion")) + + ## simplify=FALSE keeps the list shape + res <- .parse("response_px_last.json", simplify=FALSE, parser=.p) + expect_true(is.list(res) && length(res) == 1L && names(res) == "px_last", + info = .with("simplify=FALSE returns named list")) + + ## multi-item query: one data.frame per 'get' item + res <- .parse("response_multi_item.json", parser=.p) + expect_true(is.list(res) && !inherits(res, "data.frame"), info = .with("multi item returns list")) + expect_equal(names(res), c("name", "pe_ratio"), info = .with("list named by data item")) + expect_equal(colnames(res$name), c("ID", "name"), info = .with("no secondary columns")) + expect_equal(colnames(res$pe_ratio), + c("ID", "pe_ratio", "AS_OF_DATE", "PERIOD_END_DATE", "REVISION_COUNT"), + info = .with("secondary columns appended")) + expect_equal(class(res$pe_ratio$REVISION_COUNT), "integer", info = .with("INT maps to integer")) + expect_equal(res$name$name[2], "Apple Inc", info = .with("string values")) + ## a DATE column is converted through unique()/match(), so assert the + ## values and not only the name: these two are deliberately descending, + ## and a column of duplicates could not detect a reordering + expect_equal(res$pe_ratio$PERIOD_END_DATE, as.Date(c("2024-09-30", "2024-09-28")), + info = .with("secondary DATE column keeps the row order")) + + ## BQL errors surface as R errors + expect_error(.parse("response_syntax_error.json", parser=.p), + pattern = "Unable to parse request", info = .with("responseExceptions raise")) + + ## literal "NA" strings in STRING columns are preserved, not turned into NA + res <- .parse("response_string_na.json", parser=.p) + expect_equal(res$ticker[2], "NA", info = .with("literal 'NA' string value preserved")) + expect_false(anyNA(res$ticker), info = .with("no spurious NAs in string column")) + + ## item-level responseExceptions surface as warnings, data is kept + expect_warning(res <- .parse("response_item_error.json", parser=.p), + pattern = "Insufficient data", info = .with("item-level exceptions warn")) + expect_equal(nrow(res), 1L, info = .with("partial data still returned")) + + ## grouped aggregation, e.g. let(#mv=sum(group(amt_outstanding(), + ## by=[year(maturity()), industry_sector()]));): the ID column holds + ## composite group labels, year() yields an INT column, and ORIG_IDS is + ## null for multi-security groups but set for single-security groups + ## (synthetic values; structure verified against a live response) + res <- .parse("response_grouped.json", parser=.p) + expect_equal(dim(res), c(6L, 8L), info = .with("grouped: dimensions")) + expect_equal(colnames(res), + c("ID", "#mv", "CURRENCY_OF_ISSUE", "MULTIPLIER", "CURRENCY", + "ORIG_IDS", "YEAR(MATURITY())", "INDUSTRY_SECTOR()"), + info = .with("grouped: column names")) + expect_equal(unname(sapply(res, function(x) class(x)[1])), + c("character", "numeric", "character", "numeric", "character", + "character", "integer", "character"), + info = .with("grouped: column types incl. INT from year()")) + expect_equal(res$ID[1], "2027.0:Technology", info = .with("grouped: composite group id")) + expect_equal(res[["#mv"]][1], 1500000000, info = .with("grouped: aggregated value")) + expect_equal(res[["YEAR(MATURITY())"]][1], 2027L, info = .with("grouped: integer year")) + expect_true(anyNA(res$ORIG_IDS) && !all(is.na(res$ORIG_IDS)), + info = .with("grouped: ORIG_IDS null for groups, set for singletons")) + expect_equal(res$CURRENCY_OF_ISSUE[1], "USD", + info = .with("grouped: undeclared types like ENUM fall back to character")) +} + +## -- fragmented responses ------------------------------------------------- + +## The C++ layer returns one string per response message, and the service cuts +## a response above 4 MiB at a byte boundary, in the middle of a token, so the +## fragments form one document only once joined. Chunking a fixture into pieces +## far smaller than 4 MiB reproduces that without needing a 4 MiB response. +## +## The chunking is on bytes, not on characters, because that is what the +## service does: a boundary can fall inside a multi-byte UTF-8 character, which +## leaves that one fragment invalid UTF-8 on its own. +.chunkBytes <- function(txt, n) { + b <- charToRaw(txt) + i <- split(seq_along(b), ceiling(seq_along(b) / n)) + vapply(i, function(k) rawToChar(b[k]), character(1), USE.NAMES = FALSE) +} + +for (.p in .parsers) { + for (f in list.files("bql", pattern = "[.]json$")) { + doc <- .readFixture(f) + ref <- .outcome(doc, .p) + ## the two largest sizes are derived from the document, as a fixed size + ## above the smallest fixture would give one chunk and compare the + ## document with itself + nb <- nchar(doc, type = "bytes") + for (n in unique(c(1L, 7L, 64L, nb %/% 7L, nb %/% 2L))) { + frags <- .chunkBytes(doc, n) + expect_true(length(frags) > 1L, + info = .with(paste0(f, " really is split at ", n, " bytes"))) + ## the join must return the original bytes; asserted directly as + ## well as through the parser, so a failure says which one broke + expect_identical(Rblpapi:::.bqlJoin(frags), doc, + info = .with(paste0(f, " rejoins byte for byte at ", n))) + expect_equal(.outcome(frags, .p), ref, + info = .with(paste0(f, " in ", length(frags), + " chunks of ", n, " bytes"))) + } + } + + ## a single fragment is not a document: the failure the joining prevents + doc <- .readFixture("response_px_last.json") + frags <- .chunkBytes(doc, nchar(doc, type = "bytes") %/% 2L) + expect_true(length(frags) > 1L, info = .with("the fixture really was split")) + expect_error(Rblpapi:::.bqlParse(frags[1], parser = .p), + info = .with("a lone fragment does not parse")) + + ## a boundary inside a multi-byte UTF-8 character must still rejoin; the + ## characters are written as escapes so that this file stays ASCII + utf8doc <- .oneItemDoc("STRING", + c('"Nestl\u00e9 S\u00e9n\u00e9gal"', '"\u00dcbermorgen"'), + name = "name") + want <- c("Nestl\u00e9 S\u00e9n\u00e9gal", "\u00dcbermorgen") + expect_equal(Rblpapi:::.bqlParse(utf8doc, parser = .p)$name, want, + info = .with("multi-byte characters read correctly")) + for (n in 1L:8L) { + frags <- .chunkBytes(utf8doc, n) + expect_identical(Rblpapi:::.bqlJoin(frags), utf8doc, + info = .with(paste0("multi-byte rejoin at ", n, " bytes"))) + expect_equal(Rblpapi:::.bqlParse(frags, parser = .p)$name, want, + info = .with(paste0("multi-byte characters survive ", n, + "-byte chunking"))) + } +} + +## -- the parsers must agree exactly ---------------------------------------- + +if (length(.parsers) > 1L) { + for (f in list.files("bql", pattern="[.]json$")) { + out <- lapply(.parsers, function(p) .outcome(.readFixture(f), p)) + expect_true(.allIdentical(out), info = paste("all parsers agree on", f)) + } +} + +## -- parser selection ------------------------------------------------------ + +expect_true(Rblpapi:::.bqlParser() %in% .parsers, info = "default parser is installed") +## the expected name is written out rather than taken from .bqlParsers, which +## would make the assertion agree with any order that variable happened to have +if (all(c("RcppSimdJson", "jsonlite") %in% .parsers)) + expect_equal(Rblpapi:::.bqlParser(), "RcppSimdJson", + info = "RcppSimdJson is preferred when both are installed") +## one helper, so a throwing assertion cannot leak the option to later tests +.withOption <- function(value, expr) { + old <- options(bqlParser=value) + on.exit(options(old)) + force(expr) +} +.withOption(.parsers[length(.parsers)], + expect_equal(Rblpapi:::.bqlParser(), .parsers[length(.parsers)], + info = "option selects the parser")) + +## an unknown parser name must be reported, not treated as "no data" +expect_error(Rblpapi:::.bqlFromJSON("{}", "notAParser"), + pattern = "Unknown BQL JSON parser", + info = "an unknown parser name is an error") + +## the option is validated: no abbreviations, and an unknown name is not +## silently dropped when a known one sits beside it +for (.bad in list("notAParser", c("notAParser", "jsonlite"), "R", "j", + NA_character_, "", 1L, TRUE, list("jsonlite"), character(0))) + .withOption(.bad, + expect_error(Rblpapi:::.bqlParser(), + info = paste("option rejected:", + paste(deparse(.bad), collapse = "")))) + +## the parsers must agree on the intermediate structure, not merely on the +## final data.frame: '[]', '{}' and null are where they differ by default, so +## this is what the two 'empty' arguments and max_simplify_lvl="list" buy +if (length(.parsers) > 1L) { + .shapes <- '{"a":[],"b":{},"c":[1,null,"x",true],"d":{"e":[{"f":null}]}}' + .trees <- lapply(.parsers, function(p) Rblpapi:::.bqlFromJSON(.shapes, p)) + expect_true(.allIdentical(.trees), + info = "parsers agree on the intermediate structure") +} + +## -- column conversion ----------------------------------------------------- + +.col <- function(...) Rblpapi:::.bqlColumn(list(...)) + +## a column of only nulls must keep the type its declaration implies +expect_equal(.col(type="STRING", values=list(NULL, NULL)), c(NA_character_, NA_character_), + info = "all-null STRING column stays character") +expect_equal(.col(type="DATE", values=list(NULL)), as.Date(NA), + info = "all-null DATE column stays Date") +expect_equal(.col(type="DOUBLE", values=list(NULL)), NA_real_, + info = "all-null DOUBLE column stays numeric") + +## an empty or absent 'values' key gives a zero-length column, not an error +expect_equal(.col(type="DOUBLE", values=list()), numeric(0), info = "empty column") +expect_equal(.col(type="STRING"), character(0), info = "absent values key") +expect_equal(.col(type="DATE"), as.Date(character(0)), info = "absent values key, DATE") + +## Every placeholder means NA in a numeric column, and only there. These use +## expect_identical because all.equal() treats NaN as equal to NA_real_, so +## expect_equal could not tell a real NA from the NaN that as.numeric("NaN") +## leaves behind when the placeholder handling is missing. +expect_identical(.col(type="DOUBLE", values=list(1, "NaN", "NA", "", 2)), + c(1, NA, NA, NA, 2), info = "DOUBLE placeholders become NA") +expect_identical(.col(type="INT", values=list(1L, "NaN", "NA", "")), + c(1L, NA, NA, NA), info = "INT placeholders become NA") +expect_false(any(is.nan(.col(type="DOUBLE", values=list(1, "NaN")))), + info = "'NaN' becomes NA rather than NaN") +expect_equal(.col(type="STRING", values=list("NaN", "NA", "")), + c("NaN", "NA", ""), info = "STRING keeps the same spellings verbatim") + +## JSON booleans and their string spellings both convert +expect_equal(.col(type="BOOLEAN", values=list(TRUE, FALSE, NULL)), c(TRUE, FALSE, NA), + info = "JSON booleans") +expect_equal(.col(type="BOOLEAN", values=list("true", "FALSE", NULL)), c(TRUE, FALSE, NA), + info = "boolean strings") + +## DATE and DATETIME are converted through unique()/match(), so a column whose +## distinct values are neither sorted nor unique must keep its own row order +.dts <- c("2024-03-05", "2024-01-31", "2024-03-05", "2024-02-29", "2024-01-31") +expect_equal(.col(type="DATE", values=as.list(paste0(.dts, "T00:00:00Z"))), + as.Date(.dts), info = "DATE column keeps the row order") +expect_equal(.col(type="DATE", + values=c(as.list(paste0(.dts[1:2], "T00:00:00Z")), list(NULL), + as.list(paste0(.dts[3:5], "T00:00:00Z")))), + as.Date(c(.dts[1:2], NA, .dts[3:5])), + info = "DATE column with an interleaved null keeps the row order") +.tms <- c("2024-03-05T13:45:30Z", "2024-01-31T09:00:00Z", "2024-03-05T13:45:30Z") +expect_equal(.col(type="DATETIME", values=as.list(.tms)), + as.POSIXct(.tms, format="%Y-%m-%dT%H:%M:%OS", tz="UTC"), + info = "DATETIME column keeps the row order") + +## a nested value would silently shift the rows of a column, so it must fail +expect_error(.col(name="X", type="STRING", values=list("a", list("b", "c"))), + pattern = "non-scalar", info = "non-scalar values are rejected") + +## -- double precision through the JSON layer ------------------------------- + +## A DOUBLE column keeps the exact values the document carried, whether or not +## a placeholder string sits beside them: the placeholders are blanked before +## the column is flattened, so it never detours through character. The second +## case is the one that regresses if that step is dropped. +## as.numeric() is correctly rounded, so as.numeric(.v) is bit-identical to +## the literal in the document and needs no separate expected value. +## 230.66000366210938 is a real float32-derived price, the case which +## motivated all of this. +for (.p in .parsers) + for (.v in c("0.12345678901234568", "230.66000366210938")) + for (.ph in c("null", '"NaN"', '"NA"', '""')) { + res <- Rblpapi:::.bqlParse(.oneItemDoc("DOUBLE", c(.v, .ph)), parser=.p) + expect_identical(res$v[1], as.numeric(.v), + info = .with(paste("DOUBLE keeps every digit beside", .ph))) + expect_identical(res$v[2], NA_real_, + info = .with(paste("the", .ph, "placeholder itself is NA"))) + } + +## A number written as a string is not a placeholder and must still convert. +## It is also the one case which does not keep every digit, because the column +## has to come back from character; expect_identical pins that, since +## expect_equal's tolerance would hide it either way. +expect_identical(.col(type="DOUBLE", values=list("123.45", 6, "NaN")), + c(123.45, 6, NA), info = "a number sent as a string still converts") +expect_identical(.col(type="DOUBLE", values=list(230.66000366210938, "123.45")), + c(as.numeric(as.character(230.66000366210938)), 123.45), + info = "a number sent as a string costs the column its last digits") +expect_identical(.col(type="DOUBLE", values=list(230.66000366210938, "NaN")), + c(230.66000366210938, NA), + info = "a placeholder does not") + +## -- assembling an item into a data.frame ----------------------------------- + +.item <- function(...) Rblpapi:::.bqlItemToDataFrame(list(...)) +.scol <- function(nm, vals) list(name=nm, type="STRING", values=as.list(vals)) + +## an item with no columns at all is an empty data.frame, not an error from +## make.unique() being handed the NULL names of an empty list +expect_equal(dim(.item(name="x", idColumn=NULL, valuesColumn=NULL, + secondaryColumns=list())), c(0L, 0L), + info = "an item with no columns gives an empty data.frame") + +## a repeated column name must add a column, not replace the earlier one +res <- .item(name="x", idColumn=.scol("ID", c("a", "b")), + valuesColumn=.scol("VALUE", c("1", "2")), + secondaryColumns=list(.scol("DATE", c("d1", "d2")), + .scol("DATE", c("e1", "e2")))) +expect_equal(ncol(res), 4L, info = "a repeated column name keeps both columns") +expect_equal(colnames(res), c("ID", "x", "DATE", "DATE.1"), + info = "make.unique() renames the second one") +expect_equal(res$DATE, c("d1", "d2"), info = "the first DATE column is intact") +expect_equal(res[["DATE.1"]], c("e1", "e2"), info = "the second DATE column is intact") + +## columns of unequal length cannot make a valid data.frame, so say so +expect_error(.item(name="x", idColumn=.scol("ID", c("a", "b", "c")), + valuesColumn=.scol("VALUE", c("1", "2")), + secondaryColumns=list()), + pattern = "unequal length", + info = "unequal column lengths are rejected") + +## -- live test (requires a Bloomberg connection) ---------------------------- + +.runThisTest <- Sys.getenv("RunRblpapiUnitTests") == "yes" +if (!.runThisTest) exit_file("Skipping live BQL test") + +res <- bql("get(px_last) for(['IBM US Equity', 'AAPL US Equity'])") +expect_true(inherits(res, "data.frame"), info = "live query returns data.frame") +expect_equal(nrow(res), 2L, info = "one row per security") +expect_true(is.numeric(res$px_last), info = "px_last is numeric") diff --git a/man/bql.Rd b/man/bql.Rd new file mode 100644 index 0000000..d7bdb18 --- /dev/null +++ b/man/bql.Rd @@ -0,0 +1,78 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bql.R +\name{bql} +\alias{bql} +\title{Run 'Bloomberg Query Language' (BQL) Queries} +\usage{ +bql(expression, parse = TRUE, simplify = TRUE, verbose = FALSE, + parser = NULL, con = defaultConnection()) +} +\arguments{ +\item{expression}{A character string with the BQL query, e.g. +\code{"get(px_last) for(['IBM US Equity'])"}.} + +\item{parse}{A boolean indicating whether the JSON response should +be parsed into \code{data.frame} objects (requires either the +\CRANpkg{RcppSimdJson} or the \CRANpkg{jsonlite} package), +defaults to \sQuote{TRUE}. If \sQuote{FALSE} the raw JSON string +is returned.} + +\item{simplify}{A boolean indicating whether a query returning a +single data item should be returned directly as a \code{data.frame} +instead of a list of length one, defaults to \sQuote{TRUE}.} + +\item{verbose}{A boolean indicating whether verbose operation is +desired, defaults to \sQuote{FALSE}.} + +\item{parser}{A character vector naming the JSON parsers to use in +order of preference; the first one which is installed is used. +\sQuote{NULL}, the default, takes the \code{bqlParser} option and, +failing that, tries \sQuote{RcppSimdJson} then \sQuote{jsonlite}.} + +\item{con}{A connection object as created by a \code{blpConnect} +call, and retrieved via the internal function +\code{defaultConnection}.} +} +\value{ +If \code{parse} is \sQuote{TRUE}, a named list of +\code{data.frame} objects, one per data item in the query's +\code{get()} clause (or a single \code{data.frame} if +\code{simplify} is \sQuote{TRUE} and only one item was queried). +Each \code{data.frame} has an \sQuote{ID} column, a value column +named after the data item, and any secondary columns (such as +\sQuote{DATE} or \sQuote{CURRENCY}) the service returned. If +\code{parse} is \sQuote{FALSE}, a character string with the JSON +document. +} +\description{ +This function uses the Bloomberg API to execute 'BQL' (Bloomberg +Query Language) queries via the \sQuote{//blp/bqlsvc} service -- +the same service used by the Excel \code{=BQL()} function. +} +\details{ +The service returns a single JSON document. Each queried data +item is self-describing: every column carries a declared type +(\sQuote{STRING}, \sQuote{DOUBLE}, \sQuote{INT}, \sQuote{DATE}, +\sQuote{DATETIME}, \sQuote{BOOLEAN}) which is used to construct +properly-typed \code{data.frame} columns. Parsing requires either +the \CRANpkg{RcppSimdJson} or the \CRANpkg{jsonlite} package; +\CRANpkg{RcppSimdJson} is preferred when both are installed as it +is faster on the large documents BQL can return. Both give the same +result for the documents the service returns. Set +\code{parse=FALSE} to obtain the raw JSON string instead, e.g. for +queries whose shape the parser does not handle. + +Note that \sQuote{//blp/bqlsvc} is not part of the officially +documented public API; it is the service behind the Excel BQL +add-in and may change without notice. +} +\examples{ +\dontrun{ +con <- blpConnect() +bql("get(px_last) for(['IBM US Equity', 'AAPL US Equity'])") +bql("get(px_last, name) for(members('INDU Index'))", simplify=FALSE) +} +} +\author{ +Alexander Kammerer and Dirk Eddelbuettel +} diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 3f40868..b9cac11 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -158,6 +158,19 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// bql_Impl +Rcpp::CharacterVector bql_Impl(SEXP con, std::string expression, bool verbose); +RcppExport SEXP _Rblpapi_bql_Impl(SEXP conSEXP, SEXP expressionSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type con(conSEXP); + Rcpp::traits::input_parameter< std::string >::type expression(expressionSEXP); + Rcpp::traits::input_parameter< bool >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(bql_Impl(con, expression, verbose)); + return rcpp_result_gen; +END_RCPP +} // bsrch_Impl Rcpp::DataFrame bsrch_Impl(SEXP con, std::string domain, std::string limit, bool verbose); RcppExport SEXP _Rblpapi_bsrch_Impl(SEXP conSEXP, SEXP domainSEXP, SEXP limitSEXP, SEXP verboseSEXP) { @@ -275,6 +288,7 @@ static const R_CallMethodDef CallEntries[] = { {"_Rblpapi_getHeaderVersion", (DL_FUNC) &_Rblpapi_getHeaderVersion, 0}, {"_Rblpapi_getRuntimeVersion", (DL_FUNC) &_Rblpapi_getRuntimeVersion, 0}, {"_Rblpapi_haveBlp", (DL_FUNC) &_Rblpapi_haveBlp, 0}, + {"_Rblpapi_bql_Impl", (DL_FUNC) &_Rblpapi_bql_Impl, 3}, {"_Rblpapi_bsrch_Impl", (DL_FUNC) &_Rblpapi_bsrch_Impl, 4}, {"_Rblpapi_fieldSearch_Impl", (DL_FUNC) &_Rblpapi_fieldSearch_Impl, 2}, {"_Rblpapi_getBars_Impl", (DL_FUNC) &_Rblpapi_getBars_Impl, 8}, diff --git a/src/bql.cpp b/src/bql.cpp new file mode 100644 index 0000000..c2cea18 --- /dev/null +++ b/src/bql.cpp @@ -0,0 +1,137 @@ +// +// bql.cpp -- "Bloomberg Query Language" query function for the BLP API +// +// Copyright (C) 2025 Whit Armstrong and Dirk Eddelbuettel and John Laing +// +// This file is part of Rblpapi +// +// Rblpapi is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 2 of the License, or +// (at your option) any later version. +// +// Rblpapi is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with Rblpapi. If not, see . + +#if defined(HaveBlp) +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +using namespace Rcpp; + +using BloombergLP::blpapi::Session; +using BloombergLP::blpapi::Service; +using BloombergLP::blpapi::Request; +using BloombergLP::blpapi::Event; +using BloombergLP::blpapi::Element; +using BloombergLP::blpapi::Message; +using BloombergLP::blpapi::MessageIterator; +using BloombergLP::blpapi::Name; +using BloombergLP::blpapi::NotFoundException; + +// The //blp/bqlsvc service returns each response message as a single +// string-typed element holding a JSON document. Collect those strings; +// parsing is done R-side (see R/bql.R). +void processBqlEvent(Event event, std::vector& res, const bool verbose) { + MessageIterator msgIter(event); + while (msgIter.next()) { + Message msg = msgIter.message(); + if (verbose) msg.print(Rcpp::Rcout); + + Element response = msg.asElement(); + if (response.hasElement(Name{"responseError"})) { + Element err = response.getElement(Name{"responseError"}); + Rcpp::stop("Response error: " + std::string(err.getElementAsString(Name{"message"}))); + } + if (response.datatype() == BLPAPI_DATATYPE_STRING) { + res.push_back(response.getValueAsString()); + } else if (verbose) { + Rcpp::Rcout << "Skipping non-string message of type " + << msg.messageType().string() << std::endl; + } + } +} +#else +#include +#endif + +// [[Rcpp::export]] +Rcpp::CharacterVector bql_Impl(SEXP con, + std::string expression, + bool verbose=false) { +#if defined(HaveBlp) + Session* session = reinterpret_cast(checkExternalPointer(con, "blpapi::Session*")); + + const std::string bqlsvc = "//blp/bqlsvc"; + if (!session->openService(bqlsvc.c_str())) { + Rcpp::stop("Failed to open " + bqlsvc); + } + + Service bqlService = session->getService(bqlsvc.c_str()); + Request request = bqlService.createRequest("sendQuery"); + request.getElement(Name{"expression"}).setValue(expression.c_str()); + // the service expects the same client context the Excel BQL add-in sends + try { + Element clientContext = request.getElement(Name{"clientContext"}); + clientContext.setElement(Name{"appName"}, "EXCEL"); + } catch (NotFoundException& e) { + if (verbose) Rcpp::Rcout << "No 'clientContext' element in request schema" << std::endl; + } + + if (verbose) Rcpp::Rcout << "Sending Request: " << request << std::endl; + session->sendRequest(request); + + std::vector res; + + // Wait for events from Session + bool done = false; + while (!done) { + Event event = session->nextEvent(); + if (event.eventType() == Event::PARTIAL_RESPONSE) { + if (verbose) Rcpp::Rcout << "Processing Partial Response" << std::endl; + processBqlEvent(event, res, verbose); + } else if (event.eventType() == Event::RESPONSE) { + if (verbose) Rcpp::Rcout << "Processing Response" << std::endl; + processBqlEvent(event, res, verbose); + done = true; + } else if (event.eventType() == Event::REQUEST_STATUS) { + // a rejected or timed-out request sends this and never a RESPONSE, + // so without it nextEvent() would block for good (cf. bdh.cpp) + MessageIterator msgIter(event); + while (msgIter.next()) { + Message msg = msgIter.message(); + if (verbose) msg.asElement().print(Rcpp::Rcout); + } + Rcpp::stop("Bloomberg request timed out on server side"); + } else { + MessageIterator msgIter(event); + while (msgIter.next()) { + Message msg = msgIter.message(); + if (event.eventType() == Event::SESSION_STATUS) { + if (msg.messageType() == "SessionTerminated" || + msg.messageType() == "SessionStartupFailure") { + done = true; + } + } + } + } + } + + return Rcpp::wrap(res); +#else // ie no Blp + return Rcpp::CharacterVector(); +#endif +}