R/grassControl.R

Defines functions .in_osgeo4w_env .activate_osgeo4w_env findGRASS checkGisdbase setenvGRASSw searchGRASSX searchGRASSW paramGRASSw paramGRASSx searchGRASSW is_osgeo4w_env .get_GRASS_CACHE

Documented in findGRASS paramGRASSw paramGRASSx searchGRASSW searchGRASSX setenvGRASSw

.link2GI_cache <- new.env(parent = emptyenv())

.get_GRASS_CACHE <- function() {
  if (!exists(".GRASS_CACHE", envir = .link2GI_cache, inherits = FALSE)) {
    .link2GI_cache$.GRASS_CACHE <- new.env(parent = emptyenv())
  }
  .link2GI_cache$.GRASS_CACHE
}

is_osgeo4w_env <- function(root = NULL) {
  o <- Sys.getenv("OSGEO4W_ROOT")
  p <- Sys.getenv("PATH")
  has_bin <- nzchar(o) && grepl(gsub("\\\\", "/", file.path(o, "bin")), gsub("\\\\", "/", p), fixed = TRUE)
  list(
    in_env = nzchar(o) && has_bin,
    OSGEO4W_ROOT = o,
    has_bin_in_path = has_bin,
    root = root
  )
}


#' Search for valid GRASS GIS installations on Windows
#'
#' Searches for GRASS GIS installations on **Windows** using a *bounded* set of
#' plausible installation roots (no full-disk crawl). The function supports:
#' \itemize{
#'   \item OSGeo4W / QGIS-style layouts via \code{<root>/apps/grass/grass*/etc/VERSIONNUMBER}
#'   \item Standalone GRASS installs via \code{<Program Files>/GRASS GIS */etc/VERSIONNUMBER}
#'   \item Optional per-user OSGeo4W installs under
#'         \code{<USERPROFILE>/AppData/Local/Programs/OSGeo4W}
#' }
#'
#' The argument \code{DL} can be a full path or a Windows drive root
#' (e.g. \code{"C:"} or \code{"C:/"}). Drive roots are expanded to a fixed set of
#' candidate directories:
#' \code{OSGeo4W64}, \code{OSGeo4W}, \code{Program Files}, \code{Program Files (x86)}.
#'
#' @param DL Character. Search location or drive root on Windows.
#'   Accepts \code{"C:"}, \code{"C:/"}, or a concrete directory path.
#'   Backslashes are normalized to forward slashes.
#' @param quiet Logical. If \code{TRUE} (default), suppress informational messages.
#'
#' @return
#' Returns \code{FALSE} if no installation was detected.
#' Otherwise returns a \code{data.frame} with columns:
#' \describe{
#'   \item{instDir}{Root directory of the installation candidate.}
#'   \item{version}{Parsed version string (from \code{VERSIONNUMBER}) or \code{NA}.}
#'   \item{installation_type}{One of \code{"osgeo4w"}, \code{"qgis"}, \code{"standalone"}.}
#' }
#' The result is sorted by decreasing semantic version (unknown versions treated as \code{0.0.0}).
#'
#' @details
#' This function is intentionally conservative to remain fast and deterministic on
#' large Windows volumes. It does **not** recurse the entire drive.
#'
#' If multiple installations are present under the searched roots, all are returned.
#' Version parsing extracts the first \code{x.y[.z...]} pattern from the first line
#' of \code{VERSIONNUMBER}.
#'
#' @examples
#' \dontrun{
#' # Search from the C: drive root (bounded roots, no full-disk scan)
#' searchGRASSW("C:/", quiet = FALSE)
#'
#' # Search a concrete directory only
#' searchGRASSW("C:/OSGeo4W64", quiet = FALSE)
#'
#' # Drive letter without slash is accepted
#' searchGRASSW("C:", quiet = TRUE)
#' }
#'
#' @export
searchGRASSW <- function(DL = "C:/", quiet = TRUE) {
  
  .msg <- function(...) if (!isTRUE(quiet)) message(...)
  
  if (!identical(Sys.info()[["sysname"]], "Windows")) {
    stop("searchGRASSW() is Windows-only.")
  }
  
  # ------------------------------------------------------------
  # FIX 1: Windows drive semantics — MUST happen BEFORE normalizePath()
  # ------------------------------------------------------------
  DL <- gsub("\\\\", "/", DL)
  if (grepl("^[A-Za-z]:$", DL)) {
    DL <- paste0(DL, "/")
  }
  
  DL <- normalizePath(path.expand(DL), winslash = "/", mustWork = FALSE)
  
  if (is.na(DL) || !grepl("^[A-Za-z]:(/|$)", DL)) {
    return(FALSE)
  }
  
  is_drive_root <- grepl("^[A-Za-z]:(/)?$", DL)
  drive <- substr(DL, 1, 2)  # "C:"
  
  # ------------------------------------------------------------
  # Candidate roots (bounded, no full-disk crawl)
  # ------------------------------------------------------------
  candidates <- if (is_drive_root) {
    c(
      paste0(drive, "/OSGeo4W64"),
      paste0(drive, "/OSGeo4W"),
      paste0(drive, "/Program Files"),
      paste0(drive, "/Program Files (x86)")
    )
  } else {
    c(DL)
  }
  
  candidates <- unique(candidates)
  candidates <- candidates[dir.exists(candidates)]
  
  # ------------------------------------------------------------
  # FIX 2: deterministic per-user OSGeo4W
  # ------------------------------------------------------------
  up <- normalizePath(Sys.getenv("USERPROFILE"), winslash = "/", mustWork = FALSE)
  cand_user <- file.path(up, "AppData/Local/Programs/OSGeo4W")
  if (dir.exists(cand_user)) {
    candidates <- unique(c(candidates, cand_user))
  }
  
  if (length(candidates) == 0) {
    .msg("::: NO GRASS installation found: no plausible search roots exist on ", drive, "/")
    return(FALSE)
  }
  
  .read_version <- function(f) {
    x <- try(readLines(f, warn = FALSE), silent = TRUE)
    if (inherits(x, "try-error") || length(x) == 0) return(NA_character_)
    m <- regmatches(x[1], regexpr("[0-9]+(\\.[0-9]+)+", x[1]))
    if (length(m) == 0) NA_character_ else m
  }
  
  found <- list()
  
  # ------------------------------------------------------------
  # A) OSGeo4W / QGIS layout
  # ------------------------------------------------------------
  for (root in candidates) {
    
    apps_grass <- file.path(root, "apps", "grass")
    if (!dir.exists(apps_grass)) next
    
    grass_dirs <- list.dirs(apps_grass, full.names = TRUE, recursive = FALSE)
    grass_dirs <- grass_dirs[grepl("^grass[0-9]+", basename(grass_dirs), ignore.case = TRUE)]
    
    for (gd in grass_dirs) {
      vf <- file.path(gd, "etc", "VERSIONNUMBER")
      if (!file.exists(vf)) next
      
      instDir <- normalizePath(root, winslash = "/", mustWork = FALSE)
      
      installation_type <- "osgeo4w"
      if (grepl("/QGIS", instDir, ignore.case = TRUE)) {
        installation_type <- "qgis"
      }
      
      found[[length(found) + 1]] <- data.frame(
        instDir = instDir,
        version = .read_version(vf),
        installation_type = installation_type,
        stringsAsFactors = FALSE
      )
    }
  }
  
  # ------------------------------------------------------------
  # B) Standalone layout
  # ------------------------------------------------------------
  pf_roots <- intersect(
    c(paste0(drive, "/Program Files"), paste0(drive, "/Program Files (x86)")),
    candidates
  )
  
  for (root in pf_roots) {
    
    grass_pf <- list.dirs(root, full.names = TRUE, recursive = FALSE)
    grass_pf <- grass_pf[grepl("^GRASS GIS", basename(grass_pf), ignore.case = TRUE)]
    
    for (gd in grass_pf) {
      vf <- file.path(gd, "etc", "VERSIONNUMBER")
      if (!file.exists(vf)) next
      
      found[[length(found) + 1]] <- data.frame(
        instDir = normalizePath(gd, winslash = "/", mustWork = FALSE),
        version = .read_version(vf),
        installation_type = "standalone",
        stringsAsFactors = FALSE
      )
    }
  }
  
  if (length(found) == 0) {
    .msg("::: NO GRASS installation found at: '", DL, "'")
    .msg("::: NOTE: Avoid scanning full drive roots; install roots differ (OSGeo4W/QGIS/user-local).")
    return(FALSE)
  }
  
  out <- unique(do.call(rbind, found))
  
  suppressWarnings({
    vnum <- numeric_version(ifelse(is.na(out$version), "0.0.0", out$version))
    out <- out[order(vnum, decreasing = TRUE), , drop = FALSE]
  })
  
  if (!quiet) {
    message("::: Found ", nrow(out), " GRASS installation(s) derived from: '", DL, "'")
    print(out)
  }
  
  invisible(out)
}



#'@title Usually for internally usage, get 'GRASS GIS' and \code{rgrass} parameters on 'Linux' OS
#'@name paramGRASSx
#'@description Initialize and set up \code{rgrass}  for 'Linux'
#'@details During the rsession you will have full access to GRASS7 GIS via the \code{rgrass} wrapper. Additionally you may use also use the API calls of GRASS via the command line.
#'@param set_default_GRASS, default is NULL. will force a search for 'GRASS GIS' You may provide a valid combination as 
#'                                    c('/usr/lib/grass74','7.4.1','grass74')
#'@param MP, default is '/usr/bin'. mount point to be searched. 
#'@param quiet boolean, default is TRUE.  switch for suppressing console messages 
#'@param ver_select if TRUE you must interactively select between alternative installations
#'@keywords internal
#'
#' @examples
#' 
#' run = FALSE
#' if (run) {
#' # automatic retrieval of the GRASS environment settings
#' paramGRASSx()
#' 
#' 
#' # typical stand_alone installation
#' paramGRASSx('/usr/bin/grass72')
#' 
#' # typical user defined installation (compiled sources)
#' paramGRASSx('/usr/local/bin/grass72')
#' }
paramGRASSx <- function(set_default_GRASS = NULL, MP = "/usr/bin", ver_select = FALSE, quiet = TRUE) {
  
  if (ver_select == "T") ver_select <- TRUE
  if (ver_select == "F" && !is.numeric(ver_select)) ver_select <- FALSE
  
  if (Sys.info()["sysname"] == "Windows") {
    if (!quiet) {
      message("You are running Windows - Please choose a suitable searchLocation argument that MUST include a Windows drive letter and colon")
    }
    return(FALSE)  }
  
  # If we know nothing about grass paths we have to search
  if (is.null(set_default_GRASS)) {
    params_GRASS <- findGRASS(searchLocation = MP, quiet = quiet)
  } else {
    params_GRASS <- rbind.data.frame(set_default_GRASS)
    names(params_GRASS) <- c("instDir", "version", "installation_type")
  }
  
  # robust "found" check
  if (isFALSE(params_GRASS) || !is.data.frame(params_GRASS) || nrow(params_GRASS) < 1) {
    return(list(exist = FALSE))
  }
  
  # choose the desired installation depending on ver_select options
  if (nrow(params_GRASS) == 1) {
    
    gisbase_GRASS <- as.character(params_GRASS$instDir[[1]])
    
  } else if (nrow(params_GRASS) > 1 && is.numeric(ver_select) &&
             (ver_select > 0 && ver_select <= nrow(params_GRASS))) {
    
    if (!quiet) {
      cat("You have more than one valid GRASS version installed!\n")
      print(params_GRASS)
      cat("Selected version is: ", ver_select, "\n")
    }
    gisbase_GRASS <- as.character(params_GRASS$instDir[[ver_select]])
    
  } else if (nrow(params_GRASS) > 1 && !isTRUE(ver_select)) {
    
    # if ver_select is FALSE take the one with the highest version number
    v <- suppressWarnings(numeric_version(params_GRASS$version))
    idx <- which(v == max(v))[1]
    
    if (!quiet) {
      cat("You have more than one valid GRASS version installed!\n")
      cat("The latest installed version (", idx, ") has been selected \n")
      print(params_GRASS)
      cat("\n")
    }
    gisbase_GRASS <- as.character(params_GRASS$instDir[[idx]])
    
  } else {
    
    # ver_select == TRUE: interactively select
    cat("You have more than one valid GRASS version installed!\n")
    print(params_GRASS)
    cat("\n")
    ver <- as.numeric(readline(prompt = "Please select one:  "))
    gisbase_GRASS <- as.character(params_GRASS$instDir[[ver]])
  }
  
  grass <- list()
  grass$gisbase_GRASS <- gisbase_GRASS
  grass$installed <- params_GRASS
  grass$exist <- TRUE
  
  return(grass)
}



#'@title Usually for internally usage get 'GRASS GIS' and \code{rgrass} parameters on 'Windows' OS
#'@name paramGRASSw
#'@description Initialize the enviroment variables on a 'Windows' OS for using 
#'  'GRASS GIS' via \code{rgrass}
#'@details The concept is very straightforward but for an all days usage pretty
#'  helpful. You need to provide a \code{terra} or a \code{sf} object. The derived properties are used to initialize a temporary but static
#'  \href{https://CRAN.R-project.org/package=rgrass}{rgrass} environment. During the rsession you will have full access to
#'  GRASS both via the wrapper package as well as the command line. paramGRASSw initializes the usage of GRASS.
#'@param DL character search location default = \code{C:}
#'@param ver_select boolean default is FALSE. If there is more than one 'SAGA GIS' installation and \code{ver_select} = TRUE the user can select interactively the preferred 'SAGA GIS' version 
#'@param set_default_GRASS default = NULL forces a full search for 'GRASS GIS' binaries. You may
#'  alternatively provide a vector containing paths and keywords. c('C:/OSGeo4W64','grass-7.0.5','osgeo4w') is valid for a typical osgeo4w installation.
#'  
#'@param quiet boolean  switch for supressing console messages default is TRUE
#'@keywords internal
#'  
#' @examples
#' 
#' run = FALSE
#' if (run) {
#' # automatic retrieval of valid 'GRASS GIS' environment settings 
#' # if more than one is found the user has to choose.
#' paramGRASSw()
#'
#' # typical OSGeo4W64 installation
#' paramGRASSw(c('C:/OSGeo4','grass7.8','osgeo4W'))
#' }
paramGRASSw <- function(set_default_GRASS = NULL, DL = "C:/", ver_select = FALSE, quiet = TRUE) {
  
  if (ver_select == "T") ver_select <- TRUE
  if (ver_select == "F" && !is.numeric(ver_select)) ver_select <- FALSE
  
  if (Sys.info()["sysname"] == "Linux") {
    return(cat("You are running Linux - please choose a suitable searchLocation argument"))
  }
  
  # (R) set paths of 'GRASS' binaries depending on 'WINDOWS'
  if (is.null(set_default_GRASS)) {
    if (DL == "default" || is.null(DL)) DL <- "C:/"
    params_GRASS <- findGRASS(searchLocation = DL, quiet = quiet)
  } else {
    params_GRASS <- rbind.data.frame(set_default_GRASS)
    names(params_GRASS) <- c("instDir", "version", "installation_type")
  }
  
  # --- robust success check ---
  if (isFALSE(params_GRASS) || !is.data.frame(params_GRASS) || nrow(params_GRASS) < 1) {
    return(list(exist = FALSE))
  }
  
  # --- select version ---
  if (nrow(params_GRASS) == 1) {
    
    gisbase_GRASS <- setenvGRASSw(
      root_GRASS = params_GRASS$instDir[[1]],
      grass_version = params_GRASS$version[[1]],
      installation_type = params_GRASS$installation_type[[1]],
      quiet = quiet
    )
    
    grass_version <- params_GRASS$version[[1]]
    installation_type <- params_GRASS$installation_type[[1]]
    
  } else if (nrow(params_GRASS) > 1 && is.numeric(ver_select) &&
             (ver_select > 0 && ver_select <= nrow(params_GRASS))) {
    
    if (!quiet) {
      cat("You have more than one valid GRASS GIS version\n")
      print(params_GRASS)
      cat("You have selected version: ", ver_select, "\n")
    }
    
    gisbase_GRASS <- normalizePath(
      setenvGRASSw(
        root_GRASS = params_GRASS$instDir[[ver_select]],
        grass_version = params_GRASS$version[[ver_select]],
        installation_type = params_GRASS$installation_type[[ver_select]],
        quiet = quiet
      ),
      winslash = "/"
    )
    
    grass_version <- params_GRASS$version[[ver_select]]
    installation_type <- params_GRASS$installation_type[[ver_select]]
    
  } else if (nrow(params_GRASS) > 1 && !isTRUE(ver_select)) {
    
    # take the latest installed version (semantic version compare)
    v <- suppressWarnings(numeric_version(params_GRASS$version))
    idx <- which(v == max(v))[1]
    
    if (!quiet) {
      cat("You have more than one valid GRASS version installed!\n")
      cat("The latest installed version (", idx, ") has been selected \n")
    }
    
    gisbase_GRASS <- setenvGRASSw(
      root_GRASS = params_GRASS$instDir[[idx]],
      grass_version = params_GRASS$version[[idx]],
      installation_type = params_GRASS$installation_type[[idx]],
      quiet = quiet
    )
    
    grass_version <- params_GRASS$version[[idx]]
    installation_type <- params_GRASS$installation_type[[idx]]
    
  } else {
    
    # interactive selection
    cat("You have more than one valid GRASS GIS version\n")
    print(params_GRASS)
    cat("\n")
    ver <- as.numeric(readline(prompt = "Please select one:  "))
    
    gisbase_GRASS <- normalizePath(
      setenvGRASSw(
        root_GRASS = params_GRASS$instDir[[ver]],
        grass_version = params_GRASS$version[[ver]],
        installation_type = params_GRASS$installation_type[[ver]],
        quiet = quiet
      ),
      winslash = "/"
    )
    
    grass_version <- params_GRASS$version[[ver]]
    installation_type <- params_GRASS$installation_type[[ver]]
  }
  
  grass <- list()
  grass$gisbase_GRASS <- gsub("\\\\", "/", gisbase_GRASS)
  grass$version <- grass_version
  grass$type <- installation_type
  grass$installed <- params_GRASS
  grass$exist <- TRUE
  
  return(grass)
}





#' Search for valid GRASS GIS installations on Windows
#'
#' @param DL Character. Search root (e.g. `"C:/"`).
#' @param quiet Logical. Suppress messages.
#'
#' @return `FALSE` or a `data.frame` with columns `instDir`, `version`, `installation_type`.
#' @keywords internal
#' @export
searchGRASSW <- function(DL = "C:/", quiet = TRUE) {
  
  DL <- bf_wpath(DL)
  
  if (!quiet) {
    cat("\nsearching for GRASS installations - this may take a while\n")
    cat("For providing the path manually see ?searchGRASSW \n")
  }
  
  # save + restore options safely
  old_show_err <- getOption("show.error.messages")
  old_warn <- getOption("warn")
  on.exit({
    options(show.error.messages = old_show_err)
    options(warn = old_warn)
  }, add = TRUE)
  
  options(show.error.messages = FALSE)
  options(warn = -1)
  
  raw_GRASS <- try(system(paste0("cmd.exe /c WHERE /R ", DL, " ", "grass*.bat"), intern = TRUE), silent = TRUE)
  
  # restore warning display for subsequent logic/messages (on.exit will also restore)
  options(show.error.messages = TRUE)
  options(warn = 0)
  
  if (methods::is(raw_GRASS, "try-error") || length(raw_GRASS) == 0) {
    message("::: NO GRASS installation found at: '", DL, "'")
    message("::: NOTE:  Links or symbolic links like 'C:/Documents' are not searched...")
    return(FALSE)
  }
  
  # detect standard "not found" outputs
  not_found <- unique(
    grepl(raw_GRASS, pattern = "File not found") |
      grepl(raw_GRASS, pattern = "Datei nicht gefunden") |
      grepl(raw_GRASS, pattern = "INFORMATION:") |
      grepl(raw_GRASS, pattern = "FEHLER:") |
      grepl(raw_GRASS, pattern = "ERROR:")
  )
  
  if (isTRUE(not_found)) {
    message("::: NO GRASS installation found at: '", DL, "'")
    message("::: NOTE:  Links or symbolic links like 'C:/Documents' are not searched...")
    return(FALSE)
  }
  
  installations_GRASS <- lapply(seq_along(raw_GRASS), function(i) {
    
    batchfile_lines <- system(
      paste0("cmd.exe /C TYPE  ", utils::shortPathName(raw_GRASS[i])),
      ignore.stdout = FALSE,
      intern = TRUE
    )
    
    osgeo4w <- FALSE
    stand_alone <- FALSE
    root_dir <- ""
    ver_char <- NA_character_
    installerType <- NA_character_
    
    if (length(unique(grep("OSGEO4W", batchfile_lines, value = TRUE))) > 0) {
      osgeo4w <- TRUE
      stand_alone <- FALSE
    }
    
    if (length(unique(grep("NSIS installer", batchfile_lines, value = TRUE))) > 0) {
      osgeo4w <- FALSE
      stand_alone <- TRUE
    }
    
    if (osgeo4w) {
      
      bn <- basename(utils::shortPathName(raw_GRASS[i]))
      
      if (bn %in% c("grass78.bat", "grass79.bat", "grass83.bat")) {
        
        root_dir <- dirname(dirname(utils::shortPathName(raw_GRASS[i])))
        ver_char <- substr(bn, 6, 7)
        installerType <- "osgeo4W"
        
      } else {
        
        if (length(grep("PREREM~1", utils::shortPathName(raw_GRASS[i]))) == 0 &&
            length(grep("extrabin", utils::shortPathName(raw_GRASS[i]))) == 0) {
          
          root_dir <- unique(grep("OSGEO4W_ROOT", batchfile_lines, value = TRUE))
          if (length(root_dir) > 0) {
            root_dir <- substr(root_dir, gregexpr(pattern = "=", root_dir)[[1]][1] + 1, nchar(root_dir))
          }
          
          ver_char <- unique(grep("\\benv.bat\\b", batchfile_lines, value = TRUE))
          if (length(root_dir) > 0 && length(ver_char) > 0) {
            ver_char <- substr(ver_char, gregexpr(pattern = "\\grass-", ver_char)[[1]][1], nchar(ver_char))
            ver_char <- substr(ver_char, 1, gregexpr(pattern = "\\\\", ver_char)[[1]][1] - 1)
          }
        }
        
        installerType <- "osgeo4W"
      }
    }
    
    if (stand_alone) {
      
      root_dir <- unique(grep("set GISBASE=", batchfile_lines, value = TRUE))
      if (length(root_dir) > 0) {
        root_dir <- substr(root_dir, gregexpr(pattern = "=", root_dir)[[1]][1] + 1, nchar(root_dir))
      }
      
      ver_char <- root_dir
      if (length(root_dir) > 0) {
        ver_char <- substr(ver_char, gregexpr(pattern = "GRASS", ver_char)[[1]][1], nchar(ver_char))
      }
      
      installerType <- "NSIS"
    }
    
    exist <- FALSE
    if (length(root_dir) > 0 && !is.na(root_dir)) {
      # keep your original "strip after =" behavior but guard indices
      if (length(gregexpr(pattern = "=", root_dir)[[1]]) > 0 && gregexpr(pattern = "=", root_dir)[[1]][1] > 0) {
        root_dir <- substr(root_dir[[1]], gregexpr(pattern = "=", root_dir)[[1]][1] + 1, nchar(root_dir))
      } else {
        root_dir <- root_dir[[1]]
      }
      exist <- file.exists(file.path(root_dir))
    }
    
    if (length(root_dir) > 0 && exist) {
      data.frame(
        instDir = root_dir,
        version = ver_char,
        installation_type = installerType,
        stringsAsFactors = FALSE
      )
    } else {
      NULL
    }
  })
  
  installations_GRASS <- do.call("rbind", installations_GRASS)
  
  if (is.null(installations_GRASS) || nrow(installations_GRASS) == 0) {
    if (!quiet) cat("Did not find any valid GRASS installation at mount point", DL)
    return(FALSE)
  }
  
  return(installations_GRASS)
}



#' Search for valid GRASS GIS installation(s) on Unix (Linux/macOS)
#'
#' Strategy:
#' 1) Prefer `grass --config path` (returns GISBASE on modern GRASS)
#' 2) Fallback: locate `grass` via `Sys.which()`, then infer common GISBASE paths
#'
#' @param MP Character. Ignored for detection (kept for API compatibility).
#'   You may pass a directory or an executable path; it will be used only as a hint.
#' @param quiet Logical.
#' @return FALSE or data.frame(instDir, version, installation_type)
#' @export
#' @keywords internal
searchGRASSX <- function(MP = "default", quiet = TRUE) {
  
  .msg <- function(...) if (!isTRUE(quiet)) message(...)
  
  # 0) Hint handling (directory or file); keep for compatibility but don't rely on it
  hint_dir <- NULL
  if (!is.null(MP) && !identical(MP, "default")) {
    if (file.exists(MP) && !dir.exists(MP)) hint_dir <- dirname(MP)
    if (dir.exists(MP)) hint_dir <- MP
  }
  
  # 1) Locate grass executable (PATH)
  grass_exe <- Sys.which("grass")
  if (!nzchar(grass_exe) && !is.null(hint_dir)) {
    cand <- file.path(hint_dir, "grass")
    if (file.exists(cand)) grass_exe <- cand
  }
  
  if (!nzchar(grass_exe)) {
    .msg("searchGRASSX(): 'grass' not found on PATH.")
    return(FALSE)
  }
  
  # 2) Ask GRASS for GISBASE (preferred, stable)
  gisbase <- try(system2(grass_exe, c("--config", "path"), stdout = TRUE, stderr = TRUE), silent = TRUE)
  if (!inherits(gisbase, "try-error") && length(gisbase) > 0) {
    gisbase <- trimws(gisbase[1])
    if (nzchar(gisbase) && dir.exists(gisbase)) {
      
      # version (best-effort)
      ver <- try(system2(grass_exe, "--version", stdout = TRUE, stderr = TRUE), silent = TRUE)
      ver_char <- NA_character_
      if (!inherits(ver, "try-error") && length(ver) > 0) {
        # "GRASS GIS 8.3.2"
        m <- regmatches(ver[1], regexpr("[0-9]+(\\.[0-9]+)+", ver[1]))
        if (length(m) > 0) ver_char <- m
      }
      
      return(data.frame(
        instDir = gisbase,
        version = ver_char,
        installation_type = basename(grass_exe),
        stringsAsFactors = FALSE
      ))
    }
  }
  
  # 3) Fallback: infer typical GISBASE locations (last resort)
  # Try /usr/lib/grass* and /usr/local/lib/grass*
  roots <- c("/usr/lib", "/usr/local/lib", "/opt")
  cand <- unlist(lapply(roots, function(r) Sys.glob(file.path(r, "grass*"))), use.names = FALSE)
  cand <- cand[dir.exists(cand)]
  cand <- cand[file.exists(file.path(cand, "etc", "VERSIONNUMBER")) | dir.exists(file.path(cand, "etc"))]
  
  if (length(cand) == 0) {
    .msg("searchGRASSX(): could not resolve GISBASE via '--config path' and no fallback candidates found.")
    return(FALSE)
  }
  
  # pick highest version-looking suffix
  suf <- suppressWarnings(as.integer(gsub(".*grass", "", basename(cand), ignore.case = TRUE)))
  cand <- cand[order(suf, decreasing = TRUE)]
  data.frame(
    instDir = cand[1],
    version = NA_character_,
    installation_type = basename(grass_exe),
    stringsAsFactors = FALSE
  )
}




#'@title Usually for internally usage, create valid 'GRASS GIS 7.xx' rsession environment settings according to the selected GRASS GIS 7.x and Windows Version
#'@name setenvGRASSw
#'@description  Initializes and set up  access to 'GRASS GIS 7.xx' via the \code{rgrass} wrapper or command line packages. Set and returns all necessary environment variables and additionally returns the GISBASE directory as string.
#'@param root_GRASS  grass root directory i.e. 'C:\\OSGEO4~1',
#'@param grass_version grass version name i.e. 'grass-7.0.5'
#'@param installation_type two options 'osgeo4w' as installed by the 'OSGeo4W'-installer and 'NSIS' that is typical for a stand_alone installation of 'GRASS GIS'.
#'@param quiet boolean  switch for suppressing console messages default is TRUE
#'@author Chris Reudenbach
#'@keywords internal
#'
#'@examples
#' \dontrun{
#' # set selected 'GRASS GIS' installation folders 
#' setenvGRASSw(root_GRASS = 'C:\\PROGRA~1\\QGIS2~1.18',
#'              grass_version =  'grass-7.2.1',
#'              installation_type =  'osgeo4W')
#' }
setenvGRASSw <- function(root_GRASS, grass_version = NULL, installation_type = NULL, quiet = TRUE) {
  
  root_GRASS <- normalizePath(root_GRASS, winslash = "/", mustWork = FALSE)
  
  # If user passed OSGeo4W root, derive real GISBASE = .../apps/grass/grassXX
  if (!dir.exists(file.path(root_GRASS, "scripts")) &&
      dir.exists(file.path(root_GRASS, "apps", "grass"))) {
    
    cand <- list.dirs(file.path(root_GRASS, "apps", "grass"),
                      full.names = TRUE, recursive = FALSE)
    
    cand <- cand[grepl("^grass[0-9]+", basename(cand), ignore.case = TRUE)]
    cand <- cand[dir.exists(file.path(cand, "scripts"))]
    
    if (length(cand) > 0) {
      # choose highest numeric suffix (e.g., grass84 > grass83)
      suf <- suppressWarnings(as.integer(gsub(".*grass", "", basename(cand), ignore.case = TRUE)))
      cand <- cand[order(suf, decreasing = TRUE)]
      root_GRASS <- cand[1]
    }
  }
  
  # return GISBASE (must contain scripts/)
  gisbase_GRASS <- root_GRASS
  
  if (!dir.exists(file.path(gisbase_GRASS, "scripts"))) {
    stop(gisbase_GRASS, " does not contain scripts/")
  }
  
  gisbase_GRASS
}




checkGisdbase <- function(x = NULL, gisdbase = NULL, location = NULL,
                          gisdbase_exist = FALSE, obj_name = NULL) {
  
  if (isTRUE(gisdbase_exist)) {
    # Link to an existing GRASS database/location
    linkGRASS(gisdbase = gisdbase, location = location, gisdbase_exist = TRUE)
  } else {
    # Create/init GRASS database/location using spatial reference from x
    linkGRASS(x = x, gisdbase = gisdbase, location = location)
  }
  
  path <- Sys.getenv("GISDBASE")
  
  if (is.null(obj_name) || is.na(obj_name) || !nzchar(obj_name)) {
    sq_name <- NA_character_
  } else {
    sq_name <- gsub("-", "_", tolower(paste0(obj_name, ".sqlite")))
  }
  
  return(list(gisbase_path = path, sqlite = sq_name))
}




#' @title Returns attributes of valid 'GRASS GIS' installation(s) on the system.
#' @name findGRASS
#' @description Retrieve a list of valid 'GRASS GIS' installation(s) on your system.
#' On Windows, uses searchGRASSW() (cmd-free). On Unix, uses searchGRASSX().
#' @param searchLocation On Windows MUST start with drive letter + colon, e.g. "C:", "C:/", "C:/Users/...".
#' Defaults to "C:/". On Unix defaults to "/usr/bin".
#' @param ver_select If TRUE and more than one installation is found, interactively select one.
#' @param quiet Suppress messages.
#' @return FALSE or data.frame(instDir, version, installation_type)
#' @export
findGRASS <- function(searchLocation = "default", ver_select = FALSE, quiet = TRUE) {
  
  .msg <- function(...) if (!isTRUE(quiet)) message(...)
  
  # ---------------------------
  # Windows
  # ---------------------------
  if (Sys.info()[["sysname"]] == "Windows") {
    
    # Resolve default
    if (identical(searchLocation, "default") || is.null(searchLocation)) {
      searchLocation <- "C:/"
    } else {
      searchLocation <- normalizePath(path.expand(searchLocation), winslash = "/", mustWork = FALSE)
    }
    
    # Validate Windows drive prefix (NO vector-pattern bug; NO cat()/NULL)
    if (is.na(searchLocation) || !grepl("^[A-Za-z]:(/|$)", searchLocation)) {
      .msg(
        "You are running Windows - Please choose a suitable searchLocation argument ",
        "that MUST include a Windows drive letter and colon"
      )
      return(FALSE)
    }
    
    # Run Windows finder (cmd-free)
    link <- searchGRASSW(DL = searchLocation, quiet = quiet)
    
    # Optional hint ONLY if not found and GRASS not on PATH
    if (isFALSE(link)) {
      check <- try(system("o-help", intern = TRUE), silent = TRUE)
      if (methods::is(check, "try-error") && !quiet) {
        message(
          "PLEASE NOTE: If you use GRASS version > 7.8 and/or the OSGeo4W installation you may need:\n",
          " 1) start the OSGeo4W shell\n",
          " 2) start grassxx --gtext\n",
          " 3) start Rstudio from command line in the shell\n",
          "Then both link2GI and rgrass should work.\n"
        )
      }
    }
    
    # ---------------------------
    # Unix / Linux / macOS
    # ---------------------------
    # Unix / Linux / macOS
  } else {
    
    if (identical(searchLocation, "default") || is.null(searchLocation)) {
      searchLocation <- "/usr/bin"
    }
    
    # if a file was provided (e.g. /usr/bin/grass), search its directory
    if (file.exists(searchLocation) && !dir.exists(searchLocation)) {
      searchLocation <- dirname(normalizePath(searchLocation, winslash = "/", mustWork = TRUE))
    }
    
    if (grepl(":", searchLocation, fixed = TRUE)) {
      .msg("You are running Linux/Unix - please choose a suitable searchLocation argument")
      return(FALSE)
    }
    
    link <- link2GI::searchGRASSX(MP = searchLocation, quiet = quiet)
  }
  
  
  # ---------------------------
  # Optional interactive selection
  # ---------------------------
  if (isTRUE(ver_select) && is.data.frame(link) && nrow(link) > 1) {
    if (!quiet) {
      cat("You have more than one valid GRASS GIS version\n")
      print(link)
      cat("\n")
    }
    ver <- suppressWarnings(as.numeric(readline(prompt = "Please select one:  ")))
    if (!is.na(ver) && ver >= 1 && ver <= nrow(link)) {
      link <- link[ver, , drop = FALSE]
      rownames(link) <- NULL
    }
  }
  
  link
}

.activate_osgeo4w_env <- function(osgeo4w_root, quiet = TRUE) {
  osgeo4w_root <- normalizePath(osgeo4w_root, winslash = "/", mustWork = TRUE)
  
  # minimal set of vars that rgrass/initGRASS typically checks for OSGeo4W
  Sys.setenv(OSGEO4W_ROOT = osgeo4w_root)
  
  # prepend OSGeo4W/bin to PATH (DLL search path)
  bin <- normalizePath(file.path(osgeo4w_root, "bin"), winslash = "/", mustWork = TRUE)
  p <- Sys.getenv("PATH")
  if (!grepl("OSGeo4W[/\\\\]bin", p, ignore.case = TRUE)) {
    Sys.setenv(PATH = paste(bin, p, sep = .Platform$path.sep))
  }
  
  if (!quiet) {
    message("::: Activated OSGeo4W environment: ", osgeo4w_root)
  }
  
  invisible(TRUE)
}

.in_osgeo4w_env <- function() {
  nzchar(Sys.getenv("OSGEO4W_ROOT")) || grepl("OSGeo4W[/\\\\]bin", Sys.getenv("PATH"), ignore.case = TRUE)
}

Try the link2GI package in your browser

Any scripts or data that you put into this service are public.

link2GI documentation built on Dec. 23, 2025, 9:09 a.m.