branch: externals/plz
commit 7c27e4bdcd747f0bfc5a6298040739562a941e08
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Change: Sync with accept-process-output
No need for separate functions to handle synchronous requests, and no
duplicated code from the sentinel.
Also, no need for a separate plz--curl function, just to deal with one
argument.
---
plz.el | 210 ++++++++++++------------------------------------------
tests/test-plz.el | 46 ++++++------
2 files changed, 70 insertions(+), 186 deletions(-)
diff --git a/plz.el b/plz.el
index 1a9fdd742f..50ac5ccc74 100644
--- a/plz.el
+++ b/plz.el
@@ -168,6 +168,12 @@ Called in current curl process buffer.")
Called after the then/else function, without arguments, outside
the curl process buffer.")
+(defvar-local plz-result nil
+ "Used when `plz' is called synchronously.")
+
+(defvar-local plz-sync nil
+ "Used when `plz' is called synchronously.")
+
;;;; Customization
(defgroup plz nil
@@ -209,33 +215,9 @@ connection phase and waiting to receive the response (the
(cl-defun plz (method url &key headers body as then else finally noquery
(body-type 'text) (decode t decode-s)
(connect-timeout plz-connect-timeout) (timeout
plz-timeout))
- "Request BODY with METHOD to URL with curl.
-
-AS selects the kind of result to pass to the callback function
-THEN. It may be:
-
-- `buffer' to pass the response buffer.
-- `binary' to pass the response body as an undecoded string.
-- `string' to pass the response body as a decoded string.
-- `response' to pass a `plz-response' struct.
-- A function, which is called in the response buffer with it
- narrowed to the response body (suitable for, e.g. `json-read').
-
-If DECODE is non-nil, the response body is decoded automatically.
-For binary content, it should be nil. When AS is `binary',
-DECODE is automatically set to nil.
-
-THEN is a callback function, whose sole argument is selected
-above with AS.
-
-ELSE is an optional callback function called when the request
-fails with one argument, a `plz-error' struct. If ELSE is nil,
-an error is signaled when the request fails, either
-`plz-curl-error' or `plz-http-error' as appropriate, with a
-`plz-error' struct as the error data.
-
-FINALLY is an optional function called without argument after
-THEN or ELSE, as appropriate.
+ "Request METHOD from URL with curl.
+Return the curl process object or, for a synchronous request, the
+selected result.
HEADERS may be an alist of extra headers to send with the
request.
@@ -243,66 +225,9 @@ request.
BODY-TYPE may be `text' to send BODY as text, or `binary' to send
it as binary.
-NOQUERY is passed to `make-process', which see.
-
-CONNECT-TIMEOUT and TIMEOUT are a number of seconds that limit
-how long it takes to connect to a host and to receive a response
-from a host, respectively."
- (declare (indent defun))
- (plz--curl method url
- :body body :body-type body-type
- :headers headers
- :connect-timeout connect-timeout :timeout timeout
- :decode (if (and decode-s (not decode)) nil decode)
- :as as :then then :else else :finally finally :noquery noquery))
-
-(cl-defun plz-get-sync (url &key headers as
- (decode t decode-s)
- (connect-timeout plz-connect-timeout) (timeout
plz-timeout))
- "Get HTTP URL with curl synchronously.
-
-AS selects the kind of result to return. It may be:
-
-- `binary' to pass the response body as an undecoded string.
-- `string' to pass the response body as a decoded string.
-- `response' to pass a `plz-response' struct.
-- A function, which is called in the response buffer with it
- narrowed to the response body (suitable for, e.g. `json-read').
-
-If DECODE is non-nil, the response body is decoded automatically.
-For binary content, it should be nil. When AS is `binary',
-DECODE is automatically set to nil.
-
-If the request fails, an error is signaled, either
-`plz-curl-error' or `plz-http-error' as appropriate, with a
-`plz-error' struct as the error data.
-
-HEADERS may be an alist of extra headers to send with the
-request.
-
-CONNECT-TIMEOUT and TIMEOUT are a number of seconds that limit
-how long it takes to connect to a host and to receive a response
-from a host, respectively."
- (declare (indent defun))
- (plz--curl-sync 'get url
- :headers headers
- :connect-timeout connect-timeout :timeout timeout
- :decode (if (and decode-s (not decode)) nil decode)
- :as as))
-
-;;;;; Private
-
-;;;;;; Curl
-
-;; Functions for calling and handling curl processes.
-
-(cl-defun plz--curl (method url &key body headers connect-timeout timeout
- decode as then else finally noquery
- (body-type 'text))
- "Make HTTP METHOD request to URL with curl.
-
AS selects the kind of result to pass to the callback function
-THEN. It may be:
+THEN, or the kind of result to return for synchronous requests.
+It may be:
- `buffer' to pass the response buffer.
- `binary' to pass the response body as an undecoded string.
@@ -312,25 +237,23 @@ THEN. It may be:
narrowed to the response body (suitable for, e.g. `json-read').
If DECODE is non-nil, the response body is decoded automatically.
+For binary content, it should be nil. When AS is `binary',
+DECODE is automatically set to nil.
THEN is a callback function, whose sole argument is selected
-above with AS.
+above with AS. Or it may be `sync' to make a synchronous
+request, in which case the result is returned directly.
ELSE is an optional callback function called when the request
fails with one argument, a `plz-error' struct. If ELSE is nil,
an error is signaled when the request fails, either
`plz-curl-error' or `plz-http-error' as appropriate, with a
-`plz-error' struct as the error data.
+`plz-error' struct as the error data. For synchronous requests,
+this argument is ignored.
FINALLY is an optional function called without argument after
-THEN or ELSE, as appropriate.
-
-BODY may be a string or buffer to send as the request body.
-BODY-TYPE may be `text' to send BODY as text, or `binary' to send
-it as binary.
-
-HEADERS may be an alist of extra headers to send with the
-request.
+THEN or ELSE, as appropriate. For synchronous requests, this
+argument is ignored.
CONNECT-TIMEOUT and TIMEOUT are a number of seconds that limit
how long it takes to connect to a host and to receive a response
@@ -338,6 +261,9 @@ from a host, respectively.
NOQUERY is passed to `make-process', which see."
;; Inspired by and copied from `elfeed-curl-retrieve'.
+ (declare (indent defun))
+ (setf decode (if (and decode-s (not decode))
+ nil decode))
;; NOTE: By default, for PUT requests and POST requests >1KB, curl sends an
;; "Expect:" header, which causes servers to send a "100 Continue" response,
which
;; we don't want to have to deal with, so we disable it by setting the
header to
@@ -369,7 +295,12 @@ NOQUERY is passed to `make-process', which see."
concat (format "%s \"%s\"\n" key value)))
(decode (pcase as
('binary nil)
- (_ decode))))
+ (_ decode)))
+ sync-p)
+ (when (eq 'sync then)
+ (setf sync-p t
+ then (lambda (result)
+ (setf plz-result result))))
(with-current-buffer (generate-new-buffer " *plz-request-curl*")
;; Avoid making process in a nonexistent directory (in case the current
;; default-directory has since been removed). It's unclear what the best
@@ -406,7 +337,8 @@ NOQUERY is passed to `make-process', which see."
(funcall then (funcall as))))))))
(setf plz-then then
plz-else else
- plz-finally finally)
+ plz-finally finally
+ plz-sync sync-p)
;; Send --config arguments.
(process-send-string process curl-config)
(when body
@@ -415,71 +347,18 @@ NOQUERY is passed to `make-process', which see."
(buffer (with-current-buffer body
(process-send-region process (point-min) (point-max))))))
(process-send-eof process)
- process))))
-
-(cl-defun plz--curl-sync (_method url &key headers connect-timeout timeout
- decode as)
- "Return result for HTTP request to URL made synchronously with curl.
-
-AS selects the kind of result to return. It may be:
-
-- `string' to pass the response body as a string.
-- `response' to pass a `plz-response' struct.
-- A function, which is called in the response buffer with it
- narrowed to the response body (suitable for, e.g. `json-read').
-
-If DECODE is non-nil, the response body is decoded automatically.
-
-HEADERS may be an alist of extra headers to send with the
-request.
-
-CONNECT-TIMEOUT and TIMEOUT are a number of seconds that limit
-how long it takes to connect to a host and to receive a response
-from a host, respectively.
+ (if sync-p
+ (progn
+ (while
+ ;; According to the Elisp manual, blocking on a process's
+ ;; output is really this simple. And it seems to work.
+ (accept-process-output process))
+ (prog1 plz-result
+ (unless (eq as 'buffer)
+ (kill-buffer))))
+ process)))))
-If the request fails, an error is signaled, either
-`plz-curl-error' or `plz-http-error' as appropriate, with a
-`plz-error' struct as the error data.
-
-Uses `call-process' to call curl synchronously."
- (with-current-buffer (generate-new-buffer " *plz-request-curl*")
- (let* ((coding-system-for-read 'binary)
- (process-connection-type nil)
- (header-args (cl-loop for (key . value) in headers
- collect (format "--header %s: %s" key value)))
- (curl-args (append plz-curl-default-args header-args
- (when connect-timeout
- (list "--connect-timeout" (number-to-string
connect-timeout)))
- (when timeout
- (list "--max-time" (number-to-string timeout)))
- (list url)))
- (decode (pcase as
- ('binary nil)
- (_ decode)))
- (status (apply #'call-process plz-curl-program nil t nil
- curl-args))
- ;; THEN form copied from `plz--curl'.
- ;; TODO: DRY this. Maybe we could use a thread and a condition
variable, but...
- (plz-then (pcase-exhaustive as
- ((or `nil 'string 'binary)
- (lambda ()
- (let ((coding-system (or (plz--coding-system)
'utf-8)))
- (pcase as
- ('binary (set-buffer-multibyte nil)))
- (plz--narrow-to-body)
- (when decode
- (decode-coding-region (point) (point-max)
coding-system))
- (buffer-string))))
- ('response
- (apply-partially #'plz--response :decode-p decode))
- ((pred functionp)
- (lambda ()
- (let ((coding-system (or (plz--coding-system)
'utf-8)))
- (plz--narrow-to-body)
- (when decode
- (decode-coding-region (point) (point-max)
coding-system))
- (funcall as)))))))
- (plz--sentinel (current-buffer) status))))
+;;;;; Private
(defun plz--sentinel (process-or-buffer status)
"Process buffer of curl output in PROCESS-OR-BUFFER.
@@ -490,9 +369,11 @@ node `(elisp) Sentinels'). Kills the buffer before
returning."
(let* ((buffer (cl-etypecase process-or-buffer
(process (process-buffer process-or-buffer))
(buffer process-or-buffer)))
- (finally (buffer-local-value 'plz-finally buffer)))
+ (finally (buffer-local-value 'plz-finally buffer))
+ sync)
(unwind-protect
(with-current-buffer buffer
+ (setf sync plz-sync)
(pcase-exhaustive status
((or 0 "finished\n")
;; Curl exited normally: check HTTP status code.
@@ -524,7 +405,8 @@ node `(elisp) Sentinels'). Kills the buffer before
returning."
((pred functionp) (funcall plz-else err)))))))
(when finally
(funcall finally))
- (kill-buffer buffer))))
+ (unless sync
+ (kill-buffer buffer)))))
;;;;;; HTTP Responses
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 8fa933e6af..10812b06d9 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -120,8 +120,8 @@
(should (string= "value" (alist-get 'key (json-read-from-string
.data)))))))
(ert-deftest plz-post-jpeg-string nil
- (let* ((jpeg-to-upload (plz-get-sync "https://httpbin.org/image/jpeg";
- :as 'binary))
+ (let* ((jpeg-to-upload (plz 'get "https://httpbin.org/image/jpeg";
+ :as 'binary :then 'sync))
(response-json)
(response-jpeg)
(process (plz 'post "https://httpbin.org/post";
@@ -162,23 +162,25 @@
;;;;; Sync
(ert-deftest plz-get-string-sync nil
- (should (string-match "curl" (plz-get-sync "https://httpbin.org/get";
- :as 'string)))
- (should (string-match "curl" (plz-get-sync "https://httpbin.org/get";))))
+ (let-alist (json-read-from-string (plz 'get "https://httpbin.org/get";
+ :as 'string :then 'sync))
+ (should (equal "https://httpbin.org/get"; .url))))
(ert-deftest plz-get-response-sync nil
- (plz-test-get-response (plz-get-sync "https://httpbin.org/get";
- :as 'response)))
+ (plz-test-get-response (plz 'get "https://httpbin.org/get";
+ :as 'response :then 'sync)))
(ert-deftest plz-get-json-sync nil
- (let-alist (plz-get-sync "https://httpbin.org/get";
- :as #'json-read)
+ (let-alist (plz 'get "https://httpbin.org/get";
+ :as #'json-read :then 'sync)
(should (string-match "curl" .headers.User-Agent))))
(ert-deftest plz-get-buffer-sync nil
- ;; `buffer' is not a valid type for `plz-get-sync'.
- (should-error (plz-get-sync "https://httpbin.org/get";
- :as 'buffer)))
+ (let ((buffer (plz 'get "https://httpbin.org/get";
+ :as 'buffer :then 'sync)))
+ (unwind-protect
+ (should (buffer-live-p buffer))
+ (kill-buffer buffer))))
;;;;; Headers
@@ -212,9 +214,9 @@
(should (equal "value" (alist-get 'key (json-read-from-string
.data)))))))
(ert-deftest plz-get-json-with-headers-sync ()
- (let-alist (plz-get-sync "https://httpbin.org/get";
+ (let-alist (plz 'get "https://httpbin.org/get";
:headers '(("X-Plz-Test-Header" . "plz-test-header-value"))
- :as #'json-read)
+ :as #'json-read :then 'sync)
(should (string-match "curl" .headers.User-Agent))
(should (equal "plz-test-header-value" .headers.X-Plz-Test-Header))))
@@ -252,8 +254,8 @@
(ert-deftest plz-get-curl-error-sync nil
;; Sync.
- (let ((err (should-error (plz-get-sync
"https://httpbinnnnnn.org/get/status/404";
- :as 'string)
+ (let ((err (should-error (plz 'get "https://httpbinnnnnn.org/get/status/404";
+ :as 'string :then 'sync)
:type 'plz-curl-error)))
(should (eq 'plz-curl-error (car err)))
(should (plz-error-p (cdr err)))
@@ -275,8 +277,8 @@
(eq 404 (plz-response-status (plz-error-response err))))))
;; Sync.
- (let ((err (should-error (plz-get-sync "https://httpbin.org/get/status/404";
- :as 'string)
+ (let ((err (should-error (plz 'get "https://httpbin.org/get/status/404";
+ :as 'string :then 'sync)
:type 'plz-http-error)))
(should (and (eq 'plz-http-error (car err))
(plz-error-p (cdr err))
@@ -301,8 +303,8 @@
;; Sync.
(let ((start-time (current-time))
(err (cdr
- (should-error (plz-get-sync "https://httpbin.org/delay/5";
- :as 'string :timeout 1)
+ (should-error (plz 'get "https://httpbin.org/delay/5";
+ :as 'string :then 'sync :timeout 1)
:type 'plz-curl-error)))
(end-time (current-time)))
(should (eq 28 (car (plz-error-curl-error err))))
@@ -333,8 +335,8 @@
(should (equal 'jpeg (image-type-from-data test-jpeg)))))
(ert-deftest plz-get-jpeg-sync ()
- (let ((jpeg (plz-get-sync "https://httpbin.org/image/jpeg";
- :as 'binary)))
+ (let ((jpeg (plz 'get "https://httpbin.org/image/jpeg";
+ :as 'binary :then 'sync)))
(should (equal 'jpeg (image-type-from-data jpeg)))))
;;;; Footer
