# Author: Matteo Mattiuzzi, matteo.mattiuzzi@boku.ac.at
# Date: August 2011
# Licence GPL v3
# product="MOD13Q1"; collection=NULL; server="LPDAAC"; begin=NULL; end=NULL; forceCheck=FALSE; wait=0; stubbornness=1
getStruc <- function(product, collection=NULL, server=getOption("MODIS_MODISserverOrder")[1], begin=NULL, end=NULL, forceCheck=FALSE, wait=1, stubbornness=10)
{
server <- toupper(server)[1]
if(!server %in% c("LPDAAC","LAADS","NSIDC"))
{
stop("getStruc() Error! Server must be or 'LPDAAC' or 'LAADS'")
}
opts <- combineOptions()
sturheit <- stubborn(level=stubbornness)
#########################
# Check Platform and product
product <- getProduct(x=product,quiet=TRUE)
# Check collection
if (!is.null(collection))
{
product$CCC <- getCollection(product=product,collection=collection)
}
if (length(product$CCC)==0)
{
product$CCC <- getCollection(product=product) # if collection isn't provided, this gets the newest for the selected products.
}
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"
if (is.na(info))
{
getIT <- TRUE
} else
{
lastcheck <- as.Date(strsplit(basename(info),"\\.")[[1]][4],"%Y%j")
output$dates <- na.omit(as.Date(read.table(info,stringsAsFactors=FALSE)[,1]))
if (max(output$dates,na.rm=TRUE) > dates$end)
{
getIT <- FALSE
} else if (lastcheck < as.Date(todoy,"%Y%j"))
{
getIT <- TRUE
} else
{
getIT <- FALSE
}
}
if (getIT | forceCheck)
{
if (!require(RCurl))
{
stop("You need to install the 'RCurl' package: install.packages('RCurl')")
}
lockfile <- paste0(opts$auxPath, basnam,".lock")[[1]]
if(file.exists(lockfile))
{
if(as.numeric(Sys.time() - file.info(lockfile)$mtime) > 10)
{
unlink(lockfile)
}
}
if(file.exists(lockfile))
{
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" | server=="NSIDC")
{
startPath <- strsplit(path$remotePath[[server]],"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(wait)
}
FtpDayDirs <- na.omit(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(wait)
} else
{
if(once & (30 > wait)) {cat("Server problems, trying with 'wait=",max(30,wait),"\n")}
once <- FALSE
Sys.sleep(max(30,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")
}
if(!exists("FtpDayDirs"))
{
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(!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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.