fixes #2313

Author: edzer

R/RcppExports.R

@@ -301,8 +301,8 @@ CPL_get_pipelines <- function(crs, authority, AOI, Use, grid_availability, accur
     .Call(`_sf_CPL_get_pipelines`, crs, authority, AOI, Use, grid_availability, accuracy, strict_containment, axis_order_auth_compl)
 }
 
-CPL_get_data_dir <- function(b = FALSE) {
-    .Call(`_sf_CPL_get_data_dir`, b)
+CPL_get_data_dir <- function(from_proj = FALSE) {
+    .Call(`_sf_CPL_get_data_dir`, from_proj)
 }
 
 CPL_is_network_enabled <- function(b = FALSE) {
@@ -313,8 +313,8 @@ CPL_enable_network <- function(url, enable = TRUE) {
     .Call(`_sf_CPL_enable_network`, url, enable)
 }
 
-CPL_set_data_dir <- function(data_dir) {
-    .Call(`_sf_CPL_set_data_dir`, data_dir)
+CPL_set_data_dir <- function(data_dir, with_proj) {
+    .Call(`_sf_CPL_set_data_dir`, data_dir, with_proj)
 }
 
 CPL_use_proj4_init_rules <- function(v) {

R/geom-measures.R

@@ -128,7 +128,7 @@ st_perimeter = function(x, ...) {
 		if (!requireNamespace("lwgeom", quietly = TRUE))
 			stop("package lwgeom required, please install it first")
 		# note that units are handled appropriately by lwgeom
-		lwgeom::st_perimeter(x)
+		lwgeom::st_perimeter_lwgeom(x)
 	}
 }
 

R/init.R

@@ -92,7 +92,7 @@ load_gdal <- function() {
 	if (!identical(Sys.getenv("R_SF_USE_PROJ_DATA"), "true")) {
 		if (file.exists(prj <- system.file("proj", package = "sf")[1])) {
 			# nocov start
-			if (! CPL_set_data_dir(prj)) { # if TRUE, uses C API to set path, leaving PROJ_LIB / PROJ_DATA alone
+			if (! sf_proj_search_paths(prj)) { # if TRUE, uses C API to set path, leaving PROJ_LIB / PROJ_DATA alone
 				save_and_replace("PROJ_LIB", prj, .sf_cache)
 				save_and_replace("PROJ_DATA", prj, .sf_cache)
 			}

R/proj.R

@@ -3,7 +3,7 @@
 #' @param type character; one of `have_datum_files`, `proj`, `ellps`, `datum`, `units`, `path`, or `prime_meridians`; see Details.
 #' @param path character; PROJ search path to be set
 #' @export
-#' @details \code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}).
+#' @details \code{sf_proj_info} lists the available projections, ellipses, datums, units, or data search path of the PROJ library when \code{type} is equal to proj, ellps, datum, units or path; when \code{type} equals \code{have_datum_files} a boolean is returned indicating whether datum files are installed and accessible (checking for \code{conus}). `path` returns the `PROJ_INFO.searchpath` field directly, as a single string with path separaters (`:`  or `;`).
 #'
 #' for PROJ >= 6, \code{sf_proj_info} does not provide option \code{type = "datums"}. 
 #' PROJ < 6 does not provide the option \code{type = "prime_meridians"}.
@@ -18,10 +18,10 @@ sf_proj_info = function(type = "proj", path) {
 		return(CPL_have_datum_files(0))
 
 	if (type == "path")
-		return(CPL_get_data_dir(FALSE))
+		return(CPL_get_data_dir(TRUE))
 
 	if (!missing(path) && is.character(path))
-		return(invisible(unique(CPL_set_data_dir(path))))
+		return(invisible(unique(CPL_set_data_dir(path, TRUE))))
 
 	if (type == "network")
 		return(CPL_is_network_enabled(TRUE))
@@ -81,16 +81,26 @@ sf_project = function(from = character(0), to = character(0), pts, keep = FALSE,
 
 #' Manage PROJ settings
 #' 
-#' Manage PROJ search path and network settings
-#' @param paths the search path to be set; omit if no paths need to be set
+#' Query or manage PROJ search path and network settings
+#' @param paths the search path to be set; omit if paths need to be queried
+#' @param with_proj logical; if `NA` set for both GDAL and PROJ, otherwise set either for PROJ (TRUE) or GDAL (FALSE)
 #' @return `sf_proj_search_paths()` returns the search path (possibly after setting it)
 #' @name proj_tools
 #' @export
-sf_proj_search_paths = function(paths = character(0)) {
+sf_proj_search_paths = function(paths = character(0), with_proj = NA) {
 	if (length(paths) == 0)
 		CPL_get_data_dir(FALSE)
-	else
-		CPL_set_data_dir(as.character(paths)) # set
+	else {
+		if (is.na(with_proj) || !isTRUE(with_proj))
+			CPL_set_data_dir(as.character(paths), FALSE) # set GDAL
+		if (is.na(with_proj) || isTRUE(with_proj)) { # set for PROJ
+			if (length(paths) > 1) {
+				paths = paste0(paths, collapse = .Platform$path.sep)
+				message(paste("setting proj path(s) to", paths))
+			}
+			CPL_set_data_dir(as.character(paths), TRUE)
+		}
+	}
 }
 
 #' @param enable logical; set this to enable (TRUE) or disable (FALSE) the proj network search facility

man/proj_tools.Rd

@@ -1053,13 +1053,13 @@ BEGIN_RCPP
 END_RCPP
 }
 // CPL_get_data_dir
-Rcpp::CharacterVector CPL_get_data_dir(bool b);
-RcppExport SEXP _sf_CPL_get_data_dir(SEXP bSEXP) {
+Rcpp::CharacterVector CPL_get_data_dir(bool from_proj);
+RcppExport SEXP _sf_CPL_get_data_dir(SEXP from_projSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
-    Rcpp::traits::input_parameter< bool >::type b(bSEXP);
-    rcpp_result_gen = Rcpp::wrap(CPL_get_data_dir(b));
+    Rcpp::traits::input_parameter< bool >::type from_proj(from_projSEXP);
+    rcpp_result_gen = Rcpp::wrap(CPL_get_data_dir(from_proj));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -1087,13 +1087,14 @@ BEGIN_RCPP
 END_RCPP
 }
 // CPL_set_data_dir
-Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir);
-RcppExport SEXP _sf_CPL_set_data_dir(SEXP data_dirSEXP) {
+Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir, bool with_proj);
+RcppExport SEXP _sf_CPL_set_data_dir(SEXP data_dirSEXP, SEXP with_projSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type data_dir(data_dirSEXP);
-    rcpp_result_gen = Rcpp::wrap(CPL_set_data_dir(data_dir));
+    Rcpp::traits::input_parameter< bool >::type with_proj(with_projSEXP);
+    rcpp_result_gen = Rcpp::wrap(CPL_set_data_dir(data_dir, with_proj));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -1534,7 +1535,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_sf_CPL_get_data_dir", (DL_FUNC) &_sf_CPL_get_data_dir, 1},
     {"_sf_CPL_is_network_enabled", (DL_FUNC) &_sf_CPL_is_network_enabled, 1},
     {"_sf_CPL_enable_network", (DL_FUNC) &_sf_CPL_enable_network, 2},
-    {"_sf_CPL_set_data_dir", (DL_FUNC) &_sf_CPL_set_data_dir, 1},
+    {"_sf_CPL_set_data_dir", (DL_FUNC) &_sf_CPL_set_data_dir, 2},
     {"_sf_CPL_use_proj4_init_rules", (DL_FUNC) &_sf_CPL_use_proj4_init_rules, 1},
     {"_sf_CPL_proj_version", (DL_FUNC) &_sf_CPL_proj_version, 1},
     {"_sf_CPL_proj_is_valid", (DL_FUNC) &_sf_CPL_proj_is_valid, 1},

man/st_transform.Rd

@@ -185,22 +185,20 @@ Rcpp::DataFrame CPL_get_pipelines(Rcpp::CharacterVector crs, Rcpp::CharacterVect
 }
 
 // [[Rcpp::export]]
-Rcpp::CharacterVector CPL_get_data_dir(bool b = false) {
-	Rcpp::CharacterVector ret(2);
-	ret[0] = proj_info().searchpath;
+Rcpp::CharacterVector CPL_get_data_dir(bool from_proj = false) {
+	if (from_proj) {
+		Rcpp::CharacterVector ret(proj_info().searchpath);
+		return ret;
+	} else {
 #if GDAL_VERSION_NUM >= 3000300
-	char **ogr_sp = OSRGetPROJSearchPaths();
-	Rcpp::CharacterVector ogr_sp_sf = charpp2CV(ogr_sp);
-	ret[1] = ogr_sp_sf[0];
-	CSLDestroy(ogr_sp);
+		char **ogr_sp = OSRGetPROJSearchPaths();
+		Rcpp::CharacterVector ogr_sp_sf = charpp2CV(ogr_sp);
+		CSLDestroy(ogr_sp);
+		return ogr_sp_sf;
 #else
-	ret[1] = "requires GDAL >= 3.0.3";
+		Rcpp::stop("requires GDAL >= 3.0.3");
 #endif
-	Rcpp::CharacterVector nms(2);
-	nms(0) = "PROJ";
-	nms(1) = "GDAL";
-	ret.attr("names") = nms;
-	return ret;
+	}
 }
 
 // [[Rcpp::export]]
@@ -240,16 +238,21 @@ Rcpp::CharacterVector CPL_enable_network(Rcpp::CharacterVector url, bool enable
 }
 
 // [[Rcpp::export]]
-Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir) {
-	if (data_dir.size() != 1)
-		Rcpp::stop("data_dir should be size 1 character vector"); // #nocov
-	std::string dd = Rcpp::as<std::string>(data_dir);
-	const char *cp = dd.c_str();
-	proj_context_set_search_paths(PJ_DEFAULT_CTX, 1, &cp);
+Rcpp::LogicalVector CPL_set_data_dir(Rcpp::CharacterVector data_dir, bool with_proj) {
+	if (with_proj) {
+		if (data_dir.size() != 1)
+			Rcpp::stop("data_dir should be size 1 character vector"); // #nocov
+		std::string dd = Rcpp::as<std::string>(data_dir);
+		const char *cp = dd.c_str();
+		proj_context_set_search_paths(PJ_DEFAULT_CTX, 1, &cp);
+	} else {
 #if GDAL_VERSION_NUM >= 3000000
-	std::vector <char *> dirs = create_options(data_dir, true);
-	OSRSetPROJSearchPaths(dirs.data());
+		std::vector <char *> dirs = create_options(data_dir, true);
+		OSRSetPROJSearchPaths(dirs.data());
+#else
+		Rcpp::stop("setting proj search path for GDAL requires GDAL >= 3.0.0");
 #endif
+	}
 	return true;
 }
 
@@ -452,7 +455,7 @@ Rcpp::CharacterVector CPL_enable_network(Rcpp::CharacterVector url, bool enable
 #endif
 }
 
-Rcpp::CharacterVector CPL_get_data_dir(bool b = false) {
+Rcpp::CharacterVector CPL_get_data_dir(bool from_proj = false) {
 #if PROJ_VERSION_MAJOR >= 7
 	return Rcpp::CharacterVector(proj_info().searchpath);
 #else

src/RcppExports.cpp

@@ -1,5 +1,5 @@
 
-R version 4.3.1 (2023-06-16) -- "Beagle Scouts"
+R version 4.3.2 (2023-10-31) -- "Eye Holes"
 Copyright (C) 2023 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu (64-bit)
 
@@ -144,9 +144,9 @@ First 10 features:
 8   point      POINT (843278.5 287241.6)
 9   point      POINT (648477.7 235466.6)
 10  point        POINT (852593 267248.3)
-Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon) : 
+Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon,  : 
   rthomas is not an exported function from spatstat.random.
-Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon) : 
+Error in st_poly_sample(x, size = size, ..., type = type, by_polygon = by_polygon,  : 
   The spatstat function rThomas did not return a valid result. Consult the help file.
 Error message from spatstat:
 Error in spatstat_fun(..., win = spatstat.geom::as.owin(x)) : 
@@ -166,4 +166,4 @@ In st_as_sfc.owin(spatstat.geom::as.owin(x)) :
 > 
 > proc.time()
    user  system elapsed 
-  2.011   0.116   2.121 
+  2.039   1.402   1.935