File: zzz.R

package info (click to toggle)
r-cran-ritis 1.0.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 1,156 kB
  • sloc: sh: 13; makefile: 2
file content (97 lines) | stat: -rw-r--r-- 2,275 bytes parent folder | download
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
tc <- function(l) Filter(Negate(is.null), l)

argsnull <- function(x) {
  if (length(x) == 0) {
    NULL
  } else {
    x
  }
}

nmslwr <- function(x) {
  stats::setNames(x, tolower(names(x)))
}

itbase <- function() 'https://www.itis.gov/ITISWebService/services/ITISService/'
itjson <- function() 'https://www.itis.gov/ITISWebService/jsonservice/'
itis_solr_url <- function() "https://services.itis.gov"
iturl <- function(x) {
  if (!tolower(x) %in% c('json', 'xml')) {
    stop("'wt' must be one of 'json' or 'xml'", call. = FALSE)
  }
  switch(
    x,
    json = itjson(),
    xml = itbase()
  )
}

`%-%` <- function(x, y) if (length(x) == 0 || nchar(x) == 0 || is.null(x)) y else x

dr_op <- function(x, y) UseMethod("dr_op")
dr_op.default <- function(x, y) return(NULL)
dr_op.data.frame <- function(x, y) x[, !tolower(names(x)) %in% tolower(y)]
dr_op.list <- function(x, y) x[!tolower(names(x)) %in% tolower(y)]

itis_GET <- function(endpt, args, wt, ...){
  args <- argsnull(args)
  cli <- crul::HttpClient$new(
    url = paste0(iturl(wt), endpt),
    opts = list(...)
  )
  tt <- cli$get(query = args)
  tt$raise_for_status()

  # sort out encoding - if not found, parse differently
  encoding <- NULL
  if (!is.null(tt$response_headers$`content-type`)) {
    encoding <- strsplit(
      strsplit(tt$response_headers$`content-type`, ";")[[1]][2],
      "="
    )[[1]][2]
  }
  if (is.null(encoding) || !nzchar(encoding)) {
    readBin(tt$content, character())
  } else {
    tt$parse(encoding)
  }
}

parse_raw <- function(x) {
  if ((inherits(x, "character") && !nzchar(x)) || is.na(x)) {
    return(tibble::as_tibble())
  }
  jsonlite::fromJSON(x, flatten = TRUE)
}

pick_cols <- function(x, nms) {
  UseMethod("pick_cols")
}

pick_cols.default <- function(x, nms) {
  return(NULL)
}

pick_cols.data.frame <- function(x, nms) {
  if (NROW(x) > 0) {
    names(x) <- tolower(names(x))
    x[, names(x) %in% tolower(nms)]
  } else {
    NULL
  }
}

pick_cols.list <- function(x, nms) {
  if (NROW(x) > 0) {
    names(x) <- tolower(names(x))
    x[names(x) %in% tolower(nms)]
  } else {
    NULL
  }
}

make_itis_conn <- function(proxy) {
  solrium::SolrClient$new(host = "services.itis.gov",
    scheme = "https", port = NULL, errors = "complete",
    proxy = proxy)
}