mirror of https://codeberg.org/cage/tinmop/
- fixed, again fs:dirp;
- fixed iri parser (parses correctly IRI like mailto:...).
This commit is contained in:
parent
61c39b6c62
commit
6690a1b6f7
|
@ -166,8 +166,9 @@
|
|||
(nix:s-isreg (nix:stat-mode (nix:stat path))))
|
||||
|
||||
(defun dirp (path)
|
||||
(and (nix:stat path)
|
||||
(nix:s-isdir (nix:stat-mode (nix:stat path)))))
|
||||
(ignore-errors
|
||||
(and (nix:stat path)
|
||||
(nix:s-isdir (nix:stat-mode (nix:stat path))))))
|
||||
|
||||
(defun split-path-elements (path)
|
||||
(cl-ppcre:split *directory-sep-regexp* path))
|
||||
|
|
|
@ -83,8 +83,10 @@
|
|||
(defrule scheme (and alpha (* (or alpha digit "+" "-" "." )))
|
||||
(:text t))
|
||||
|
||||
(defrule ihier-part (and iauthority-start iauthority)
|
||||
(:function second))
|
||||
(defrule ihier-part (or (and iauthority-start iauthority ipath-abempty)
|
||||
ipath-absolute ; text
|
||||
ipath-rootless ;text
|
||||
ipath-empty)) ;text
|
||||
|
||||
(defrule user-credentials (and iuserinfo credential-delim)
|
||||
(:function first))
|
||||
|
@ -169,21 +171,28 @@
|
|||
(:text t))
|
||||
|
||||
(defun extract-fields-from-absolute-iri (parsed)
|
||||
(let ((authority (third parsed)))
|
||||
(list (first parsed) ; scheme
|
||||
(first authority) ; user-credentials
|
||||
(second authority) ; host
|
||||
(third authority) ; port
|
||||
(fourth parsed) ; path
|
||||
(fifth parsed) ; iquery
|
||||
(sixth parsed)))) ; ifragment
|
||||
(let* ((scheme (first parsed))
|
||||
(ihier-part (third parsed))
|
||||
(authority (when (consp ihier-part)
|
||||
(second ihier-part)))
|
||||
(user-credentials (first authority))
|
||||
(host (second authority))
|
||||
(port (third authority))
|
||||
(ipath (if (consp ihier-part)
|
||||
(third ihier-part)
|
||||
ihier-part))
|
||||
(iquery (fourth parsed))
|
||||
(ifragment (fifth parsed)))
|
||||
(list scheme
|
||||
user-credentials
|
||||
host
|
||||
port
|
||||
ipath
|
||||
iquery
|
||||
ifragment)))
|
||||
|
||||
(defrule iri (and scheme ":"
|
||||
ihier-part
|
||||
(or ipath-abempty
|
||||
ipath-absolute
|
||||
ipath-noscheme
|
||||
ipath-empty)
|
||||
(? iquery)
|
||||
(? ifragment))
|
||||
(:function extract-fields-from-absolute-iri))
|
||||
|
|
|
@ -61,7 +61,11 @@
|
|||
("http://" .
|
||||
("http" nil nil nil nil nil nil))
|
||||
("http" .
|
||||
(nil nil nil nil "http" nil nil))))
|
||||
(nil nil nil nil "http" nil nil))
|
||||
("tel:+31-thisiisnotanumber" .
|
||||
("tel" nil nil nil "+31-thisiisnotanumber" nil nil))
|
||||
("mailto:name@localhost.localdomain" .
|
||||
("mailto" nil nil nil "name@localhost.localdomain" nil nil))))
|
||||
|
||||
(deftest test-parsing (iri-suite)
|
||||
(loop for (a . b) in *test-cases* do
|
||||
|
|
|
@ -52,9 +52,6 @@
|
|||
(nil nil nil nil "http" nil nil))
|
||||
("http://" .
|
||||
("http" nil nil nil nil nil nil))
|
||||
;; are these valid URI?
|
||||
;; ("tel:+31-641044153" .
|
||||
;; ("tel" nil nil "+31-641044153" nil nil))
|
||||
;; ("http:" .
|
||||
;; ("http" nil nil nil nil nil))
|
||||
("ldap://[2001:db8::7]/c=GB?objectClass?one" .
|
||||
|
|
|
@ -17,6 +17,8 @@
|
|||
|
||||
(in-package :uri-parser)
|
||||
|
||||
;; NOTE: the parser is broken, use :iri-parser, instead
|
||||
|
||||
(define-constant +segment-separator+ "/" :test #'string=)
|
||||
|
||||
(defrule alpha (character-ranges (#\a #\z) (#\A #\Z))
|
||||
|
|
Loading…
Reference in New Issue