Patch to make TSget still work with fame when loading data.table

patch_getfame.R

# getfame makes use of year from the tis package... 
# and thus conflicts with data.table... if the fame package would import instead of 
# depending on tis, everything would be solved... but it doesn't so this
# patch helps out. 
# Hat tip to Richie cotton for helping me out in this SO thread
# http://stackoverflow.com/questions/26462903/how-to-handle-masking-conflicts-in-r-package-the-right-way
# The remaining problem with Richie's ideas was that getfame contains numerous not exported 
# function so I had to hunt them down and add a fame:::functionname to it... 
# here's the patch, TSget won't fail after loading data.table. YAY!
assignInNamespace(
  "getfame", 
  function(sernames, db, connection = NULL, save = FALSE, envir = parent.frame(), 
           start = NULL, end = NULL, getDoc = TRUE) 
  {
    if (is.null(connection)) 
      dbPath <- fame:::getFamePath(db)
    else dbPath <- db
    if (!fame:::fameRunning()) 
      fameStart()
    dbKey <- fameDbOpen(dbPath, connection = connection)
    on.exit(fameDbClose(dbKey))
    n <- length(sernames)
    retList <- attList <- vector(n, mode = "list")
    if (is.null(rnames <- names(sernames))) 
      rnames <- sernames
    names(retList) <- rnames
    for (i in 1:n) attList[[i]] <- fameWhat(dbKey, sernames[i], 
                                            getDoc)
    status <- lapply(attList, "[[", "status")
    class <- lapply(attList, "[[", "class")
    dbName <- basename(gsub(".db", "", dbPath))
    if (any((status == 0) & ((class == fame:::fameClasses["formula"]) | 
                               (class == fame:::fameClasses["scalar"])))) {
      openCmd <- paste("open <access read> \"", dbPath, "\" as ", 
                       dbName, sep = "")
      if (!is.null(connection)) {
        connCmd <- "connect"
        service <- attr(connection, "service")
        host <- attr(connection, "host")
        username <- attr(connection, "user")
        password <- attr(connection, "password")
        if (!is.null(service)) 
          connCmd <- paste(connCmd, "to", service)
        if (!is.null(host)) 
          connCmd <- paste(connCmd, "on", host)
        connCmd <- paste(connCmd, "as Rconn")
        if (!is.null(username)) 
          connCmd <- paste(connCmd, "user", username)
        if (!is.null(password)) 
          connCmd <- paste(connCmd, "password", password)
        fameCommand(connCmd, silent = TRUE)
        on.exit(fameCommand("disconnect Rconn"), add = TRUE)
        openCmd <- paste(openCmd, "on Rconn")
      }
      fameCommand(openCmd, silent = TRUE)
      on.exit(fameCommand(paste("close", dbName), silent = TRUE), 
              add = TRUE)
      fameCommand("image date value \"<year><mz><dz>:<hhz>:<mmz>:<ssz>\"")
      fameCommand("image boolean auto")
      fameCommand("decimal auto")
    }
    for (i in 1:n) {
      retItem <- list()
      atts <- attList[[i]]
      sername <- sernames[i]
      if (atts$status == 0) {
        if (atts$class == fame:::fameClasses["scalar"]) {
          retItem <- fameCommand(paste("type", sername), 
                                 capture = TRUE)
          if (attr(retItem, "status") != 0) {
            cat("Problem reading", sername, "\n")
            retItem <- list()
            next
          }
          else retItem <- as.vector(retItem)
          isTi <- between(atts$type, 8, 228)
          if (isTi || atts$type == fameTypes["date"]) {
            retItem <- strptime(retItem, "%Y%m%d:%H:%M:%S")
            if (isTi) 
              retItem <- ti(retItem, tif = fame:::fameToTif(atts$type))
          }
          if (atts$type %in% fameTypes[c("boolean", "numeric", 
                                         "precision")]) {
            if (retItem == "NC") {
              if (atts$type == fameTypes["boolean"]) 
                retItem <- NA
              else retItem <- NaN
            }
            else {
              if (retItem %in% c("ND", "NA")) 
                retItem <- NA
              else retItem <- eval(parse(text = retItem))
            }
          }
          if (getDoc) {
            description(retItem) <- atts$des
            documentation(retItem) <- atts$doc
          }
        }
        else {
          if (atts$class == fame:::fameClasses["formula"]) {
            fameCommand(paste("-/", sername, " = ", dbName, 
                              "'", sername, sep = ""), silent = TRUE)
            fAtts <- atts
            atts <- fameWhat(0, sernames[i], getDoc)
            if (getDoc) {
              if (fAtts$des != "") 
                atts$des <- fAtts$des
              if (fAtts$doc != "") 
                atts$doc <- fAtts$doc
            }
          }
          if (atts$status != 0) {
            cat(paste("ERROR retrieving", sername, fameStatusMessage(atts$status)), 
                "\n")
          }
          else {
            if (atts$freq == 232) {
              if (between(atts$type, 8, 228)) {
                fameFreq <- atts$type
                atts$type <- 6
              }
              range <- atts$range
              obs <- range[3] - range[2] + 1
            }
            else {
              tif <- fame:::fameToTif(atts$freq)
              dbStart <- ti(c(atts$fyear, atts$fprd), tif)
              dbEnd <- dbStart + atts$obs - 1
              if (is.null(start)) 
                desiredStart <- dbStart
              else desiredStart <- ti(start, tif = tif)
              if (is.null(end)) 
                desiredEnd <- dbEnd
              else desiredEnd <- ti(end, tif = tif)
              actualStart <- max(dbStart, desiredStart)
              actualEnd <- min(dbEnd, desiredEnd)
              startYear <- as.integer(tis::year(actualStart))
              startPeriod <- as.integer(cycle(actualStart))
              obs <- as.integer(actualEnd - actualStart + 
                                  1)
              if (obs < 1) 
                next
              range <- fame:::fameRange(freq = atts$freq, startYear = startYear, 
                                        startPeriod = startPeriod, obs = obs)$range
            }
            z <- switch(as.character(atts$type), `1` = {
              .C("fameReadNumericSeries", status = integer(1), 
                 dbKey = atts$dbKey, name = atts$name, range = as.integer(range), 
                 data = double(obs), PACKAGE = "fame")
            }, `5` = {
              .C("fameReadPrecisionSeries", status = integer(1), 
                 dbKey = atts$dbKey, name = atts$name, range = as.integer(range), 
                 data = double(obs), PACKAGE = "fame")
            }, `3` = {
              .C("fameReadIntegerSeries", status = integer(1), 
                 dbKey = atts$dbKey, name = atts$name, range = as.integer(range), 
                 data = logical(obs), PACKAGE = "fame")
            }, `6` = {
              .C("fameReadIntegerSeries", status = integer(1), 
                 dbKey = atts$dbKey, name = atts$name, range = as.integer(range), 
                 data = integer(obs), PACKAGE = "fame")
            }, `4` = {
              zz <- .C("fameGetStringLengths", status = integer(1), 
                       dbKey = atts$dbKey, name = atts$name, range = as.integer(range), 
                       lengths = integer(obs), PACKAGE = "fame")
              if (zz$status != 0) {
                cat(fameStatusMessage(z$status))
                break
              }
              maxlen <- max(3, max(zz$lengths) + 1)
              zzz <- .C("fameReadStringSeries", status = integer(1), 
                        dbKey = atts$dbKey, name = atts$name, range = as.integer(range), 
                        data = rep(blanks(maxlen), obs), strlength = as.integer(maxlen), 
                        PACKAGE = "fame")
              zzz$data <- stripBlanks(zzz$data)
              zzz
            }, {
              list(status = 16)
            })
            if (z$status == 0) {
              if (atts$freq == 232) {
                if (atts$type == 6) 
                  retItem <- fameDateToTi(z$data, fameFreq)
                else retItem <- z$data
                names(retItem) <- range[2]:range[3]
              }
              else {
                retItem <- tis(z$data, start = actualStart)
                if (atts$basis > 0) 
                  attr(retItem, "basis") <- c("daily", 
                                              "business")[atts$basis]
                if (atts$observ > 0) 
                  attr(retItem, "observed") <- c("beginnin", 
                                                 "ending", "averaged", "summed", "annualized", 
                                                 "formula", "high", "low")[atts$observ]
              }
              if (getDoc) {
                description(retItem) <- atts$des
                documentation(retItem) <- atts$doc
              }
            }
            else retItem <- list()
          }
        }
      }
      retList[[i]] <- retItem
    }
    retLengths <- lapply(retList, length)
    zz <- retList[retLengths > 0]
    if (save) {
      for (name in names(zz)) {
        assign(name, zz[[name]], envir = envir)
      }
      invisible(zz)
    }
    else return(zz)
  },
  "fame"
)