R/ftp-tools.R

Defines functions recupPrevi listPrevi deposePrevi

Documented in deposePrevi listPrevi recupPrevi

##' Depot de fichier sur le Ftp Previ
##' 
##' Dépose un fichier sur le serveur Ftp d'EDF dans le répertoire
##' cible fourni en argument.
##' 
##' @param file le chemin du fichier à déposer sur le serveur Ftp.
##' @param target le chemin, sur le serveur Ftp, du répertoire cible 
##' de  dépose des fichiers. Par défaut, les fichiers sont déposées 
##' dans le réportoire \samp{"previ"}. 
##' 
##' @return \command{deposePrevi} retourne une valeur logique indiquant 
##' si le succès du dépôt, ainsi que les log du serveur Ftp dans 
##' l'attribut \var{message}.   
##' 
##' @author Thomas Esclaffer \email{[email protected]@edf.fr}
##' @export 
deposePrevi <- 
  function(file, target="previ") 
  {
    TMP <- dirname(file)
    FIC <- basename(file)
    target <- gsub('\\',"/", target, fixed=TRUE)
    
    if (.Platform$OS.type=="windows") {
      ## Systeme windows
      CMD <- tempfile(fileext = "_ftp.cmd") 
      cat("open ftp.edf.fr", "ftpdtg", "dtg1recep",
          sprintf("cd %s", target), "binary", sprintf("lcd %s", TMP),
          sprintf("put %s", FIC), "bye", sep="\n", 
          file=CMD)
      chk <- try(system(sprintf("ftp -i -s:%s",CMD), intern=TRUE))
    } else {
      ## Systeme linux
      CMD <- tempfile(fileext = "_ftp.sh") 
      cat("ftp -n ftp.edf.fr <<EOF", "user ftpdtg dtg1recep",
          sprintf("cd %s", target), "binary", sprintf("lcd %s", TMP),
          sprintf("put %s", basename(FIC)), "bye","EOF", sep="\n", 
          file=CMD)
      chk <- try(system(sprintf("sh %s", CMD), intern=TRUE))
    } 
    Ok <- any(grepl("^5?0 ", chk))
    Ok <- (any(grepl("CWD command successful", chk)) 
           && any(grepl("CWD command successful", chk)))
    structure(Ok, message=chk)
  }

##' Liste le contenu d'une archive Ftp 
##' 
##' \command{listPrevi} liste le contenu d'un répertoire donné 
##' sur le serveur Ftp des centre hydrométéorologiques. 
##' 
##' @param dir le répertoire cible sur le Ftp ; \samp{\dQuote{previ}} 
##' par défaut. 
##' @param full.names valeur logique indiquant si les chemins retournés 
##' sont complets ou relatifs (le nom du fichier seulement).   
##'   
##' @return La commande retourne l'inventaire des fichiers sout la forme 
##' d'un vecteur de chaîne de caractères.  
##'   
##' @author  Thomas Esclaffer \email{[email protected]@edf.fr}
##' @export
listPrevi <- 
  function(dir="previ", pattern=NULL, full.names=TRUE) 
  {
    
    if (.Platform$OS.type=="windows") {
      ## Systeme windows
      CMD <- tempfile(fileext = "_ftp.cmd") 
      cat("open ftp.edf.fr", "ftpdtg", "dtg1recep",
          sprintf("ls %s", dir), "bye", sep = "\n", 
          file = CMD)
      chk <- try(system(sprintf("ftp -i -s:%s",CMD), intern = TRUE))
    } else {
      ## Systeme linux
      CMD <- tempfile(fileext = "_ftp.sh") 
      cat("ftp -n ftp.edf.fr <<EOF", "user ftpdtg dtg1recep",
          sprintf("ls %s", dir), "bye","EOF", sep = "\n", 
          file = CMD)
      chk <- try(system(sprintf("sh %s", CMD), intern = TRUE))
    }  
    if (inherits(chk,"try-error")) 
      return(NA)
    else {
      files <- grep(sprintf("^%s",dir), chk, value=TRUE)
      files <- gsub("\r$","", files)
      if (!is.null(pattern)) 
        files <- grep(pattern, files, value = TRUE)
      if (length(files) < 1) return(NULL)
      if (full.names) 
        return(sprintf("ftp://ftpdtg:[email protected]/%s", files))
      else
        return(basename(files))
    }   
  }

##' @rdname deposePrevi 
##' @export
recupPrevi <- 
  function(file, ...) {
    fname <- file.path(tempdir(), basename(file))
    download.file(file, fname, ...)
    if (file.exists(fname)) return(fname)
    else NA
  }
coolTot/DtgRecup documentation built on May 12, 2017, 9:45 a.m.