Compare commits

..

5 Enmetoj

Author SHA1 Message Date
Jaidyn Ann 7807afece2 Replace cl-strings with split-sequence
… which is already pulled in as an indirect
dependency, anyway.
2024-05-29 22:03:08 -05:00
Jaidyn Ann 43cc123057 Fix URL-substitions with some tags (<link>) 2024-05-29 21:55:59 -05:00
Jaidyn Ann 93022814fd Fix crunching of mirrored filenames
Previously, a “!” was enough to throw off the
crunching; that’s fixed now! Huzzah!
2024-05-29 21:55:08 -05:00
Jaidyn Ann 55362c7075 Update URL-parsing tests
Also modifies a test URL to have a question-mark.
2024-05-29 21:27:03 -05:00
Jaidyn Ann d9bead00b4 Fix error with URL-parsing
Query parameters (post-?) were previously ignored.
2024-05-29 21:26:38 -05:00
3 changed files with 44 additions and 13 deletions

View File

@ -64,7 +64,7 @@ For example:
(linked-urls dom :tags tags)))) (linked-urls dom :tags tags))))
;; lquery-dom alist list → nil ;; lquery-dom alist list → nil
(defun substitute-urls (dom substitution-alist &key (tags '("img"))) (defun substitute-urls (dom substitution-alist &key (tags *default-tags*))
"Replace SRC or HREF attributes of certain tags in an LQuery DOM, based on a "Replace SRC or HREF attributes of certain tags in an LQuery DOM, based on a
substitution associative list. The substitution alist is made up of cons-cells substitution associative list. The substitution alist is made up of cons-cells
mapping replacee URLs to substition URLs. mapping replacee URLs to substition URLs.
@ -89,13 +89,12 @@ among the given tags."
"Given a URL, return the corresponding path we would download it to, were we "Given a URL, return the corresponding path we would download it to, were we
to mirror it." to mirror it."
(let* ((url (quri:uri url)) (let* ((url (quri:uri url))
(path (quri:uri-path url))) (path (uri-path+query url)))
(pathname (pathname
(format nil "~@[~A/~]~A/~A~@[.~A~]" (format nil "~@[~A/~]~A/~A"
base-dir base-dir
(quri:uri-host url) (quri:uri-host url)
(pathname-name path) (pathname-leaf path)))))
(pathname-type path)))))
@ -126,10 +125,11 @@ HREF and SRC attributes."
"Set the SRC or HREF attribute of an LQuery node (based on which attribute is "Set the SRC or HREF attribute of an LQuery node (based on which attribute is
already set)." already set)."
(and node (and node
(if (lquery-funcs:attr node "src") (cond ((lquery-funcs:attr node "src")
(lquery-funcs:attr node "src" url)) (lquery-funcs:attr node "src" url))
(if (lquery-funcs:attr node "href") ((lquery-funcs:attr node "href")
(lquery-funcs:attr node "href" url)))) (lquery-funcs:attr node "href" url))
('T node))))
@ -139,7 +139,7 @@ already set)."
(defun http-fetch (url path) (defun http-fetch (url path)
"Download a URL to a path; if successful, returns the pathname. Otherwise, NIL." "Download a URL to a path; if successful, returns the pathname. Otherwise, NIL."
(handler-case (handler-case
(and (dexador:fetch (url-encode-uri (quri:uri url)) path) (and (dexador:fetch (url-encode-uri url) path)
(pathname path)) (pathname path))
(cl-user::file-exists () (cl-user::file-exists ()
path) path)
@ -154,7 +154,7 @@ already set)."
(quri:uri-scheme uri) (quri:uri-scheme uri)
(quri:uri-host uri) (quri:uri-host uri)
(uri-explicit-port uri) (uri-explicit-port uri)
(url-encode-path (quri:uri-path uri))))) (url-encode-path (uri-path+query uri)))))
;; string → string ;; string → string
(defun url-encode-path (path) (defun url-encode-path (path)
@ -178,3 +178,14 @@ That is, 443 is implied by HTTPS, so nil is returned; but 998 wouldnt be impl
(and (equal scheme "http") (and (equal scheme "http")
(eq port 80))) (eq port 80)))
port))) port)))
;; quri-uri → string
(defun uri-path+query (uri)
"Return everything in a URI after the TLD — that is, both the path _and_ the query."
(format nil "~A~@[?~A~]" (quri:uri-path uri) (quri:uri-query uri)))
;; pathname → string
(defun pathname-leaf (pathname)
"Given a pathname, return the entirety of the file leaf.
That is, everything following the last directory name."
(car (last (split-sequence:split-sequence #\/ (namestring pathname)))))

View File

@ -70,11 +70,17 @@
(mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt" (mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt"
:base-dir #p"base/"))) :base-dir #p"base/")))
(define-test mirrored-pathname.esperanto-question (:tags '(base))
(assert-equal
#p"base/invalid.tld/?!?! ĉu ne?!?!.png"
(mirror-img::mirrored-pathname "https://invalid.tld/dir/s/d/ askldjas/ asldkja/?!?! ĉu ne?!?!.png"
:base-dir #p"base/")))
(define-test linked-urls (:tags '(dom)) (define-test linked-urls (:tags '(dom))
(assert-equal (assert-equal
'("http://localhost:4242/res/img/b/fireplace.jpg" '("http://localhost:4242/res/img/b/fireplace.jpg"
"http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/more_calming.jpg" "http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/more_calming.jpg"
"http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas%3F!/classy_fireplace.jpg" "http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas?!/classy_fireplace.jpg"
"http://localhost:4242/res/img/level-2/café.jpg" "http://localhost:4242/res/img/level-2/café.jpg"
"http://localhost:4242/res/img/merry christmas!!! ^_^.jpg" "http://localhost:4242/res/img/merry christmas!!! ^_^.jpg"
"http://localhost:4242/res/style.css" "http://localhost:4242/res/style.css"
@ -94,6 +100,11 @@
"/images%21/dad%20alive.jpg" "/images%21/dad%20alive.jpg"
(mirror-img::url-encode-path "/images!/dad alive.jpg"))) (mirror-img::url-encode-path "/images!/dad alive.jpg")))
(define-test url-encode-path.question (:tags '(util))
(assert-equal
"/images%21/%3F%C4%89u_ne%20tio%20sufi%C4%89e%3F%21.jpg"
(mirror-img::url-encode-path "/images!/?ĉu_ne tio sufiĉe?!.jpg")))
(define-test uri-explicit-port.http80 (:tags '(util)) (define-test uri-explicit-port.http80 (:tags '(util))
(assert-eq (assert-eq
nil nil
@ -114,3 +125,12 @@
nil nil
(mirror-img::uri-explicit-port (quri:uri "https://xwx.moe:443/bird.png")))) (mirror-img::uri-explicit-port (quri:uri "https://xwx.moe:443/bird.png"))))
(define-test pathname-leaf.simple (:tags '(util))
(assert-equal
"apple_berries.png"
(mirror-img::pathname-leaf #p"/mom/dad/apple/laksdjal/apple_berries.png")))
(define-test pathname-leaf.very-weird (:tags '(util))
(assert-equal
" lak -!?ĉ_berries.png"
(mirror-img::pathname-leaf #p"/mom/dad?!?Ljla asdasd'' aslkdjĉ/apple/laksdjal/ lak -!?ĉ_berries.png")))

View File

@ -62,7 +62,7 @@
<p>Three…</p> <p>Three…</p>
<figure> <figure>
<img src="http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas%3F!/classy_fireplace.jpg"> <img src="http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas?!/classy_fireplace.jpg">
<figcaption><em>Youre surrounded by your superiors.</em> <figcaption><em>Youre surrounded by your superiors.</em>
<a href="https://www.pixiv.net/artworks/115188449"> <a href="https://www.pixiv.net/artworks/115188449">
🔗 🔗