R/modDownload.R

Defines functions mod_Download recursiveModDownload modDownload

Documented in modDownload

#' Download MODIS images from a search list
#'
#' \code{modDownload} downloads the images from a list of uniform resource 
#' locators (URLs) generated by the \code{\link{modSearch}} function from NASA’s
#' `EartData' plataform. The images are saved as GTiff files in the 
#' \code{AppRoot} directory.
#'
#' \code{modDownload} is able to download MODIS Terra and Aqua products.
#' These products are published in the 
#' \href{https://earthdata.nasa.gov}{`EarthData' Platform}.
#' The platform is supported by the Earth Observing System Data and Information
#' System (EODIS) and managed NASA’s Earth Science Data Systems (ESDS).
#' \code{modDownload} requires credentianls from an `EarthData' account to
#' access the NASA’s web data service, which can be obtained 
#' \href{https://urs.earthdata.nasa.gov/users/new}{here}.
#' 
#' When \code{extract.tif = TRUE}, the function decompresses the imagery. If
#' only a subset of bands is required, band names can be provided through the
#' \code{bFilter} argument. The band names are specified by “B” and the two-digit
#' band number (e.g., “B01”). Image decompression duplicates the information due
#' to the presence of both, compressed and decompressed images. Set 
#' \code{raw.rm = TRUE} to remove former ones.
#'
#' @param searchres the output from the \code{\link{modSearch}} function.
#' @param username NASA’s `EarthData' username.
#' @param password NASA’s `EarthData' password.
#' @param AppRoot the directory where the images will be saved.
#' @param nattempts the number of attempts to download an image in case it
#' becomes corrupted.
#' @param raw.rm logical argument. If \code{TRUE}, removes the raw images.
#' @param extract.tif logical argument. If \code{TRUE}, extracts all the layers
#' from hdf files and saves them as GTiff.
#' @param verbose logical argument. If \code{TRUE}, the function prints running stages and warnings.
#' @param overwrite logical argument. If \code{TRUE}, overwrites the existing
#' images with the same name.
#' @param ... argument for nested functions:
#'  \itemize{
#'        \item \code{dates} a vector with the capturing dates being considered
#'   for downloading.
#'        \item \code{bFilter} a vector with the bands to be extracted when \code{extract.tif=TRUE}. If not
#'   supplied, all bands are extracted.
#' }
#' @return this function does not return anything. It saves the imagery as
#' `hdf’ (and GTiff files) in a folder called `raw’ (`tif’) in the
#'  \code{AppRoot} directory.
#' @examples
#' \dontrun{
#' # load a spatial polygon object of Navarre
#' data(ex.navarre)
#' sres <- modSearch(product = "MYD13A2",
#'                   startDate = as.Date("01-01-2011", "%d-%m-%Y"),
#'                   endDate = as.Date("31-12-2013", "%d-%m-%Y"),
#'                   collection = 6,
#'                   extent = ex.navarre)
#' head(sres)
#' # download the first image in sres
#' wdir <- file.path(tempdir(),"Path_for_downloading_folder")
#' print(wdir)
#' wdir.mod <- file.path(wdir,"Modis","MYD13A2")
#' wdir.mod.hdf <- file.path(wdir.mod,"hdf")
#' modDownload(mList[1], 
#'             username = "username", 
#'             password = "password",
#'             AppRoot = wdir.mod.hdf)
#' # download all images in mList
#' modDownload(sres, 
#'             username = "username", 
#'             password = "password",
#'             AppRoot = wdir.mod.hdf)
#' }
modDownload<-function(searchres, 
                      AppRoot, 
                      username = NULL,
                      password = NULL,
                      nattempts=5,
                      verbose=FALSE,
                      extract.tif=FALSE,
                      overwrite=FALSE,
                      raw.rm=FALSE,
                      ...){
  if(class(searchres)!="modres"){stop("A response from modis search function is needed.")}
  searchres<-searchres$hdf
  arg<-list(...)
  if(is.null(username)|is.null(password)){
    stop("Username and/or password not defined!")
  }
  if("dates"%in%names(arg)){searchres<-searchres[modGetDates(searchres)%in%arg$dates]}
    
  downdir<-file.path(AppRoot,"hdf")
  tiffdir<-file.path(AppRoot,"tif")
  if(extract.tif)
    dir.create(tiffdir,recursive=TRUE,showWarnings = FALSE)
  natps<-0
  dir.create(downdir,recursive = TRUE,showWarnings = FALSE)
  message(paste0("Downloading the images in: ",downdir))
  for(s in searchres){
    recursiveModDownload(s=s,
                         username=username,
                         password=password,
                         downdir=downdir,
                         tiffdir=tiffdir,
                         verbose=verbose,
                         extract.tif=extract.tif,
                         nattempts=nattempts,
                         natps=0,
                         raw.rm=raw.rm,
                         ...)
  }
  if(extract.tif){
    message(paste0("The images have been downloaded and saved on HDD. \nFile path: ",tiffdir))
  }else{
    message(paste0("The images have been downloaded and saved on HDD. \nFile path: ",downdir))
  }
  
}

recursiveModDownload<-function(s,username,password,downdir,tiffdir,verbose,nattempts,extract.tif,natps,raw.rm=FALSE,...){
  tryCatch(
    {
      mod_Download(s,username,password,AppRoot=downdir)
      if(extract.tif){
        if(verbose){message(paste0("Extracting ",file.path(downdir,basename(s))," to dir ",tiffdir))}
        modExtractHDF(file.path(downdir,basename(s)),AppRoot=tiffdir,verbose=verbose,...)
        if(raw.rm){
          file.remove(file.path(downdir,basename(s)))
        }
      }
    },
    error=function(cond) {
      if(grepl("Operation was aborted",cond)){stop(cond)}
      message(paste0(cond,"\n"))
      file.remove(file.path(downdir,basename(s)))
      if(natps<nattempts){
        message("Error downloading the image, trying again...")
        recursiveModDownload(s=s,
                             username=username,
                             password=password,
                             downdir=downdir,
                             tiffdir=tiffdir,
                             verbose=verbose,
                             nattempts=nattempts,
                             extract.tif=extract.tif,
                             natps=natps+1,
                             raw.rm=raw.rm,
                             ...)
      }else{
        message(paste0("No way for downloading ",basename(s), " image, skipping..."))
      }
    })
}

mod_Download<-function(searchres, AppRoot, username = NULL,password = NULL,overwrite=FALSE,...){
  arg<-list(...)
  if(is.null(username)|is.null(password)){
    stop("Username and/or password not defined!")
  }
  if("dates"%in%names(arg)){searchres<-searchres[modGetDates(searchres)%in%arg$dates]}
  
  AppRoot<-pathWinLx(AppRoot)
  dir.create(AppRoot,showWarnings = FALSE,recursive = TRUE)
  
  for(l in searchres){
    if(file.exists(paste0(AppRoot,"/",basename(l)))&&overwrite){
      file.remove(paste0(AppRoot,"/",basename(l)))
    }

    if(!file.exists(paste0(AppRoot,"/",basename(l)))){
      c.handle = new_handle()
      handle_setopt(c.handle,
                    referer=paste0("https://",domain(l),"/"),
                    useragent = getRGISToolsOpt("USERAGENT"),
                    followlocation = TRUE ,
                    autoreferer = TRUE ,
                    username=username,
                    password=password)
      message(paste0("Downloading ",basename(l)," image."))
      curl_download(l, destfile=paste0(AppRoot,"/",basename(l)),handle = c.handle)
    }else if(overwrite){
      c.handle = new_handle()
      handle_setopt(c.handle,
                    referer=paste0("https://",domain(l),"/"),
                    useragent = getRGISToolsOpt("USERAGENT"),
                    followlocation = TRUE ,
                    autoreferer = TRUE ,
                    username=username,
                    password=password)
      file.remove(paste0(AppRoot,"/",basename(l)))
      message(paste0("Downloading ",basename(l)," image."))
      curl_download(l, destfile=paste0(AppRoot,"/",basename(l)),handle = c.handle)
    }else{
      message("File already exists.")
    }
  }
}
spatialstatisticsupna/RGISTools documentation built on Feb. 21, 2023, 12:01 a.m.