From f485db7273499dfcd1ae5dd738e36ca629b0b19f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 18 Jun 2025 09:34:30 -0500 Subject: [PATCH 1/2] Add interrupts escape hatch I can't see any way to test this, but I experimented interactively with this code: ```R library(httr2) request_base <- request(example_url()) reqs <- rep(list(request_base |> req_url_path("/delay/0.1")), 100) repeat(req_perform_parallel(reqs)) ``` Fixes #1810 --- NEWS.md | 1 + R/httr2-package.R | 1 + R/req-perform-iterative.R | 2 ++ R/req-perform-parallel.R | 2 ++ R/req-perform-sequential.R | 2 ++ R/utils.R | 10 ++++++++++ 6 files changed, 18 insertions(+) diff --git a/NEWS.md b/NEWS.md index a80f2d3a..c5536bc3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # httr2 (development version) +* Functions that capture interrutps (like `req_perform_parallel()` and friends) are now easier to escape if they're called inside a loop: you can press Ctrl + C twice to guarantee an exit (#1810). * New `last_request_json()` and `last_response_json()` to conveniently see JSON bodies (#734). * `req_body_json_modify()` can now be used on a request with an empty body. * `resp_timing()` exposes timing information about the request measured by libcurl (@arcresu, #725). diff --git a/R/httr2-package.R b/R/httr2-package.R index a38694ec..175c8caf 100644 --- a/R/httr2-package.R +++ b/R/httr2-package.R @@ -17,3 +17,4 @@ the$token_cache <- new_environment() the$last_response <- NULL the$last_request <- NULL the$pool_pollers <- new_environment() +the$last_interrupt <- .POSIXct(-Inf) diff --git a/R/req-perform-iterative.R b/R/req-perform-iterative.R index 9c4cae39..a877f9c7 100644 --- a/R/req-perform-iterative.R +++ b/R/req-perform-iterative.R @@ -181,6 +181,8 @@ req_perform_iterative <- function( } }, interrupt = function(cnd) { + check_repeated_interrupt() + # interrupt might occur after i was incremented if (is.null(resps[[i]])) { i <<- i - 1 diff --git a/R/req-perform-parallel.R b/R/req-perform-parallel.R index 88fda143..9639d32a 100644 --- a/R/req-perform-parallel.R +++ b/R/req-perform-parallel.R @@ -91,6 +91,8 @@ req_perform_parallel <- function( tryCatch( queue$process(), interrupt = function(cnd) { + check_repeated_interrupt() + queue$queue_status <- "errored" queue$process() diff --git a/R/req-perform-sequential.R b/R/req-perform-sequential.R index f5607ba2..6c9a1ae3 100644 --- a/R/req-perform-sequential.R +++ b/R/req-perform-sequential.R @@ -92,6 +92,8 @@ req_perform_sequential <- function( } }, interrupt = function(cnd) { + check_repeated_interrupt() + resps <- resps[seq_len(i)] cli::cli_alert_warning( "Terminating iteration; returning {i} response{?s}." diff --git a/R/utils.R b/R/utils.R index 4e8005ab..dd962e16 100644 --- a/R/utils.R +++ b/R/utils.R @@ -347,3 +347,13 @@ log_stream <- function(..., prefix = "<< ") { paste_c <- function(..., collapse = "") { paste0(c(...), collapse = collapse) } + +# Give user the get-out-of-jail-free card if interrupt-capturing function +# is wrapped inside a loop +check_repeated_interrupt <- function() { + if (Sys.time() - the$last_interrupt < 1) { + cli::cli_alert_warning("Interrupting") + interrupt() + } + the$last_interrupt <- Sys.time() +} From bc5a29e193b82b9cb7179b7426afce0d0bf1bc10 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 18 Jun 2025 10:12:10 -0500 Subject: [PATCH 2/2] Apply suggestions from code review Co-authored-by: Charlie Gao <53399081+shikokuchuo@users.noreply.github.com> --- R/httr2-package.R | 2 +- R/utils.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/httr2-package.R b/R/httr2-package.R index 175c8caf..3cdfe248 100644 --- a/R/httr2-package.R +++ b/R/httr2-package.R @@ -17,4 +17,4 @@ the$token_cache <- new_environment() the$last_response <- NULL the$last_request <- NULL the$pool_pollers <- new_environment() -the$last_interrupt <- .POSIXct(-Inf) +the$last_interrupt <- 0 diff --git a/R/utils.R b/R/utils.R index dd962e16..7a779006 100644 --- a/R/utils.R +++ b/R/utils.R @@ -351,9 +351,9 @@ paste_c <- function(..., collapse = "") { # Give user the get-out-of-jail-free card if interrupt-capturing function # is wrapped inside a loop check_repeated_interrupt <- function() { - if (Sys.time() - the$last_interrupt < 1) { + if (as.double(Sys.time()) - the$last_interrupt < 1) { cli::cli_alert_warning("Interrupting") interrupt() } - the$last_interrupt <- Sys.time() + the$last_interrupt <- as.double(Sys.time()) }