hateimparlament/R/fetch.R

mk_absolute_url <- function(path) paste0("https://www.bundestag.de", path)

mk_url <- function(offset) {
    mk_absolute_url %$% sprintf("/ajax/filterlist/de/services/opendata/543410-543410?offset=%d",
                                offset)
}

download_protocol <- function(path, name, download_dir) {
    fp <- paste0(download_dir, name)
    try %$% download.file(mk_absolute_url(path), fp, quiet=T)
    progress <<- progress + 1
    setTimerProgressBar(pb, progress)
}

fetch_batch <- function(offset, download_dir) {
    stopifnot("Offset must be numeric" = is.numeric(offset))
    mk_url(offset) %>%
        rvest::read_html() %>%
        as.character() %>%
        str_match_all("/resource/blob/.*?/([0-9]*-data\\.xml)") %>%
        `[[`(1) ->
        paths
    mapply(download_protocol,
           paths[,1],
           paths[,2],
           MoreArgs=list(download_dir = download_dir))
    return(length(paths) > 0)
}

# TODO: error handling
# - what if: page not reachable
# - wrong format, etc.

#' Download available records
#'
#' This fetches all available records of the 19th legislative period of the german Bundestag.
#'
#' @param download_dir character
#'
#' @export
fetch_all <- function(download_dir="records/", create=FALSE) {
    # check if download_dir path is a directory path
    if (str_sub(download_dir, -1) != .Platform$file.sep)
        download_dir <- str_c(download_dir, .Platform$file.sep)

    # check if download_dir exists
    if(file.access(download_dir, mode=0) == -1) {
        if (create) {
            tryCatch(dir.create(download_dir),
                     error = stop_dir_not_creatable,
                     warning = stop_dir_not_creatable)
        } else {
            stop("Directory does not exist. Use create = TRUE if you wish to create the directory.")
        }
    } else if (file.access(download_dir, mode=2) == -1) {
        stop("Directory exists, but is not writeable.")
    }
    cat("Fetching all available records from bundestag.de. This may take a while ...\n")

    # create progress bar
    pb <<- timerProgressBar(min=0, max=250, width=40, char="+")
    progress <<- 0
    # close progress bar on exit (also on error)
    on.exit({close(pb); cat("Done.\n")})

    # fetch batch by batch
    offset <- 0
    while(fetch_batch(offset, download_dir)) offset <- offset + 10

    # if successful, set progressbar to 100%
    setTimerProgressBar(pb, 250)
}

stop_dir_not_creatable <- function(cond) {
    # currently this has call: dir.create(download_dir)
    # do we want to change this to fetch_all(...) ?
    cond$message <- "Directory does not exist and can't be created. Probably because the path is not writeable."
    stop(cond)
}