R/KorAPQuery.R

#' @import jsonlite
#' @import curl

defaultFields <- c("corpusSigle", "textSigle", "pubDate",  "pubPlace",
            "availability", "textClass", "snippet")

contentFields <- c("snippet")

QueryParameterFromUrl <- function(url, parameter) {
  regex <- paste0(".*[?&]", parameter, "=([^&]*).*")
  if (grepl(regex, url)) {
    return(gsub(regex, '\\1', url, perl = TRUE))
  } else {
    return("")
  }
}

KorAPQueryStringFromUrl <- function(KorAPUrl) {
  return(URLdecode(gsub(".*[?&]q=([^&]*).*", '\\1', KorAPUrl, perl = TRUE)))
}

#' \code{KorAPQuery} perform a query on the KorAP server.
#' @param con object obtained from \code{\link{KorAPConnection}}, that contains all necessary connection information
#' @param query string that contains the corpus query. The query langauge depends on the \code{ql} parameter. Either \code{query} must be provided or \code{KorAPUrl}
#' @param vc string describing the virtual corpus in which the query should be performed. An empty string (default) means the whole corpus, as far as it is license-wise accessible.
#' @param KorAPUrl instead of providing the query and vc string parameters, you can also simply copy a KorAP query URL from your browser and use it here (and in \code{KorAPConnection}) to provide all necessary information for the query.
#' @param metadataOnly boolean that determines whether queries should return only metadata without any snippets. This can also be useful to prevent access rewrites. Note that the default value is TRUE, unless the connection is authorized (currently not possible).
#' @param ql string to choose the query language
#' @param fields (meta)data fields that will be fetched for every match
#' @return A KorAP query object that, among other information, contains the total number of results in \code{$meta$totalResults}. The resulting object can be used to fetch all query results (with \code{\link{KorAPFetchAll}}) or the next page of results (with \code{\link{KorAPFetchNext}}). Please make sure to check \code{$collection$rewrites} to see if any unforseen access rewrites of the query's virtual corpus had to be performed.
#'
#' @examples
#' q <- KorAPQuery(con, "Ameisenplage")
#' q <- KorAPQuery(KorAPConnection(), "Ameisenplage")
#' q <- KorAPQuery(con, KorAPUrl = "https://korap.ids-mannheim.de/?q=Ameise&cq=pubDate+since+2017&ql=poliqarp&cutoff=1")
#'
#' @references
#' \url{https://ids-pub.bsz-bw.de/frontdoor/index/index/docId/9026}
#'
#' @export
KorAPQuery <- function(con, query, vc = NA, KorAPUrl = NA, metadataOnly = TRUE, ql = "poliqarp", fields = defaultFields) {
  if (is.na(query) && is.na(KorAPUrl) ||  ! (is.na(query) || is.na(KorAPUrl))) {
    stop("Exaclty one of the parameters query and KorAPUrl must be specified.")
  }
  if (is.na(query)) {
    query <- QueryParameterFromUrl(KorAPUrl, "q")
    vc <- QueryParameterFromUrl(KorAPUrl, "vc")
    ql <- QueryParameterFromUrl(KorAPUrl, "ql")
  }
  if (is.na(vc)) {
    vc <- ""
  }
  request <- paste0('?q=', URLencode(query, reserved=TRUE),
                    ifelse(vc != '', paste0('&vc=', URLencode(vc, reserved=TRUE)), ''),
                    '&ql=', ql);
  webUIRequestUrl <- paste0(con$KorAPUrl, request)
  requestUrl <- paste0(con$apiUrl, 'search', request,
                       '&fields=', paste(defaultFields, collapse = ","),
                       ifelse(metadataOnly, '&access-rewrite-disabled=true', ''))
  result <- fromJSON(paste0(requestUrl, '&count=1'))
  result$fields <- fields[!metadataOnly || !fields %in% contentFields]
  result$requestUrl <- requestUrl
  result$request <- request
  result$vc <- vc
  result$webUIRequestUrl <- webUIRequestUrl
  result$nextStartIndex <- 0
  result$hasMoreMatches <- (result$meta$totalResults > 0)
  return(result)
}

#' @export
KorAPFetchAll <- function(queryObject, verbose=FALSE) {
  if (queryObject$meta$totalResults == 0) { return(data.frame()) }

  page <- 1
  results <- 0

  repeat {
    res <- fromJSON(paste0(queryObject$requestUrl, '&count=50&offset=', results))
    if (res$meta$totalResults == 0) { return(data.frame()) }
    for (field in queryObject$fields) {
      if (!field %in% colnames(res$matches)) {
        res$matches[, field] <- NA
      }
    }
    currentMatches <- res$matches[queryObject$fields]
    factorCols <- colnames(subset(currentMatches, select=-c(pubDate)))
    currentMatches[factorCols] <- lapply(currentMatches[factorCols], factor)
    currentMatches$pubDate = as.Date(currentMatches$pubDate, format = "%Y-%m-%d")
    if (results == 0) {
      allMatches <- currentMatches
      expectedResults <- res$meta$totalResults
    } else {
      allMatches <- rbind(allMatches, currentMatches)
    }
    if (verbose) {
      cat(paste0("Retrieved page: ", page, "/", ceiling(expectedResults / res$meta$itemsPerPage), ': ', res$meta$benchmark, '\n'))
    }
    page <- page + 1
    results <- results + res$meta$itemsPerPage
    if (results >= expectedResults) {
      break
    }
  }
  return(allMatches)
}

#' @export
KorAPFetchNext <- function(queryObject, offset=queryObject$nextStartIndex, verbose=FALSE) {
  if (queryObject$nextStartIndex >= queryObject$meta$totalResults) {
    queryObject$hasMoreMatches <- FALSE
    return(queryObject)
  }

  res <- fromJSON(paste0(queryObject$requestUrl, '&count=50&offset=', offset))
  for (field in queryObject$fields) {
    if (!field %in% colnames(res$matches)) {
      res$matches[, field] <- NA
    }
  }
  currentMatches <- res$matches[queryObject$fields]
  factorCols <- colnames(subset(currentMatches, select=-c(pubDate)))
  currentMatches[factorCols] <- lapply(currentMatches[factorCols], factor)
  currentMatches$pubDate = as.Date(currentMatches$pubDate, format = "%Y-%m-%d")
  if (offset == 0) {
    res$collectedMatches <- currentMatches
  } else {
    res$collectedMatches <- rbind(queryObject$collectedMatches, currentMatches)
  }
  if (verbose) {
    cat(paste0("Retrieved page in ", res$meta$benchmark, '\n'))
  }
  res$nextStartIndex <- res$meta$startIndex + res$meta$itemsPerPage
  res$fields <- queryObject$fields
  res$requestUrl <- queryObject$requestUrl
  res$request <- queryObject$request
  res$webUIRequestUrl <- queryObject$webUIRequestUrl
  res$hasMoreMatches <- (res$meta$totalResults > res$nextStartIndex)

  return(res)
}