# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  sinkOn.r                                                                               #
  #           Last Updated Funclist  :  19 Feb 2015,  1:33 PM (Thursday)                                                       #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   sinkOn             ( filename=newLogFile(), append=FALSE, split=FALSE, subl=FALSE, zarchive.old.files=TRUE               #
  #                        , verbose=TRUE )                                                                                    #
  #   sinkOff            ( filename, verbose=TRUE )                                                                            #
  #   sublsink           ( filename=getOption("sink")$filename )                                                               #
  #   isSinkOn           (  )                                                                                                  #
  #   newLogFile         ( name=NULL, ext="logr", dir=(if (exists("logDir")) logDir else getwd()), ts=timeStamp()              #
  #                        , name.postfix="" )                                                                                 #
  #   getSinkFile        (  )                                                                                                  #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

## TODO:  Note that sink(type="output") can get piled on, so that options("snk") used here is not quite accurate. 
##      have a look at sink.number
##        eg:       connex.msg <- sink.number(type = "message")
##        eg:       connex.out <- sink.number(type = "output")
##

showSink <- function(file=getOption("sink")$filename)  {
  # if (!is.character(file))
  #  .... I was going to put a substitute here, but not needed

  if (isErr(file) || is.null(file)) {
    stop ("file is NULL (or errored) -- probably means that no sinkfile option set", if (exists("logDir")) paste("\n\nHINT: FILES IN logDir ARE\n", pasteQ(w="", dir(logDir))) )
  }

  file <- trim(file)
  ## Turn off Sync
  sinkOff(verbose=FALSE)

  ## Check if there is a more recent file
  d <- dirname(file)
  b <- basename(file)
  other_like_files <- dir(d) %>% extract(removeText("_\\d{8}_\\d{4,6}\\.logr", b), .) %>% {.[. > b]}
  if (length(other_like_files))
    other_like_files %<>% as.path(d,.)

  if (!file.exists(file)) {
    file.zArchived <- as.path(dirname(file), "zArchive", basename(file))
    if (file.exists(file.zArchived)) {
      message("Looks like the file was zArchived, and it's current full path is \n\n  '", file.zArchived, "'\n")
      file <- file.zArchived
      Sys.sleep(0.8)
    } else if (length(getProjName()) && file.exists(log.p(file))) {
      file <- log.p(file)
    } else if (length(getProjName()) && file.exists(log.p("zArchive", file))) {
      file <- log.p("zArchive", file)
    } else
      stop ("file '", file, "'does not exist and was not found in the zArchive", if (length(other_like_files)) paste0("\n\nA more recent file exists however: \n  '", other_like_files, "'"))
  }
  catn(readLines(file), sep="\n", "")

  if (length(other_like_files))
    message("More recent logfile(s) exist(s):", paste("\n  ", path.unexpand(other_like_files)))
}


sinkOn <- function(filename=newLogFile(), append=FALSE, split=FALSE, subl=FALSE, zarchive.old.files=TRUE, width=getWidth(actual=TRUE), dont.shrink.width=TRUE, verbose=TRUE)  {

  if (width != getWidth(actual=TRUE)) {
    verboseMsg(verbose, "Setting width")
    setWidth(n=width, dont.shrink=dont.shrink.width)
  }

  if (verbose)
    message("All subsequent output following this will be going to \n    ", filename, "\n")

  ## Create if not exist
  folder <- dirname(filename)
  dir.create(folder, showWarnings=FALSE, recursive=TRUE)
  system(sprintf("touch %s", shellClean(filename)))

  if (isTRUE(zarchive.old.files)) {
    try({
      zarch.folder <- as.path(folder, "zArchive")
      dir.create(zarch.folder, showWarnings=FALSE, recursive=TRUE)
      files.to.zarch <- dir(folder, full=FALSE)
      # filename.nodate <- gsub("(.*)(_2\\d{7}_\\d{4,6})(\\..{3,})", "\\1", basename(filename))
      # pat.filename <- paste0("^", escapeRegEx(filename.nodate), "_\\d{6,8}_\\d{4,6}.*")

      pat.filename <- 
        basename(filename) %>% 
        gsub("(.*)(_2\\d{7}_\\d{4,6})(\\..{3,})", "\\1", .) %>%
        escapeRegEx %>%
        paste0("^", ., "_\\d{6,8}_\\d{4,6}.*")

      files.to.zarch <- extract(pat.filename, files.to.zarch)
      files.to.zarch <- setdiff(files.to.zarch, basename(filename))
      if (length(files.to.zarch))
        file.rename(as.path(folder, files.to.zarch), as.path(zarch.folder, files.to.zarch) )
    })
  }


  fcon <- file(filename, open="at")
  sink(file=fcon, append=append, split=split, type="output")
  sink(file=fcon, append=append, split=split, type="message")

  verboseMsg(TRUE, pasteR(62), "\nsink() diverted to this file, \"", filename, "\"", time=TRUE, endl=2, sep="")

  if (subl)
    sublsink(filename)

  ret <- list(filename=filename, fcon=fcon, is.on=TRUE)
  options("sink" = ret)
  return(invisible(ret))
}

sinkOff <- function(filename, verbose=TRUE) {
  opts <- getOption("sink")
  wasOn <- isSinkOn()

  if (!wasOn)
    verboseMsg(verbose, "If you are seeing this then sink was already off. Otherwsie, turning off now\n", pasteR(62), stampFirstLine=FALSE, time=TRUE, sep="")
  else 
    verboseMsg(verbose, "Turning off sink()\n", pasteR(62), stampFirstLine=FALSE, time=TRUE, sep="")

  suppressWarnings( sink(file=NULL, type="output")  )
  suppressWarnings( sink(file=NULL, type="message") )

  ## modify the options
  if ("fcon" %in% names(opts))
    opts[["fcon"]]  <- NULL
  opts[["is.on"]] <- FALSE
  options("sink" = opts)

  ## return only the filename
  ret <- if("filename" %in% names(opts)) opts$filename else NULL

  if (verbose)
    message("All further output is back to console.", if (wasOn && !is.null(ret)) paste0("Previous output is logged  \n    ", ret, "\n"))

  return(ret)
}


sublsink <- function(filename=getOption("sink")$filename) {
  if (!is.null(filename) && exists(".Pfm") && .Pfm == "Darwin")
    system(sprintf("subl %s", shellClean(filename)))
  else return(FALSE)
}

isSinkOn <- function() {
  opts  <- getOption("sink")
  is.on <- ("is.on" %in% names(opts)) && opts[["is.on"]]

  isTRUE(is.on) && !is.null(is.on)
}


newLogFile <- function(name=NULL, ext="logr", dir= (if (exists("logDir")) logDir else getwd()), ts=timeStamp(), name.postfix="" ) {

  if (is.null(ts) || identical(ts, FALSE))
    ts <- ""
  if (isTRUE(ts))
    ts <- timeStamp()

  ## For Blank names use the proj & subproj. Force a timestamp
  if (is.null(name)) {
    name <- c(getProjName(), getSubProj())

    ## if blank, use the following
    if (!any(nchar(name)>0))
      name <- "Rlogfile"

    ## force a time stamp if new log file
    if (!nchar(ts))
      ts <- timeStamp()
  }

  name <- c(name, ts, name.postfix)
  name <- name[nchar(name)>0]
  name <- pasteC(name, C="_")

  logfile <- as.path(dir, name, ext=ext)
  dir.create(dirname(logfile), showWarnings=FALSE, recursive=TRUE)
  system(sprintf("touch %s", shellClean(logfile)))
  return(logfile)
}

getSinkFile <- function() {
  opts <- getOption("sink")

  if (is.null(opts)) {
    warning ("No 'sink' options set.  Did you mean to call newLogFile() instead? ")
    return(opts)
  }

  filename <- opts$filename
  is.on <- isTRUE(opts$is.o)
  attr(filename, "is.on") <- is.on
  return(filename)
}

getLastSinkFileFromDisk <- function(name, dir= (if (exists("logDir")) logDir else getwd()), ext="logr") {
  pat <- paste0(name, ".*", ext, "$")
  dir %>% dir(pattern=pat, full=TRUE) %>% sort %>% tail(1)
}