R/kegg_info.R

In utubun/keggr: KEGG API

# superfunction

kegg_info <- function(query) {

    url <- sprintf('http://rest.kegg.jp/info/%s', query)

    resp <- httr::GET(url)

    if (.kegg_check_response(resp)) {
        return(kegg_parse_info(resp))
    }

    stop(httr::http_status(resp)$message)
}

# middleware

kegg_parse_info <- function(response) {

    txt <- httr::content(response, encoding = 'utf-8')
    met <- as.list(httr::headers(response))

    if(basename(response$url) %in% c('kegg', 'ligand')) {
        # save the headders as an attributes?
        met <- c(
             setNames(
                 gsub('^.+Release\\s(.+)\\n.*Kanehisa.*', '\\1', txt) |>
                     strsplit(split = ',\\s*') |>
                     unlist(),
                 c('Release', 'Release Date')
             ) |>
            as.list()
        )
        txt <- gsub('^.*Kanehisa Laboratories\\n', '', txt)
        txt <- gsub('(\\n\\t|\\t*entries\\n)', '\n', txt)
        txt <- gsub(',', '', txt)
        res <- read.table(text = txt)
        res <- setNames(res, c('database', 'entries'))

    } else if(basename(response$url) == 'genes') {
        txt <- gsub('^.*Kanehisa Laboratories\\n', '', txt)
        txt <- gsub('(\\n\\t|\\t*entries\\n)', '\n', txt)
        txt <- gsub('(,|\\n)', '', txt)
        txt <- paste('genes', txt, collapse = '\t')
        res <- read.table(text = txt)
        res <- setNames(res, c('database', 'entries'))
    } else {
        txt <- gsub('^.+\\n\\n', '', txt)
        txt <- gsub('^linked db', '', txt)
        txt <- gsub('(\\n*\\t+|\\s+)', '\n', txt)
        txt <- gsub('<org>', 'org', txt)
        txt <- gsub('^\\n', '', txt)
        res <- read.table(text = txt)
        res[, 2] <- basename(response$url)
        res <- setNames(res[, c(2, 1)], c('database', 'linked'))
    }

    return(res)
}