diff --git a/CHANGELOG b/CHANGELOG
index 1342f911423685e6a18ebdd740902ef8612269d2..00bc34e1255cbaa4a19e544e1ff9de2325e3ddda 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,21 @@
+2020-08-18 David Byers <david.byers@liu.se>
+
+ Resolve issue #10:
+ * olc.el (olc-http-error): New error.
+ (olc-http-parse-response): New function to (partially) parse an
+ HTTP response.
+ (olc-http-request-json): New function.
+ (olc-shorten-compound): Replace call to request.
+ (olc-recover-compound): Replace call to reqeust.
+ (json): Unconditionally require the json library.
+
+ * test/olctest.el (olctest-localtests): Added test for shortening
+ when geocoding fails.
+
+ * olc.texi: Correct some typos. Correct error names. Add
+ olc-http-error to the documentation. Remove references to the
+ request package.
+
2020-07-25 David Byers <david.byers@liu.se>
Fix issue #7:
diff --git a/olc.el b/olc.el
index 308e8e895839f2f85f09ad5f6b0bacfc7f3a502e..80129aa6659d7b1369b0a64e9ccf8c7a62ec0862 100644
--- a/olc.el
+++ b/olc.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2020 David Byers
;;
;; Author: David Byers <david.byers@liu.se>
-;; Version: 1.4.1
+;; Version: 1.5.1
;; Package-Requires: ((emacs "25.1"))
;; Keywords: extensions, lisp
;; URL: https://gitlab.liu.se/davby02/olc
@@ -25,9 +25,9 @@
;;; Commentary:
;; This program provides basic open location code support in Emacs
-;; Lisp. The support for recovering shortened codes depends on the
-;; request library and uses OpenStreetMap; please check the terms of
-;; use for the service to ensure that you remain compliant.
+;; Lisp. Recovery of shortened codes uses OpenStreetMap nominatim;
+;; please check the terms of use for the service to ensure that your
+;; use complies with the API terms of use.
;;
;; All methods required by the open location code specification are
;; provided in some form. The implementation passed the tests present
@@ -42,14 +42,8 @@
;; (which is a pain in the backside). So cl-lib it is.
(require 'cl-lib)
-(require 'request nil t)
-(require 'json nil t)
-
-;; Silence compiler if request is not on load-path at compile time.
-
-(declare-function request "ext:request" t t)
-(declare-function request-response-status-code "ext:request" t t)
-(declare-function request-response-data "ext:request" t t)
+(require 'json)
+(require 'mm-decode)
;;; Variables:
@@ -131,6 +125,10 @@
"Invalid reference location"
'olc-recover-error)
+(define-error 'olc-http-error
+ "Error retrieving or parsing http request"
+ 'olc-error)
+
;;; Base 20 digits:
@@ -215,12 +213,22 @@ raise, and args for the raised error.
(setq index (1+ index)))
code))))
-(defun olc-nominatim-endpoint (path)
+(defun olc-url-encode-params (params)
+ "Encode PARAMS to be used as the query of an url."
+ (mapconcat (lambda (param)
+ (concat (url-hexify-string (format "%s" (car param)))
+ "="
+ (url-hexify-string (format "%s" (cdr param)))))
+ params "&"))
+
+(cl-defun olc-nominatim-endpoint (path &key (params nil))
"Build a complete url for nominatim endpoint PATH."
(concat olc-nominatim-url
(if (= ?/ (elt olc-nominatim-url (1- (length olc-nominatim-url))))
"" "/")
- path))
+ path
+ "?"
+ (olc-url-encode-params (cons '(format . "json") params))))
(defsubst olc-clip-latitude (lat)
"Clip LAT to -90,90."
@@ -334,15 +342,15 @@ This function changes the match data."
pos (+ 2 pos)
precision (+ 2 precision))))))
- ;; Parse grid
- (while (< pos (length code))
- (cond ((not (olc-valid-char (elt code pos)))
- (signal 'olc-parse-error-invalid-character
- (list code pos (string (elt code pos)))))
- ((>= (length grid) 5) (setq pos (1+ pos)))
- (t (setq grid (cons (elt code pos) grid)
- pos (1+ pos)
- precision (1+ precision)))))
+ ;; Parse grid
+ (while (< pos (length code))
+ (cond ((not (olc-valid-char (elt code pos)))
+ (signal 'olc-parse-error-invalid-character
+ (list code pos (string (elt code pos)))))
+ ((>= (length grid) 5) (setq pos (1+ pos)))
+ (t (setq grid (cons (elt code pos) grid)
+ pos (1+ pos)
+ precision (1+ precision)))))
;; Check for an empty code
(unless pairs
@@ -369,35 +377,35 @@ This function changes the match data."
If compound is non-nil, then return non-nil if CODE looks like a
compound open location code (i.e. everything up to the first
space character is a valid code)."
- (or (olc-parse-p code)
- (save-match-data
- (when (and compound (string-match "\\s-+" code))
- (setq code (substring code 0 (match-beginning 0))))
- (let ((case-fold-search t))
-
- ;; The code is decomposed into PAIRS PADDING "+" SUFFIX.
- ;;
- ;; Rules:
- ;;
- ;; - For all codes:
- ;; - Pairs has an even (zero counts) length of at most 8.
- ;; - Suffix is either zero or between 2 and 8 characters.
- ;; - One or both of pairs and suffix must not be empty.
- ;;
- ;; - If there is padding:
- ;; - The suffix must be empty
- ;; - The length of pairs and padding combined must be 8
-
- (when (string-match olc-code-regexp code)
- (let ((pair-len (- (match-end 1) (match-beginning 1)))
- (padd-len (- (match-end 2) (match-beginning 2)))
- (suff-len (- (match-end 3) (match-beginning 3))))
- (and (and (= 0 (% pair-len 2)) (<= pair-len 8)) ; Check pairs
- (and (<= suff-len 8) (/= suff-len 1)) ; Check suffix
- (> (+ pair-len suff-len) 0) ; Check for not empty
- (or (= padd-len 0) ; Empty padding...
- (and (= suff-len 0) ; ...or suffix
- (= (+ padd-len pair-len) 8))))))))))
+ (or (olc-parse-p code)
+ (save-match-data
+ (when (and compound (string-match "\\s-+" code))
+ (setq code (substring code 0 (match-beginning 0))))
+ (let ((case-fold-search t))
+
+ ;; The code is decomposed into PAIRS PADDING "+" SUFFIX.
+ ;;
+ ;; Rules:
+ ;;
+ ;; - For all codes:
+ ;; - Pairs has an even (zero counts) length of at most 8.
+ ;; - Suffix is either zero or between 2 and 8 characters.
+ ;; - One or both of pairs and suffix must not be empty.
+ ;;
+ ;; - If there is padding:
+ ;; - The suffix must be empty
+ ;; - The length of pairs and padding combined must be 8
+
+ (when (string-match olc-code-regexp code)
+ (let ((pair-len (- (match-end 1) (match-beginning 1)))
+ (padd-len (- (match-end 2) (match-beginning 2)))
+ (suff-len (- (match-end 3) (match-beginning 3))))
+ (and (and (= 0 (% pair-len 2)) (<= pair-len 8)) ; Check pairs
+ (and (<= suff-len 8) (/= suff-len 1)) ; Check suffix
+ (> (+ pair-len suff-len) 0) ; Check for not empty
+ (or (= padd-len 0) ; Empty padding...
+ (and (= suff-len 0) ; ...or suffix
+ (= (+ padd-len pair-len) 8))))))))))
(cl-defun olc-is-short (code &key compound)
"Return non-nil if CODE is a valid short open location code.
@@ -584,6 +592,58 @@ shortened code, of if LIMIT is not positive and even."
(min limit (* (car spec) 2))))))
code))))
+(defun olc-http-parse-json ()
+ "Parse an http response as json in the current buffer."
+ (save-match-data
+ (goto-char (point-min))
+ (unless (looking-at "^\\s-*HTTP/[0-9.]+ \\([0-9]+\\) \\(.*\\)$")
+ (signal 'olc-http-error (list "invalid http response")))
+ (let ((code (string-to-number (match-string 1)))
+ mime body charset)
+
+ ;; Check the response code
+ (if (/= code 200)
+ (cons code nil)
+
+ ;; Delete first line so as not to confude the mime parser
+ (delete-region (point) (progn (forward-line 1) (point)))
+
+ ;; Parse the message as if it were a mime message
+ (setq mime (mm-dissect-buffer t t))
+
+ ;; Check that parsing was successful
+ (unless mime
+ (signal 'olc-http-error (list "unable to parse http response")))
+
+ ;; Check that it is the content type we want
+ (unless (string-equal "application/json" (car (mm-handle-type mime)))
+ (signal 'olc-http-error (list "invalid response type")))
+
+ ;; Extract and check the response charset
+ (setq charset (intern-soft
+ (downcase (alist-get 'charset
+ (cdr (mm-handle-type mime))
+ "iso-8859-1"))))
+ (unless (and charset (coding-system-p charset))
+ (signal 'olc-http-error (list "unable to decode http response")))
+
+ ;; Decode the response body
+ (setq body (decode-coding-string
+ (with-current-buffer (mm-handle-buffer mime)
+ (buffer-string))
+ charset t))
+
+ ;; Parse the body
+ (cons code (json-read-from-string body))))))
+
+(cl-defun olc-http-request-json (url &key (timeout 2))
+ "Perform an http request for URL with timeout TIMEOUT.
+
+Returns the result of the request, parsed as JSON."
+ (cl-check-type url stringp)
+ (with-current-buffer
+ (url-retrieve-synchronously url t nil timeout)
+ (olc-http-parse-json)))
(cl-defun olc-shorten-compound (code &key (limit 4) (zoom '(1 18)))
"Attempt to shorten CODE with a geographic reference.
@@ -643,17 +703,14 @@ faster.
(catch 'result
(while (< zoom-lo zoom-hi)
(let* ((zoom (floor (+ zoom-lo zoom-hi) 2))
- (resp (request-response-data
- (request
- (olc-nominatim-endpoint "reverse")
- :params `((lat . ,(olc-area-lat area))
- (lon . ,(olc-area-lon area))
- (zoom . ,zoom)
- (format . "json"))
- :parser #'json-read
- :sync t)))
+ (resp (cdr (olc-http-request-json
+ (olc-nominatim-endpoint
+ "reverse"
+ :params `((lat . ,(olc-area-lat area))
+ (lon . ,(olc-area-lon area))
+ (zoom . ,zoom))))))
(tmp-code
- (when resp
+ (when (and (assq 'lon resp) (assq 'lat resp))
(olc-shorten code
(string-to-number (alist-get 'lat resp))
(string-to-number (alist-get 'lon resp))
@@ -663,7 +720,7 @@ faster.
;; If resp is nil, then there's no point in going further
- (if (null resp)
+ (if (null tmp-code)
(setq zoom-lo zoom-hi)
;; Keep the shortest code we see that has at most limit
@@ -740,10 +797,7 @@ not specified, the reference is assumed to be embedded into CODE.
If FORMAT is `area' (the default), the returned value is an full
open location code. If FORMAT is `latlon' it is a list (LATITUDE
LONGITUDE) representing the center of the location."
- ;; Make sure we can do requests
(save-match-data
- (unless (fboundp 'request) (signal 'void-function '(request)))
-
;; Check types (defer check of ref)
(cl-check-type code stringp)
(cl-check-type format (member latlon area))
@@ -759,23 +813,21 @@ LONGITUDE) representing the center of the location."
;; If the code is full then return it
(if (olc-is-full code)
(olc-recover code 0 0 :format format)
- (let ((resp (request (olc-nominatim-endpoint "search")
- :params `((q . ,ref)
- (format . "json")
- (limit . 1))
- :parser #'json-read
- :sync t)))
+ (let ((resp (olc-http-request-json
+ (olc-nominatim-endpoint "search"
+ :params `((q . ,ref)
+ (limit . 1))))))
;; Check that we got a response
- (unless (eq 200 (request-response-status-code resp))
+ (unless (eq 200 (car resp))
(signal 'olc-recover-error-reference-search-failed
(list code ref)))
- (unless (> (length (request-response-data resp)) 0)
+ (unless (> (length (cdr resp)) 0)
(signal 'olc-recover-error-reference-not-found
(list code ref)))
- (let* ((data (elt (request-response-data resp) 0))
+ (let* ((data (elt (cdr resp) 0))
(lat (alist-get 'lat data))
(lon (alist-get 'lon data)))
@@ -793,4 +845,10 @@ LONGITUDE) representing the center of the location."
(provide 'olc)
+;;; Local Variables:
+;;; change-log-default-name: "CHANGELOG"
+;;; sentence-end-double-space: nil
+;;; indent-tabs-mode: nil
+;;; End:
+
;;; olc.el ends here
diff --git a/olc.info b/olc.info
index 302d78a7f8fcd7887f441a76835ff40c5526ec00..012450679b05ad7f249feaa4b7946f6d485da9e5 100644
--- a/olc.info
+++ b/olc.info
@@ -192,22 +192,28 @@ Errors
parent of the various recovery errors raised by ‘olc-recover’ and
‘olc-recover-compound’.
-‘olc-recover-error-geocoding-request’
- The messags is ‘Reference location search failed’. Raised when
- geographical search fails due to an error at the HTTP layer. The
+‘olc-recover-error-reference-search-failed’
+ The message is ‘Reference location search failed’. Raised when
+ geographical search fails due to an error from the server. The
associated data is (CODE, REF) where REF is the reference being
searched.
-‘olc-recover-error-geocoding-not-found’
- The messags is ‘Reference location not found’. Raised when
+‘olc-recover-error-reverejce-not-found’
+ The message is ‘Reference location not found’. Raised when
geographical search returns no result. The associated data is
(CODE, REF) where REF is the reference being searched.
-‘olc-recover-error-geocoding-invalid’
- The messags is ‘Invalid reference location’. Raised when
+‘olc-recover-error-invalid-reference’
+ The message is ‘Invalid reference location’. Raised when
geographical search returns an invalid result. The associated data
is (CODE, REF) where REF is the reference being searched.
+‘olc-http-error’
+ The message is ‘Error retrieving or parsing http request’. Raised
+ when an http response cannot be parsed. Note that http requests
+ that fail at the network layer, e.g. due to name resolution
+ issues, will result in a standard error, not an olc-specific one.
+
File: olc.info, Node: Functions, Next: Index, Prev: Errors, Up: Top
@@ -320,10 +326,10 @@ Functions
(olc-recover-compound "M24Q+89" "Mutitjulu" :format 'latlon)
⇒ (-25.344187500000004 131.0384375)
- This function requires the ‘request’ package to be installed, and
- uses the OpenStreetMap API to convert the geographical reference to
- coordinates. Please make sure you follow the acceptable use policy
- for the API (e.g., one request per second, tops, allowed).
+ This function uses the OpenStreetMap API to convert the
+ geographical reference to coordinates. Please make sure you follow
+ the acceptable use policy for the API (e.g., one request per
+ second, tops, allowed).
-- Function: olc-is-valid code &key compound
Returns non-‘nil’ if CODE is a valid open location code. If
@@ -385,8 +391,8 @@ Node: Data types1146
Node: olc-area1524
Node: olc-parse2452
Node: Errors3682
-Node: Functions7622
-Node: Index13947
+Node: Functions7931
+Node: Index14200
End Tag Table
diff --git a/olc.texi b/olc.texi
index 1194022b7a828d2060f321d1926bb33ad31c65c1..e7ed7b93ff6d1db61c53132cbd345c5f3e46c171 100644
--- a/olc.texi
+++ b/olc.texi
@@ -204,24 +204,30 @@ the code being recovered as its first element. This is the parent of
the various recovery errors raised by @code{olc-recover} and
@code{olc-recover-compound}.
-@item olc-recover-error-geocoding-request
-The messags is @samp{Reference location search failed}. Raised when
-geographical search fails due to an error at the HTTP layer. The
+@item olc-recover-error-reference-search-failed
+The message is @samp{Reference location search failed}. Raised when
+geographical search fails due to an error from the server. The
associated data is (@var{code}, @var{ref}) where @var{ref} is the
reference being searched.
-@item olc-recover-error-geocoding-not-found
-The messags is @samp{Reference location not found}. Raised when
+@item olc-recover-error-reverejce-not-found
+The message is @samp{Reference location not found}. Raised when
geographical search returns no result. The associated data is
(@var{code}, @var{ref}) where @var{ref} is the reference being
searched.
-@item olc-recover-error-geocoding-invalid
-The messags is @samp{Invalid reference location}. Raised when
+@item olc-recover-error-invalid-reference
+The message is @samp{Invalid reference location}. Raised when
geographical search returns an invalid result. The associated data is
(@var{code}, @var{ref}) where @var{ref} is the reference being
searched.
+@item olc-http-error
+The message is @samp{Error retrieving or parsing http request}. Raised
+when an http response cannot be parsed. Note that http requests that
+fail at the network layer, e.g. due to name resolution issues, will
+result in a standard error, not an olc-specific one.
+
@end table
@node Functions,Index,Errors,Top
@@ -367,10 +373,9 @@ location.
@end group
@end example
-This function requires the @code{request} package to be installed, and
-uses the OpenStreetMap API to convert the geographical reference to
-coordinates. Please make sure you follow the acceptable use policy for
-the API (e.g., one request per second, tops, allowed).
+This function uses the OpenStreetMap API to convert the geographical
+reference to coordinates. Please make sure you follow the acceptable
+use policy for the API (e.g., one request per second, tops, allowed).
@end defun
@defun olc-is-valid code &key compound
@@ -404,3 +409,8 @@ invalid codes.
@printindex fn
@bye
+
+@c Local Variables:
+@c change-log-default-name: "CHANGELOG"
+@c End:
+
diff --git a/test/olctest.el b/test/olctest.el
index cc1ec394f02ddc62fa226842a739044176e80d3c..42e6ecdff52634cb0fb6421adbb7a069c789b02a 100644
--- a/test/olctest.el
+++ b/test/olctest.el
@@ -262,7 +262,9 @@
(olctest-equal :act (olc-shorten-compound "546FWWM2+F6")
:exp "WWM2+F6 Adamstown, Pitcairn")
- ))
+
+ (olctest-equal :act (olc-shorten-compound "22QQ22QQ+QQ")
+ :exp "22QQ22QQ+QQ")))
(defun olctest-issue-3 ()
@@ -487,25 +489,25 @@
(olc-recover-compound "22+ Nowhere Special, Pitcairn"))
(let ((olc-nominatim-url "https://invalid.domain/nominatim"))
- (olctest-assert-error (:exp ((olc-recover-error-reference-search-failed
- "22+" "Sweden")) :msg "R2")
+ (olctest-assert-error (:exp ((error "invalid.domain/443 Name or service not known"))
+ :msg "R2")
(olc-recover-compound "22+ Sweden")))
))
(defun olctest-issue-5 ()
(olctest-testcase "local:issue-5"
- (olctest-string= :exp "https://nominatim.openstreetmap.org/search"
+ (olctest-string= :exp "https://nominatim.openstreetmap.org/search?format=json"
:act (olc-nominatim-endpoint "search")
:msg "1")
(let ((olc-nominatim-url "https://nominatim.invalid"))
- (olctest-string= :exp "https://nominatim.invalid/search"
+ (olctest-string= :exp "https://nominatim.invalid/search?format=json"
:act (olc-nominatim-endpoint "search")
:msg "2"))
(let ((olc-nominatim-url "https://nominatim.invalid/"))
- (olctest-string= :exp "https://nominatim.invalid/reverse"
+ (olctest-string= :exp "https://nominatim.invalid/reverse?format=json"
:act (olc-nominatim-endpoint "reverse")
:msg "3"))))
@@ -577,3 +579,9 @@
(error (message (format "error: %s %s" (car err) (cdr err))) nil))
0 1)))
+
+;;; Local Variables:
+;;; change-log-default-name: "CHANGELOG"
+;;; End:
+
+;;; olctest.el ends here