# ---------------------------------------------------------------------------------------------------------------------------------------------------------------- # # -------------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # File Name : as.path.r # # Last Updated Funclist : 08 Feb 2015, 5:14 AM (Sunday) # # # # Author Name : Rick Saporta # # Author Email : RickSaporta@gmail.com # # Author URL : www.github.com/rsaporta # # # # Packages Called : NA # # Packages Used via NS : NA # # # # -------------------------------------------------------------------------------------------------------------------------------------------------------------- # # # # unpath.expand ( file # # , possibleHomeDirs=paste0(c("/mnt/data/home", "/Users"), "/", system("whoami", TRUE)), ignore.default=FALSE ) # # path.unexpand ( path # # , user=system("whoami", TRUE), home=gsub("/$", "", path.expand(paste0("~", user))), alternate.home=paste0("/mnt/data/home/", user) ) # # as.path ( ..., ext="", ts=FALSE, fsep=.Platform$file.sep, expand=FALSE, verbose=TRUE # # , stop.if.bad.values=TRUE, showWarnings=TRUE, frmt.ts="_%Y%m%d_%H%M" # # , wd=if (exists("wrkDir")) wrkDir else getwd() ) # # cleanDotDotPath.split ( pathParts, fsep=.Platform$file.sep, expand=TRUE ) # # cleanDotDotPath.combine ( splat, fsep=.Platform$file.sep, expand=TRUE ) # # # # # # # # -------------------------------------------------------------------------------------------------------------------------------------------------------------- # # ---------------------------------------------------------------------------------------------------------------------------------------------------------------- # unpath.expand <- function(file, possibleHomeDirs=paste0(c("/mnt/data/home", "/Users"), "/", system("whoami", TRUE)), ignore.default=FALSE) { warning ("'unpath.expand' has been deprecated. Use path.unexpand() instead") if (!ignore.default) possibleHomeDirs <- unique(c(possibleHomeDirs, path.expand("~"))) ## if either file or possibleHomeDirs are empty, do nothing. if (!length(file) || !length(possibleHomeDirs)) return(file) ## Confirm that there are no funky chars properRegex(possibleHomeDirs, warnIfOffender=TRUE) ## clear off any trailing "/" possibleHomeDirs <- sub("/$", "", possibleHomeDirs) ## clean off file for (pat in unique(possibleHomeDirs)) file <- sub(paste0("^", pat), "~", file, ignore.case=FALSE, fixed=FALSE) file } path.unexpand <- function(path , user = system("whoami", TRUE) , home = gsub("/$", "", path.expand(paste0("~", user))) ## remove trailing slash , alternate.home = paste0("/mnt/data/home/", user) ) { ## Accomplishes two things. ## (1) replaces the '~' with '~username' ## (2) replaces the expanded path (eg /Users/username) with '~username' ## Check for path having been expanded in a different system and brought over via, say, readRDS() or bringme() if (!any(grepl(escapeRegEx(home), path)) && any(grepl(paste0("^", escapeRegEx(alternate.home)), path))) home <- alternate.home ## annoying pet peeve. Remove the extra slash form path.expand path <- gsub("//git", "/git", path) pat.home <- sprintf("(~|%s)(/|$)", home) repl.home <- sprintf("~%s\\2", user) return(sub(pat.home, repl.home, path)) } as.path <- function(..., ext="", ts=FALSE, fsep=sep, sep=.Platform$file.sep, expand=FALSE, verbose=TRUE , stop.if.bad.values=TRUE, showWarnings=TRUE, frmt.ts="_%Y%m%d_%H%M", wd=if(exists("wrkDir")) wrkDir else getwd() , show.warnings="DEPRECATED") { # concatenates the `...` into a valid path, accounting for extra slashes and dot-dot's ## ## Depends on: cleanDotDotPath.split() & cleanDotDotPath.combine() ## deprecated show.warnings for showWarnings if (!missing(show.warnings)) { if (!missing(showWarnings)) stop ("show.warnings has been deprecated -- it appears both 'show.warnings' and 'showWarnings' has been set") showWarnings <- show.warnings warning ("'show.warnings' has been deprecated -- use 'showWarnings' instead") } if (is.null(ext)) ext <- "" # grab the dots, remove any null values. dots <- lapply(list(...), as.character) dots <- dots[sapply(dots, length)>0] if (!length(dots)) { if (showWarnings) warning("No values sent to create a path or filename from. Returning ", ifelse(all(ext==""), "''.", paste0(" simply the value of `ext`='", paste(ext, collapse=", "), "'.")) ) return(ext) } # after removing specific NULL values, etc, we may still have lists or vectors that have odd values inside. We may also have NAs if (stop.if.bad.values || showWarnings) { alldots <- unlist(dots, recursive=TRUE) whichbad <- sapply(alldots, function(x) is.null(x) || is.na(x) || length(x) == 0 || nchar(x) == 0) if (any(whichbad)) { # if the only bad value is the last one, it will be treated as a value that should be dropped if (!any(head(whichbad, -1)) && length(alldots)>1) { # if not any of the first ones, alldots <- head(alldots, -1) } else { msg <- paste("Some values sent to `as.path` are peculiar.\n The suspicious values are the following: \n\t", pasteQ(alldots[whichbad], wrap=""), "\n") if (stop.if.bad.values) stop(msg) warning(msg) } } } ## If first argument starts with "http" or "ftp" and `fsep` hasn't been explicitly set, ## Then fsep should be "/". if(any(grepl("^(http|ftp)", as.character(dots[[1]]))) && missing(fsep)) fsep <- "/" # error check if (any(grepl("^/~", dots[[1]]))) stop ("Path cannot start with `/~`\nDid you mean to use simply `~` ?") ## ending in a slash (ie a folder) and ext not being NULL makes no sense ## Not issuing a warning, because sometimes as.path might be deep enough that warnings are suppressed and bugs missed if (grepl(paste0(fsep, "\\.{0,2}$"), tail(dots, 1)) && !is.null(ext) && nchar(ext)) stop ("'ext' is NOT blank, but as.path would resolve to a folder name. Nothing to append ext to.") ## Debugging browser(expr=inDebugMode(c("as.path", "path")), text="in as.path() in the middle") ## if dot[[1]] is a simple "." or "./" replace it with wd dots[[1]] <- sub(sprintf("^\\.(%s|$)", fsep), paste0(wd, "\\1"), dots[[1]]) ## If starts with "..", append wd ahead of it. as in `as.path("..", subdir)` # note : `dotdot` refers to folder level `/../subdir` # `dots` refers to R's ellipsis (...) argument pat.dotdothead <- sprintf("^\\.\\.(%s|$)", fsep) if ( any( {wh.dotdot <- grepl(pat.dotdothead, dots[[1]])} )) { # if the first element is not a vector, we can just append the wd to the list and proceed as normal if (length(dots[[1]]) == 1) dots <- c(dirname(wd), sub(pat.dotdothead, "", dots)) else # if however, it is a vector, we need to append only to appropriate elements. # Furthermore, to preserve vectorization capabilities, we need to flatten to a single string, each element within dots dots[[1]][wh.dotdot] <- as.path(dirname(wd), dots[[1]][wh.dotdot]) } ## If starts with fsep, we will preserve it. # OLD 20141019 : startWith <- ifelse(substr(dots[[1]], 1, 1) == fsep, fsep, "") startWith <- ifelse(substr(dots[[1]], 1, 1) == fsep, fsep, "") # Clean up the input (removing superfluous slashes at head or tail of string) cleaned <- lapply(dots, function(x) { # remove any leading slashes x <- ifelse(substr(x, 1, 1) == fsep, substr(x, nchar(fsep)+1, nchar(x)), x) # remove any trailing slashes lng <- nchar(x) x <- ifelse(substr(x, lng, lng) == fsep, substr(x, 1, lng-1), x) # return x to cleaned x }) ## remove ending or middle "just a dot", ie "/./" "/.$" NOT: "^./" cleaned <- lapply(cleaned, gsub, pat=sprintf("%s\\.(%1$s|$)", fsep), repl=fsep) ## TODO: The first `identical` was to prevent some edge case where an element in `cleaned` was blank ## currently, I cannot identify such a case. If found, document it. ## Note that the second `identical` is to remove any `""` so that we dont get `folder//folder/file` as are value cleaned <- cleaned[!sapply(cleaned, function(x) identical(nchar(x), integer(0)) || identical(nchar(x), 0L))] L.cl <- length(cleaned) ## Add timestamp if (ts) cleaned[[L.cl]] <- timeStamp(cleaned[[L.cl]], frmt=frmt.ts, sep="") # append '.ext' to last item if (!is.na(ext) && !ext=="") cleaned[[L.cl]] <- paste0(cleaned[[L.cl]], ".", gsub("^\\.", "", ext)) # checking for '..' ie: "~/git/" + "../out" ==> "~/out" ## unescaped patterns are either "^../" or "/../" or "/..$" or "^..$" pat.dotdot <- sprintf("(^|%s)\\.\\.(%s|$)", fsep, fsep) # if (any ( grepl("\\.\\.", cleaned) )) { if ( any( grepl(pat.dotdot, cleaned)) ) { return(cleanDotDotPath.split( c(startWith, cleaned), fsep=fsep, expand=expand)) } # else putTogether <- do.call(file.path, c(cleaned, fsep=fsep)) putTogether <- paste0(startWith, putTogether) if (!expand) return(putTogether) return(path.expand(putTogether)) } # TEST CASES: # as.path("/", NULL, "file", ext=".txt") # /file.txt # as.path("./", NULL, "file", ext=".txt") # ./file.txt # as.path("/", "/", NULL, NULL, NULL, NULL, "file", ext=".txt") # /file.txt # # as.path("/", "../", "file") # as.path("/", "folder1", "folder2", "folder3", "../../", "file") # as.path("/", "folder1", "folder2", "folder3", "../../../", "file") # as.path("/", "folder1", "folder2", "folder3", "../../../../", "file") # as.path("folder1", "folder2", "folder3", "../../", "file") # as.path("folder1", "folder2", "folder3", "../../../", "file") # as.path("folder1", "folder2", "folder3", "../../../../", "file") # as.path("folder1", "folder2", "folder3", "../../../../../", "file") cleanDotDotPath.split <- function(pathParts, fsep=.Platform$file.sep, expand=TRUE) { ## PURPOSE: Combine pathParts by taking into account `../` ## eg, if the pathParts is: # list("~/git/nbs", "../../../Shared/Adobe") # output should be: # "/Users/Shared/Adobe" # # pathParts: A list of path-like objects that will be concatenated into a single path string # If it is not a list, it will be coerced into one. # fsep : a character representing the seaparator between path parts. ie, "/" or "\\" # expand : If T, "~" will be expanded, normally to "/Users/usrName/" or similar, as per system # If F, path may be expanded anyway, if the amount of ".."'s require it. # expand "~usr/" if (expand) pathParts <- lapply(pathParts, path.expand) # pathParts should be a list. Coerce if it isn't if (!is.list(pathParts)) pathParts <- as.list(pathParts) # first paste the multi pieces together then split on fsep putTogether <- do.call(file.path, c(pathParts, fsep=fsep)) ## if expand is FALSE, and startWith == "" (in as.path()), ## then putTogether will start with /~/ .. ## We can change startWith to NULL in as.path, but this would kill vectorization ## Instead, we just check for it here and remove it putTogether <- gsub("^/~/", "~/", putTogether) ## Now split it up piece by piece the put together splats <- strsplit(putTogether, fsep) ## note that splats is a LIST of vector(s). For each element (group of path) combine into its own path if (length(splats) == 1) return(cleanDotDotPath.combine(splats[[1]], fsep=fsep, expand=expand)) return(sapply(splats, cleanDotDotPath.combine, fsep=fsep, expand=expand)) } cleanDotDotPath.combine <- function(splat, fsep=.Platform$file.sep, expand=TRUE) { if (is.list(splat)) stop ("'splat' in cleanDotDotPath.combine should not be a list.\nHINT: use lapply()") # check for superfluous "", which came from 'dir1//dir2.' # These should be ignored and hence removed # However if splat[1] is "", this came from '/dir1' and should be preserved if (any(splat[-1] == "")) splat <- c(splat[[1]], splat[-1][!splat[-1]==""] ) # if (expand) { # splat.splat <- # splat <- unlist(strsplit(path.expand(splat), fsep)) ## note that the string split will lose the initial "" but will gain a similar one from the first "/" from path.expand("~") # } # now each element in spat is a single directory or a dotdot # identify which are the dotdots. isdotdot <- splat == ".." # check if there are more dotdot's than folders before it. eg: # FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE # "~" "git" "nbs" ".." ".." ".." "Shared" "Adobe" if (any(toroot <- cumsum(isdotdot) >= cumsum(!isdotdot))) { ## TODO: This might be incorrect for as.path("..", subdir) # if we hadn't expanded, rerun the split function, this time with expand being TRUE if (!expand) { ## NOTE TO SELF, this might hit an infinite loop if hits a bug. return(cleanDotDotPath.split(splat, fsep=fsep, expand=TRUE)) } # otherwise.. # the first of the "too many dots" is the new root root <- min(which(toroot)) # keep only those elements of splat after the new root. # adding in `""` which signifies "/" when pasted back splat <- c("", tail(splat, -root)) # re-run this function from the new root return(cleanDotDotPath.combine(splat, fsep=fsep, expand=expand)) } ## ELSE: # for each index of dotdot, we are going to remove the index of the dir # that is "right before" it, ie the max of the indecies less than it areDots <- which(isdotdot) # these are the indecies to the dots areDirs <- which(!isdotdot) # these are the indecies to the directories ## Note that areDirs is specifically the values which are NOT dot ## thus, this covers "git" "orch" ".." ".." "src" ## AND "git" ".." "orch" ".." "src" <~~~ Although, why would one do this? ## ## for each dot, remove from areDirs, the largest index smaller than dot for (dot in areDots) areDirs <- setdiff(areDirs, which.max(areDirs[areDirs < dot]) ) # replace splat with only the indecies being kept. The `as.list` is for the `do.call` splat <- as.list(splat[areDirs]) # paste it back together with fsep return(do.call(file.path, c(splat, fsep=fsep)) ) }