R/cranMirrors.R

In packageRank: Computation and Visualization of Package Download Counts and Percentiles

#' Scrape CRAN Mirrors data.
#'
#' https://cran.r-project.org/mirrors.html
#' @param description Logical. Mirror details.
#' @export

cranMirrors <- function(description = FALSE) {
  mirrors.url <- "https://cran.r-project.org/mirrors.html"
  web_page <- readLines(mirrors.url)
  start.line <- grep("<dt>", web_page)
  stop.line <- grep("</dd>", web_page)

  hosts <- web_page[start.line]
  hosts <- unname(vapply(hosts, function(x) {
    gsub("<.*?>", "", x)
  }, character(1L)))

  # lookup alternative names
  other.name <- c("0-Cloud", "Czech Republic", "0-Cloud-East-Asia", "Iran", 
    "Korea", "Russia", "Taiwan", "UK", "USA")
  host.tld <- c(NA, "CZ", "ASIA", "IR", "KR", "RU", "TW", "GB", "US")
  other.hosts <- data.frame(name = other.name, tld = host.tld)
  no.match <- hosts[!hosts %in% ISOcodes::ISO_3166_1$Name]
  
  tld_etc <- other.hosts[other.hosts$name %in% no.match, ]
  
  vars <- c("Name", "Alpha_2")
  tld <- ISOcodes::ISO_3166_1[ISOcodes::ISO_3166_1$Name %in% hosts, vars]

  tld <- stats::setNames(tld, c("name", "tld"))
  tld <- rbind(tld, tld_etc)
  tld <- tld[order(tld$name), ]
  row.names(tld) <- NULL

  if (any(!hosts %in% tld$name)) stop("Update mirrors!", call. = FALSE)

  out <- lapply(seq_along(hosts), function(i) {
    start <- start.line[i]
    stop <- stop.line[i]
    host.tmp <- web_page[start:stop]
    data.tmp <- host.tmp[grep("href", host.tmp)]

    url <- unname(vapply(data.tmp, function(x) {
      gsub("<.*?>", "", x)
    }, character(1L)))

    mirror <- gsub("<.*?>", "", web_page[start])
    desc <- host.tmp[grep("<td>", host.tmp) + 1]
    data.frame(country = hosts[i],
               url = url,
               country.code = tolower(tld[tld$name == mirror, "tld"]),
               description = desc)
  })

  out <- do.call(rbind,out)
  
  # match CRAN order #
  asia.sel <- which(out$country.code == "asia")
  E.asia <- out[asia.sel, ]
  
  E.sel <- grepl("^e", out$country.code) & grepl("^E", out$country)
  E <- out[E.sel, ]
  
  E.sel <- c(asia.sel, which(E.sel))
  
  out <- rbind(out[as.numeric(row.names(out)) < E.sel, ],
               out[as.numeric(row.names(out)) == E.sel, ],
               out[as.numeric(row.names(out)) > E.sel, ])
  
  if (description) out
  else out[, names(out) != "description"]
}