MODIS/R/getStruc.R

# Author: Matteo Mattiuzzi, Florian Detsch
# Date: January 2018
getStruc <- function(product, collection = NULL, server = NULL, begin = NULL
                     , end = NULL, forceCheck = FALSE, ...)
{

  opts     <- combineOptions(...)
  sturheit <- stubborn(level = opts$stubbornness)

  if (is.null(server)) {
    server = opts$MODISserverOrder[1]
  }
  
  setPath(opts$auxPath, ask=FALSE)
  #########################
  # Check Platform and product
  inp = product
  product <- getProduct(x=product,quiet=TRUE)
  
  if (is.null(product)) {
    stop("Product '", inp, "' not recognized. See getProduct() for a list of "
         , "available products.")
  } else rm(inp)
    
  # Check collection
  product$CCC = getCollection(product = product, collection = collection
                              , forceCheck = forceCheck) 

  dates <- transDate(begin=begin,end=end)
  todoy <- format(as.Date(format(Sys.time(),"%Y-%m-%d")),"%Y%j")
  ########################
  
  # load aux
  col    <- product$CCC[[1]]
  basnam <- paste0(product$PRODUCT[1],".",product$CCC[[1]],".",server)
  info   <- list.files(path=opts$auxPath,pattern=paste0(basnam,".*.txt"),full.names=TRUE)[1]
  
  output <- list(dates=NULL,source=server,online=NA)
  class(output) <- "MODISonlineFolderInfo" 
  
  ## no local structure
  if (is.na(info)) {
    getIT <- TRUE
    online <- TRUE
    
  ## if local structure exists, check if  
  } else {
    lastcheck    <- as.Date(strsplit(basename(info),"\\.")[[1]][4],"%Y%j")
    output$dates <- na.omit(as.Date(read.table(info,stringsAsFactors=FALSE)[,1]))
    
    # end date in local structure is younger than user-defined end date
    if (max(output$dates,na.rm=TRUE) > dates$end) {
      getIT <- FALSE
      online <- "up-to-date"
      
    } else {
      
      # last check is older than 24 hours  
      if (lastcheck < as.Date(todoy,"%Y%j")) {
        getIT <- TRUE
        online <- TRUE
        
      # last check is not older than 24 hours, but end date in local structure 
      # is older than user-defined end date
      } else {
        getIT <- FALSE
        online <- "up-to-date"
      }
    }
  }
  
  if (getIT | forceCheck)
  {

    lockfile <- paste0(opts$auxPath, basnam,".lock")[[1]]
    if(file.exists(lockfile))
    {
      if(as.numeric(Sys.time() - file.info(lockfile)$mtime) > 10)
      {
        unlink(lockfile)
      } else
      {
        readonly <- TRUE
      }
    } else
    {
      zz <- file(description=lockfile, open="wt")  # open an output file connection
      write('deleteme',zz)
      close(zz)
      
      readonly <- FALSE
      on.exit(unlink(lockfile))
    }
    
    path <- genString(x=product$PRODUCT[1], collection=col, local=FALSE)
    
    cat("Downloading structure on '",server,"' for: ",product$PRODUCT[1],".",col,"\n",sep="")
    
    if(exists("FtpDayDirs"))
    {
      rm(FtpDayDirs)
    }
    
    if (server=="LPDAAC")
    {
      startPath <- strsplit(path$remotePath$LPDAAC,"DATE")[[1]][1] # cut away everything behind DATE
      for (g in 1:sturheit)
      {
        cat("Try:",g," \r")
        FtpDayDirs <- try(filesUrl(startPath))
        cat("             \r")
        if(exists("FtpDayDirs"))
        {    
          break
        }
        Sys.sleep(opts$wait)
      }
      FtpDayDirs <- as.Date(as.character(FtpDayDirs),"%Y.%m.%d")
    } else if (server=="LAADS")
    {
      startPath <- strsplit(path$remotePath$LAADS,"YYYY")[[1]][1] # cut away everything behind YYYY
      opt <- options("warn")
      options("warn"=-1)
      rm(years)
      
      once <- TRUE
      for (g in 1:sturheit)
      {
        cat("Downloading structure from 'LAADS'-server! Try:",g,"\r")
        years <- try(filesUrl(startPath))
        years <- as.character(na.omit(as.numeric(years))) # removes folders/files probably not containing data
        
        if(g < (sturheit/2))
        {
          Sys.sleep(opts$wait)
        } else
        {
          if(once & (30 > opts$wait)) {cat("Server problems, trying with 'wait=",max(30,opts$wait),"\n")}
          once <- FALSE                        
          Sys.sleep(max(30,opts$wait))
        }
        if(exists("years"))
        {    
          break
        }
        cat("                                                      \r") 
      }
      options("warn"=opt$warn)
      
      Ypath <- paste0(startPath,years,"/")
      
      ouou <- vector(length=length(years),mode="list")
      for(ix in seq_along(Ypath))
      {
        cat("Downloading structure of '",years[ix],"' from '",server,"'-server.                        \r",sep="")
        ouou[[ix]] <- paste0(years[ix], filesUrl(Ypath[ix]))
      }
      cat("                                                                    \r")
      FtpDayDirs <- as.Date(unlist(ouou),"%Y%j")
      
    } else if (server == "NTSG") {
      
      startPath <- strsplit(path$remotePath$NTSG,"YYYY")[[1]][1] # cut away everything behind YYYY
      opt <- options("warn")
      options("warn"=-1)

      once <- TRUE
      for (g in 1:sturheit) {
        
        cat("Downloading structure from 'NTSG'-server! Try:", g, "\n")
        years <- try(filesUrl(startPath), silent = TRUE)
        
        if (!inherits(years, "try-error")) {
          years_new <- gsub("^Y", "", years)
          break
          
        } else {  
          
          if (g < (sturheit/2)) {
            Sys.sleep(opts$wait)
          } else {
            if (once & (30 > opts$wait)) {
              cat("Encountering server problems, now trying with 'wait = 30'...\n")
            }
            once <- FALSE                        
            Sys.sleep(max(30,opts$wait))
          }
        }
      }
      options("warn"=opt$warn)
      
      if (product$PRODUCT != "MOD16A3") {
        Ypath <- paste0(startPath,years,"/")
        
        ouou <- vector(length=length(years),mode="list")
        cat("Downloading structure from", years_new[1], "to", years_new[length(years_new)], "from", server, "file server.\n")
        for(ix in seq_along(Ypath))
        {
          ouou[[ix]] <- paste(years[ix], filesUrl(Ypath[ix]), sep = "/")
        }
        cat("                                                                    \r")
        FtpDayDirs <- as.Date(unlist(ouou),"Y%Y/D%j")
      
      ## if product is 'MOD16A3', no daily sub-folders exist    
      } else {
        FtpDayDirs <- as.Date(paste(years_new, "12", "31", sep = "-"))
      }
    }
  }
  
  if(!exists("FtpDayDirs"))
  {

    if (online == "up-to-date") {
      cat("Local structure is up-to-date. Using offline information!\n")
      output$online <- TRUE
    } else {
      cat("Couldn't get structure from", server, "server. Using offline information!\n")
      output$online <- FALSE
    }
    
  } else if (FtpDayDirs[1]==FALSE)
  {
    cat("Couldn't get structure from", server, "server. Using offline information!\n")
    output$online <- FALSE
  } else
  {
    output$dates  <- FtpDayDirs
    output$online <- TRUE
  }
  
  if (exists("readonly")) {
    if(!readonly)
    {
      unlink(list.files(path=opts$auxPath, pattern=paste0(basnam,".*.txt"), full.names=TRUE))
      unlink(lockfile)
      write.table(output$dates, paste0(opts$auxPath,basnam,".",todoy,".txt"), row.names=FALSE, col.names=FALSE)  
    }
  }
  
  return(output)
}