Merge pull request #201 from dansmith01/main

Author: gaborcsardi

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ps
 Title: List, Query, Manipulate System Processes
-Version: 1.9.1.9000
+Version: 1.9.1.9001
 Authors@R: c(
     person("Jay", "Loden", role = "aut"),
     person("Dave", "Daeschler", role = "aut"),

NAMESPACE

@@ -56,6 +56,7 @@ export(ps_set_nice)
 export(ps_shared_lib_users)
 export(ps_shared_libs)
 export(ps_status)
+export(ps_string)
 export(ps_suspend)
 export(ps_system_cpu_times)
 export(ps_system_memory)

NEWS.md

@@ -1,5 +1,7 @@
 # ps (development version)
 
+* New `ps_string()` for uniquely identifying a process.
+
 # ps 1.9.1
 
 * ps now builds correctly on Alpine Linux (3.19) on R 4.5.0.

R/low-level.R

@@ -2,8 +2,8 @@
 
 #' Create a process handle
 #'
-#' @param pid Process id. Integer scalar. `NULL` means the current R
-#'   process.
+#' @param pid A process id (integer scalar) or process string (from
+#'   `ps_string()`). `NULL` means the current R process.
 #' @param time Start time of the process. Usually `NULL` and ps will query
 #'   the start time.
 #' @return `ps_handle()` returns a process handle (class `ps_handle`).
@@ -16,6 +16,7 @@
 
 ps_handle <- function(pid = NULL, time = NULL) {
   if (!is.null(pid)) pid <- assert_pid(pid)
+  if (is.character(pid)) return(ps__str_decode(pid))
   if (!is.null(time)) assert_time(time)
   .Call(psll_handle, pid, time)
 }

R/string.R

@@ -0,0 +1,70 @@
+
+#' Encode a `ps_handle` as a short string
+#'
+#' A convenient format for passing between processes, naming semaphores, or
+#' using as a directory/file name. Will always be 14 alphanumeric characters,
+#' with the first character guarantied to be a letter. Encodes the pid and
+#' creation time for a process.
+#'
+#' @param p Process handle.
+#'
+#' @return A process string (scalar character), that can be passed to
+#' `ps_handle()` in place of a pid.
+#'
+#' @export
+#' @examplesIf ps::ps_is_supported() && ! ps:::is_cran_check()
+#' (p <- ps_handle())
+#' (str <- ps_string(p))
+#' ps_handle(pid = str)
+
+ps_string <- function (p = ps_handle()) {
+  assert_ps_handle(p)
+  ps__str_encode(ps_pid(p), ps_create_time(p))
+}
+
+
+ps__str_encode <- function (process_id, time) {
+
+  whole_secs <- as.integer(time)
+  micro_secs <- as.numeric(time) %% 1 * 1000000
+
+  # Assumptions:
+  #   time between Jan 1st 1970 and Dec 5th 3769.
+  #   max time precision = 1/1,000,000 of a second.
+  #   pid <= 7,311,615 (current std max = 4,194,304).
+
+  # Note: micro_secs has three extra unused bits
+
+  map <- c(letters, LETTERS, 0:9)
+
+  paste(collapse = '', map[1 + c(
+    floor(process_id / 52 ^ (3:0)) %% 52,
+    floor(whole_secs / 62 ^ (5:0)) %% 62,
+    floor(micro_secs / 62 ^ (3:0)) %% 62 )])
+}
+
+
+ps__str_decode <- function (str) {
+
+  map <- structure(0:61, names = c(letters, LETTERS, 0:9))
+  val <- map[strsplit(str, '', fixed = TRUE)[[1]]]
+
+  process_id <- sum(val[01:04] * 52 ^ (3:0))
+  whole_secs <- sum(val[05:10] * 62 ^ (5:0))
+  micro_secs <- sum(val[11:14] * 62 ^ (3:0))
+
+  time <- whole_secs + (micro_secs / 1000000)
+  time <- as.POSIXct(time, tz = 'GMT', origin = '1970-01-01')
+
+  # Allow fuzzy-matching the time by +/- 2 microseconds
+  tryCatch(
+    expr  = {
+      p <- ps_handle(pid = process_id)
+      stopifnot(abs(ps_create_time(p) - time) < 2/1000000)
+      p
+    },
+    error = function (e) {
+      ps_handle(pid = process_id, time = time)
+    }
+  )
+}

R/utils.R

@@ -135,8 +135,13 @@ assert_pid <- function(x) {
       as.integer(x) == x) {
     return(as.integer(x))
   }
-  stop(ps__invalid_argument(match.call()$x,
-                            " is not a process id (integer scalar)"))
+  if (is.character(x) && length(x) == 1 && !is.na(x) &&
+      grepl("^[A-Za-z]{4}[A-Za-z0-9]{10}$", x)) {
+    return(x)
+  }
+  stop(ps__invalid_argument(
+    match.call()$x,
+    " is not a process id (integer scalar) or process string (from `ps_string()`)"))
 }
 
 assert_grace <- function(x) {

_pkgdown.yml

@@ -96,5 +96,6 @@ reference:
 - title: Utility functions
   contents:
   - ps_is_supported
+  - ps_string
   - signals
   - errno

man/ps_handle.Rd

@@ -17,6 +17,29 @@ test_that("print", {
   expect_output(print(ps), format_regexp())
 })
 
+test_that("string", {
+  ps <- ps_handle()
+
+  # Values satisfy encoding assumptions
+  expect_true(all(ps_pids() < 52^4))
+  expect_true(Sys.time() < 62^6 * .99)
+  expect_identical(nchar(format(ps_create_time(), "%OS8")), 9L)
+
+  # Roundtrip through ps_string
+  str <- expect_silent(ps_string(ps))
+  ps2 <- expect_silent(ps_handle(str))
+
+  # Got the same process back
+  expect_true(ps_is_running(ps2))
+  expect_identical(ps_pid(ps),  ps_pid(ps2))
+  expect_identical(ps_ppid(ps), ps_ppid(ps2))
+
+  # Invalid process
+  str <- ps__str_encode(ps_pid(ps), ps_create_time(ps) + 1)
+  ps3 <- expect_silent(ps_handle(str))
+  expect_false(ps_is_running(ps3))
+})
+
 test_that("pid", {
   ## Argument check
   expect_error(ps_pid(123), class = "invalid_argument")